investigating issue

src/Lib/CaseTree.idr

@@ -128,14 +128,6 @@ getConstructors ctx tm = error (getValFC tm) "Not a type constructor \{show tm}"
 -- Extend environment with fresh variables from a pi-type
 -- return context, remaining type, and list of names
 extendPi : Context -> Val -> SnocList Bind -> M (Context, Val, List Bind)
--- NEXT This doesn't work, unsound.
--- We need all of these vars with icity _and_ to insert implicits in the pattern
--- extendPi ctx (VPi x str Implicit a b) nms = do
---     let nm = fresh "pat"
---     let ctx' = extend ctx nm a
---     let v = VVar emptyFC (length ctx.env) [<]
---     tyb <- b $$ v
---     extendPi ctx' tyb nms
 extendPi ctx (VPi x str icit a b) nms = do
     let nm = fresh "pat"
     let ctx' = extend ctx nm a
@@ -157,9 +149,11 @@ buildCase ctx prob scnm (dcName, _, ty) = do
   vty <- eval [] CBN ty
   (ctx', ty', vars) <- extendPi ctx (vty) [<]
 
-  debug "clauses were \{show prob.clauses} (dcon \{show dcName}) (vars \{show vars})"
+  debug "(dcon \{show dcName}) (vars \{show vars}) clauses were"
+  for_ prob.clauses $ (\x => debug "    \{show x}")
   let clauses = mapMaybe (rewriteClause vars) prob.clauses
-  debug "    and now \{show clauses}"
+  debug "and now:"
+  for_ clauses $ (\x => debug "    \{show x}")
   -- So ideally we'd know which position we're splitting and the surrounding context
   -- That might be a lot to carry forward (maybe a continuation?) but we could carry
   -- backwards as a List Missing that we augment as we go up.
@@ -205,7 +199,7 @@ buildCase ctx prob scnm (dcName, _, ty) = do
           PatVar _ s => Just $ c :: (xs ++ acc)
           PatWild _ => Just $ c :: (xs ++ acc)
           PatCon _ str ys => if str == dcName
-            then Just $ (makeConst vars ys) ++ acc
+            then Just $ (makeConst vars ys) ++ xs ++ acc
             else Nothing
         else rewriteCons vars xs (c :: acc)
 

src/Lib/Check.idr

@@ -112,6 +112,9 @@ parameters (ctx: Context)
     debug "  =?= \{show u}"
     t' <- forceMeta t
     u' <- forceMeta u
+    debug "forced \{show t'}"
+    debug "  =?= \{show u'}"
+    debug "env \{show ctx.env}"
     case (t',u') of
       (VLam _ _ t,  VLam _ _ t') => unify (l + 1) !(t $$ VVar emptyFC l [<]) !(t' $$ VVar emptyFC l [<])
       (t,         VLam fc' _ t') => unify (l + 1) !(t `vapp` VVar emptyFC l [<]) !(t' $$ VVar emptyFC l [<])
@@ -121,9 +124,11 @@ parameters (ctx: Context)
         if k == k' then unifySpine l (k == k') sp sp'
         else error emptyFC "vvar mismatch \{show k} \{show k'}"
       (VRef fc k def sp,   VRef fc' k' def' sp'  ) =>
