add let to frontend syntax

This commit is contained in:
rhiannon morris 2023-12-04 18:48:25 +01:00
parent 59e7a457a6
commit 68d8019f00
6 changed files with 55 additions and 0 deletions

View file

@ -264,6 +264,9 @@ mutual
<*> fromPTermDScope ds ns [< j1] val1 <*> fromPTermDScope ds ns [< j1] val1
<*> pure loc <*> pure loc
Let (qty, x, rhs) body loc =>
?fromPTerm_let
private private
fromPTermEnumArms : Loc -> Context' PatVar d -> Context' PatVar n -> fromPTermEnumArms : Loc -> Context' PatVar d -> Context' PatVar n ->
List (PTagVal, PTerm) -> List (PTagVal, PTerm) ->

View file

@ -261,6 +261,9 @@ reserved =
Word "caseω" `Or` Word "case#", Word "caseω" `Or` Word "case#",
Word1 "return", Word1 "return",
Word1 "of", Word1 "of",
Word1 "let", Word1 "in",
Word1 "let0", Word1 "let1",
Word "letω" `Or` Word "let#",
Word1 "fst", Word1 "snd", Word1 "fst", Word1 "snd",
Word1 "_", Word1 "_",
Word1 "Eq", Word1 "Eq",

View file

@ -585,13 +585,28 @@ where
foldr (\(q, x, s), t => Pi q x s t loc) cod $ toDoms (toQty q) doms foldr (\(q, x, s), t => Pi q x s t loc) cod $ toDoms (toQty q) doms
letIntro : FileName -> Grammar True PQty
letIntro fname =
withLoc fname (PQ Zero <$ res "let0")
<|> withLoc fname (PQ One <$ res "let1")
<|> withLoc fname (PQ Any <$ res "letω")
<|> do resC "let"
qty fname <* needRes "." <|> defLoc fname (PQ One)
export export
letTerm : FileName -> Grammar True PTerm
letTerm fname = withLoc fname $ do
qty <- letIntro fname
x <- patVar fname <* mustWork (resC "=")
rhs <- assert_total term fname <* mustWork (resC "in")
body <- assert_total term fname
pure $ Let (qty, x, rhs) body
-- term : FileName -> Grammar True PTerm -- term : FileName -> Grammar True PTerm
term fname = lamTerm fname term fname = lamTerm fname
<|> piTerm fname <|> piTerm fname
<|> sigmaTerm fname <|> sigmaTerm fname
<|> letTerm fname
export export

View file

@ -100,6 +100,8 @@ namespace PTerm
| Coe (PatVar, PTerm) PDim PDim PTerm Loc | Coe (PatVar, PTerm) PDim PDim PTerm Loc
| Comp (PatVar, PTerm) PDim PDim PTerm PDim | Comp (PatVar, PTerm) PDim PDim PTerm PDim
(PatVar, PTerm) (PatVar, PTerm) Loc (PatVar, PTerm) (PatVar, PTerm) Loc
| Let (PQty, PatVar, PTerm) PTerm Loc
%name PTerm s, t %name PTerm s, t
public export public export
@ -144,6 +146,7 @@ Located PTerm where
(Ann _ _ loc).loc = loc (Ann _ _ loc).loc = loc
(Coe _ _ _ _ loc).loc = loc (Coe _ _ _ _ loc).loc = loc
(Comp _ _ _ _ _ _ _ loc).loc = loc (Comp _ _ _ _ _ _ _ loc).loc = loc
(Let _ _ loc).loc = loc
export export
Located PCaseBody where Located PCaseBody where

View file

@ -108,6 +108,13 @@ tests = "lexer" :- [
lexes "case0" [Reserved "case0"], lexes "case0" [Reserved "case0"],
lexes "case##" [Name "case##"], lexes "case##" [Name "case##"],
lexes "let" [Reserved "let"],
lexes "letω" [Reserved "letω"],
lexes "let#" [Reserved "letω"],
lexes "let1" [Reserved "let1"],
lexes "let0" [Reserved "let0"],
lexes "let##" [Name "let##"],
lexes "_" [Reserved "_"], lexes "_" [Reserved "_"],
lexes "_a" [Name "_a"], lexes "_a" [Name "_a"],
lexes "a_" [Name "a_"], lexes "a_" [Name "a_"],

View file

@ -411,6 +411,30 @@ tests = "parser" :- [
(V "x" {}) _) (V "x" {}) _)
], ],
"let" :- [
parseMatch term "let x = y in z"
`(Let (PQ One _, PV "x" {}, V "y" {}) (V "z" {}) _),
parseMatch term "let0 x = y in z"
`(Let (PQ Zero _, PV "x" {}, V "y" {}) (V "z" {}) _),
parseMatch term "let1 x = y in z"
`(Let (PQ One _, PV "x" {}, V "y" {}) (V "z" {}) _),
parseMatch term "letω x = y in z"
`(Let (PQ Any _, PV "x" {}, V "y" {}) (V "z" {}) _),
parseMatch term "let x = y1 y2 in z1 z2"
`(Let (PQ One _, PV "x" {},
(App (V "y1" {}) (V "y2" {}) _))
(App (V "z1" {}) (V "z2" {}) _) _),
parseMatch term "let x = a in let y = b in z"
`(Let (PQ One _, PV "x" {}, V "a" {})
(Let (PQ One _, PV "y" {}, V "b" {}) (V "z" {}) _) _),
parseMatch term "let x = y in z ∷ Z"
`(Let (PQ One _, PV "x" {}, V "y" {})
(Ann (V "z" {}) (V "Z" {}) _) _),
parseMatch term "let x = y in z₁ ≡ z₂ : Z"
`(Let (PQ One _, PV "x" {}, V "y" {})
(Eq (Unused _, V "Z" {}) (V "z₁" {}) (V "z₂" {}) _) _)
],
"definitions" :- "definitions" :-
let definition = flip definition [] in [ let definition = flip definition [] in [
parseMatch definition "defω x : {a} × {b} = ('a, 'b);" parseMatch definition "defω x : {a} × {b} = ('a, 'b);"