record update syntax

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