make quantities optional and default to 1

This commit is contained in:
rhiannon morris 2023-07-18 23:12:04 +02:00
parent 349cf2f477
commit 932469a91e
10 changed files with 193 additions and 122 deletions

View file

@ -35,7 +35,7 @@ ToInfo Failure where
parameters {auto _ : (Show a, Eq a)} {c : Bool} (grm : FileName -> Grammar c a)
parsesWith : String -> (a -> Bool) -> Test
parsesWith inp p = test (ltrim inp) $ do
res <- mapFst ParseError $ lexParseWith (grm "test") inp
res <- mapFst ParseError $ lexParseWith (grm "<test>") inp
unless (p res) $ Left $ WrongResult $ show res
parsesAs : String -> a -> Test
@ -166,9 +166,15 @@ tests = "parser" :- [
`(Pi (PQ One _) (PV "x" _) (V "A" {})
(Pi (PQ One _) (PV "y" _) (V "A" {})
(App (V "B" {}) (V "x" {}) _) _) _),
parseFails term "(x : A) → B x",
parseMatch term "(x : A) → B x"
`(Pi (PQ One _) (PV "x" _) (V "A" {}) (App (V "B" {}) (V "x" {}) _) _),
parseMatch term "1.A → B"
`(Pi (PQ One _) (Unused _) (V "A" {}) (V "B" {}) _),
parseMatch term "A → B"
`(Pi (PQ One _) (Unused _) (V "A" {}) (V "B" {}) _),
parseMatch term "A → B → C"
`(Pi (PQ One _) (Unused _) (V "A" {})
(Pi (PQ One _) (Unused _) (V "B" {}) (V "C" {}) _) _),
parseMatch term "1.(List A) → List B"
`(Pi (PQ One _) (Unused _)
(App (V "List" {}) (V "A" {}) _)
@ -190,7 +196,21 @@ tests = "parser" :- [
parseMatch term "A × B × C" $
`(Sig (Unused _) (V "A" {}) (Sig (Unused _) (V "B" {}) (V "C" {}) _) _),
parseMatch term "(A × B) × C" $
`(Sig (Unused _) (Sig (Unused _) (V "A" {}) (V "B" {}) _) (V "C" {}) _)
`(Sig (Unused _) (Sig (Unused _) (V "A" {}) (V "B" {}) _) (V "C" {}) _),
parseMatch term "A × B → C" $
`(Pi (PQ One _) (Unused _)
(Sig (Unused _) (V "A" {}) (V "B" {}) _)
(V "C" {}) _),
parseMatch term "A → B × C" $
`(Pi (PQ One _) (Unused _)
(V "A" {})
(Sig (Unused _) (V "B" {}) (V "C" {}) _) _),
parseMatch term "A → B × C → D" $
`(Pi (PQ One _) (Unused _)
(V "A" {})
(Pi (PQ One _) (Unused _)
(Sig (Unused _) (V "B" {}) (V "C" {}) _)
(V "D" {}) _) _)
],
"lambdas" :- [
@ -330,7 +350,25 @@ tests = "parser" :- [
(CasePair (PV "l" _, PV "r" _)
(App (V "r" {}) (V "l" {}) _) _) _),
parseMatch term
"case 1 . f s return x ⇒ A x of { (l, r) ⇒ r l }"
"case 1. f s return x ⇒ A x of { (l, r) ⇒ r l }"
`(Case (PQ One _) (App (V "f" {}) (V "s" {}) _)
(PV "x" _, App (V "A" {}) (V "x" {}) _)
(CasePair (PV "l" _, PV "r" _)
(App (V "r" {}) (V "l" {}) _) _) _),
parseMatch term
"caseω f s return x ⇒ A x of { (l, r) ⇒ r l }"
`(Case (PQ Any _) (App (V "f" {}) (V "s" {}) _)
(PV "x" _, App (V "A" {}) (V "x" {}) _)
(CasePair (PV "l" _, PV "r" _)
(App (V "r" {}) (V "l" {}) _) _) _),
parseMatch term
"case0 f s return x ⇒ A x of { (l, r) ⇒ r l }"
`(Case (PQ Zero _) (App (V "f" {}) (V "s" {}) _)
(PV "x" _, App (V "A" {}) (V "x" {}) _)
(CasePair (PV "l" _, PV "r" _)
(App (V "r" {}) (V "l" {}) _) _) _),
parseMatch term
"case f s return x ⇒ A x of { (l, r) ⇒ r l }"
`(Case (PQ One _) (App (V "f" {}) (V "s" {}) _)
(PV "x" _, App (V "A" {}) (V "x" {}) _)
(CasePair (PV "l" _, PV "r" _)
@ -352,6 +390,12 @@ tests = "parser" :- [
parseMatch term "caseω n return of { succ _, 1.ih ⇒ ih; zero ⇒ 0; }"
`(Case (PQ Any _) (V "n" {}) (Unused _, Nat _)
(CaseNat (Zero _) (Unused _, PQ One _, PV "ih" _, V "ih" {}) _) _),
parseMatch term "caseω n return of { succ _, ω.ih ⇒ ih; zero ⇒ 0; }"
`(Case (PQ Any _) (V "n" {}) (Unused _, Nat _)
(CaseNat (Zero _) (Unused _, PQ Any _, PV "ih" _, V "ih" {}) _) _),
parseMatch term "caseω n return of { succ _, ih ⇒ ih; zero ⇒ 0; }"
`(Case (PQ Any _) (V "n" {}) (Unused _, Nat _)
(CaseNat (Zero _) (Unused _, PQ One _, PV "ih" _, V "ih" {}) _) _),
parseFails term "caseω n return A of { zero ⇒ a }",
parseFails term "caseω n return of { succ ⇒ 5 }"
],