Make adding primitives more robust
This commit is contained in:
@@ -127,8 +127,6 @@ checkFile fn = unsafePerformIO $ do
|
|||||||
else pure MkUnit
|
else pure MkUnit
|
||||||
(Right (top, json)) <- (do
|
(Right (top, json)) <- (do
|
||||||
modifyTop [ errors := Nil ]
|
modifyTop [ errors := Nil ]
|
||||||
putStrLn "add prim"
|
|
||||||
addPrimitives
|
|
||||||
putStrLn "processModule"
|
putStrLn "processModule"
|
||||||
_ <- processModule emptyFC lspFileSource Nil modns
|
_ <- processModule emptyFC lspFileSource Nil modns
|
||||||
pure MkUnit
|
pure MkUnit
|
||||||
|
|||||||
@@ -14,20 +14,22 @@ import Data.List1
|
|||||||
import Lib.Elab
|
import Lib.Elab
|
||||||
|
|
||||||
-- declare internal primitives
|
-- declare internal primitives
|
||||||
addPrimitives : M Unit
|
addPrimitives : M ModContext
|
||||||
addPrimitives = do
|
addPrimitives = do
|
||||||
processDecl primNS (PType emptyFC "Int" Nothing)
|
processDecl primNS (PType emptyFC "Int" Nothing)
|
||||||
processDecl primNS (PType emptyFC "String" Nothing)
|
processDecl primNS (PType emptyFC "String" Nothing)
|
||||||
processDecl primNS (PType emptyFC "Char" 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
|
setDef (QN primNS "PiType") emptyFC (Erased emptyFC) (PrimFn "(h0, h1) => ({ tag: \"PiType\", h0, h1 });" (S (S Z)) Nil) Nil
|
||||||
top <- getTop
|
top <- getTop
|
||||||
let modules = updateMap primNS (MkModCtx "" top.defs (MC emptyMap Nil 0 CheckAll) top.ops Nil) top.modules
|
let mod = MkModCtx "" top.defs (MC emptyMap Nil 0 CheckAll) top.ops Nil
|
||||||
|
let modules = updateMap primNS mod top.modules
|
||||||
modifyTop [ modules := modules
|
modifyTop [ modules := modules
|
||||||
; imported := primNS :: Nil
|
; imported := primNS :: Nil
|
||||||
; hints := emptyMap
|
; hints := emptyMap
|
||||||
; ns := Nil
|
; ns := Nil
|
||||||
; defs := emptyMap
|
; defs := emptyMap
|
||||||
]
|
]
|
||||||
|
pure mod
|
||||||
|
|
||||||
record FileSource where
|
record FileSource where
|
||||||
getFile : FC → String → M (String × String)
|
getFile : FC → String → M (String × String)
|
||||||
@@ -64,7 +66,11 @@ processModule : FC → FileSource → List String → (stack : List String) →
|
|||||||
processModule importFC repo stk modns = do
|
processModule importFC repo stk modns = do
|
||||||
top <- getTop
|
top <- getTop
|
||||||
let name = joinBy "." modns
|
let name = joinBy "." modns
|
||||||
let (Nothing) = lookupMap' modns top.modules | Just mod => pure mod
|
let (Nothing) = lookupMap' modns top.modules
|
||||||
|
| Just mod => pure mod
|
||||||
|
|
||||||
|
let (False) = modns == primNS
|
||||||
|
| _ => addPrimitives
|
||||||
|
|
||||||
let fn = joinBy "/" modns ++ ".newt"
|
let fn = joinBy "/" modns ++ ".newt"
|
||||||
-- TODO now we can pass in the module name...
|
-- TODO now we can pass in the module name...
|
||||||
@@ -90,6 +96,7 @@ processModule importFC repo stk modns = do
|
|||||||
when (elem name' stk) $ \ _ => error nameFC "import loop \{show name} → \{show name'}"
|
when (elem name' stk) $ \ _ => error nameFC "import loop \{show name} → \{show name'}"
|
||||||
processModule nameFC repo (name :: stk) imp
|
processModule nameFC repo (name :: stk) imp
|
||||||
pure $ imp
|
pure $ imp
|
||||||
|
processModule nameFC repo (name :: stk) primNS
|
||||||
let imported = snoc imported primNS
|
let imported = snoc imported primNS
|
||||||
|
|
||||||
putStrLn "module \{modName}"
|
putStrLn "module \{modName}"
|
||||||
|
|||||||
@@ -94,7 +94,6 @@ processFile fn = do
|
|||||||
|
|
||||||
let modns = split modName "."
|
let modns = split modName "."
|
||||||
base <- getBaseDir fn nameFC modns
|
base <- getBaseDir fn nameFC modns
|
||||||
addPrimitives
|
|
||||||
|
|
||||||
invalidateModule modns
|
invalidateModule modns
|
||||||
let repo = dirFileSource base
|
let repo = dirFileSource base
|
||||||
|
|||||||
Reference in New Issue
Block a user