wip

2024-10-05 06:07:21 +03:00 · 2018-10-29 15:43:32 -04:00 · 2018-10-29 15:43:32 -04:00 · a5b08d749c
commit a5b08d749c
parent 905d0741b8
8 changed files with 101 additions and 53 deletions
--- a/parser-typechecker/src/Unison/Builtin.hs
+++ b/parser-typechecker/src/Unison/Builtin.hs
@ -9,9 +9,11 @@ import           Control.Arrow ((&&&), second)
 import qualified Data.Map as Map
 import qualified Text.Megaparsec.Error as MPE
 import qualified Unison.ABT as ABT
+import           Unison.Codebase.Name (Name)
 import           Unison.DataDeclaration (DataDeclaration', EffectDeclaration')
 import qualified Unison.DataDeclaration as DD
 import qualified Unison.FileParser as FileParser
+import qualified Unison.Lexer as L
 import           Unison.Parser (Ann(..))
 import qualified Unison.Parser as Parser
 import           Unison.PrintError (prettyParseError)
@ -24,7 +26,6 @@ import qualified Unison.TypeParser as TypeParser
 import qualified Unison.Util.ColorText as Color
 import           Unison.Var (Var)
 import qualified Unison.Var as Var
-import qualified Unison.Lexer as L

 type Term v = Term.AnnotatedTerm v Ann
 type Type v = AnnotatedType v Ann
@ -76,6 +77,9 @@ builtinTerms =
              (r, typ) <- Map.toList builtins0 ]
  in (builtinDataAndEffectCtors ++ fns)

