144 lines
5.0 KiB
Agda
144 lines
5.0 KiB
Agda
module Lib.ProcessModule
|
||
|
||
import Prelude
|
||
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 ModContext
|
||
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
|
||
top <- getTop
|
||
let mod = MkModCtx "" top.defs (MC emptyMap Nil 0 CheckAll) top.ops Nil top.errors
|
||
let modules = updateMap primNS mod top.modules
|
||
-- TODO - do we clear this? Try just modules := modules, but wait until this refactor is done.
|
||
modifyTop [ modules := modules
|
||
; imported := primNS :: Nil
|
||
; hints := emptyMap
|
||
; ns := ""
|
||
; defs := emptyMap
|
||
]
|
||
pure mod
|
||
|
||
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
|
||
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
|
||
|
||
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
|
||
|
||
-- HACK this is returning src to help render errors..
|
||
-- Maybe return module, put src and errors in module, add error for import with error, callers can sort out what they want to do?
|
||
-- The issue here is command line newt wants to report all errors (we can print that though?) LSP wants something more subtle
|
||
processModule : FC → FileSource → List String → String → M ModContext
|
||
processModule importFC repo stk modns = do
|
||
top <- getTop
|
||
|
||
let (Nothing) = lookupMap' modns top.modules
|
||
| Just mod => pure mod
|
||
|
||
let (False) = modns == primNS
|
||
| _ => addPrimitives
|
||
let parts = split modns "."
|
||
let fn = joinBy "/" parts ++ ".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 == 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
|
||
|
||
imported <- for imports $ \case
|
||
MkImport fc (nameFC, name') => do
|
||
when (elem name' stk) $ \ _ => error nameFC "import loop \{modns} → \{name'}"
|
||
processModule nameFC repo (modns :: stk) name'
|
||
pure $ name'
|
||
processModule nameFC repo (modns :: stk) primNS
|
||
let imported = snoc imported primNS
|
||
|
||
putStrLn "module \{modName}"
|
||
|
||
log 1 $ \ _ => "MODNS " ++ show modns
|
||
top <- getTop
|
||
(decls, ops) <- parseDecls fn top.ops toks Lin
|
||
|
||
top <- getTop
|
||
let freshMC = MC emptyMap Nil 0 CheckAll
|
||
-- NOW Print and drop errors here
|
||
-- 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 src top.defs top.metaCtx top.ops imported top.errors
|
||
|
||
let modules = updateMap modns mod top.modules
|
||
modifyTop [modules := modules]
|
||
|
||
logMetas $ reverse $ listValues top.metaCtx.metas
|
||
-- FIXME module context should hold errors, to report in replay
|
||
pure mod
|
||
where
|
||
tryProcessDecl : String → String → Decl → M Unit
|
||
tryProcessDecl src ns decl = do
|
||
(Left err) <- tryError $ processDecl ns decl | _ => pure MkUnit
|
||
addError err
|
||
|
||
-- NOW TODO clear dependents too.
|
||
invalidateModule : String -> M Unit
|
||
invalidateModule modname = modifyTop [modules $= deleteMap modname]
|