-        if k == k' then unifySpine l (k == k') sp sp'
+        if k == k' then do
+          debug "unify \{show l} spine at \{k} \{show sp} \{show sp'}"
+          unifySpine l (k == k') sp sp'
         -- REVIEW - consider forcing?
-        else error emptyFC "vref mismatch \{show k} \{show k'}"
+        else error emptyFC "vref mismatch \{show k} \{show k'} -- \{show sp} \{show sp'}"
       (VMeta fc k sp,  VMeta fc' k' sp' ) =>
         if k == k' then unifySpine l (k == k') sp sp'
         else solve l k sp (VMeta fc' k' sp')
@@ -136,13 +141,14 @@ parameters (ctx: Context)
         debug "expand \{show t} =?= %ref \{k'}"
         case lookup k' !(get) of
           Just (MkEntry name ty (Fn tm)) => unify l t !(vappSpine !(eval [] CBN tm) sp')
-          _ => error emptyFC "unify failed \{show t'} =?= \{show u'} [no Fn]\n  env is \{show ctx.env} \{show $ map fst ctx.types}"
+          _ => error ctx.fc "unify failed \{show t'} =?= \{show u'} [no Fn]\n  env is \{show ctx.env} \{show $ map fst ctx.types}"
       -- REVIEW I'd like to quote this back, but we have l that aren't in the environment.
-      _ => error emptyFC "unify failed \{show t'} =?= \{show u'} \n  env is \{show ctx.env} \{show $ map fst ctx.types}"
+      _ => error ctx.fc "unify failed \{show t'} =?= \{show u'} \n  env is \{show ctx.env} \{show $ map fst ctx.types}"
 
 unifyCatch : FC -> Context -> Val -> Val -> M ()
 unifyCatch fc ctx ty' ty = catchError (unify ctx ctx.lvl ty' ty) $ \(E x str) => do
     let names = toList $ map fst ctx.types
+    debug "fail \{show ty'} \{show ty}"
     a <- quote ctx.lvl ty'
     b <- quote ctx.lvl ty
     let msg = "\n  failed to unify \{pprint names a}\n    with \{pprint names b}\n  " <+> str

src/Lib/Parser.idr

@@ -140,9 +140,9 @@ letExpr = do
       pure (name,fc,t)
 
 pLetArg : Parser (Icit, String, Maybe Raw)
-pLetArg = (Implicit,,) <$> braces ident <*> optional (sym ":" >> typeExpr)
-       <|> (Explicit,,) <$> parens ident <*> optional (sym ":" >> typeExpr)
-       <|> (Explicit,,Nothing) <$> ident
+pLetArg = (Implicit,,) <$> braces (ident <|> uident) <*> optional (sym ":" >> typeExpr)
+       <|> (Explicit,,) <$> parens (ident <|> uident) <*> optional (sym ":" >> typeExpr)
+       <|> (Explicit,,Nothing) <$> (ident <|> uident)
        <|> (Explicit,"_",Nothing) <$ keyword "_"
 
 -- lam: λ {A} {b : A} (c : Blah) d e f. something
@@ -203,7 +203,7 @@ term =  caseExpr
 ebind : Parser (List (String, Icit, Raw))
 ebind = do
   sym "("
-  names <- some ident
+  names <- some (ident <|> uident)
   sym ":"
   ty <- typeExpr
   sym ")"
@@ -213,7 +213,7 @@ ibind : Parser (List (String, Icit, Raw))
 ibind = do
   sym "{"
   mustWork $ do
-    names <- some ident
+    names <- some (ident <|> uident)
     ty <- optional (sym ":" >> typeExpr)
     pos <- getPos
     sym "}"
@@ -262,7 +262,7 @@ export
 parseDef : Parser Decl
 parseDef = do
   fc <- getPos
-  nm <- ident
+  nm <- ident <|> uident
   pats <- many pPattern
   keyword "="
   body <- mustWork typeExpr
@@ -289,14 +289,16 @@ parseData : Parser Decl
 parseData = do
   fc <- getPos
   keyword "data"
-  name <- uident
-  keyword ":"
-  ty <- typeExpr
-  keyword "where"
-  commit
-  decls <- startBlock $ manySame $ parseSig
-  -- TODO - turn decls into something more useful
-  pure $ Data fc name ty decls
+  -- FIXME - switch from mustWork / commit to checking if we've consumed tokens
+  mustWork $ do
+    name <- uident
+    keyword ":"
+    ty <- typeExpr
+    keyword "where"
+    commit
+    decls <- startBlock $ manySame $ parseSig
+    -- TODO - turn decls into something more useful
+    pure $ Data fc name ty decls
 
 -- Not sure what I want here.
 -- I can't get a Tm without a type, and then we're covered by the other stuff

src/Lib/ProcessDecl.idr

@@ -37,7 +37,7 @@ processDecl (TypeSig fc nm tm) = do
     | _ => error fc "\{show nm} is already defined"
   putStrLn "-----"
   putStrLn "TypeSig \{nm} \{show tm}"
-  ty <- check (mkCtx top.metas) tm (VU fc)
+  ty <- check (mkCtx top.metas fc) tm (VU fc)
   ty' <- nf [] ty
   putStrLn "got \{pprint [] ty'}"
   modify $ setDef nm ty' Axiom
@@ -47,7 +47,7 @@ processDecl (PType fc nm) = do
   modify $ setDef nm (U fc) PrimTCon
 processDecl (PFunc fc nm ty src) = do
   top <- get
-  ty <- check (mkCtx top.metas) ty (VU fc)
+  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)
@@ -69,8 +69,7 @@ processDecl (Def fc nm clauses) = do
   vty <- eval empty CBN ty
   putStrLn "vty is \{show vty}"
 
-  tm <- buildTree ({ fc := fc} $ mkCtx ctx.metas) (MkProb clauses vty)
-  -- tm <- check (mkCtx ctx.metas) body vty
+  tm <- buildTree (mkCtx ctx.metas fc) (MkProb clauses vty)
   putStrLn "Ok \{pprint [] tm}"
 
   mc <- readIORef ctx.metas
@@ -86,10 +85,10 @@ processDecl (Def fc nm clauses) = do
 processDecl (DCheck fc tm ty) = do
   top <- get
   putStrLn "check \{show tm} at \{show ty}"
-  ty' <- check (mkCtx top.metas) tm (VU fc)
+  ty' <- check (mkCtx top.metas fc) tm (VU fc)
   putStrLn "got type \{pprint [] ty'}"
   vty <- eval [] CBN ty'
-  res <- check (mkCtx top.metas) ty vty
+  res <- check (mkCtx top.metas fc) ty vty
   putStrLn "got \{pprint [] res}"
   norm <- nf [] res
   putStrLn "norm \{pprint [] norm}"
@@ -104,7 +103,7 @@ processDecl (DImport fc str) = throwError $ E fc "import not implemented"
 processDecl (Data fc nm ty cons) = do
   -- It seems like the FC for the errors are not here?
   ctx <- get
-  tyty <- check (mkCtx ctx.metas) ty (VU fc)
+  tyty <- check (mkCtx ctx.metas fc) ty (VU fc)
   -- FIXME we need this in scope, but need to update
   modify $ setDef nm tyty Axiom
   ctx <- get
@@ -112,7 +111,7 @@ processDecl (Data fc nm ty cons) = do
       -- expecting tm to be a Pi type
       (TypeSig fc nm' tm) => do
           ctx <- get
-          dty <- check (mkCtx ctx.metas) tm (VU fc)
+          dty <- check (mkCtx ctx.metas fc) tm (VU fc)
           debug "dty \{nm'} is \{pprint [] dty}"
 
           -- We only check that codomain uses the right type constructor

src/Lib/Syntax.idr

@@ -48,7 +48,6 @@ record Clause where
   -- it has names from Pats, which will need types in the env
   expr : Raw
 
-
 -- could be a pair, but I suspect stuff will be added?
 public export
 data RCaseAlt = MkAlt Raw Raw

src/Lib/Types.idr

@@ -378,8 +378,8 @@ M = (StateT TopContext (EitherT Impl.Error IO))
 -- we need more of topcontext later - Maybe switch it up so we're not passing
 -- around top
 export
-mkCtx : IORef MetaContext -> Context
-mkCtx metas = MkCtx 0 [] [] [] metas emptyFC
+mkCtx : IORef MetaContext -> FC -> Context
+mkCtx metas fc = MkCtx 0 [] [] [] metas fc
 
 ||| Force argument and print if verbose is true
 export