diff --git a/TODO.md b/TODO.md index 94286ed..74bd5e3 100644 --- a/TODO.md +++ b/TODO.md @@ -7,10 +7,15 @@ - [ ] Remove context lambdas when printing solutions (show names from context) - maybe build list of names and strip λ, then call pprint with names - [ ] Revisit substitution in case building -- [ ] Check for shadowing when declaring dcon +- [x] Check for shadowing when declaring dcon + - Handles the forward decl in `Zoo1.newt`, but we'll need different syntax if + we have different core terms for TCon/DCon/Function - [ ] Require infix decl before declaring names (helps find bugs) - [ ] sugar for typeclasses - [ ] maybe add implicits in core to help resugar operators? + - There is also a bit where kovacs uses the implicit on the type (a value) to decide to insert +- [ ] consider binders in environment, to better mark let and to provide names +- [ ] move some top-level chattiness to `debug` - [x] Allow unicode operators/names - Web playground - [x] editor @@ -19,8 +24,9 @@ - [ ] run javascript - [x] need to shim out Buffer - [x] get rid of stray INFO from auto resolution -- [ ] handle `if_then_else_` style mixfix - - [ ] equational reasoning sample (maybe PLFA "Lists") +- [x] handle `if_then_else_` style mixfix + - [x] equational reasoning sample (maybe PLFA "Lists") + - actual `if_then_else_` isn't practical because the language is strict - [x] Search should look at context - [ ] records - [ ] copattern matching @@ -59,10 +65,8 @@ - [x] matching on operators - [x] top level - [x] case statements -- [ ] Lean / Agda ⟨ ⟩ +- [ ] Lean / Agda ⟨ ⟩ (does agda do this or just lean?) - [ ] Lean-like .map, etc? (resolve name in namespace of target type, etc) -- [x] ~~SKIP list syntax~~ - - Agda doesn't have it, clashes with pair syntax - [x] autos / typeclass resolution - [x] very primitive version in place, not higher order, search at end - [x] monad is now working diff --git a/src/Lib/ProcessDecl.idr b/src/Lib/ProcessDecl.idr index 81e5c4c..ee7d7e4 100644 --- a/src/Lib/ProcessDecl.idr +++ b/src/Lib/ProcessDecl.idr @@ -175,25 +175,22 @@ processDecl (TypeSig fc names tm) = do putStrLn "-----" putStrLn "TypeSig \{unwords names} : \{show tm}" ty <- check (mkCtx top.metas fc) tm (VU fc) - putStrLn "got \{pprint [] ty}" - -- I was doing this previously, but I don't want to over-expand VRefs - -- ty' <- nf [] ty - -- putStrLn "nf \{pprint [] ty'}" - for_ names $ \nm => modify $ setDef nm ty Axiom + debug "got \{pprint [] ty}" + for_ names $ \nm => setDef nm fc ty Axiom -- Zoo4eg has metas in TypeSig, need to decide if I want to support that going forward. -- logMetas mstart processDecl (PType fc nm ty) = do top <- get ty' <- check (mkCtx top.metas fc) (maybe (RU fc) id ty) (VU fc) - modify $ setDef nm ty' PrimTCon + setDef nm fc ty' PrimTCon processDecl (PFunc fc nm ty src) = do top <- get ty <- check (mkCtx top.metas fc) ty (VU fc) ty' <- nf [] ty putStrLn "pfunc \{nm} : \{pprint [] ty'} := \{show src}" - modify $ setDef nm ty' (PrimFn src) + setDef nm fc ty' (PrimFn src) processDecl (Def fc nm clauses) = do putStrLn "-----" @@ -224,7 +221,7 @@ processDecl (Def fc nm clauses) = do tm' <- zonk top 0 [] tm putStrLn "NF \{pprint[] tm'}" debug "Add def \{nm} \{pprint [] tm'} : \{pprint [] ty}" - modify $ setDef nm ty (Fn tm') + updateDef nm fc ty (Fn tm') logMetas mstart processDecl (DCheck fc tm ty) = do @@ -249,7 +246,11 @@ processDecl (Data fc nm ty cons) = do mc <- readIORef top.metas let mstart = length mc.metas tyty <- check (mkCtx top.metas fc) ty (VU fc) - modify $ setDef nm tyty Axiom + case lookup nm top of + Just (MkEntry name type Axiom) => do + unifyCatch fc (mkCtx top.metas fc) !(eval [] CBN tyty) !(eval [] CBN type) + Just (MkEntry name type _) => error fc "\{show nm} already declared" + Nothing => setDef nm fc tyty Axiom cnames <- for cons $ \x => case x of (TypeSig fc names tm) => do debug "check dcon \{show names} \{show tm}" @@ -266,11 +267,12 @@ processDecl (Data fc nm ty cons) = do when (hn /= nm) $ error (getFC codomain) "Constructor codomain is \{pprint tnames codomain} rather than \{nm}" - for_ names $ \ nm' => modify $ setDef nm' dty (DCon (getArity dty) nm) + for_ names $ \ nm' => do + setDef nm' fc dty (DCon (getArity dty) nm) pure names _ => throwError $ E (0,0) "expected constructor declaration" putStrLn "setDef \{nm} TCon \{show $ join cnames}" - modify $ setDef nm tyty (TCon (join cnames)) + updateDef nm fc tyty (TCon (join cnames)) logMetas mstart where checkDeclType : Tm -> M () diff --git a/src/Lib/TopContext.idr b/src/Lib/TopContext.idr index f25df4c..05187d9 100644 --- a/src/Lib/TopContext.idr +++ b/src/Lib/TopContext.idr @@ -26,15 +26,42 @@ empty : HasIO m => m TopContext empty = pure $ MkTop [] !(newIORef (MC [] 0)) False !(newIORef []) [] empty ||| set or replace def. probably need to check types and Axiom on replace +-- public export +-- setDef : String -> Tm -> Def -> TopContext -> TopContext +-- setDef name ty def = { defs $= go } +-- where +-- go : List TopEntry -> List TopEntry +-- go [] = [MkEntry name ty def] +-- go (x@(MkEntry nm ty' def') :: defs) = if nm == name +-- then MkEntry name ty def :: defs +-- else x :: go defs + public export -setDef : String -> Tm -> Def -> TopContext -> TopContext -setDef name ty def = { defs $= go } +setDef : String -> FC -> Tm -> Def -> M () +setDef name fc ty def = do + top <- get + defs <- go top.defs + put $ { defs := defs } top where - go : List TopEntry -> List TopEntry - go [] = [MkEntry name ty def] + go : List TopEntry -> M (List TopEntry) + go [] = pure $ [MkEntry name ty def] go (x@(MkEntry nm ty' def') :: defs) = if nm == name - then MkEntry name ty def :: defs - else x :: go defs + then error fc "\{name} is already defined" + else (x ::) <$> go defs + +public export +updateDef : String -> FC -> Tm -> Def -> M () +updateDef name fc ty def = do + top <- get + defs <- go top.defs + put $ { defs := defs } top + where + go : List TopEntry -> M (List TopEntry) + go [] = error fc "\{name} not declared" + go (x@(MkEntry nm ty' def') :: defs) = if nm == name + then pure $ MkEntry name ty def :: defs + else (x ::) <$> go defs + public export addError : HasIO io => {auto top : TopContext} -> Error -> io ()