Use List String for module name, add abstraction for loading files (prep for LSP)

src/Lib/ProcessModule.newt

@@ -0,0 +1,154 @@
+module Lib.ProcessModule
+
+import Prelude
+import Serialize
+import Lib.Types
+import Lib.Common
+import Lib.Syntax
+import Lib.ProcessDecl
+import Lib.TopContext
+import Lib.Tokenizer
+import Data.SortedMap
+import Lib.Parser.Impl
+import Lib.Parser
+import Data.List1
+import Lib.Elab
+
+-- declare internal primitives
+addPrimitives : M Unit
+addPrimitives = do
+  processDecl primNS (PType emptyFC "Int" Nothing)
+  processDecl primNS (PType emptyFC "String" Nothing)
+  processDecl primNS (PType emptyFC "Char" Nothing)
+  setDef (QN primNS "PiType") emptyFC (Erased emptyFC) (PrimFn "(h0, h1) => ({ tag: \"PiType\", h0, h1 });" (S (S Z)) Nil) Nil
+
+
+record FileSource where
+  getFile : FC → String → M (String × String)
+
+parseDecls : String → Operators → TokenList → SnocList Decl → M (List Decl × Operators)
+parseDecls fn ops Nil acc = pure (acc <>> Nil, ops)
+parseDecls fn ops toks@(first :: _) acc =
+  case partialParse fn (sameLevel parseDecl) ops toks of
+    Left (err, toks) => do
+      putStrLn $ showError "" err
+      addError err
+      parseDecls fn ops (recover toks) acc
+    Right (decl,ops,toks) => parseDecls fn ops toks (acc :< decl)
+  where
+    recover : TokenList → TokenList
+    recover Nil = Nil
+    -- skip to top token, but make sure there is progress
+    recover (tok :: toks) = if tok.bounds.startCol == 0 && tok.bounds /= first.bounds
+      then (tok :: toks)
+      else recover toks
+
+moduleHash : String → List (List String) → M String
+moduleHash src imports = do
+  srcHash <- liftIO $ checksum src
+  top <- getTop
+  let mods = mapMaybe (\x => lookupMap' x top.modules) imports
+  let modHashes = map (\x => x.csum) mods
+  liftIO $ checksum $ fastConcat $ srcHash :: modHashes
+
+importToName : Import → List String
+importToName  (MkImport fc (_,name)) = split name "."
+
+importHints : List TopEntry → M Unit
+importHints Nil = pure MkUnit
+importHints (entry :: entries) = do
+  when (elem Hint entry.eflags) $ \ _ => addHint entry.name
+  importHints entries
+
+processModule : FC → FileSource → List String → List String → M String
+processModule importFC repo stk modns = do
+  top <- getTop
+  -- let modns = (snoc ns nm)
+  let name = joinBy "." modns
+  let (Nothing) = lookupMap modns top.modules | _ => pure ""
+  -- dummy entry for processing
+  modifyTop [modules := updateMap modns (emptyModCtx "") top.modules]
+
+  let fn = joinBy "/" modns ++ ".newt"
+  -- TODO now we can pass in the module name...
+  (fn,src) <- repo.getFile importFC fn
+  let (Right toks) = tokenise fn src
+    | Left err => throwError err
+
+  let (Right ((nameFC, modName), ops, toks)) = partialParse fn parseModHeader top.ops toks
+    | Left (err, toks) => throwError err
+
+  log 1 $ \ _ => "scan imports for module \{modName}"
+  let (True) = modns == split modName "."
+    | _ => throwError $ E nameFC "module name \{show modName} doesn't match file name \{show fn}"
+
+  let (Right (imports, ops, toks)) = partialParse fn parseImports ops toks
+    | Left (err, toks) => throwError err
+
+  let importNames = map importToName imports
+
+  imported <- for imports $ \case
+    MkImport fc (nameFC,name') => do
+      let imp = split name' "."
+      when (elem name' stk) $ \ _ => error nameFC "import loop \{show name} → \{show name'}"
+      processModule nameFC repo (name :: stk) imp
+      pure $ imp
+  let imported = snoc imported primNS
+  srcSum <- liftIO $ checksum src
+  csum <- moduleHash srcSum imported
+
+  putStrLn "module \{modName}"
+  top <- getTop
+  -- TODO we need a flag on this so `make newt3.js` properly tests self-compile
+  (Nothing) <- loadModule modns csum
+    | Just mod => do
+      let modules = updateMap modns mod top.modules
+
+      -- FIXME - we don't want stray operators in a module.
+      -- inject module ops into top
+      let ops = foldMap const top.ops $ toList mod.ctxOps
+      modifyTop [modules := modules; ops := ops ]
+      pure src  -- why am I returning this?
+
+  log 1 $ \ _ => "MODNS " ++ show modns
+  top <- getTop
+  (decls, ops) <- parseDecls fn top.ops toks Lin
+
+  top <- getTop
+  let freshMC = MC emptyMap Nil 0 CheckAll
+  -- set imported, mod, freshMC, ops  before processing
+  modifyTop [ imported := imported
+            ; hints := emptyMap
+            ; ns := modns
+            ; defs := emptyMap
+            ; metaCtx := freshMC
+            ; ops := ops
+            ]
+  for imported $ \ ns => do
+    let (Just mod) = lookupMap' ns top.modules | _ => error emptyFC "namespace \{show ns} missing"
+    importHints (listValues mod.modDefs)
+
+  log 1 $ \ _ => "process Decls"
+  traverse (tryProcessDecl src modns) (collectDecl decls)
+
+  -- update modules with result, leave the rest of context in case this is top file
+  top <- getTop
+
+  let mod = MkModCtx csum top.defs top.metaCtx top.ops importNames
+  if stk /= Nil && length' top.errors == 0
+    then dumpModule modns src mod
+    else pure MkUnit
+
+  let modules = updateMap modns mod top.modules
+  modifyTop [modules := modules]
+
+  logMetas $ reverse $ listValues top.metaCtx.metas
+  let (Nil) = top.errors
+    | errors => throwError $ E importFC "Failed to compile module \{joinBy "." modns}"
+  pure src
+  where
+    tryProcessDecl : String → List String → Decl → M Unit
+    tryProcessDecl src ns decl = do
+      (Left err) <- tryError $ processDecl ns decl | _ => pure MkUnit
+      putStrLn $ showError src err
+      addError err

src/Lib/Types.newt

@@ -402,7 +402,7 @@ record ModContext where
   modMetaCtx : MetaContext
   -- longer term maybe drop this, put the operator decls in ctxDefs and collect them on import
   ctxOps : Operators
-  modDeps : List QName
+  modDeps : List (List String)
 
 -- Top level context.
 -- Most of the reason this is separate is to have a different type

src/Lib/Util.newt

@@ -32,27 +32,20 @@ splitTele = go Nil
     go ts (Pi fc nm icit quant t u) = go (MkBinder fc nm icit quant t :: ts) u
     go ts tm = (tm, reverse ts)
 
-
-
-getBaseDir : String → FC → String → M (String × QName)
+-- given a filename and split module name, return the base path or an error
+getBaseDir : String → FC → List String → M String
 getBaseDir fn fc modName = do
-  let (path, modName') = unsnoc $ split1 modName "."
-  let parts = split1 fn "/"
-  let (dirs,file) = unsnoc parts
-  let (name, ext) = splitFileName file
-
-  let parts = split1 fn "/"
-  let (dirs,file) = unsnoc parts
-  let (path, modName') = unsnoc $ split1 modName "."
-  unless (modName' == name) $ \ _ => error fc "module name \{modName'} doesn't match \{name}"
-  let (Right base) = baseDir (Lin <>< dirs) (Lin <>< path)
+  let path = fst $ splitFileName fn
+  let dirs = split path "/"
+  let (Right base) = baseDir (Lin <>< dirs) (Lin <>< modName)
     | Left err => error fc err
   let base = if base == "" then "." else base
-  pure (base, QN path modName')
+  pure base
   where
     baseDir : SnocList String -> SnocList String -> Either String String
     baseDir dirs Lin = Right $ joinBy "/" (dirs <>> Nil)
     baseDir (dirs :< d) (ns :< n) = if d == n
       then baseDir dirs ns
-      else Left "module path doesn't match directory"
-    baseDir Lin _ = Left "module path doesn't match directory"
+      else Left "module name \{joinBy "." modName} doesn't match path \{fn}"
+    baseDir Lin _ = Left "module name \{joinBy "." modName} doesn't match path \{fn}"
+