Primitive "Add missing cases" for vscode

TODO.md

@@ -1,6 +1,19 @@
 
 ## TODO
 
+- [ ] in-scope type at point in vscode
+  - So the idea here is that the references will be via FC, we remember the type at declaration and then point the usage back to the declaration (FC -> FC). We could dump all of this. (If we're still doing json.)
+  - Do we want to (maybe later) keep the scope as a FC? We could do scope at point then.
+  - But ideally we'd switch to a server/repl, so we don't have to mess around with serializing stuff.
+- [ ] LSP and/or more editor support
+  - [ ] would be nice to have "add missing cases" and "case split"
+  - [x] Probably need ranges for FC
+  - [ ] leave an interactive process running
+  - [ ] collect metadata or run through the serialization data
+  - [ ] rename in editor for top level functions (and maybe stuff in scope probably need LSP first)
+- [ ] Look into descriptions, etc.
+  - Can generating descriptions help with automatic "show" implementations
+  - We lost debug printing when switching to numeric tags
 - [ ] Add info to Ref/VRef (is dcon, arity, etc)
   - To save lookups during compilation and it might make eval faster
 - [x] number tags for data constructors
@@ -14,7 +27,8 @@
   - [ ] Maybe add qualified names to surface syntax and allow / detect conflicts on reference
   - [ ] Add `export` keywords
 - [ ] vscode - run newt when switching editors
-- [ ] who calls X?  We can only do this scoped to the current context for now. Someday whole source dir.
+- [ ] who calls X?  We can only do this scoped to the current context for now. Someday whole source dir. #lsp
+- [ ] Magic to make Bool a boolean
 - [ ] case split
   - We could fake this up:
     - given a name and a point in the editor
@@ -23,9 +37,9 @@
     - enumerate valid constructors (and their arity)
     - Repeat the line with each, applied to args
     - For `<-` or `let` we'd want to fudge some `|` lines
-- [ ] Support "Add missing cases"
+- [x] Support "Add missing cases"
-    - We could possibly fake up missing cases, too. Since they're listed and have an FC pointing at the first one
+  - This has been hakced together
-    - [ ] Might need proper, enumerated errors for that
+  - We could possibly fake up missing cases, too. Since they're listed and  have an FC pointing at the first one
 - [x] inline struct getters during code generation (We'd like  `x.h1.h2`)
 - [ ] Better FC for parse errors (both EOF and the ones that show up just after the error)
 - [x] Code gen for PiType (rather than static JS)
@@ -58,12 +72,7 @@
   - [ ] see if we can make the typeclass stuff a little leaner, e.g. inline a projection of a static record.
   - It would be nice if IO looked like imperative JS, but that might be a bit of a stretch.
 
-- [ ] LSP and/or more editor support
+
-  - [ ] would be nice to have "add missing cases" and "case split"
-  - [ ] Probably need ranges for FC
-  - [ ] leave an interactive process running
-  - [ ] collect metadata or run through the serialization data
-  - [ ] rename in editor for top level functions (and maybe stuff in scope, probably need LSP first)
 - [ ] warn on unused imports?
 - [x] redo code to determine base path
 - [x] emit only one branch for default case when splitting inductives
@@ -78,9 +87,10 @@
 - [x] get port to run
   - [x] something goes terribly wrong with traverse_ and for_ (related to erasure, I think)
 - [x] ~~don't use `take` - it's not stack safe~~ The newt version is stack safe
-- [ ] report info in case of error
+- [ ] show user hole info even in case of error
 - [x] tokenizer that can be ported to newt
 - [ ] Add default path for library, so we don't need symlinks everywhere and can write tests for the library
+  - We need this to work for tests / dev and for installed newt.
 - [x] string interpolation?
   - The tricky part here is the `}` - I need to run the normal tokenizer in a way that treats `}` specially.
   - Idris handles `putStrLn "done \{ show $ add {x=1} 2}"` - it recurses for `{` `}` pairs.  Do we want that complexity?
@@ -91,7 +101,8 @@
 - [x] for parse error, seek to col 0 token and process next decl
 - [x] record update sugar
 - [x] Change `Ord` to be more like Idris - LT / EQ / GT (and entail equality)
-- [ ] Keep a `compare` function on `SortedMap` (like lean)
+- [x] Keep a `compare` function on `SortedMap` (like lean)
+  - `emptyMap` helper defaults to `compare` from `Ord a`
 - [x] keymap for monaco
 - [x] SortedMap.newt issue in `where`
 - [x] fix "insufficient patterns", wire in M or Either String
@@ -163,7 +174,7 @@
 - [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 with `_` (helps find bugs) or implicitly define infixl something if it's missing
+- [ ] Require infix decl before declaring mixfix names with `_` (helps find bugs) or implicitly define as infixl something if it is missing
 - [x] sugar for typeclasses
 - [x] maybe add implicits in core to help resugar operators?
 - [ ] consider putting binders in environment, like Idris, to better mark `let` and to provide names
@@ -182,7 +193,8 @@
   - actual `if_then_else_` isn't practical because the language is strict
 - [x] Search should look at context
 - [ ] copattern matching
-- [ ] Get `Combinatory.newt` to work
+- [x] Get `Combinatory.newt` to work
+  - Fixed when eval was fixed
 - [x] Remember operators from imports
 - [x] Default cases for non-primitives (currently gets expanded to all constructors)
   - This may need a little care. But I think I could collect all constructors that only match wildcards into a single case. This would lose any information from breaking out the individual, unnamed cases though.
@@ -235,11 +247,9 @@
   - [x] push down to value/term
   - [x] check quantity
   - [x] erase in output
-  - [ ] remove erased top level arguments
+- [ ] remove erased top level arguments
 - [x] top level at point in vscode
-- [ ] in-scope type at point in vscode
 - [ ] repl
-- [ ] LSP
 - [x] don't match forced constructors at runtime
   - I think we got this by not switching for single cases
 - [x] magic nat (codegen as number with appropriate pattern matching)
@@ -249,10 +259,11 @@
 - [ ] add `pop` or variant of `pfunc` that maps to an operator, giving the js operator and precedence on RHS
   - This has now been hard-coded in codegen, but a syntax or something would be better.
 - [ ] consider moving caselet, etc. desugaring out of the parser
-- [ ] pattern matching lambda
+- [-] pattern matching lambda
+  - `\case` is sufficient
   - I kept wanting this in AoC and use it a lot in the newt code
   - This conflicts with current code (unused?) that allows telescope information in lambdas
-  - For now, I'll implement `\case`
+
 
 ### Parsing
 

newt-vscode/src/extension.ts

@@ -40,7 +40,6 @@ export function activate(context: vscode.ExtensionContext) {
     const lineText = document.lineAt(position.line).text;
     const start = Math.max(0, position.character - 10);
     const snippet = lineText.slice(start, position.character);
-    console.log(`change '${text}' snippet ${snippet}`);
     const m = snippet.match(/(\\[^ ]+)$/);
     if (m) {
       const cand = m[0];
@@ -282,6 +281,49 @@ export function activate(context: vscode.ExtensionContext) {
     if (document.fileName.endsWith(".newt")) checkDocument(document);
 
   context.subscriptions.push(diagnosticCollection);
+  context.subscriptions.push(
+    vscode.languages.registerCodeActionsProvider(
+      { language: "newt" },
+      {
+        provideCodeActions(document, range, context, token) {
+          const actions: vscode.CodeAction[] = [];
+          for (const diagnostic of context.diagnostics) {
+            let {message,range} = diagnostic
+            let m = diagnostic.message.match(/missing cases: (.*)/);
+            if (m) {
+              // A lot of this logic would also apply to case split.
+              let cons = m[1].split(', ');
+              const line = diagnostic.range.start.line;
+              const lineText = document.lineAt(line).text;
+              let m2 = lineText.match(/(.*=>?)/);
+              if (!m2) continue;
+              let s = range.start.character;
+              let e = range.end.character;
+              let a = lineText.slice(0,s);
+              let b = lineText.slice(e,m2[0].length);
+              let parens = a.endsWith('(') && b.startsWith(')');
+              let lines = cons.map(con =>
+                !parens && con.includes('_')
+                ? `${a}(${con})${b} ?`
+                : `${a}${con}${b} ?`);
+                const fix = new vscode.CodeAction(
+                  "Add missing cases",
+                  vscode.CodeActionKind.QuickFix
+                );
+                fix.edit = new vscode.WorkspaceEdit();
+                // TODO - we should skip over subsequent lines that are indented more than the current.
+                const insertPos = new vscode.Position(line + 1, 0);
+                fix.edit.insert(document.uri, insertPos, lines.join('\n') + '\n');
+                fix.diagnostics = [diagnostic];
+                fix.isPreferred = true;
+                actions.push(fix);
+            }
+          }
+          return actions;
+        }
+      }
+    )
+  );
 }
 
 export function deactivate() {}

src/Lib/Common.newt

@@ -14,7 +14,10 @@ record Bounds where
 
 -- FIXME we should handle overlap and out of order..
 instance Add Bounds where
-  a + b = MkBounds a.startLine a.startCol b.endLine b.endCol
+  a + b =
+    let a' = if a.startLine < b.startLine  || a.startLine == b.startLine && a.startCol < b.startCol then a else b
+        b' = if a.endLine < b.endLine || a.endLine == b.endLine && a.endCol < b.endCol then b else a
+    in MkBounds a'.startLine a'.startCol b'.endLine b'.endCol
 
 instance Eq Bounds where
   (MkBounds sl sc el ec) == (MkBounds sl' sc' el' ec') =
@@ -103,6 +106,9 @@ record FC where
   bnds : Bounds
 
 
+instance Add FC where
+  MkFC fn a + MkFC _ b = MkFC fn (a + b)
+
 instance ToJSON FC where
   toJson (MkFC file (MkBounds line col endline endcol)) = JsonObj (("file", toJson file) :: ("line", toJson line) :: ("col", toJson col) :: ("endline", toJson endline) :: ("endcol", toJson endcol):: Nil)
 
@@ -132,6 +138,9 @@ emptyFC' fn = MkFC fn (MkBounds 0 0 0 0)
 data QName : U where
   QN : List String -> String -> QName
 
+.baseName : QName → String
+(QN _ name).baseName = name
+
 instance Eq QName where
   -- `if` gets us short circuit behavior, idris has a lazy `&&`
   QN ns n == QN ns' n' = if n == n' then ns == ns' else False
@@ -159,7 +168,8 @@ showError src (E fc msg) = "ERROR at \{show fc}: \{msg}\n" ++ go 0 (lines src)
     go l Nil = ""
     go l (x :: xs) =
       if l == fcLine fc then
-        "  \{x}\n  \{replicate (cast $ fcCol fc) ' '}^\n"
+        let width = fc.bnds.endCol - fc.bnds.startCol + 1 in
+        "  \{x}\n  \{replicate (cast $ fcCol fc) ' '}\{replicate (cast width) '^'}\n"
       else if fcLine fc - 3 < l then "  " ++ x ++ "\n" ++ go (l + 1) xs
       else go (l + 1) xs
 showError src (Postpone fc ix msg) = "ERROR at \{show fc}: Postpone \{show ix} \{msg}\n" ++ go 0 (lines src)

src/Lib/Elab.newt

@@ -990,7 +990,7 @@ mkPat (tm, icit) = do
                 (Just (MkEntry _ name type (DCon _ _ k str) _)) => do
                   -- TODO check arity, also figure out why we need reverse
                   bpat <- traverse (mkPat) b
-                  pure $ PatCon fc icit name bpat Nothing
+                  pure $ PatCon (getFC tm) icit name bpat Nothing
                 -- This fires when a global is shadowed by a pattern var
                 -- Just _ => error (getFC tm) "\{show nm} is not a data constructor"
                 _ => case b of
@@ -1144,9 +1144,27 @@ 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 isDefault prob.clauses
-  when (length' defclauses == 0) $ \ _ => error fc "missing cases \{show missing} on \{show scnm}"
+  -- 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 _ _ Explicit _ _ t) = go "\{acc} _" t
+        go acc (Pi _ _ _ _ _ t) = go acc t
+        go acc _ = acc
+
     isDefault : Clause -> Bool
     isDefault cl = case find ((_==_ scnm) ∘ fst) cl.cons of
       Just (_, (PatVar _ _ _)) => True

src/Lib/Parser.newt

@@ -74,7 +74,7 @@ interpString = do
     append : Raw -> Raw -> Raw
     append t u =
       let fc = getFC t in
-      (RApp (getFC t) (RApp fc (RVar fc "_++_") t Explicit) u Explicit)
+      (RApp (fc + getFC u) (RApp fc (RVar fc "_++_") t Explicit) u Explicit)
 
 intLit : Parser Raw
 intLit = do
@@ -166,19 +166,18 @@ pratt ops prec stop left spine = do
         case lookupMap' nm ops of
           Just (MkOp name p fix False rule) => if p < prec
             then pure (left, spine)
-            else
+            else runRule p fix stop rule (RApp (getFC left + fc) (RVar fc name) left Explicit) rest
-              runRule p fix stop rule (RApp fc (RVar fc name) left Explicit) rest
           Just _ => fail "expected operator"
           Nothing =>
             if isPrefixOf "." nm
-            then pratt ops prec stop (RApp (getFC tm) tm left Explicit) rest
+            then pratt ops prec stop (RApp (getFC left + getFC tm) tm left Explicit) rest
-            else pratt ops prec stop (RApp (getFC left) left tm Explicit) rest
+            else pratt ops prec stop (RApp (getFC left + getFC tm) left tm Explicit) rest
-    ((icit, fc, tm) :: rest) => pratt ops prec stop (RApp (getFC left) left tm icit) rest
+    ((icit, fc, tm) :: rest) => pratt ops prec stop (RApp (getFC left + getFC tm) left tm icit) rest
   where
     projectHead : Raw -> AppSpine -> (Raw × AppSpine)
     projectHead t sp@((Explicit, fc', RVar fc nm) :: rest) =
       if isPrefixOf "." nm
-        then projectHead (RApp fc (RVar fc nm) t Explicit) rest
+        then projectHead (RApp (fc + getFC t) (RVar fc nm) t Explicit) rest
         else (t,sp)
     projectHead t sp = (t, sp)
 
@@ -188,7 +187,7 @@ pratt ops prec stop left spine = do
     runProject : AppSpine -> AppSpine
     runProject (t@(Explicit, fc', tm) :: u@(Explicit, _, RVar fc nm) :: rest) =
       if isPrefixOf "." nm
-        then runProject ((Explicit, fc', RApp fc (RVar fc nm) tm Explicit) :: rest)
+        then runProject ((Explicit, fc', RApp (fc + getFC tm) (RVar fc nm) tm Explicit) :: rest)
         else (t :: u :: rest)
     runProject tms = tms
 
@@ -203,7 +202,7 @@ pratt ops prec stop left spine = do
       case spine of
                 ((_, fc, right) :: rest) => do
                   (right, rest) <- pratt ops pr stop right rest
-                  pratt ops prec stop (RApp (getFC left) left right Explicit) rest
+                  pratt ops prec stop (RApp (getFC left + getFC right) left right Explicit) rest
                 _ => fail "trailing operator"
 
     runRule p fix stop (nm :: rule) left spine = do
@@ -215,7 +214,7 @@ pratt ops prec stop left spine = do
           let ((_,fc',RVar fc name) :: rest) = rest
             | _ => fail "expected \{nm}"
           if name == nm
-            then runRule p fix stop rule (RApp (getFC left) left right Explicit) rest
+            then runRule p fix stop rule (RApp (getFC left + getFC right) left right Explicit) rest
             else fail "expected \{nm}"
 
     -- run any prefix operators
@@ -417,7 +416,9 @@ term = do
   where
     apply : Raw -> List (FC × Raw) -> Raw
     apply t Nil = t
-    apply t ((fc,x) :: xs) = RApp fc t (apply x xs) Explicit
+    apply t ((fc,x) :: xs) =
+      let u = apply x xs in
+      RApp (getFC t + getFC u) t u Explicit
 
 varname : Parser String
 varname = (ident <|> uident <|> keyword "_" *> pure "_")