allow fst/snd to take multiple arguments

also succ though that won't be well typed
This commit is contained in:
rhiannon morris 2023-12-04 18:21:27 +01:00
parent e2ad18ff1f
commit 4291afd51b
2 changed files with 25 additions and 13 deletions

View file

@ -381,11 +381,24 @@ eqTerm : FileName -> Grammar True PTerm
eqTerm fname = withLoc fname $ eqTerm fname = withLoc fname $
resC "Eq" *> mustWork [|Eq (typeLine fname) (termArg fname) (termArg fname)|] resC "Eq" *> mustWork [|Eq (typeLine fname) (termArg fname) (termArg fname)|]
private
appArg : Loc -> PTerm -> Either PDim PTerm -> PTerm
appArg loc f (Left p) = DApp f p loc
appArg loc f (Right s) = App f s loc
||| a dimension argument with an `@` prefix, or
||| a term argument with no prefix
export
anyArg : FileName -> Grammar True (Either PDim PTerm)
anyArg fname = dimArg fname <||> termArg fname
export export
resAppTerm : FileName -> (word : String) -> (0 _ : IsReserved word) => resAppTerm : FileName -> (word : String) -> (0 _ : IsReserved word) =>
(PTerm -> Loc -> PTerm) -> Grammar True PTerm (PTerm -> Loc -> PTerm) -> Grammar True PTerm
resAppTerm fname word f = withLoc fname $ resAppTerm fname word f = withLoc fname $ do
resC word *> mustWork [|f (termArg fname)|] head <- withLoc fname $ resC word *> mustWork [|f (termArg fname)|]
args <- many $ anyArg fname
pure $ \loc => foldl (appArg loc) head args
export export
succTerm : FileName -> Grammar True PTerm succTerm : FileName -> Grammar True PTerm
@ -399,21 +412,12 @@ export
sndTerm : FileName -> Grammar True PTerm sndTerm : FileName -> Grammar True PTerm
sndTerm fname = resAppTerm fname "snd" Snd sndTerm fname = resAppTerm fname "snd" Snd
||| a dimension argument with an `@` prefix, or
||| a term argument with no prefix
export
anyArg : FileName -> Grammar True (Either PDim PTerm)
anyArg fname = dimArg fname <||> termArg fname
export export
normalAppTerm : FileName -> Grammar True PTerm normalAppTerm : FileName -> Grammar True PTerm
normalAppTerm fname = withLoc fname $ do normalAppTerm fname = withLoc fname $ do
head <- termArg fname head <- termArg fname
args <- many $ anyArg fname args <- many $ anyArg fname
pure $ \loc => foldl (ap loc) head args pure $ \loc => foldl (appArg loc) head args
where ap : Loc -> PTerm -> Either PDim PTerm -> PTerm
ap loc f (Left p) = DApp f p loc
ap loc f (Right s) = App f s loc
||| application term `f x @y z`, or other terms that look like application ||| application term `f x @y z`, or other terms that look like application
||| like `succ` or `coe`. ||| like `succ` or `coe`.

View file

@ -138,7 +138,15 @@ tests = "parser" :- [
parseMatch term "f @p" parseMatch term "f @p"
`(DApp (V "f" {}) (V "p" {}) _), `(DApp (V "f" {}) (V "p" {}) _),
parseMatch term "f x @p y" parseMatch term "f x @p y"
`(App (DApp (App (V "f" {}) (V "x" {}) _) (V "p" {}) _) (V "y" {}) _) `(App (DApp (App (V "f" {}) (V "x" {}) _) (V "p" {}) _) (V "y" {}) _),
parseMatch term "fst e"
`(Fst (V "e" {}) _),
parseMatch term "snd e"
`(Snd (V "e" {}) _),
parseMatch term "(fst e) x"
`(App (Fst (V "e" {}) _) (V "x" {}) _),
parseMatch term "fst e x"
`(App (Fst (V "e" {}) _) (V "x" {}) _)
], ],
"annotations" :- [ "annotations" :- [