allow fst/snd to take multiple arguments
also succ though that won't be well typed
This commit is contained in:
parent
e2ad18ff1f
commit
4291afd51b
2 changed files with 25 additions and 13 deletions
|
@ -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`.
|
||||||
|
|
|
@ -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" :- [
|
||||||
|
|
Loading…
Reference in a new issue