Add list sugar
Some checks are pending
Publish Playground / build (push) Waiting to run
Publish Playground / deploy (push) Blocked by required conditions

This commit is contained in:
2026-03-29 19:30:37 -07:00
parent 2f1185bf4c
commit 4814682712
5 changed files with 53 additions and 0 deletions

View File

@@ -80,6 +80,18 @@ lookupDef ctx name = go 0 ctx.types ctx.env
go ix ((nm, ty) :: xs) (v :: vs) = if nm == name then Just v else go (1 + ix) xs vs go ix ((nm, ty) :: xs) (v :: vs) = if nm == name then Just v else go (1 + ix) xs vs
go ix _ _ = Nothing go ix _ _ = Nothing
expandList : FC Maybe Raw Raw
expandList fc Nothing = RVar fc "Nil"
expandList fc (Just t) = go fc t
where
cons : FC Raw Raw Raw
cons fc t u = RApp fc (RApp fc (RVar fc "_::_") t Explicit) u Explicit
go : FC Raw Raw
go fc (RApp fc' (RApp fc'' (RVar fc "_,_") t Explicit) u Explicit) =
cons fc t $ go fc u
go fc t = cons fc t (RVar fc "Nil")
forceMeta : Val -> M Val forceMeta : Val -> M Val
forceMeta (VMeta fc ix sp) = do forceMeta (VMeta fc ix sp) = do
meta <- lookupMeta ix meta <- lookupMeta ix
@@ -977,6 +989,7 @@ mkPat (RAs fc as tm, icit) = do
(PatCon fc icit nm args Nothing) => pure $ PatCon fc icit nm args (Just as) (PatCon fc icit nm args Nothing) => pure $ PatCon fc icit nm args (Just as)
(PatCon fc icit nm args _) => error fc "Double as pattern \{show tm}" (PatCon fc icit nm args _) => error fc "Double as pattern \{show tm}"
t => error fc "Can't put as on non-constructor \{show tm}" t => error fc "Can't put as on non-constructor \{show tm}"
mkPat (RList fc mt, icit) = mkPat (expandList fc mt, icit)
mkPat (tm, icit) = do mkPat (tm, icit) = do
top <- getTop top <- getTop
case splitArgs tm Nil of case splitArgs tm Nil of
@@ -1538,6 +1551,8 @@ infer ctx (RVar fc nm) = go 0 ctx.types
go i ((x, ty) :: xs) = if x == nm then pure (Bnd fc i, ty) go i ((x, ty) :: xs) = if x == nm then pure (Bnd fc i, ty)
else go (i + 1) xs else go (i + 1) xs
infer ctx (RList fc mt) = infer ctx $ expandList fc mt
infer ctx (RApp fc t u icit) = do infer ctx (RApp fc t u icit) = do
-- If the app is explicit, add any necessary metas -- If the app is explicit, add any necessary metas
(icit, t, tty) <- case icit of (icit, t, tty) <- case icit of

View File

@@ -110,6 +110,14 @@ asAtom = do
recordUpdate : Parser Raw recordUpdate : Parser Raw
listTypeExp : Parser Raw
listTypeExp = do
fc <- getPos
symbol "["
tm <- optional typeExpr
symbol "]"
pure $ RList fc tm
parenTypeExp : Parser Raw parenTypeExp : Parser Raw
parenTypeExp = do parenTypeExp = do
fc <- getPos fc <- getPos
@@ -134,6 +142,7 @@ atom = do
<|> lit <|> lit
<|> RImplicit <$> getPos <* keyword "_" <|> RImplicit <$> getPos <* keyword "_"
<|> RHole <$> getPos <* keyword "?" <|> RHole <$> getPos <* keyword "?"
<|> listTypeExp
<|> parenTypeExp <|> parenTypeExp
updateClause : Parser UpdateClause updateClause : Parser UpdateClause

View File

@@ -60,6 +60,7 @@ data Raw : U where
-- has to be applied or we have to know its type as Foo → Foo to elaborate. -- 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. -- I can bake the arg in here, or require an app in elab.
RUpdateRec : (fc : FC) List UpdateClause Maybe Raw Raw RUpdateRec : (fc : FC) List UpdateClause Maybe Raw Raw
RList : (fc : FC) Maybe Raw Raw
instance HasFC Raw where instance HasFC Raw where
getFC (RVar fc nm) = fc getFC (RVar fc nm) = fc
@@ -78,6 +79,7 @@ instance HasFC Raw where
getFC (RAs fc _ _) = fc getFC (RAs fc _ _) = fc
getFC (RUpdateRec fc _ _) = fc getFC (RUpdateRec fc _ _) = fc
getFC (RImpossible fc) = fc getFC (RImpossible fc) = fc
getFC (RList fc _) = fc
data Import = MkImport FC (FC × Name) data Import = MkImport FC (FC × Name)
@@ -189,6 +191,8 @@ instance Pretty Raw where
asDoc p (RWhere _ dd b) = text "TODO pretty RWhere" asDoc p (RWhere _ dd b) = text "TODO pretty RWhere"
asDoc p (RAs _ nm x) = text nm ++ text "@(" ++ asDoc 0 x ++ text ")" asDoc p (RAs _ nm x) = text nm ++ text "@(" ++ asDoc 0 x ++ text ")"
asDoc p (RUpdateRec _ clauses tm) = text "{" <+> text "TODO RUpdateRec" <+> text "}" asDoc p (RUpdateRec _ clauses tm) = text "{" <+> text "TODO RUpdateRec" <+> text "}"
asDoc p (RList _ (Just t)) = text "[" <+> asDoc p t <+> text "]"
asDoc p (RList _ Nothing) = text "[]"
prettyBind : (BindInfo × Raw) -> Doc prettyBind : (BindInfo × Raw) -> Doc
prettyBind (BI _ nm icit quant, ty) = wrap icit (text (show quant ++ nm) <+> text ":" <+> pretty ty) prettyBind (BI _ nm icit quant, ty) = wrap icit (text (show quant ++ nm) <+> text ":" <+> pretty ty)
@@ -246,6 +250,8 @@ substRaw ss t = case t of
(RWhere fc ds body) => RWhere fc (map substDecl ds) (substRaw ss body) (RWhere fc ds body) => RWhere fc (map substDecl ds) (substRaw ss body)
(RDo fc stmts) => RDo fc (substStmts ss stmts) (RDo fc stmts) => RDo fc (substStmts ss stmts)
(RCase fc scrut mdef alts) => RCase fc (substRaw ss scrut) (map (substRaw ss) mdef) (map substAlt alts) (RCase fc scrut mdef alts) => RCase fc (substRaw ss scrut) (map (substRaw ss) mdef) (map substAlt alts)
(RList fc (Just t)) => RList fc (Just $ substRaw ss t)
(RList fc Nothing) => RList fc Nothing
-- Enumerate to force consideration of new cases -- Enumerate to force consideration of new cases
t@(RImpossible _) => t t@(RImpossible _) => t
t@(RU _) => t t@(RU _) => t

19
tests/ListSugar.newt Normal file
View File

@@ -0,0 +1,19 @@
module ListSugar
import Prelude
blah : List Int
blah = [ 1, 2, 3]
bar : List Int Int
bar [ ] = 0
bar [x] = 1
bar _ = 42
main : IO Unit
main = do
printLn blah
printLn $ bar []
printLn $ bar [ 42 ]
printLn $ bar blah

View File

@@ -0,0 +1,4 @@
[1, 2, 3]
0
1
42