dunham/newt
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

Keep track of autos to be solved, shaves about 12% off of Elab.newt processing time

Browse Source
This commit is contained in:
Steve Dunham
2025-04-05 21:25:53 -07:00
parent 549cca19e3
commit eeb790f1b2
10 changed files with 134 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
src/Main.newt
View File

@@ -88,6 +88,11 @@ moduleHash src imports = do
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
-- New style loader, one def at a time
processModule : FC -> String -> List String -> QName -> M String
@@ -98,7 +103,7 @@ processModule importFC base stk qn@(QN ns nm) = do
let name = joinBy "." modns
let (Nothing) = lookupMap modns top.modules | _ => pure ""
-- dummy entry for processing
modifyTop (\ top => MkTop (updateMap modns (emptyModCtx "") top.modules) top.imported top.ns top.defs top.metaCtx top.verbose top.errors top.ops)
modifyTop (\ top => MkTop (updateMap modns (emptyModCtx "") top.modules) top.imported top.hints top.ns top.defs top.metaCtx top.verbose top.errors top.ops)
let fn = (joinBy "/" (base :: ns)) ++ "/" ++ nm ++ ".newt"
(Right src) <- liftIO {M} $ readFile fn
| Left err => exitFailure "ERROR at \{show importFC}: error reading \{fn}: \{show err}"
@@ -127,7 +132,6 @@ processModule importFC base stk qn@(QN ns nm) = do
processModule fc base (name :: stk) qname
pure $ split name' "."
let imported = snoc imported primNS
srcSum <- liftIO $ checksum src
csum <- moduleHash srcSum imported
@@ -143,7 +147,7 @@ processModule importFC base stk qn@(QN ns nm) = do
-- FIXME - we don't want stray operators in a module.
-- inject module ops into top
let ops = foldMap const top.ops $ toList mod.ctxOps
in MkTop modules top.imported top.ns top.defs top.metaCtx top.verbose top.errors ops)
in MkTop modules top.imported top.hints top.ns top.defs top.metaCtx top.verbose top.errors ops)
pure src -- why am I returning this?
log 1 $ \ _ => "MODNS " ++ show modns
@@ -151,9 +155,13 @@ processModule importFC base stk qn@(QN ns nm) = do
(decls, ops) <- parseDecls fn top.ops toks Lin
top <- getTop
freshMC <- newIORef (MC EmptyMap 0 CheckAll)
freshMC <- newIORef (MC EmptyMap Nil 0 CheckAll)
-- set imported, mod, freshMC, ops before processing
modifyTop (\ top => MkTop top.modules imported modns EmptyMap freshMC top.verbose top.errors ops)
modifyTop (\ top => MkTop top.modules imported EmptyMap modns EmptyMap freshMC top.verbose top.errors 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 ns) (collectDecl decls)
@@ -168,19 +176,19 @@ processModule importFC base stk qn@(QN ns nm) = do
else pure MkUnit
let modules = updateMap modns mod top.modules
modifyTop (\ top => MkTop modules top.imported top.ns top.defs top.metaCtx top.verbose top.errors top.ops)
modifyTop (\ top => MkTop modules top.imported top.hints top.ns top.defs top.metaCtx top.verbose top.errors top.ops)
(Nil) <- liftIO {M} $ readIORef top.errors
| errors => do
for_ errors $ \err =>
putStrLn (showError src err)
exitFailure "Compile failed"
if stk == Nil then logMetas $ reverse $ listValues mc.metas else pure MkUnit
logMetas $ reverse $ listValues mc.metas
pure src
where
tryProcessDecl : List String -> Decl -> M Unit
tryProcessDecl ns decl = do
Left err <- tryError $ processDecl ns decl | _ => pure MkUnit
(Left err) <- tryError $ processDecl ns decl | _ => pure MkUnit
addError err
@@ -230,8 +238,8 @@ processFile fn = do
processDecl primNS (PType emptyFC "Char" Nothing)
top <- getTop
let modules = updateMap primNS (MkModCtx "" top.defs (MC EmptyMap 0 CheckAll) top.ops) top.modules
modifyTop (\ top => MkTop modules (primNS :: Nil) Nil EmptyMap top.metaCtx top.verbose top.errors top.ops)
let modules = updateMap primNS (MkModCtx "" top.defs (MC EmptyMap Nil 0 CheckAll) top.ops) top.modules
modifyTop (\ top => MkTop modules (primNS :: Nil) EmptyMap Nil EmptyMap top.metaCtx top.verbose top.errors top.ops)
src <- processModule emptyFC base Nil qn
top <- getTop
@@ -244,7 +252,7 @@ cmdLine : List String -> M (Maybe String × List String)
cmdLine Nil = pure (Nothing, Nil)
cmdLine ("--top" :: args) = cmdLine args -- handled later
cmdLine ("-v" :: args) = do
modifyTop (\ top => MkTop top.modules top.imported top.ns top.defs top.metaCtx (top.verbose + 1) top.errors top.ops)
modifyTop (\ top => MkTop top.modules top.imported top.hints top.ns top.defs top.metaCtx (top.verbose + 1) top.errors top.ops)
cmdLine args
cmdLine ("-o" :: fn :: args) = do
(out, files) <- cmdLine args