add missing and case split for lsp

src/Lib/Elab.newt

@@ -245,8 +245,6 @@ solveAutos = do
       res <- trySolveAuto e
       if res then pure True else run es
 
--- We need to switch to SortedMap here
-
 updateMeta : QName -> (MetaEntry -> M MetaEntry) -> M Unit
 updateMeta ix f = do
   top <- getTop
@@ -713,6 +711,14 @@ findSplit (x@(PC nm (PatCon _ _ _ _ _) _) :: xs) = Just x
 findSplit (x@(PC nm (PatLit _ val) _) :: xs) = Just x
 findSplit (x :: xs) = findSplit xs
 
+lookupDCon : QName -> M (QName × Int × Tm)
+lookupDCon nm = do
+  top <- getTop
+  case lookup nm top of
+    (Just (MkEntry _ name type (DCon _ _ k str) _)) => pure (name, length' k, type)
+    Just _ => error emptyFC "Internal Error: \{show nm} is not a DCon"
+    Nothing => error emptyFC "Internal Error: DCon \{show nm} not found"
+
 -- Get the constructors for a type
 getConstructors : Context -> FC -> Val -> M (List (QName × Int × Tm))
 getConstructors ctx scfc (VRef fc nm _) = do
@@ -725,13 +731,7 @@ getConstructors ctx scfc (VRef fc nm _) = do
       case lookup nm top of
         (Just (MkEntry _ name type (TCon _ names) _)) => pure names
         _ => error scfc "Not a type constructor: \{show nm}"
-    lookupDCon : QName -> M (QName × Int × Tm)
-    lookupDCon nm = do
-      top <- getTop
-      case lookup nm top of
-        (Just (MkEntry _ name type (DCon _ _ k str) _)) => pure (name, length' k, type)
-        Just _ => error fc "Internal Error: \{show nm} is not a DCon"
-        Nothing => error fc "Internal Error: DCon \{show nm} not found"
+
 getConstructors ctx scfc tm = do
   tms <- vprint ctx tm
   error scfc "Can't split - not VRef: \{tms}"
@@ -1088,9 +1088,15 @@ checkDone fc ctx Nil (Just body) ty = do
   got <- check ctx body ty
   debug $ \ _ => "DONE<- got \{rpprint (names ctx) got}"
   pure got
-checkDone fc ctx (PC x (PatWild _ _) scty :: xs) body ty = checkDone fc ctx xs body ty
-checkDone fc ctx (PC nm (PatVar _ _ nm') scty :: xs) body ty =
-  let ctx = MkCtx ctx.lvl ctx.env (rename ctx.types) ctx.bds ctx.ctxFC in
+checkDone fc ctx (PC x (PatWild pvfc icit) scty :: xs) body ty = do
+  -- sometimes have the same FC as real arguments
+  when (icit == Explicit) $ \ _ => addInfo $ CaseSplit pvfc ctx "_" scty
+  checkDone fc ctx xs body ty
+checkDone fc ctx (PC nm (PatVar pvfc _ nm') scty :: xs) body ty = do
+  -- TIME 5.50 -> 5.62 (we can flag this if it's an issue)
+  addInfo $ CaseSplit pvfc ctx nm' scty
+
+  let ctx = MkCtx ctx.lvl ctx.env (rename ctx.types) ctx.bds ctx.ctxFC
   checkDone fc ctx xs body ty
   where
     rename : List (String × Val) -> List (String × Val)
@@ -1182,26 +1188,13 @@ buildLitCase ctx prob fc scnm scty lit = do
 buildDefault : Context → Problem → FC → String → List QName → M CaseAlt
 buildDefault ctx prob fc scnm missing = do
   let defclauses = filter (isDefaultCase scnm) prob.clauses
-  -- HACK - For missing cases, we leave enough details in the error message to enable
-  -- the editor to add them
-  -- We can't do this precisely without a better pretty printer.
-  when (length' defclauses == 0) $ \ _ => do
-      missing <- traverse applied missing
-      error fc "missing cases: \{show missing}"
-  CaseDefault <$> buildTree ctx (MkProb defclauses prob.ty)
-  where
-    -- apply a dcon to _ for each explicit argument
-    applied : QName → M String
-    applied qn = do
-      top <- getTop
-      case lookup qn top of
-        Just (MkEntry _ _ ty (DCon _ _ _ _) _) => pure $ go qn.baseName ty
-        _ => pure qn.baseName
-      where
-        go : String → Tm → String
-        go acc (Pi _ nm Explicit _ _ t) = go "\{acc} \{nm}" t
-        go acc (Pi _ _ _ _ _ t) = go acc t
-        go acc _ = acc
+  case defclauses of
+    Nil => do
+      addInfo $ MissingCases fc ctx missing
+      addError $ E fc "missing cases: \{show missing}"
+      hole <- freshMeta ctx fc prob.ty ErrorHole
+      pure $ CaseDefault hole
+    _ => CaseDefault <$> buildTree ctx (MkProb defclauses prob.ty)
 
 buildLitCases : Context -> Problem -> FC -> String -> Val -> M (List CaseAlt)
 buildLitCases ctx prob fc scnm scty = do
@@ -1543,17 +1536,7 @@ check ctx tm ty = do
       unifyCatch (getFC tm) ctx ty' ty
       pure tm'
 
--- We assume the types are the same here, which looses some flexibility
--- This does not work because the meta is unsolved when `updateRecord` tries to do
--- its thing. We would need to defer elab to get this to work - insert placeholder
--- and solve it later.
-infer ctx tm@(RUpdateRec fc _ _) = do
-  error fc "I can't infer record updates"
-  -- mvar <- freshMeta ctx fc (VU emptyFC) Normal
-  -- a <- eval ctx.env mvar
-  -- let ty = VPi fc ":ins" Explicit Many a (MkClosure ctx.env mvar)
-  -- tm <- check ctx tm ty
-  -- pure (tm, ty)
+infer ctx tm@(RUpdateRec fc _ _) = error fc "I can't infer record updates"
 
 infer ctx (RVar fc nm) = go 0 ctx.types
   where
@@ -1601,7 +1584,7 @@ infer ctx (RApp fc t u icit) = do
       -- If it's not a VPi, try to unify it with a VPi
       -- TODO test case to cover this.
       tty => do
-        debug $ \ _ => "unify PI for \{show tty}"
+        debug $ \ _ => "unify PI for \{show tty} at \{show $ getFC tty}"
         a <- freshMeta ctx fc (VU emptyFC) Normal >>= eval ctx.env
         b <- MkClosure ctx.env <$> freshMeta (extend ctx ":ins" a) fc (VU emptyFC) Normal
         -- FIXME - I had to guess Many here.  What are the side effects?

src/Lib/Erasure.newt

@@ -96,7 +96,7 @@ erase env t sp = case t of
   (Bnd fc k) => do
     case getAt (cast k) env of
       Nothing => error fc "bad index \{show k}"
-      Just (nm, Zero, ty) => error fc "used erased value \{show nm} (FIXME FC may be wrong here - see Elab.lookupName)"
+      Just (nm, Zero, ty) => error fc "used erased value \{show nm} (FIXME FC may be wrong here)"
       Just (nm, Many, ty) => eraseSpine env t sp ty
   (UU fc) => eraseSpine env t sp (Just $ UU fc)
   (Lit fc lit) => eraseSpine env t sp Nothing

src/Lib/ProcessModule.newt

@@ -21,7 +21,7 @@ addPrimitives = do
   processDecl primNS (PType emptyFC "Char" Nothing)
   setDef (QN primNS "PiType") emptyFC (Erased emptyFC) (PrimFn "(h0, h1) => ({ tag: \"PiType\", h0, h1 });" (S (S Z)) Nil) Nil
   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 Nil
   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
@@ -106,11 +106,12 @@ processModule importFC repo stk modns = do
   top <- getTop
   let freshMC = MC emptyMap Nil 0 CheckAll
   -- NOW Print and drop errors here
-  -- set imported, mod, freshMC, ops  before processing
+  -- clear per module fields before processing this module
   modifyTop [ imported := imported
             ; hints := emptyMap
             ; ns := modns
             ; defs := emptyMap
+            ; infos := Nil
             ; metaCtx := freshMC
             ; ops := ops
             ]
@@ -124,7 +125,7 @@ processModule importFC repo stk modns = do
   -- update modules with result, leave the rest of context in case this is top file
   top <- getTop
 
-  let mod = MkModCtx src top.defs top.metaCtx top.ops imported top.errors
+  let mod = MkModCtx src top.defs top.metaCtx top.ops imported top.errors top.infos
 
   let modules = updateMap modns mod top.modules
   modifyTop [modules := modules]
@@ -159,5 +160,4 @@ invalidateModule modname = do
     go deps (name :: names) = do
       modifyTop [modules $= deleteMap name]
       let ds = fromMaybe Nil $ lookupMap' name deps
-      putStrLn "Chase \{name} → \{show ds}"
       go deps $ ds ++ names

src/Lib/TopContext.newt

@@ -47,7 +47,7 @@ instance Show TopContext where
   show top = "\nContext:\n [\{ joinBy "\n" $ map (show ∘ snd) $ toList top.defs}]"
 
 emptyTop : TopContext
-emptyTop = MkTop emptyMap Nil emptyMap "" emptyMap (MC emptyMap Nil 0 CheckAll) 0 Nil emptyMap
+emptyTop = MkTop emptyMap Nil emptyMap Nil "" emptyMap (MC emptyMap Nil 0 CheckAll) 0 Nil emptyMap
 
 
 setFlag : QName → FC → EFlag → M Unit
@@ -94,4 +94,9 @@ addHint qn = do
 addError : Error -> M Unit
 addError err = do
   top <- getTop
-  modifyTop [ errors $= _::_ err ]
+  modifyTop [ errors $= (err ::) ]
+
+addInfo : EditorInfo → M Unit
+addInfo info = do
+  top <- getTop
+  modifyTop [ infos $= (info ::)]

src/Lib/Types.newt

@@ -294,17 +294,19 @@ showClosure (MkClosure xs t) = "(%cl [\{show $ length xs} env] \{show t})"
 
 Context : U
 
-data MetaKind = Normal | User | AutoSolve
+data MetaKind = Normal | User | AutoSolve | ErrorHole
 
 instance Show MetaKind where
   show Normal = "Normal"
   show User = "User"
   show AutoSolve = "Auto"
+  show ErrorHole = "ErrorHole"
 
 instance Eq MetaKind where
   Normal == Normal = True
   User == User = True
   AutoSolve == AutoSolve = True
+  ErrorHole == ErrorHole = True
   _ == _ = False
 
 -- constrain meta applied to val to be a val
@@ -394,6 +396,11 @@ record TopEntry where
 instance Show TopEntry where
   show (MkEntry fc name type def flags) = "\{show name} : \{show type} := \{show def} \{show flags}"
 
+data EditorInfo
+  = CaseSplit FC Context String Val
+  -- Not sure we need Context here?
+  | MissingCases FC Context (List QName)
+
 record ModContext where
   constructor MkModCtx
   modSource : String
@@ -404,6 +411,7 @@ record ModContext where
   ctxOps : Operators
   modDeps : List String
   modErrors : List Error
+  modInfos : List EditorInfo
 
 -- Top level context.
 -- Most of the reason this is separate is to have a different type
@@ -414,17 +422,25 @@ record ModContext where
 
 -- A placeholder while walking through dependencies of a module
 emptyModCtx : String → ModContext
-emptyModCtx csum = MkModCtx csum emptyMap (MC emptyMap Nil 0 NoCheck) emptyMap Nil Nil
+emptyModCtx source = MkModCtx source emptyMap (MC emptyMap Nil 0 NoCheck) emptyMap Nil Nil Nil
 
 HintTable : U
 HintTable = SortedMap QName (List (QName × Tm))
 
+
+-- DERIVE - HasFC would be an example of a user-defined derived
+instance HasFC EditorInfo where
+  getFC (CaseSplit fc _ _ _) = fc
+  getFC (MissingCases fc _ _) = fc
+
+
 record TopContext where
   constructor MkTop
   modules : SortedMap String ModContext
   imported : List String
   -- TCon name → function name × type
   hints : HintTable
+  infos : List EditorInfo
 
   -- current module
   ns : String