record update syntax

TODO.md

@@ -1,15 +1,18 @@
 
 ## TODO
 
-Syntax -> Parser.Impl ?
-
-- [ ] Eq Nat is not being identified as tail recursive...
+- [ ] vscode - run newt when switching editors
+- [ ] inline struct getters
 - [x] fix string highlighting
 - [x] implement tail call optimization
 - [x] implement magic nat
+- [ ] record update can't elaborate if type is unsolved meta
+  - need to postpone elab until meta is known. Create fresh meta for the term to return and have postponed elab fill it in later.
 - [ ] drop erased args on types and top level functions
 - [ ] can I do some inlining without blowing up code size?
-- [ ] use hint table for auto solving. (I think walking the `toList` is a big chunk of performance in `Elab.newt`.)
+  - [ ] Maybe tag some functions as inline
+  - [ ] Eq Nat is not tail recursive because of the call to `==`
+- [x] use hint table for auto solving. (I think walking the `toList` is a big chunk of performance in `Elab.newt`.)
 - [x] implement string enum (or number, but I'm using strings for tags at the moment)
 - [x] use monaco input method instead of lean's
 - [x] `Def` is shadowed between Types and Syntax (TCon vs DCon), detect this
@@ -21,6 +24,7 @@ Syntax -> Parser.Impl ?
   - Two issues
     - I'm rewriting stuff in the context, leaving it in a bad state (forward references). I think I can avoid this.
     - The variables at the end of pattern matching have types with references in the wrong order. I think we can reorder them on dependencies.
+    - should w
 - Improve `auto`
   - [ ] Improve cases where the auto isn't solved because of a type error
   - [ ] Handle `Foo Blah`, `Foo a => Bar a` vs `Bar Blah`
@@ -48,9 +52,6 @@ Syntax -> Parser.Impl ?
 - [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
-
-More comments in code! This is getting big enough that I need to re-find my bearings when fixing stuff.
-
 - [ ] report info 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
@@ -62,8 +63,7 @@ More comments in code! This is getting big enough that I need to re-find my bear
   - need to scan sigs and then defs, will have to make sure Compile.idr puts them all in scope before processing each.
 - [x] Move on to next decl in case of error
 - [x] for parse error, seek to col 0 token and process next decl
-- [ ] record update sugar, syntax TBD
-  - I think I'm going to hold off on this for now as it requires the type to elaborate. This ends up at the head of an app, which typically is inferred. We'd need a special case somewhere that infers its argument instead.
+- [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] keymap for monaco

newt-vscode/syntaxes/newt.tmLanguage.json

@@ -24,6 +24,10 @@
       "end": "`",
       "patterns": [{ "include": "source.js" }]
     },
+    {
+      "name": "character",
+      "match": "'\\\\?.'"
+    },
     {
       "name": "string.double.newt",
       "begin": "\"",

src/Lib/Elab.newt

@@ -1313,9 +1313,60 @@ undo prev ((DoArrow fc left right alts) :: xs) = do
   pure $ RApp fc (RApp fc (RVar fc "_>>=_") right Explicit)
     (RLam fc (BI fc nm Explicit Many) rest) Explicit
 
+
+
+
+-- REVIEW do we want to let arg?
+-- collect fields and default assignment
+-- subst in real assignment
+updateRec : Context → FC → List UpdateClause → Maybe Raw → Val → M Tm
+updateRec ctx fc clauses arg ty = do
+  ((QN _ conname), args) <- getTele arg ty
+  args' <- foldlM doClause args clauses
+  let tm = foldl (\ acc tm => RApp (getFC tm) acc tm Explicit) (RVar fc conname) $ map snd args'
+  let tm = case arg of
+    Just arg => tm
+    Nothing => RLam fc (BI fc "$ru" Explicit Many) tm
+  check ctx tm ty
+  where
+    doClause : List (String × Raw) → UpdateClause → M (List (String × Raw))
+    doClause args (ModifyField fc nm tm) = go args
+      where
+        go : List (String × Raw) → M (List (String × Raw))
+        go Nil = error fc "\{nm} is not a field of \{show ty}"
+        go (x :: xs) = if fst x == nm
+        -- need arg in here and apply tm to arg
+          then pure $ (nm, RApp fc tm (snd x) Explicit) :: xs
+          else _::_ x <$> go xs
+    doClause args (AssignField fc nm tm) = go args
+      where
+        go : List (String × Raw) → M (List (String × Raw))
+        go Nil = error fc "\{nm} is not a field of \{show ty}"
+        go (x :: xs) = if fst x == nm then pure $ (nm, tm) :: xs else _::_ x <$> go xs
+
+    collect : Raw → Tm → List (String × Raw)
+    collect arg (Pi _ nm _ _ a b) = (nm, RApp fc (RVar fc $ "." ++ nm) arg Explicit) :: collect arg b
+    collect _ _ = Nil
+
+    getTele : Maybe Raw → Val → M (QName × List (String × Raw))
+    getTele (Just arg) (VRef fc nm sp) = do
+      top <- getTop
+      let (Just (MkEntry _ _ _ (TCon _ (conname :: Nil)) _)) = lookup nm top
+        | Just _ => error fc "\{show nm} is not a record"
+        | _ => error fc "\{show nm} not in scope"
+      let (Just (MkEntry _ _ ty (DCon _ _ _) _)) = lookup conname top
+        | _ => error fc "\{show conname} not a dcon"
+      pure $ (conname, collect arg ty)
+    --
+    getTele Nothing (VPi _ _ _ _ a b) = getTele (Just $ RVar fc "$ru") a
+    getTele Nothing v = error (getFC v) "Expected a pi type, got \{show v}"
+    getTele _ v = error (getFC v) "Expected a record type, got \{show v}"
+
+
 check ctx tm ty = do
   ty' <- forceType ctx.env ty
   case (tm, ty') of
+    (RUpdateRec fc clauses arg, ty) => updateRec ctx fc clauses arg ty
     (RWhere fc decls body, ty) => checkWhere ctx (collectDecl decls) body ty
     (RIf fc a b c, ty) =>
       let tm' = RCase fc a ( MkAlt (RVar (getFC b) "True") b :: MkAlt (RVar (getFC c) "False") c  :: Nil) in
@@ -1406,6 +1457,18 @@ 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 CBN mvar
+  -- let ty = VPi fc ":ins" Explicit Many a (MkClosure ctx.env mvar)
+  -- tm <- check ctx tm ty
+  -- pure (tm, ty)
+
 infer ctx (RVar fc nm) = go 0 ctx.types
   where
     go : Int -> List (String × Val)  -> M (Tm × Val)

src/Lib/Parser.newt

@@ -110,6 +110,8 @@ asAtom = do
     Nothing  => pure $ RVar fc nm
 
 -- the inside of Raw
+recordUpdate : Parser Raw
+
 atom : Parser Raw
 atom = do
   pure MkUnit
@@ -122,14 +124,34 @@ atom = do
     <|> RImplicit <$> getPos <* keyword "_"
     <|> RHole <$> getPos <* keyword "?"
     <|> parenWrap typeExpr
+    <|> recordUpdate
+
+updateClause : Parser UpdateClause
+updateClause = do
+  fc <- getPos
+  nm <- ident
+  op <- True <$ symbol ":=" <|> False <$ symbol "$="
+  tm <- term
+  case op of
+    True => pure $ AssignField fc nm tm
+    _    => pure $ ModifyField fc nm tm
+
+-- ambiguity vs {a} or {a} -> ... is tough, we can do [] or put a keyword in front.
+recordUpdate = do
+  fc <- getPos
+  symbol "["
+  clauses <- sepBy (symbol ";") updateClause
+  symbol "]"
+  tm <- optional atom
+  pure $ RUpdateRec fc clauses tm
 
 -- Argument to a Spine
 pArg : Parser (Icit × FC × Raw)
 pArg = do
   fc <- getPos
-  (\x => Explicit, fc, x) <$> atom
-    <|> (\x => Implicit, fc, x) <$> braces typeExpr
+  (\x => Implicit, fc, x) <$> braces typeExpr
     <|> (\x => Auto, fc, x) <$> dbraces typeExpr
+    <|> (\x => Explicit, fc, x) <$> atom
 
 AppSpine : U
 AppSpine = List (Icit × FC × Raw)

src/Lib/Syntax.newt

@@ -55,6 +55,7 @@ record Clause where
 
 data RCaseAlt = MkAlt Raw Raw
 
+data UpdateClause = AssignField FC String Raw | ModifyField FC String Raw
 
 data DoStmt : U where
   DoExpr : (fc : FC) -> Raw -> DoStmt
@@ -64,7 +65,7 @@ data DoStmt : U where
 Decl : U
 data Raw : U where
   RVar : (fc : FC) -> (nm : Name) -> Raw
-  RLam : (fc : FC) -> BindInfo -> (ty : Raw) -> Raw
+  RLam : (fc : FC) -> BindInfo -> (sc : Raw) -> Raw
   RApp : (fc : FC) -> (t : Raw) -> (u : Raw) -> (icit : Icit) -> Raw
   RU   : (fc : FC) -> Raw
   RPi  : (fc : FC) -> BindInfo -> (ty : Raw) -> (sc : Raw) -> Raw
@@ -78,6 +79,9 @@ data Raw : U where
   RIf : (fc : FC) -> Raw -> Raw -> Raw -> Raw
   RWhere : (fc : FC) -> (List Decl) -> Raw -> Raw
   RAs : (fc : FC) -> Name -> Raw -> Raw
+  -- has to be applied or we have to know its type as Foo → Foo to elaborate.
+  -- I can bake the arg in here, or require an app in elab.
+  RUpdateRec : (fc : FC) → List UpdateClause → Maybe Raw → Raw
 
 instance HasFC Raw where
   getFC (RVar fc nm) = fc
@@ -95,6 +99,7 @@ instance HasFC Raw where
   getFC (RIf fc _ _ _) = fc
   getFC (RWhere fc _ _) = fc
   getFC (RAs fc _ _) = fc
+  getFC (RUpdateRec fc _ _) = fc
 
 
 data Import = MkImport FC Name
@@ -184,10 +189,14 @@ instance Show Pattern where
 instance Show RCaseAlt where
   show (MkAlt x y)= foo ("MkAlt" :: show x :: show y :: Nil)
 
+instance Show UpdateClause where
+  show (ModifyField _ nm tm) = foo ("ModifyField" :: nm :: show tm :: Nil)
+  show (AssignField _ nm tm) = foo ("AssignField" :: nm :: show tm :: Nil)
 
 instance Show Raw where
   show (RImplicit _) = "_"
   show (RHole _) = "?"
+  show (RUpdateRec _ clauses tm) = foo ("RUpdateRec" :: show clauses :: show tm :: Nil)
   show (RVar _ name) = foo ("RVar" :: show name :: Nil)
   show (RAnn _ t ty) = foo ( "RAnn" :: show t :: show ty :: Nil)
   show (RLit _ x) = foo ( "RLit" :: show x :: Nil)
@@ -257,6 +266,7 @@ instance Pretty Raw where
     asDoc p (RIf _ x y z) = par p 0 $ text "if" <+> asDoc 0 x <+/> text "then" <+> asDoc 0 y <+/> text "else" <+> asDoc 0 z
     asDoc p (RWhere _ dd b) = text "TODO pretty where"
     asDoc p (RAs _ nm x) = text nm ++ text "@(" ++ asDoc 0 x ++ text ")"
+    asDoc p (RUpdateRec _ clauses tm) = text "{" <+> text "TODO RUpdateRec" <+> text "}"
 
 prettyBind : (BindInfo × Raw) -> Doc
 prettyBind (BI _ nm icit quant, ty) = wrap icit (text (show quant ++ nm) <+> text ":" <+> pretty ty)

src/Lib/Tokenizer.newt

@@ -14,7 +14,7 @@ import Data.String
 import Data.SnocList
 
 standalone : List Char
-standalone = unpack "()\\{}[],.@"
+standalone = unpack "()\\{}[],.@;"
 
 keywords : List String
 keywords = ("let" :: "in" :: "where" :: "case" :: "of" :: "data" :: "U" :: "do" ::
@@ -25,7 +25,8 @@ keywords = ("let" :: "in" :: "where" :: "case" :: "of" :: "data" :: "U" :: "do"
             -- it would be nice to find a way to unkeyword "." so it could be
             -- used as an operator too
             "$" :: "λ" :: "?" :: "@" :: "." ::
-             "->" :: "→" :: ":" :: "=>" :: ":=" :: "=" :: "<-" :: "\\" :: "_" :: "|" :: Nil)
+             "->" :: "→" :: ":" :: "=>" :: ":=" :: "$="
+             :: "=" :: "<-" :: "\\" :: "_" :: "|" :: Nil)
 
 record TState where
   constructor TS

src/Main.newt

@@ -103,7 +103,7 @@ processModule importFC base stk qn@(QN ns nm) = do
   let name = joinBy "." modns
   let (Nothing) = lookupMap modns top.modules | _ => pure ""
   -- dummy entry for processing
-  modifyTop (\ top => MkTop (updateMap modns (emptyModCtx "") top.modules) top.imported top.hints top.ns top.defs top.metaCtx top.verbose top.errors top.ops)
+  modifyTop [modules := updateMap modns (emptyModCtx "") top.modules]
   let fn = (joinBy "/" (base :: ns)) ++ "/" ++ nm ++ ".newt"
   (Right src) <- liftIO {M} $ readFile fn
     | Left err => exitFailure "ERROR at \{show importFC}: error reading \{fn}: \{show err}"
@@ -143,11 +143,10 @@ processModule importFC base stk qn@(QN ns nm) = do
     | Just mod => do
       let modules = updateMap modns mod top.modules
 
-      modifyTop (\ top =>
       -- FIXME - we don't want stray operators in a module.
       -- inject module ops into top
       let ops = foldMap const top.ops $ toList mod.ctxOps
-        in MkTop modules top.imported top.hints top.ns top.defs top.metaCtx top.verbose top.errors ops)
+      modifyTop [modules := modules; ops := ops ]
       pure src  -- why am I returning this?
 
   log 1 $ \ _ => "MODNS " ++ show modns
@@ -176,7 +175,7 @@ processModule importFC base stk qn@(QN ns nm) = do
     else pure MkUnit
 
   let modules = updateMap modns mod top.modules
-  modifyTop (\ top => MkTop modules top.imported top.hints top.ns top.defs top.metaCtx top.verbose top.errors top.ops)
+  modifyTop [modules := modules]
 
   (Nil) <- liftIO {M} $ readIORef top.errors
     | errors => do
@@ -252,7 +251,7 @@ cmdLine : List String -> M (Maybe String × List String)
 cmdLine Nil = pure (Nothing, Nil)
 cmdLine ("--top" :: args) = cmdLine args -- handled later
 cmdLine ("-v" :: args) = do
-  modifyTop (\ top => MkTop top.modules top.imported top.hints top.ns top.defs top.metaCtx (top.verbose + 1) top.errors top.ops)
+  modifyTop [ verbose $= _+_ 1 ]
   cmdLine args
 cmdLine ("-o" :: fn :: args) = do
   (out, files) <- cmdLine args

tests/RUTest.newt

@@ -0,0 +1,19 @@
+module RUTest
+
+import Prelude
+
+record Foo where
+  constructor MkFoo
+  bar : Nat
+  baz : Nat
+
+blah : Foo → Foo
+blah x = [ bar := Z ] x
+
+main : IO Unit
+main = do
+  let x = blah $ MkFoo (S Z) (S (S Z))
+  printLn x.bar
+  -- this is unfortunate, it can't get record type from a meta
+  let x' = the Foo $ [ baz := Z ] x
+  printLn x'.baz

tests/RUTest.newt.golden

@@ -0,0 +1,2 @@
+0
+3