cleanup
This commit is contained in:
@@ -50,8 +50,8 @@ processDecl (TypeSig fc names tm) = do
|
|||||||
for_ names $ \nm => modify $ setDef nm ty Axiom
|
for_ names $ \nm => modify $ setDef nm ty Axiom
|
||||||
|
|
||||||
processDecl (PType fc nm ty) = do
|
processDecl (PType fc nm ty) = do
|
||||||
ctx <- get
|
top <- get
|
||||||
ty' <- check (mkCtx ctx.metas fc) (maybe (RU fc) id ty) (VU fc)
|
ty' <- check (mkCtx top.metas fc) (maybe (RU fc) id ty) (VU fc)
|
||||||
modify $ setDef nm ty' PrimTCon
|
modify $ setDef nm ty' PrimTCon
|
||||||
|
|
||||||
processDecl (PFunc fc nm ty src) = do
|
processDecl (PFunc fc nm ty src) = do
|
||||||
@@ -64,8 +64,10 @@ processDecl (PFunc fc nm ty src) = do
|
|||||||
processDecl (Def fc nm clauses) = do
|
processDecl (Def fc nm clauses) = do
|
||||||
putStrLn "-----"
|
putStrLn "-----"
|
||||||
putStrLn "def \{show nm}"
|
putStrLn "def \{show nm}"
|
||||||
ctx <- get
|
top <- get
|
||||||
let Just entry = lookup nm ctx
|
mc <- readIORef top.metas
|
||||||
|
let mstart = length mc.metas
|
||||||
|
let Just entry = lookup nm top
|
||||||
| Nothing => throwError $ E fc "skip def \{nm} without Decl"
|
| Nothing => throwError $ E fc "skip def \{nm} without Decl"
|
||||||
let (MkEntry name ty Axiom) := entry
|
let (MkEntry name ty Axiom) := entry
|
||||||
| _ => throwError $ E fc "\{nm} already defined"
|
| _ => throwError $ E fc "\{nm} already defined"
|
||||||
@@ -75,31 +77,24 @@ processDecl (Def fc nm clauses) = do
|
|||||||
putStrLn "vty is \{show vty}"
|
putStrLn "vty is \{show vty}"
|
||||||
|
|
||||||
-- I can take LHS apart syntactically or elaborate it with an infer
|
-- I can take LHS apart syntactically or elaborate it with an infer
|
||||||
clauses' <- traverse (makeClause ctx) clauses
|
clauses' <- traverse (makeClause top) clauses
|
||||||
tm <- buildTree (mkCtx ctx.metas fc) (MkProb clauses' vty)
|
tm <- buildTree (mkCtx top.metas fc) (MkProb clauses' vty)
|
||||||
putStrLn "Ok \{pprint [] tm}"
|
putStrLn "Ok \{pprint [] tm}"
|
||||||
tm' <- zonk ctx 0 [] tm
|
tm' <- zonk top 0 [] tm
|
||||||
putStrLn "NF \{pprint[] tm'}"
|
putStrLn "NF \{pprint[] tm'}"
|
||||||
mc <- readIORef ctx.metas
|
mc <- readIORef top.metas
|
||||||
|
|
||||||
-- Maybe here we try search?
|
-- Maybe here we try search?
|
||||||
|
|
||||||
|
for_ (drop mstart mc.metas) $ \case
|
||||||
for_ mc.metas $ \case
|
|
||||||
(Solved k x) => pure ()
|
(Solved k x) => pure ()
|
||||||
(Unsolved (l,c) k ctx ty User) => do
|
(Unsolved (l,c) k ctx ty User) => do
|
||||||
-- TODO print here
|
-- TODO print here
|
||||||
pure ()
|
pure ()
|
||||||
(Unsolved (l,c) k ctx ty kind) => do
|
(Unsolved (l,c) k ctx ty kind) => do
|
||||||
-- should just print, but it's too subtle in the sea of messages
|
|
||||||
-- we'd also need the ability to mark the whole top context as failure if we continue
|
|
||||||
-- put a list of errors in TopContext
|
|
||||||
|
|
||||||
-- Something wrong here - bad VVar
|
|
||||||
tm <- quote ctx.lvl !(forceMeta ty)
|
tm <- quote ctx.lvl !(forceMeta ty)
|
||||||
-- putStrLn $ showError "" $ E (l,c) "Unsolved meta \{show k} type \{show ty}"
|
-- Now that we're collecting errors, maybe we simply check at the end
|
||||||
addError $ E (l,c) "Unsolved meta \{show k} type \{pprint (names ctx) tm}"
|
addError $ E (l,c) "Unsolved meta \{show k} type \{pprint (names ctx) tm}"
|
||||||
-- throwError $ E (l,c) "Unsolved meta \{show k}"
|
|
||||||
debug "Add def \{nm} \{pprint [] tm'} : \{pprint [] ty}"
|
debug "Add def \{nm} \{pprint [] tm'} : \{pprint [] ty}"
|
||||||
modify $ setDef nm ty (Fn tm')
|
modify $ setDef nm ty (Fn tm')
|
||||||
|
|
||||||
@@ -116,14 +111,12 @@ processDecl (DCheck fc tm ty) = do
|
|||||||
putStrLn "NF "
|
putStrLn "NF "
|
||||||
|
|
||||||
processDecl (Data fc nm ty cons) = do
|
processDecl (Data fc nm ty cons) = do
|
||||||
ctx <- get
|
top <- get
|
||||||
tyty <- check (mkCtx ctx.metas fc) ty (VU fc)
|
tyty <- check (mkCtx top.metas fc) ty (VU fc)
|
||||||
modify $ setDef nm tyty Axiom
|
modify $ setDef nm tyty Axiom
|
||||||
ctx <- get
|
|
||||||
cnames <- for cons $ \x => case x of
|
cnames <- for cons $ \x => case x of
|
||||||
(TypeSig fc names tm) => do
|
(TypeSig fc names tm) => do
|
||||||
ctx <- get
|
dty <- check (mkCtx top.metas fc) tm (VU fc)
|
||||||
dty <- check (mkCtx ctx.metas fc) tm (VU fc)
|
|
||||||
debug "dty \{show names} is \{pprint [] dty}"
|
debug "dty \{show names} is \{pprint [] dty}"
|
||||||
|
|
||||||
-- We only check that codomain uses the right type constructor
|
-- We only check that codomain uses the right type constructor
|
||||||
|
|||||||
Reference in New Issue
Block a user