quox/tests/Tests/Parser.idr
rhiannon morris 7e079a9668 add file locations to Parser.Syntax
they're immediately thrown away currently. but one step at a time
2023-04-26 06:12:03 +02:00

403 lines
15 KiB
Idris
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

module Tests.Parser
import Quox.Parser
import Data.List
import Data.String
import TAP
import Language.Reflection
%language ElabReflection
public export
data Failure =
ParseError Parser.Error
| WrongResult String
| ExpectedFail String
export
ToInfo Parser.Error where
toInfo (LexError err) =
[("type", "LexError"), ("info", show err)]
toInfo (ParseError errs) =
("type", "ParseError") ::
map (bimap show show) ([1 .. length errs] `zip` toList errs)
export
ToInfo Failure where
toInfo (ParseError err) =
toInfo err
toInfo (WrongResult got) =
[("type", "WrongResult"), ("got", got)]
toInfo (ExpectedFail got) =
[("type", "ExpectedFail"), ("got", got)]
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
unless (p res) $ Left $ WrongResult $ show res
parsesAs : String -> a -> Test
parsesAs inp exp = parsesWith inp (== exp)
%macro
parseMatch : String -> TTImp -> Elab Test
parseMatch inp pat =
parsesWith inp <$> check `(\case ~(pat) => True; _ => False)
parseFails : String -> Test
parseFails inp = test "\{ltrim inp} # fails" $ do
either (const $ Right ()) (Left . ExpectedFail . show) $
lexParseWith (grm "test") inp
export
tests : Test
tests = "parser" :- [
"pattern vars" :- [
parseMatch patVar "_" `(Unused _),
parseMatch patVar "F" `(PV "F" _),
parseFails patVar "a.b.c"
],
"names" :- [
parsesAs (const qname) "x"
(MakePName [<] "x"),
parsesAs (const qname) "Data.String.length"
(MakePName [< "Data", "String"] "length"),
parseFails (const qname) "_"
],
"dimensions" :- [
parseMatch dim "0" `(K Zero _),
parseMatch dim "1" `(K One _),
parseMatch dim "𝑖" `(V "𝑖" _),
parseFails dim "M.x",
parseFails dim "_"
],
"quantities" :- [
parseMatch qty "0" `(PQ Zero _),
parseMatch qty "1" `(PQ One _),
parseMatch qty "ω" `(PQ Any _),
parseMatch qty "#" `(PQ Any _),
parseFails qty "anythingElse",
parseFails qty "_"
],
"enum types" :- [
parseMatch term #"{}"# `(Enum [] _),
parseMatch term #"{a}"# `(Enum ["a"] _),
parseMatch term #"{a,}"# `(Enum ["a"] _),
parseMatch term #"{a.b.c.d}"# `(Enum ["a.b.c.d"] _),
parseMatch term #"{"hel lo"}"# `(Enum ["hel lo"] _),
parseMatch term #"{a, b}"# `(Enum ["a", "b"] _),
parseMatch term #"{a, b,}"# `(Enum ["a", "b"] _),
parseMatch term #"{a, b, ","}"# `(Enum ["a", "b", ","] _),
parseFails term #"{,}"#
],
"tags" :- [
parseMatch term #" 'a "# `(Tag "a" _),
parseMatch term #" 'abc "# `(Tag "abc" _),
parseMatch term #" '"abc" "# `(Tag "abc" _),
parseMatch term #" '"a b c" "# `(Tag "a b c" _),
note "application to two arguments",
parseMatch term #" 'a b c "#
`(App (App (Tag "a" _) (V "b" _) _) (V "c" _) _)
],
"universes" :- [
parseMatch term "★₀" `(TYPE 0 _),
parseMatch term "★1" `(TYPE 1 _),
parseMatch term "★ 2" `(TYPE 2 _),
parseMatch term "Type₃" `(TYPE 3 _),
parseMatch term "Type4" `(TYPE 4 _),
parseMatch term "Type 100" `(TYPE 100 _),
parseMatch term "(Type 1000)" `(TYPE 1000 _),
parseFails term "Type",
parseFails term ""
],
"applications" :- [
parseMatch term "f"
`(V "f" _),
parseMatch term "f.x.y"
`(V (MakePName [< "f", "x"] "y") _),
parseMatch term "f x"
`(App (V "f" _) (V "x" _) _),
parseMatch term "f x y"
`(App (App (V "f" _) (V "x" _) _) (V "y" _) _),
parseMatch term "(f x) y"
`(App (App (V "f" _) (V "x" _) _) (V "y" _) _),
parseMatch term "f (g x)"
`(App (V "f" _) (App (V "g" _) (V "x" _) _) _),
parseMatch term "f (g x) y"
`(App (App (V "f" _) (App (V "g" _) (V "x" _) _) _) (V "y" _) _),
parseMatch term "f @p"
`(DApp (V "f" _) (V "p" _) _),
parseMatch term "f x @p y"
`(App (DApp (App (V "f" _) (V "x" _) _) (V "p" _) _) (V "y" _) _)
],
"annotations" :- [
parseMatch term "f :: A"
`(Ann (V "f" _) (V "A" _) _),
parseMatch term "f ∷ A"
`(Ann (V "f" _) (V "A" _) _),
parseMatch term "f x y ∷ A B C"
`(Ann (App (App (V "f" _) (V "x" _) _) (V "y" _) _)
(App (App (V "A" _) (V "B" _) _) (V "C" _) _) _),
parseMatch term "Type 0 ∷ Type 1 ∷ Type 2"
`(Ann (TYPE 0 _) (Ann (TYPE 1 _) (TYPE 2 _) _) _)
],
"binders" :- [
parseMatch term "1.(x : A) → B x"
`(Pi (PQ One _) (PV "x" _) (V "A" _) (App (V "B" _) (V "x" _) _) _),
parseMatch term "1.(x : A) -> B x"
`(Pi (PQ One _) (PV "x" _) (V "A" _) (App (V "B" _) (V "x" _) _) _),
parseMatch term "ω.(x : A) → B x"
`(Pi (PQ Any _) (PV "x" _) (V "A" _) (App (V "B" _) (V "x" _) _) _),
parseMatch term "#.(x : A) -> B x"
`(Pi (PQ Any _) (PV "x" _) (V "A" _) (App (V "B" _) (V "x" _) _) _),
parseMatch term "1.(x y : A) -> B x"
`(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 "1.A → B"
`(Pi (PQ One _) (Unused _) (V "A" _) (V "B" _) _),
parseMatch term "1.(List A) → List B"
`(Pi (PQ One _) (Unused _)
(App (V "List" _) (V "A" _) _)
(App (V "List" _) (V "B" _) _) _),
parseFails term "1.List A → List B",
parseMatch term "(x : A) × B x"
`(Sig (PV "x" _) (V "A" _) (App (V "B" _) (V "x" _) _) _),
parseMatch term "(x : A) ** B x"
`(Sig (PV "x" _) (V "A" _) (App (V "B" _) (V "x" _) _) _),
parseMatch term "(x y : A) × B" $
`(Sig (PV "x" _) (V "A" _) (Sig (PV "y" _) (V "A" _) (V "B" _) _) _),
parseFails term "1.(x : A) × B x",
parseMatch term "A × B"
`(Sig (Unused _) (V "A" _) (V "B" _) _),
parseMatch term "A ** B"
`(Sig (Unused _) (V "A" _) (V "B" _) _),
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" _) _)
],
"lambdas" :- [
parseMatch term "λ x ⇒ x"
`(Lam (PV "x" _) (V "x" _) _),
parseMatch term "fun x => x"
`(Lam (PV "x" _) (V "x" _) _),
parseMatch term "δ i ⇒ x @i"
`(DLam (PV "i" _) (DApp (V "x" _) (V "i" _) _) _),
parseMatch term "dfun i => x @i"
`(DLam (PV "i" _) (DApp (V "x" _) (V "i" _) _) _),
parseMatch term "λ x y z ⇒ x z y"
`(Lam (PV "x" _)
(Lam (PV "y" _)
(Lam (PV "z" _)
(App (App (V "x" _) (V "z" _) _) (V "y" _) _) _) _) _)
],
"pairs" :- [
parseMatch term "(x, y)"
`(Pair (V "x" _) (V "y" _) _),
parseMatch term "(x, y, z)"
`(Pair (V "x" _) (Pair (V "y" _) (V "z" _) _) _),
parseMatch term "((x, y), z)"
`(Pair (Pair (V "x" _) (V "y" _) _) (V "z" _) _),
parseMatch term "(f x, g @y)"
`(Pair (App (V "f" _) (V "x" _) _) (DApp (V "g" _) (V "y" _) _) _),
parseMatch term "((x : A) × B, 0.(x : C) → D)"
`(Pair (Sig (PV "x" _) (V "A" _) (V "B" _) _)
(Pi (PQ Zero _) (PV "x" _) (V "C" _) (V "D" _) _) _),
parseMatch term "(λ x ⇒ x, δ i ⇒ e @i)"
`(Pair (Lam (PV "x" _) (V "x" _) _)
(DLam (PV "i" _) (DApp (V "e" _) (V "i" _) _) _) _),
parseMatch term "(x,)" `(V "x" _), -- i GUESS
parseFails term "(,y)",
parseFails term "(x,,y)"
],
"equality type" :- [
parseMatch term "Eq [i ⇒ A] s t"
`(Eq (PV "i" _, V "A" _) (V "s" _) (V "t" _) _),
parseMatch term "Eq [i ⇒ A (B @i)] (f x) (g y)"
`(Eq (PV "i" _, App (V "A" _) (DApp (V "B" _) (V "i" _) _) _)
(App (V "f" _) (V "x" _) _)
(App (V "g" _) (V "y" _) _) _),
parseMatch term "Eq [A] s t"
`(Eq (Unused _, V "A" _) (V "s" _) (V "t" _) _),
parseMatch term "s ≡ t : A"
`(Eq (Unused _, V "A" _) (V "s" _) (V "t" _) _),
parseMatch term "s == t : A"
`(Eq (Unused _, V "A" _) (V "s" _) (V "t" _) _),
parseMatch term "f x ≡ g y : A B"
`(Eq (Unused _, App (V "A" _) (V "B" _) _)
(App (V "f" _) (V "x" _) _)
(App (V "g" _) (V "y" _) _) _),
parseMatch term "(A × B) ≡ (A' × B') : ★₁"
`(Eq (Unused _, TYPE 1 _)
(Sig (Unused _) (V "A" _) (V "B" _) _)
(Sig (Unused _) (V "A'" _) (V "B'" _) _) _),
note "A × (B ≡ A' × B' : ★₁)",
parseMatch term "A × B ≡ A' × B' : ★₁"
`(Sig (Unused _) (V "A" _)
(Eq (Unused _, TYPE 1 _)
(V "B" _) (Sig (Unused _) (V "A'" _) (V "B'" _) _) _) _),
parseFails term "Eq",
parseFails term "Eq s t",
parseFails term "s ≡ t",
parseFails term ""
],
"naturals" :- [
parseMatch term "" `(Nat _),
parseMatch term "Nat" `(Nat _),
parseMatch term "zero" `(Zero _),
parseMatch term "succ n" `(Succ (V "n" _) _),
parseMatch term "3"
`(Succ (Succ (Succ (Zero _) _) _) _),
parseMatch term "succ (succ 1)"
`(Succ (Succ (Succ (Zero _) _) _) _),
parseFails term "succ succ 5",
parseFails term "succ"
],
"box" :- [
parseMatch term "[1.]"
`(BOX (PQ One _) (Nat _) _),
parseMatch term "[ω. × ]"
`(BOX (PQ Any _) (Sig (Unused _) (Nat _) (Nat _) _) _),
parseMatch term "[a]"
`(Box (V "a" _) _),
parseMatch term "[0]"
`(Box (Zero _) _),
parseMatch term "[1]"
`(Box (Succ (Zero _) _) _)
],
"coe" :- [
parseMatch term "coe [A] @p @q x"
`(Coe (Unused _, V "A" _) (V "p" _) (V "q" _) (V "x" _) _),
parseMatch term "coe [i ⇒ A] @p @q x"
`(Coe (PV "i" _, V "A" _) (V "p" _) (V "q" _) (V "x" _) _),
parseFails term "coe [A] @p @q",
parseFails term "coe A @p @q x",
parseFails term "coe [i ⇒ A] @p q x"
],
"comp" :- [
parseMatch term "comp [A] @p @q s @r { 0 𝑗 ⇒ s₀; 1 𝑘 ⇒ s₁ }"
`(Comp (Unused _, V "A" _) (V "p" _) (V "q" _) (V "s" _) (V "r" _)
(PV "𝑗" _, V "s₀" _) (PV "𝑘" _, V "s₁" _) _),
parseMatch term "comp [A] @p @q s @r { 1 𝑗 ⇒ s₀; 0 𝑘 ⇒ s₁; }"
`(Comp (Unused _, V "A" _) (V "p" _) (V "q" _) (V "s" _) (V "r" _)
(PV "𝑘" _, V "s₁" _) (PV "𝑗" _, V "s₀" _) _),
parseFails term "comp [A] @p @q s @r { 1 𝑗 ⇒ s₀; 1 𝑘 ⇒ s₁; }",
parseFails term "comp [A] @p @q s @r { 0 𝑗 ⇒ s₀ }",
parseFails term "comp [A] @p @q s @r { }"
],
"case" :- [
parseMatch term
"case1 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
"case1 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 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
"case1 t return A of { 'x ⇒ p; 'y ⇒ q; 'z ⇒ r }"
`(Case (PQ One _) (V "t" _)
(Unused _, V "A" _)
(CaseEnum [(PT "x" _, V "p" _),
(PT "y" _, V "q" _),
(PT "z" _, V "r" _)] _) _),
parseMatch term "caseω t return A of {}"
`(Case (PQ Any _) (V "t" _) (Unused _, V "A" _) (CaseEnum [] _) _),
parseMatch term "case# t return A of {}"
`(Case (PQ Any _) (V "t" _) (Unused _, V "A" _) (CaseEnum [] _) _),
parseMatch term "caseω n return A of { 0 ⇒ a; succ n' ⇒ b }"
`(Case (PQ Any _) (V "n" _) (Unused _, V "A" _)
(CaseNat (V "a" _) (PV "n'" _, PQ Zero _, Unused _, V "b" _) _) _),
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" _) _) _),
parseFails term "caseω n return A of { zero ⇒ a }",
parseFails term "caseω n return of { succ ⇒ 5 }"
],
"definitions" :- [
parseMatch definition "defω x : {a} × {b} = ('a, 'b);"
`(MkPDef (PQ Any _) "x"
(Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
(Pair (Tag "a" _) (Tag "b" _) _) _),
parseMatch definition "def# x : {a} ** {b} = ('a, 'b)"
`(MkPDef (PQ Any _) "x"
(Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
(Pair (Tag "a" _) (Tag "b" _) _) _),
parseMatch definition "def ω.x : {a} × {b} = ('a, 'b)"
`(MkPDef (PQ Any _) "x"
(Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
(Pair (Tag "a" _) (Tag "b" _) _) _),
parseMatch definition "def x : {a} × {b} = ('a, 'b)"
`(MkPDef (PQ Any _) "x"
(Just (Sig (Unused _) (Enum ["a"] _) (Enum ["b"] _) _))
(Pair (Tag "a" _) (Tag "b" _) _) _),
parseMatch definition "def0 A : ★₀ = {a, b, c}"
`(MkPDef (PQ Zero _) "A" (Just $ TYPE 0 _)
(Enum ["a", "b", "c"] _) _)
],
"top level" :- [
parseMatch input "def0 A : ★₀ = {}; def0 B : ★₁ = A;"
`([PD $ PDef $ MkPDef (PQ Zero _) "A" (Just $ TYPE 0 _) (Enum [] _) _,
PD $ PDef $ MkPDef (PQ Zero _) "B" (Just $ TYPE 1 _) (V "A" _) _]),
parseMatch input "def0 A : ★₀ = {} def0 B : ★₁ = A" $
`([PD $ PDef $ MkPDef (PQ Zero _) "A" (Just $ TYPE 0 _) (Enum [] _) _,
PD $ PDef $ MkPDef (PQ Zero _) "B" (Just $ TYPE 1 _) (V "A" _) _]),
note "empty input",
parsesAs input "" [],
parseFails input ";;;;;;;;;;;;;;;;;;;;;;;;;;",
parseMatch input "namespace a {}"
`([PD $ PNs $ MkPNamespace [< "a"] [] _]),
parseMatch input "namespace a.b.c {}"
`([PD $ PNs $ MkPNamespace [< "a", "b", "c"] [] _]),
parseMatch input "namespace a {namespace b {}}"
`([PD $ PNs $ MkPNamespace [< "a"] [PNs $ MkPNamespace [< "b"] [] _] _]),
parseMatch input "namespace a {def x = 't ∷ {t}}"
`([PD $ PNs $ MkPNamespace [< "a"]
[PDef $ MkPDef (PQ Any _) "x" Nothing
(Ann (Tag "t" _) (Enum ["t"] _) _) _] _]),
parseMatch input "namespace a {def x = 't ∷ {t}} def y = a.x"
`([PD $ PNs $ MkPNamespace [< "a"]
[PDef $ MkPDef (PQ Any _) "x" Nothing
(Ann (Tag "t" _) (Enum ["t"] _) _) _] _,
PD $ PDef $ MkPDef (PQ Any _) "y" Nothing
(V (MakePName [< "a"] "x") _) _]),
parseMatch input #" load "a.quox"; def b = a.b "#
`([PLoad "a.quox" _,
PD $ PDef $ MkPDef (PQ Any _) "b" Nothing
(V (MakePName [< "a"] "b") _) _])
]
]