From ad4dce9d0e723cd7efb46f96c22a89347a987b96 Mon Sep 17 00:00:00 2001 From: Steve Dunham Date: Wed, 11 Feb 2026 19:46:04 -0800 Subject: [PATCH] Use `List String` for module name, add abstraction for loading files (prep for LSP) --- src/Lib/ProcessModule.newt | 154 +++++++++++++++++++++++++++++++++ src/Lib/Types.newt | 2 +- src/Lib/Util.newt | 25 ++---- src/Main.newt | 172 ++++--------------------------------- src/Prelude.newt | 2 + src/Serialize.newt | 10 +-- 6 files changed, 187 insertions(+), 178 deletions(-) create mode 100644 src/Lib/ProcessModule.newt diff --git a/src/Lib/ProcessModule.newt b/src/Lib/ProcessModule.newt new file mode 100644 index 0000000..bd6aacc --- /dev/null +++ b/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 diff --git a/src/Lib/Types.newt b/src/Lib/Types.newt index 6558bac..4482965 100644 --- a/src/Lib/Types.newt +++ b/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 diff --git a/src/Lib/Util.newt b/src/Lib/Util.newt index 618c809..5e0014b 100644 --- a/src/Lib/Util.newt +++ b/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}" + diff --git a/src/Main.newt b/src/Main.newt index a7c9c5f..88e7325 100644 --- a/src/Main.newt +++ b/src/Main.newt @@ -11,6 +11,7 @@ import Lib.Util import Lib.Parser.Impl import Lib.Prettier import Lib.ProcessDecl +import Lib.ProcessModule import Lib.Tokenizer import Lib.TopContext import Lib.Types @@ -20,6 +21,13 @@ import Node import Serialize import Revision +dirFileSource : String → FileSource +dirFileSource base = MkFileSource $ \fc fn => do + let fn = base ++ "/" ++ fn + (Right src) <- liftIO {M} $ readFile fn + | Left err => throwError $ E fc "error reading \{fn}: \{show err}" + pure (fn,src) + -- For editors, dump some information about the context (fc, name, type) jsonTopContext : M Json jsonTopContext = do @@ -35,16 +43,6 @@ jsonTopContext = do :: ("type", toJson (render 80 $ pprint Nil type) ) :: Nil) -dumpContext : TopContext -> M Unit -dumpContext top = do - putStrLn "Context:" - go $ listValues top.defs - putStrLn "---" - where - go : List TopEntry -> M Unit - go Nil = pure MkUnit - go (x :: xs) = putStrLn " \{show x}" >> go xs - writeSource : String -> M Unit writeSource fn = do docs <- compile @@ -57,139 +55,6 @@ writeSource fn = do | Left err => throwError $ E (MkFC fn $ MkBounds 0 0 0 0) err pure MkUnit - -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 - -importHints : List TopEntry → M Unit -importHints Nil = pure MkUnit -importHints (entry :: entries) = do - when (elem Hint entry.eflags) $ \ _ => addHint entry.name - importHints entries - -importToQN : Import → QName -importToQN (MkImport fc (_,name)) = uncurry QN $ unsnoc $ split1 name "." - --- New style loader, one def at a time -processModule : FC -> String -> List String -> QName -> M String -processModule importFC base stk qn@(QN ns nm) = do - top <- getTop - -- TODO make top.loaded a List QName - 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 "/" (base :: ns)) ++ "/" ++ nm ++ ".newt" - (Right src) <- liftIO {M} $ readFile fn - | Left err => throwError $ E importFC "error reading \{fn}: \{show err}" - 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 ns = split modName "." - let (path, modName') = unsnoc $ split1 modName "." - -- let bparts = split base "/" - let (True) = qn == QN path 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 importToQN imports - - imported <- for imports $ \case - MkImport fc (nameFC,name') => do - let (a,b) = unsnoc $ split1 name' "." - let qname = QN a b - when (elem name' stk) $ \ _ => error nameFC "import loop \{show name} -> \{show name'}" - processModule nameFC base (name :: stk) qname - pure $ split name' "." - 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 qn 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 ns) (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 qn 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 \{show qn}" - 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 - -- unwind the module part of the path name baseDir : SnocList String -> SnocList String -> Either String String baseDir dirs Lin = Right $ joinBy "/" (dirs <>> Nil) @@ -208,8 +73,8 @@ showErrors fn src = do throwError $ E (MkFC fn $ MkBounds 0 0 0 0) "Compile failed" pure MkUnit -invalidateModule : QName -> M Unit -invalidateModule (QN ns nm) = modifyTop [modules $= deleteMap (snoc ns nm)] +invalidateModule : List String -> M Unit +invalidateModule modname = modifyTop [modules $= deleteMap modname] -- processFile called on the top level file -- it sets up everything and then recurses into processModule @@ -229,14 +94,9 @@ processFile fn = do let (Right ((nameFC, modName), _, _)) = partialParse fn parseModHeader emptyMap toks | Left (err,toks) => throwError err - (base,qn) <- getBaseDir fn nameFC modName - - -- declare internal primitives - - 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 + let modns = split modName "." + base <- getBaseDir fn nameFC modns + addPrimitives top <- getTop let modules = updateMap primNS (MkModCtx "" top.defs (MC emptyMap Nil 0 CheckAll) top.ops Nil) top.modules @@ -247,9 +107,9 @@ processFile fn = do ; defs := emptyMap ] - invalidateModule qn - - src <- processModule emptyFC base Nil qn + invalidateModule modns + let repo = dirFileSource base + src <- processModule emptyFC repo Nil modns top <- getTop showErrors fn src diff --git a/src/Prelude.newt b/src/Prelude.newt index a287e3d..d96d457 100644 --- a/src/Prelude.newt +++ b/src/Prelude.newt @@ -953,3 +953,5 @@ pfunc fatalError : ∀ a. String → a := `(_, msg) => { throw new Error(msg) }` foldlM : ∀ m a e. {{Monad m}} → (a → e → m a) → a → List e → m a foldlM f a xs = foldl (\ ma b => ma >>= flip f b) (pure a) xs + +pfunc unsafePerformIO : ∀ a. IO a → a := `(a, f) => f().h1` diff --git a/src/Serialize.newt b/src/Serialize.newt index 49a214e..361a867 100644 --- a/src/Serialize.newt +++ b/src/Serialize.newt @@ -7,7 +7,7 @@ import Lib.Types import Data.SortedMap ModFile : U -ModFile = (String × List TopEntry × List (String × OpDef) × List (QName × MetaEntry) × List QName) +ModFile = (String × List TopEntry × List (String × OpDef) × List (QName × MetaEntry) × List (List String)) pfunc checksum uses (MkIORes) : String → IO String := `(a) => (w) => { const arr = new TextEncoder().encode(a); @@ -32,9 +32,9 @@ pfunc dumpModFile uses (MkIORes MkUnit): String → ModFile → IO Unit := `(fn, -- for now, include src and use that to see if something changed -dumpModule : QName → String → ModContext → M Unit +dumpModule : List String → String → ModContext → M Unit dumpModule qn src mod = do - let fn = "build/\{show qn}.newtmod" + let fn = "build/\{joinBy "." qn}.newtmod" let csum = mod.csum let defs = listValues mod.modDefs let ops = toList mod.ctxOps @@ -54,9 +54,9 @@ pfunc readModFile uses (MkIORes Just Nothing): String → IO (Maybe ModFile) := } }` -loadModule : QName → String → M (Maybe ModContext) +loadModule : List String → String → M (Maybe ModContext) loadModule qn src = do - let fn = "build/\{show qn}.newtmod" + let fn = "build/\{joinBy "." qn}.newtmod" (Just (csum, defs, ops, mctx, deps)) <- liftIO {M} $ readModFile fn | _ => pure Nothing