check for shadowed names at top level

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
+- [x] handle `if_then_else_` style mixfix
-  - [ ] equational reasoning sample (maybe PLFA "Lists")
+  - [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

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}"
+  debug "got \{pprint [] ty}"
-  -- I was doing this previously, but I don't want to over-expand VRefs
+  for_ names $ \nm => setDef nm fc ty Axiom
-  -- ty' <- nf [] ty
-  -- putStrLn "nf \{pprint [] ty'}"
-  for_ names $ \nm => modify $ setDef nm 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 ()

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 : String -> FC -> Tm -> Def -> M ()
-setDef name ty def = { defs $= go }
+setDef name fc ty def = do
+  top <- get
+  defs <- go top.defs
+  put $ { defs := defs } top
   where
-    go : List TopEntry -> List TopEntry
+    go : List TopEntry -> M (List TopEntry)
-    go [] = [MkEntry name ty def]
+    go [] = pure $ [MkEntry name ty def]
     go (x@(MkEntry nm ty' def') :: defs) = if nm == name
-      then MkEntry name ty def :: defs
+      then error fc "\{name} is already defined"
-      else x :: go defs
+      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 ()