use string for module names
This commit is contained in:
@@ -12,19 +12,19 @@ import Lib.Token
|
|||||||
import Lib.Elab
|
import Lib.Elab
|
||||||
|
|
||||||
-- For now we cheat and assume capitalized directories are a module component
|
-- For now we cheat and assume capitalized directories are a module component
|
||||||
decomposeName : String → String × List String
|
decomposeName : String → String × String
|
||||||
decomposeName fn =
|
decomposeName fn =
|
||||||
go Nil $ Lin <>< split (fst $ splitFileName fn) "/"
|
go Nil $ Lin <>< split (fst $ splitFileName fn) "/"
|
||||||
where
|
where
|
||||||
go : List String → SnocList String → String × List String
|
go : List String → SnocList String → String × String
|
||||||
go acc Lin = (".", acc)
|
go acc Lin = (".", joinBy "." acc)
|
||||||
go acc (xs :< x) = if isUpper $ strIndex x 0
|
go acc (xs :< x) = if isUpper $ strIndex x 0
|
||||||
then go (x :: acc) xs
|
then go (x :: acc) xs
|
||||||
else (joinBy "/" (xs :< x <>> Nil), acc)
|
else (joinBy "/" (xs :< x <>> Nil), joinBy "." acc)
|
||||||
|
|
||||||
-- The cheap version of type at point, find the token, lookup in global context
|
-- The cheap version of type at point, find the token, lookup in global context
|
||||||
-- Later we will either get good FC for entries or scan them all and build a cache.
|
-- Later we will either get good FC for entries or scan them all and build a cache.
|
||||||
getHoverInfo : FileSource → List String → Int → Int → M (Maybe (String × FC))
|
getHoverInfo : FileSource → String → Int → Int → M (Maybe (String × FC))
|
||||||
getHoverInfo repo modns row col = do
|
getHoverInfo repo modns row col = do
|
||||||
mod <- processModule emptyFC repo Nil modns
|
mod <- processModule emptyFC repo Nil modns
|
||||||
-- not necessarily loaded into top... (Maybe push this down into that branch of processModule)
|
-- not necessarily loaded into top... (Maybe push this down into that branch of processModule)
|
||||||
|
|||||||
11
src/LSP.newt
11
src/LSP.newt
@@ -73,7 +73,7 @@ updateFile fn src = unsafePerformIO $ do
|
|||||||
let (Right ((nameFC, modName), _, _)) = partialParse fn parseModHeader emptyMap toks
|
let (Right ((nameFC, modName), _, _)) = partialParse fn parseModHeader emptyMap toks
|
||||||
| Left (err,toks) => writeIORef state st
|
| Left (err,toks) => writeIORef state st
|
||||||
|
|
||||||
Right (ctx,_) <- (invalidateModule $ split modName ".").runM st.topContext
|
Right (ctx,_) <- (invalidateModule modName).runM st.topContext
|
||||||
| _ => writeIORef state st
|
| _ => writeIORef state st
|
||||||
-- TODO It doesn't have record type, but eta expanding resolves this. See if there is a quick fix.
|
-- TODO It doesn't have record type, but eta expanding resolves this. See if there is a quick fix.
|
||||||
-- modifyIORef state [ topContext := ctx ]
|
-- modifyIORef state [ topContext := ctx ]
|
||||||
@@ -90,7 +90,7 @@ fcToRange (MkFC uri (MkBounds sr sc er ec)) =
|
|||||||
hoverInfo : String → Int → Int → JSObject
|
hoverInfo : String → Int → Int → JSObject
|
||||||
hoverInfo uri line col = unsafePerformIO $ do
|
hoverInfo uri line col = unsafePerformIO $ do
|
||||||
let (base,modns) = decomposeName uri
|
let (base,modns) = decomposeName uri
|
||||||
putStrLn "Hover \{uri} base \{base} mod \{joinBy "." modns}"
|
putStrLn "Hover \{uri} base \{base} mod \{modns}"
|
||||||
st <- readIORef state
|
st <- readIORef state
|
||||||
if (st.baseDir /= base)
|
if (st.baseDir /= base)
|
||||||
then resetState base
|
then resetState base
|
||||||
@@ -119,8 +119,9 @@ errorToDiag (Postpone fc qn msg) = errorToDiag $ E fc "Postpone \{show qn} \{msg
|
|||||||
|
|
||||||
checkFile : String → JSObject
|
checkFile : String → JSObject
|
||||||
checkFile fn = unsafePerformIO $ do
|
checkFile fn = unsafePerformIO $ do
|
||||||
let (base,modns) = decomposeName fn
|
let (base,modName) = decomposeName fn
|
||||||
putStrLn "Checking \{fn} base \{base} mod \{joinBy "." modns}"
|
|
||||||
|
putStrLn "Checking \{fn} base \{base} mod \{modName}"
|
||||||
st <- readIORef state
|
st <- readIORef state
|
||||||
if (st.baseDir /= base)
|
if (st.baseDir /= base)
|
||||||
then resetState base
|
then resetState base
|
||||||
@@ -128,7 +129,7 @@ checkFile fn = unsafePerformIO $ do
|
|||||||
(Right (top, json)) <- (do
|
(Right (top, json)) <- (do
|
||||||
modifyTop [ errors := Nil ]
|
modifyTop [ errors := Nil ]
|
||||||
putStrLn "processModule"
|
putStrLn "processModule"
|
||||||
_ <- processModule emptyFC lspFileSource Nil modns
|
_ <- processModule emptyFC lspFileSource Nil modName
|
||||||
pure MkUnit
|
pure MkUnit
|
||||||
-- pull out errors and infos
|
-- pull out errors and infos
|
||||||
top <- getTop
|
top <- getTop
|
||||||
|
|||||||
@@ -132,8 +132,8 @@ fcCol fc = fc.bnds.startCol
|
|||||||
class HasFC a where
|
class HasFC a where
|
||||||
getFC : a -> FC
|
getFC : a -> FC
|
||||||
|
|
||||||
primNS : List String
|
primNS : String
|
||||||
primNS = ("Prim" :: Nil)
|
primNS = "Prim"
|
||||||
|
|
||||||
emptyFC : FC
|
emptyFC : FC
|
||||||
emptyFC = MkFC "" (MkBounds 0 0 0 0)
|
emptyFC = MkFC "" (MkBounds 0 0 0 0)
|
||||||
@@ -141,10 +141,9 @@ emptyFC = MkFC "" (MkBounds 0 0 0 0)
|
|||||||
emptyFC' : String → FC
|
emptyFC' : String → FC
|
||||||
emptyFC' fn = MkFC fn (MkBounds 0 0 0 0)
|
emptyFC' fn = MkFC fn (MkBounds 0 0 0 0)
|
||||||
|
|
||||||
-- Error of a parse
|
-- Using a String instead of List String for the module shaved about 16% of compile time...
|
||||||
|
|
||||||
data QName : U where
|
data QName : U where
|
||||||
QN : List String -> String -> QName
|
QN : String -> String -> QName
|
||||||
|
|
||||||
.baseName : QName → String
|
.baseName : QName → String
|
||||||
(QN _ name).baseName = name
|
(QN _ name).baseName = name
|
||||||
@@ -154,8 +153,8 @@ instance Eq QName where
|
|||||||
QN ns n == QN ns' n' = if n == n' then ns == ns' else False
|
QN ns n == QN ns' n' = if n == n' then ns == ns' else False
|
||||||
|
|
||||||
instance Show QName where
|
instance Show QName where
|
||||||
show (QN Nil n) = n
|
show (QN "" n) = n
|
||||||
show (QN ns n) = joinBy "." ns ++ "." ++ n
|
show (QN ns n) = ns ++ "." ++ n
|
||||||
|
|
||||||
instance Ord QName where
|
instance Ord QName where
|
||||||
compare (QN ns nm) (QN ns' nm') = if ns == ns' then compare nm nm' else compare ns ns'
|
compare (QN ns nm) (QN ns' nm') = if ns == ns' then compare nm nm' else compare ns ns'
|
||||||
|
|||||||
@@ -157,7 +157,7 @@ compileTerm tm@(App _ _ _) = case funArgs tm of
|
|||||||
applySucc Nil = pure $ CLam "x" $ CPrimOp "+" (CLit $ LInt 1) (CBnd 0)
|
applySucc Nil = pure $ CLam "x" $ CPrimOp "+" (CLit $ LInt 1) (CBnd 0)
|
||||||
applySucc (t :: Nil) = pure $ CPrimOp "+" (CLit $ LInt 1) t
|
applySucc (t :: Nil) = pure $ CPrimOp "+" (CLit $ LInt 1) t
|
||||||
applySucc _ = error emptyFC "overapplied Succ \{show tm}"
|
applySucc _ = error emptyFC "overapplied Succ \{show tm}"
|
||||||
compileTerm (UU _) = pure $ CRef (QN Nil "U")
|
compileTerm (UU _) = pure $ CRef (QN "" "U")
|
||||||
compileTerm (Pi _ nm icit rig t u) = do
|
compileTerm (Pi _ nm icit rig t u) = do
|
||||||
t' <- compileTerm t
|
t' <- compileTerm t
|
||||||
u' <- compileTerm u
|
u' <- compileTerm u
|
||||||
|
|||||||
@@ -1549,7 +1549,7 @@ infer ctx tm@(RUpdateRec fc _ _) = do
|
|||||||
infer ctx (RVar fc nm) = go 0 ctx.types
|
infer ctx (RVar fc nm) = go 0 ctx.types
|
||||||
where
|
where
|
||||||
entryNS : TopEntry → String
|
entryNS : TopEntry → String
|
||||||
entryNS (MkEntry fc (QN ns _) _ _ _) = joinBy "." ns
|
entryNS (MkEntry fc (QN ns _) _ _ _) = ns
|
||||||
|
|
||||||
go : Int -> List (String × Val) -> M (Tm × Val)
|
go : Int -> List (String × Val) -> M (Tm × Val)
|
||||||
go i Nil = do
|
go i Nil = do
|
||||||
|
|||||||
@@ -100,9 +100,9 @@ checkAlreadyDef fc nm = do
|
|||||||
Just entry => error fc "\{show nm} is already defined at \{show entry.fc}"
|
Just entry => error fc "\{show nm} is already defined at \{show entry.fc}"
|
||||||
|
|
||||||
|
|
||||||
processDecl : List String -> Decl -> M Unit
|
processDecl : String -> Decl -> M Unit
|
||||||
|
|
||||||
processTypeSig : List String → FC → List Name → Raw → M Unit
|
processTypeSig : String → FC → List Name → Raw → M Unit
|
||||||
processTypeSig ns fc names tm = do
|
processTypeSig ns fc names tm = do
|
||||||
log 1 $ \ _ => "-----"
|
log 1 $ \ _ => "-----"
|
||||||
top <- getTop
|
top <- getTop
|
||||||
@@ -112,7 +112,7 @@ processTypeSig ns fc names tm = do
|
|||||||
ignore $ for names $ \nm => setDef (QN ns nm) fc ty Axiom Nil
|
ignore $ for names $ \nm => setDef (QN ns nm) fc ty Axiom Nil
|
||||||
|
|
||||||
|
|
||||||
processPrimType : List Name → FC → Name → Maybe Raw → M Unit
|
processPrimType : String → FC → Name → Maybe Raw → M Unit
|
||||||
processPrimType ns fc nm ty = do
|
processPrimType ns fc nm ty = do
|
||||||
top <- getTop
|
top <- getTop
|
||||||
ty' <- check (mkCtx fc) (maybe (RU fc) id ty) (VU fc)
|
ty' <- check (mkCtx fc) (maybe (RU fc) id ty) (VU fc)
|
||||||
@@ -120,7 +120,7 @@ processPrimType ns fc nm ty = do
|
|||||||
setDef (QN ns nm) fc ty' (PrimTCon arity) Nil
|
setDef (QN ns nm) fc ty' (PrimTCon arity) Nil
|
||||||
|
|
||||||
|
|
||||||
processPrimFn : List String → FC → String → List String → Raw → String → M Unit
|
processPrimFn : String → FC → String → List String → Raw → String → M Unit
|
||||||
processPrimFn ns fc nm used ty src = do
|
processPrimFn ns fc nm used ty src = do
|
||||||
top <- getTop
|
top <- getTop
|
||||||
ty <- check (mkCtx fc) ty (VU fc)
|
ty <- check (mkCtx fc) ty (VU fc)
|
||||||
@@ -153,7 +153,7 @@ complexity (Lit _ _) = 0
|
|||||||
complexity (Case _ sc (CaseCons _ _ t :: Nil)) = 1 + complexity sc + complexity t
|
complexity (Case _ sc (CaseCons _ _ t :: Nil)) = 1 + complexity sc + complexity t
|
||||||
complexity _ = 100
|
complexity _ = 100
|
||||||
|
|
||||||
processDef : List String → FC → String → List (Raw × Maybe Raw) → M Unit
|
processDef : String → FC → String → List (Raw × Maybe Raw) → M Unit
|
||||||
processDef ns fc nm clauses = do
|
processDef ns fc nm clauses = do
|
||||||
log 1 $ \ _ => "-----"
|
log 1 $ \ _ => "-----"
|
||||||
log 1 $ \ _ => "Def \{show nm}"
|
log 1 $ \ _ => "Def \{show nm}"
|
||||||
@@ -194,7 +194,7 @@ processDef ns fc nm clauses = do
|
|||||||
then setFlag (QN ns nm) fc Inline
|
then setFlag (QN ns nm) fc Inline
|
||||||
else pure MkUnit
|
else pure MkUnit
|
||||||
|
|
||||||
processCheck : List String → FC → Raw → Raw → M Unit
|
processCheck : String → FC → Raw → Raw → M Unit
|
||||||
processCheck ns fc tm ty = do
|
processCheck ns fc tm ty = do
|
||||||
log 1 $ \ _ => "----- DCheck"
|
log 1 $ \ _ => "----- DCheck"
|
||||||
top <- getTop
|
top <- getTop
|
||||||
@@ -209,7 +209,7 @@ processCheck ns fc tm ty = do
|
|||||||
putStrLn " NF \{render 90 $ pprint Nil norm}"
|
putStrLn " NF \{render 90 $ pprint Nil norm}"
|
||||||
|
|
||||||
|
|
||||||
processClass : List String → FC → (FC × String) → Telescope → List Decl → M Unit
|
processClass : String → FC → (FC × String) → Telescope → List Decl → M Unit
|
||||||
processClass ns classFC (nameFC, nm) tele decls = do
|
processClass ns classFC (nameFC, nm) tele decls = do
|
||||||
-- REVIEW maybe we can leverage Record for this
|
-- REVIEW maybe we can leverage Record for this
|
||||||
-- a couple of catches, we don't want the dotted accessors and
|
-- a couple of catches, we don't want the dotted accessors and
|
||||||
@@ -257,7 +257,7 @@ processClass ns classFC (nameFC, nm) tele decls = do
|
|||||||
mkApp : Raw → BindInfo × Raw → Raw
|
mkApp : Raw → BindInfo × Raw → Raw
|
||||||
mkApp acc (BI fc nm icit _, _) = RApp fc acc (RVar fc nm) icit
|
mkApp acc (BI fc nm icit _, _) = RApp fc acc (RVar fc nm) icit
|
||||||
|
|
||||||
processInstance : List String → FC → Raw → Maybe (List Decl) → M Unit
|
processInstance : String → FC → Raw → Maybe (List Decl) → M Unit
|
||||||
processInstance ns instfc ty decls = do
|
processInstance ns instfc ty decls = do
|
||||||
log 1 $ \ _ => "-----"
|
log 1 $ \ _ => "-----"
|
||||||
log 1 $ \ _ => "Instance \{render 90 $ pretty ty}"
|
log 1 $ \ _ => "Instance \{render 90 $ pretty ty}"
|
||||||
@@ -372,7 +372,7 @@ processInstance ns instfc ty decls = do
|
|||||||
apply x (y :: xs) = error instfc "expected pi type \{show x}"
|
apply x (y :: xs) = error instfc "expected pi type \{show x}"
|
||||||
|
|
||||||
-- desugars to Data and processes it
|
-- desugars to Data and processes it
|
||||||
processShortData : List String → FC → Raw → List Raw → M Unit
|
processShortData : String → FC → Raw → List Raw → M Unit
|
||||||
processShortData ns fc lhs sigs = do
|
processShortData ns fc lhs sigs = do
|
||||||
(nameFC, nm,args) <- getArgs lhs Nil
|
(nameFC, nm,args) <- getArgs lhs Nil
|
||||||
let ty = foldr mkPi (RU fc) args
|
let ty = foldr mkPi (RU fc) args
|
||||||
@@ -431,7 +431,7 @@ populateConInfo entries =
|
|||||||
isSucc (MkEntry fc nm dty@(Pi _ _ _ _ (Ref _ a) (Ref _ b)) (DCon _ _ (Many :: Nil) hn) _) = a == b
|
isSucc (MkEntry fc nm dty@(Pi _ _ _ _ (Ref _ a) (Ref _ b)) (DCon _ _ (Many :: Nil) hn) _) = a == b
|
||||||
isSucc _ = False
|
isSucc _ = False
|
||||||
|
|
||||||
processData : List String → FC → FC × String → Raw → List Decl → M Unit
|
processData : String → FC → FC × String → Raw → List Decl → M Unit
|
||||||
processData ns fc (nameFC, nm) ty cons = do
|
processData ns fc (nameFC, nm) ty cons = do
|
||||||
log 1 $ \ _ => "-----"
|
log 1 $ \ _ => "-----"
|
||||||
log 1 $ \ _ => "Data \{nm}"
|
log 1 $ \ _ => "Data \{nm}"
|
||||||
@@ -487,7 +487,7 @@ processData ns fc (nameFC, nm) ty cons = do
|
|||||||
checkDeclType _ = error fc "data type doesn't return U"
|
checkDeclType _ = error fc "data type doesn't return U"
|
||||||
|
|
||||||
|
|
||||||
processRecord : List String → FC → FC × String → Telescope → Maybe (FC × Name) → List Decl → M Unit
|
processRecord : String → FC → FC × String → Telescope → Maybe (FC × Name) → List Decl → M Unit
|
||||||
processRecord ns recordFC (nameFC, nm) tele cname decls = do
|
processRecord ns recordFC (nameFC, nm) tele cname decls = do
|
||||||
log 1 $ \ _ => "-----"
|
log 1 $ \ _ => "-----"
|
||||||
log 1 $ \ _ => "Record"
|
log 1 $ \ _ => "Record"
|
||||||
|
|||||||
@@ -23,10 +23,11 @@ addPrimitives = do
|
|||||||
top <- getTop
|
top <- getTop
|
||||||
let mod = MkModCtx "" top.defs (MC emptyMap Nil 0 CheckAll) top.ops Nil top.errors
|
let mod = MkModCtx "" top.defs (MC emptyMap Nil 0 CheckAll) top.ops Nil top.errors
|
||||||
let modules = updateMap primNS mod top.modules
|
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
|
modifyTop [ modules := modules
|
||||||
; imported := primNS :: Nil
|
; imported := primNS :: Nil
|
||||||
; hints := emptyMap
|
; hints := emptyMap
|
||||||
; ns := Nil
|
; ns := ""
|
||||||
; defs := emptyMap
|
; defs := emptyMap
|
||||||
]
|
]
|
||||||
pure mod
|
pure mod
|
||||||
@@ -62,17 +63,17 @@ importHints (entry :: entries) = do
|
|||||||
-- HACK this is returning src to help render errors..
|
-- 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?
|
-- 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
|
-- 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 → (stack : List String) → M ModContext
|
processModule : FC → FileSource → List String → String → M ModContext
|
||||||
processModule importFC repo stk modns = do
|
processModule importFC repo stk modns = do
|
||||||
top <- getTop
|
top <- getTop
|
||||||
let name = joinBy "." modns
|
|
||||||
let (Nothing) = lookupMap' modns top.modules
|
let (Nothing) = lookupMap' modns top.modules
|
||||||
| Just mod => pure mod
|
| Just mod => pure mod
|
||||||
|
|
||||||
let (False) = modns == primNS
|
let (False) = modns == primNS
|
||||||
| _ => addPrimitives
|
| _ => addPrimitives
|
||||||
|
let parts = split modns "."
|
||||||
let fn = joinBy "/" modns ++ ".newt"
|
let fn = joinBy "/" parts ++ ".newt"
|
||||||
-- TODO now we can pass in the module name...
|
-- TODO now we can pass in the module name...
|
||||||
(fn,src) <- repo.getFile importFC fn
|
(fn,src) <- repo.getFile importFC fn
|
||||||
let (Right toks) = tokenise fn src
|
let (Right toks) = tokenise fn src
|
||||||
@@ -82,21 +83,18 @@ processModule importFC repo stk modns = do
|
|||||||
| Left (err, toks) => throwError err
|
| Left (err, toks) => throwError err
|
||||||
|
|
||||||
log 1 $ \ _ => "scan imports for module \{modName}"
|
log 1 $ \ _ => "scan imports for module \{modName}"
|
||||||
let (True) = modns == split modName "."
|
let (True) = modns == modName
|
||||||
| _ => throwError $ E nameFC "module name \{show modName} doesn't match file name \{show fn}"
|
| _ => throwError $ E nameFC "module name \{show modName} doesn't match file name \{show fn}"
|
||||||
|
|
||||||
let (Right (imports, ops, toks)) = partialParse fn parseImports ops toks
|
let (Right (imports, ops, toks)) = partialParse fn parseImports ops toks
|
||||||
| Left (err, toks) => throwError err
|
| Left (err, toks) => throwError err
|
||||||
|
|
||||||
let importNames = map importToName imports
|
|
||||||
|
|
||||||
imported <- for imports $ \case
|
imported <- for imports $ \case
|
||||||
MkImport fc (nameFC, name') => do
|
MkImport fc (nameFC, name') => do
|
||||||
let imp = split name' "."
|
when (elem name' stk) $ \ _ => error nameFC "import loop \{modns} → \{name'}"
|
||||||
when (elem name' stk) $ \ _ => error nameFC "import loop \{show name} → \{show name'}"
|
processModule nameFC repo (modns :: stk) name'
|
||||||
processModule nameFC repo (name :: stk) imp
|
pure $ name'
|
||||||
pure $ imp
|
processModule nameFC repo (modns :: stk) primNS
|
||||||
processModule nameFC repo (name :: stk) primNS
|
|
||||||
let imported = snoc imported primNS
|
let imported = snoc imported primNS
|
||||||
|
|
||||||
putStrLn "module \{modName}"
|
putStrLn "module \{modName}"
|
||||||
@@ -107,6 +105,7 @@ processModule importFC repo stk modns = do
|
|||||||
|
|
||||||
top <- getTop
|
top <- getTop
|
||||||
let freshMC = MC emptyMap Nil 0 CheckAll
|
let freshMC = MC emptyMap Nil 0 CheckAll
|
||||||
|
-- NOW Print and drop errors here
|
||||||
-- set imported, mod, freshMC, ops before processing
|
-- set imported, mod, freshMC, ops before processing
|
||||||
modifyTop [ imported := imported
|
modifyTop [ imported := imported
|
||||||
; hints := emptyMap
|
; hints := emptyMap
|
||||||
@@ -125,7 +124,7 @@ processModule importFC repo stk modns = do
|
|||||||
-- update modules with result, leave the rest of context in case this is top file
|
-- update modules with result, leave the rest of context in case this is top file
|
||||||
top <- getTop
|
top <- getTop
|
||||||
|
|
||||||
let mod = MkModCtx src top.defs top.metaCtx top.ops importNames top.errors
|
let mod = MkModCtx src top.defs top.metaCtx top.ops imported top.errors
|
||||||
|
|
||||||
let modules = updateMap modns mod top.modules
|
let modules = updateMap modns mod top.modules
|
||||||
modifyTop [modules := modules]
|
modifyTop [modules := modules]
|
||||||
@@ -134,11 +133,11 @@ processModule importFC repo stk modns = do
|
|||||||
-- FIXME module context should hold errors, to report in replay
|
-- FIXME module context should hold errors, to report in replay
|
||||||
pure mod
|
pure mod
|
||||||
where
|
where
|
||||||
tryProcessDecl : String → List String → Decl → M Unit
|
tryProcessDecl : String → String → Decl → M Unit
|
||||||
tryProcessDecl src ns decl = do
|
tryProcessDecl src ns decl = do
|
||||||
(Left err) <- tryError $ processDecl ns decl | _ => pure MkUnit
|
(Left err) <- tryError $ processDecl ns decl | _ => pure MkUnit
|
||||||
addError err
|
addError err
|
||||||
|
|
||||||
-- TODO clear dependents too.
|
-- NOW TODO clear dependents too.
|
||||||
invalidateModule : List String -> M Unit
|
invalidateModule : String -> M Unit
|
||||||
invalidateModule modname = modifyTop [modules $= deleteMap modname]
|
invalidateModule modname = modifyTop [modules $= deleteMap modname]
|
||||||
|
|||||||
@@ -36,7 +36,8 @@ replQN = do
|
|||||||
ident <- uident
|
ident <- uident
|
||||||
rest <- many $ token Projection
|
rest <- many $ token Projection
|
||||||
let name = joinBy "" (ident :: rest)
|
let name = joinBy "" (ident :: rest)
|
||||||
pure $ uncurry QN $ unsnoc $ split1 name "."
|
let (ns,nm) = unsnoc $ split1 name "."
|
||||||
|
pure $ QN (joinBy "." ns) nm
|
||||||
|
|
||||||
data ArgType = ArgNone | ArgString | ArgIdent | ArgOptInt | ArgQName
|
data ArgType = ArgNone | ArgString | ArgIdent | ArgOptInt | ArgQName
|
||||||
|
|
||||||
|
|||||||
@@ -65,7 +65,7 @@ rewriteTailCalls nms tm = case tm of
|
|||||||
|
|
||||||
-- the name of our trampoline
|
-- the name of our trampoline
|
||||||
bouncer : QName
|
bouncer : QName
|
||||||
bouncer = QN Nil "bouncer"
|
bouncer = QN "" "bouncer"
|
||||||
|
|
||||||
doOptimize : List (QName × CExp) → M (List (QName × CExp))
|
doOptimize : List (QName × CExp) → M (List (QName × CExp))
|
||||||
doOptimize fns = do
|
doOptimize fns = do
|
||||||
|
|||||||
@@ -34,7 +34,7 @@ lookupRaw raw top =
|
|||||||
Just entry => Just entry
|
Just entry => Just entry
|
||||||
Nothing => go top.imported
|
Nothing => go top.imported
|
||||||
where
|
where
|
||||||
go : List (List String) → Maybe TopEntry
|
go : List String → Maybe TopEntry
|
||||||
go Nil = Nothing
|
go Nil = Nothing
|
||||||
go (ns :: nss) = case lookupMap' ns top.modules of
|
go (ns :: nss) = case lookupMap' ns top.modules of
|
||||||
Nothing => go nss
|
Nothing => go nss
|
||||||
@@ -47,7 +47,7 @@ instance Show TopContext where
|
|||||||
show top = "\nContext:\n [\{ joinBy "\n" $ map (show ∘ snd) $ toList top.defs}]"
|
show top = "\nContext:\n [\{ joinBy "\n" $ map (show ∘ snd) $ toList top.defs}]"
|
||||||
|
|
||||||
emptyTop : TopContext
|
emptyTop : TopContext
|
||||||
emptyTop = MkTop emptyMap Nil emptyMap Nil emptyMap (MC emptyMap Nil 0 CheckAll) 0 Nil emptyMap
|
emptyTop = MkTop emptyMap Nil emptyMap "" emptyMap (MC emptyMap Nil 0 CheckAll) 0 Nil emptyMap
|
||||||
|
|
||||||
|
|
||||||
setFlag : QName → FC → EFlag → M Unit
|
setFlag : QName → FC → EFlag → M Unit
|
||||||
|
|||||||
@@ -402,7 +402,7 @@ record ModContext where
|
|||||||
modMetaCtx : MetaContext
|
modMetaCtx : MetaContext
|
||||||
-- longer term maybe drop this, put the operator decls in ctxDefs and collect them on import
|
-- longer term maybe drop this, put the operator decls in ctxDefs and collect them on import
|
||||||
ctxOps : Operators
|
ctxOps : Operators
|
||||||
modDeps : List (List String)
|
modDeps : List String
|
||||||
modErrors : List Error
|
modErrors : List Error
|
||||||
|
|
||||||
-- Top level context.
|
-- Top level context.
|
||||||
@@ -421,15 +421,13 @@ HintTable = SortedMap QName (List (QName × Tm))
|
|||||||
|
|
||||||
record TopContext where
|
record TopContext where
|
||||||
constructor MkTop
|
constructor MkTop
|
||||||
-- maybe we use a String instead of List String for the left of QN
|
modules : SortedMap String ModContext
|
||||||
-- I'm putting a dummy entry in
|
imported : List String
|
||||||
modules : SortedMap (List String) ModContext
|
|
||||||
imported : List (List String)
|
|
||||||
-- TCon name → function name × type
|
-- TCon name → function name × type
|
||||||
hints : HintTable
|
hints : HintTable
|
||||||
|
|
||||||
-- current module
|
-- current module
|
||||||
ns : List String
|
ns : String
|
||||||
defs : SortedMap QName TopEntry
|
defs : SortedMap QName TopEntry
|
||||||
metaCtx : MetaContext
|
metaCtx : MetaContext
|
||||||
|
|
||||||
|
|||||||
@@ -95,9 +95,9 @@ processFile fn = do
|
|||||||
let modns = split modName "."
|
let modns = split modName "."
|
||||||
base <- getBaseDir fn nameFC modns
|
base <- getBaseDir fn nameFC modns
|
||||||
|
|
||||||
invalidateModule modns
|
invalidateModule modName
|
||||||
let repo = dirFileSource base
|
let repo = dirFileSource base
|
||||||
mod <- processModule emptyFC repo Nil modns
|
mod <- processModule emptyFC repo Nil modName
|
||||||
top <- getTop
|
top <- getTop
|
||||||
|
|
||||||
showErrors fn mod.modSource
|
showErrors fn mod.modSource
|
||||||
@@ -122,7 +122,7 @@ cmdLine (fn :: args) = do
|
|||||||
browseTop : QName → M Unit
|
browseTop : QName → M Unit
|
||||||
browseTop qn@(QN ns x) = do
|
browseTop qn@(QN ns x) = do
|
||||||
top <- getTop
|
top <- getTop
|
||||||
let ns = snoc ns x
|
let ns = ns ++ "." ++ x
|
||||||
let (Just mod) = lookupMap' ns top.modules
|
let (Just mod) = lookupMap' ns top.modules
|
||||||
| _ => putStrLn "module \{show qn} not loaded"
|
| _ => putStrLn "module \{show qn} not loaded"
|
||||||
go $ listValues mod.modDefs
|
go $ listValues mod.modDefs
|
||||||
|
|||||||
Reference in New Issue
Block a user