rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

multiple semi-sep binds in a let

Browse source
This commit is contained in:
rhiannon morris 2023-12-04 23:27:59 +01:00
parent 415a823dec
commit e48f03a61c
2 changed files with 41 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

32
lib/Quox/Parser/Parser.idr
View file

@ -585,22 +585,32 @@ where
foldr (\(q, x, s), t => Pi q x s t loc) cod $ toDoms (toQty q) doms
letIntro : FileName -> Grammar True PQty
export
letIntro : FileName -> Grammar True (Maybe 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)
withLoc fname (Just . PQ Zero <$ res "let0")
<|> withLoc fname (Just . PQ One <$ res "let1")
<|> withLoc fname (Just . PQ Any <$ res "letω")
<|> Nothing <$ resC "let"
export
letBinder : FileName -> Maybe PQty -> Grammar True (PQty, PatVar, PTerm)
letBinder fname mq = do
qty <- the (Grammar False PQty) $ case mq of
Just q => pure q
Nothing => qty fname <* mustWork (resC ".") <|> defLoc fname (PQ One)
x <- patVar fname; mustWork (resC "=")
rhs <- term fname
pure $ (qty, x, rhs)
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
qty <- letIntro fname
binds <- sepEndBy1 (res ";") $ assert_total letBinder fname qty
mustWork $ resC "in"
body <- assert_total term fname
pure $ \loc => foldr (\b, s => Let b s loc) body binds
-- term : FileName -> Grammar True PTerm
term fname = lamTerm fname