+lookupBuiltinTerm :: Var v => Name -> Maybe (Term v)
+lookupBuiltinTerm v = lookup (Var.named v) builtinTerms
+
 builtinDataAndEffectCtors :: forall v . Var v => [(v, Term v)]
 builtinDataAndEffectCtors = (mkConstructors =<< builtinDataDecls')
  where
--- a/parser-typechecker/src/Unison/Codebase.hs
+++ b/parser-typechecker/src/Unison/Codebase.hs
@ -114,3 +114,10 @@ sortedApproximateMatches q possible = sortOn score matches where

 branchExists :: Functor m => Codebase m v a -> Name -> m Bool
 branchExists codebase name = elem name <$> branches codebase
+
+branchToNames :: Codebase m v a -> Branch -> m (Names v a)
+branchToNames b = case head b of
+    Branch0 {..} ->
+      let terms = Map.fromList $ toList termNamespace
+      Names terms patterns types
+
--- a/parser-typechecker/src/Unison/Codebase/CommandLine.hs
+++ b/parser-typechecker/src/Unison/Codebase/CommandLine.hs
@ -124,9 +124,9 @@ main dir currentBranchName initialFile startRuntime toA codebase = do
      incompleteLine <- atomically . peekIncompleteLine $ lineQueue
      putStr $ "\r" ++ unpack branchName ++ "> " ++ incompleteLine

-    handleUnisonFile :: Runtime v -> Codebase IO v a -> PEnv v -> FilePath -> Text -> IO ()
-    handleUnisonFile runtime codebase penv filePath src = do
-      let Result notes r = parseAndSynthesizeFile penv filePath src
+    handleUnisonFile :: Runtime v -> Branch -> Codebase IO v a -> PEnv v -> FilePath -> Text -> IO ()
+    handleUnisonFile runtime branch codebase penv filePath src = do
+      let Result notes r = parseAndSynthesizeFile fqnLookup penv filePath src
      case r of
        Nothing -> do -- parsing failed
          Console.setTitle "Unison \128721"
--- a/parser-typechecker/src/Unison/Codebase/Watch.hs
+++ b/parser-typechecker/src/Unison/Codebase/Watch.hs
@ -4,37 +4,47 @@

 module Unison.Codebase.Watch where

-import           Control.Concurrent      (forkIO, threadDelay)
+import qualified Unison.Builtin                 as B
+import           Control.Concurrent             ( forkIO
+                                                , threadDelay
+                                                )
 import           Control.Concurrent.MVar
-import           Control.Concurrent.STM  (atomically)
-import           Control.Monad           (forever, void)
-import           Data.Foldable           (toList)
+import           Control.Concurrent.STM         ( atomically )
+import           Control.Exception              ( finally )
+import           Control.Monad                  ( forever
+                                                , void
+                                                )
+import           Data.Foldable                  ( toList )
 import           Data.IORef
-import           Data.List               (isSuffixOf)
-import qualified Data.Map                as Map
-import           Data.Text               (Text)
-import qualified Data.Text               as Text
+import           Data.List                      ( isSuffixOf )
+import qualified Data.Map                      as Map
+import           Data.Text                      ( Text )
+import qualified Data.Text                     as Text
 import qualified Data.Text.IO
-import           Data.Time.Clock         (UTCTime, diffUTCTime)
-import qualified System.Console.ANSI     as Console
-import           System.Directory        (canonicalizePath)
-import           System.FSNotify         (Event (Added, Modified), watchTree,
-                                          withManager)
-import qualified Unison.FileParsers      as FileParsers
-import qualified Unison.Parser           as Parser
-import qualified Unison.Parsers          as Parsers
-import           Control.Exception       (finally)
-import           System.Random           (randomIO)
-import           Unison.Codebase         (Codebase)
-import           Unison.Codebase.Runtime (Runtime (..))
-import qualified Unison.Codebase.Runtime as RT
-import           Unison.PrintError       (renderParseErrorAsANSI,
-                                          renderNoteAsANSI)
-import           Unison.Result           (Result (Result))
+import           Data.Time.Clock                ( UTCTime
+                                                , diffUTCTime
+                                                )
+import qualified System.Console.ANSI           as Console
+import           System.Directory               ( canonicalizePath )
+import           System.FSNotify                ( Event(Added, Modified)
+                                                , watchTree
+                                                , withManager
+                                                )
+import           System.Random                  ( randomIO )
+import           Unison.Codebase                ( Codebase )
+import           Unison.Codebase.Runtime        ( Runtime(..) )
+import qualified Unison.Codebase.Runtime       as RT
+import qualified Unison.FileParsers            as FileParsers
+import qualified Unison.Parser                 as Parser
+import qualified Unison.Parsers                as Parsers
+import           Unison.PrintError              ( renderParseErrorAsANSI
+                                                , renderNoteAsANSI
+                                                )
+import           Unison.Result                  ( Result(Result) )
 import           Unison.Util.Monoid
-import           Unison.Util.TQueue      (TQueue)
-import qualified Unison.Util.TQueue      as TQueue
-import           Unison.Var              (Var)
+import           Unison.Util.TQueue             ( TQueue )
+import qualified Unison.Util.TQueue            as TQueue
+import           Unison.Var                     ( Var )

 watchDirectory' :: FilePath -> IO (IO (FilePath, UTCTime))
 watchDirectory' d = do
@ -114,7 +124,7 @@ watcher initialFile dir runtime codebase = do
            print $ renderParseErrorAsANSI source parseError
          Right (env0, parsedUnisonFile) -> do
            let (Result notes' r) =
-                              FileParsers.synthesizeUnisonFile parsedUnisonFile
+                  FileParsers.synthesizeUnisonFile B.lookupBuiltinTerm parsedUnisonFile
                showNote notes =
                  intercalateMap "\n\n" (show . renderNoteAsANSI env0 source) notes
            putStrLn . showNote . toList $ notes'
--- a/parser-typechecker/src/Unison/FileParsers.hs
+++ b/parser-typechecker/src/Unison/FileParsers.hs
@ -48,22 +48,28 @@ convertNotes :: Typechecker.Notes v ann -> Seq (Note v ann)
 convertNotes (Typechecker.Notes es is) =
  (TypeError <$> es) <> (TypeInfo <$> is)

-parseAndSynthesizeFile :: Var v
-  => PEnv v -> FilePath -> Text
-  -> Result (Seq (Note v Ann)) (PrintError.Env, Maybe (UnisonFile v))
-parseAndSynthesizeFile penv filePath src = do
-  (errorEnv, parsedUnisonFile) <-
-      Result.fromParsing $ Parsers.parseFile filePath (unpack src) penv
-  let (Result notes' r) = synthesizeUnisonFile parsedUnisonFile
+parseAndSynthesizeFile
+  :: Var v
+  => PEnv v
+  -> (Name -> Maybe (Term v))
+  -> FilePath
+  -> Text
+  -> Result
+       (Seq (Note v Ann))
+       (PrintError.Env, Maybe (UnisonFile v))
+parseAndSynthesizeFile penv fqnLookup filePath src = do
+  (errorEnv, parsedUnisonFile) <- Result.fromParsing
+    $ Parsers.parseFile filePath (unpack src) penv
+  let (Result notes' r) = synthesizeUnisonFile fqnLookup parsedUnisonFile
  Result notes' $ Just (errorEnv, fst <$> r)

 synthesizeFile
  :: forall v
   . Var v
-  => UnisonFile v
-  -> (Name -> Maybe (Term v))
+  => (Name -> Maybe (Term v))
+  -> UnisonFile v
  -> Result (Seq (Note v Ann)) (Term v, Type v)
-synthesizeFile unisonFile fqnLookup
+synthesizeFile fqnLookup unisonFile
  = let
      (UnisonFile dds0 eds0 term) =
        UF.bindBuiltins B.builtinTerms B.builtinTypes unisonFile
@ -114,18 +120,22 @@ synthesizeFile unisonFile fqnLookup
     Result (convertNotes notes) ((t,) <$> mayType)

 synthesizeUnisonFile :: Var v
-                     => UnisonFile v
+                     => (Name -> Maybe (Term v))
+                     -> UnisonFile v
                     -> Result (Seq (Note v Ann)) (UnisonFile v, Type v)
-synthesizeUnisonFile unisonFile@(UnisonFile d e _t) = do
-  (t', typ) <- synthesizeFile unisonFile undefined
+synthesizeUnisonFile fqnLookup unisonFile@(UnisonFile d e _t) = do
+  (t', typ) <- synthesizeFile fqnLookup unisonFile
  pure $ (UnisonFile d e t', typ)

-serializeUnisonFile :: Var v => UnisonFile v
-                             -> Result (Seq (Note v Ann))
-                                       (UnisonFile v, Type v, ByteString)
-serializeUnisonFile unisonFile =
-  let r = synthesizeUnisonFile unisonFile
+serializeUnisonFile
+  :: Var v
+  => (Name -> Maybe (Term v))
+  -> UnisonFile v
+  -> Result (Seq (Note v Ann)) (UnisonFile v, Type v, ByteString)
+serializeUnisonFile fqnLookup unisonFile =
+  let r = synthesizeUnisonFile fqnLookup unisonFile
      f (unisonFile', typ) =
        let bs = runPutS $ flip evalStateT 0 $ Codecs.serializeFile unisonFile'
-        in (unisonFile', typ, bs)
-  in f <$> r
+        in  (unisonFile', typ, bs)
+  in  f <$> r
+
--- a/parser-typechecker/src/Unison/Names.hs
+++ b/parser-typechecker/src/Unison/Names.hs
@ -0,0 +1,16 @@
+module Unison.Names where
+
+import           Data.Map                       ( Map )
+import           Data.Text                      ( Text )
+import           Unison.Reference               ( Reference )
+import           Unison.Term                    ( AnnotatedTerm )
+import           Unison.Type                    ( AnnotatedType )
+
+type Name = Text
+
+data Names v a = Names
+  { termNames :: Map Name (AnnotatedTerm v a, AnnotatedType v a)
+  , patternNames :: Map Name (Reference, Int)
+  , typeNames :: Map Name Reference
+  }
+
--- a/parser-typechecker/tests/Unison/Test/Common.hs
+++ b/parser-typechecker/tests/Unison/Test/Common.hs
@ -52,6 +52,6 @@ parseAndSynthesizeAsFile filename s = do
  (errorEnv, file) <- Result.fromParsing
    $ Parsers.parseFile filename s Parser.penv0
  let (Result notes' r) =
-        FP.synthesizeFile file (\v -> lookup (Var.named v) B.builtinTerms)
+        FP.synthesizeFile B.lookupBuiltinTerm file
  Result notes' $ Just (errorEnv, r)

--- a/parser-typechecker/unison-parser-typechecker.cabal
+++ b/parser-typechecker/unison-parser-typechecker.cabal
@ -59,6 +59,7 @@ library
    Unison.Hashable
    Unison.Kind
    Unison.Lexer
+    Unison.Names
    Unison.Parser
    Unison.Parsers
    Unison.Path