add file locations to Parser.Syntax
they're immediately thrown away currently. but one step at a time
This commit is contained in:
parent
97f51b4436
commit
7e079a9668
7 changed files with 822 additions and 667 deletions
|
|
@ -37,12 +37,13 @@ ToInfo Failure where
|
|||
|
||||
|
||||
parameters {c : Bool} {auto _ : Show b}
|
||||
(grm : Grammar c a) (fromP : a -> Either FromParser.Error b)
|
||||
(grm : FileName -> Grammar c a)
|
||||
(fromP : a -> Either FromParser.Error b)
|
||||
(inp : String)
|
||||
parameters {default (ltrim inp) label : String}
|
||||
parsesWith : (b -> Bool) -> Test
|
||||
parsesWith p = test label $ do
|
||||
pres <- mapFst ParseError $ lexParseWith grm inp
|
||||
pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
|
||||
res <- mapFst FromParser $ fromP pres
|
||||
unless (p res) $ Left $ WrongResult $ show res
|
||||
|
||||
|
|
@ -55,11 +56,11 @@ parameters {c : Bool} {auto _ : Show b}
|
|||
parameters {default "\{ltrim inp} # fails" label : String}
|
||||
parseFails : Test
|
||||
parseFails = test label $ do
|
||||
pres <- mapFst ParseError $ lexParseWith grm inp
|
||||
pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
|
||||
either (const $ Right ()) (Left . ExpectedFail . show) $ fromP pres
|
||||
|
||||
|
||||
FromString BName where fromString = Just . fromString
|
||||
FromString PatVar where fromString x = PV x Nothing
|
||||
|
||||
runFromParser : {default empty defs : Definitions} ->
|
||||
Eff FromParserPure a -> Either FromParser.Error a
|
||||
|
|
|
|||
|
|
@ -4,6 +4,9 @@ import Quox.Parser
|
|||
import Data.List
|
||||
import Data.String
|
||||
import TAP
|
||||
import Language.Reflection
|
||||
|
||||
%language ElabReflection
|
||||
|
||||
public export
|
||||
data Failure =
|
||||
|
|
@ -29,204 +32,227 @@ ToInfo Failure where
|
|||
[("type", "ExpectedFail"), ("got", got)]
|
||||
|
||||
|
||||
parameters {c : Bool} {auto _ : Show a} (grm : Grammar c a)
|
||||
(inp : String)
|
||||
parameters {default (ltrim inp) label : String}
|
||||
parsesWith : (a -> Bool) -> Test
|
||||
parsesWith p = test label $ do
|
||||
res <- mapFst ParseError $ lexParseWith grm inp
|
||||
unless (p res) $ Left $ WrongResult $ show res
|
||||
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
|
||||
|
||||
parses : Test
|
||||
parses = parsesWith $ const True
|
||||
parsesAs : String -> a -> Test
|
||||
parsesAs inp exp = parsesWith inp (== exp)
|
||||
|
||||
parsesAs : Eq a => a -> Test
|
||||
parsesAs exp = parsesWith (== exp)
|
||||
%macro
|
||||
parseMatch : String -> TTImp -> Elab Test
|
||||
parseMatch inp pat =
|
||||
parsesWith inp <$> check `(\case ~(pat) => True; _ => False)
|
||||
|
||||
parameters {default "\{ltrim inp} # fails" label : String}
|
||||
parseFails : Test
|
||||
parseFails = test label $ do
|
||||
either (const $ Right ()) (Left . ExpectedFail . show) $
|
||||
lexParseWith grm inp
|
||||
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" :- [
|
||||
parsesAs patVar "_" Nothing,
|
||||
parsesAs patVar "F" (Just "F"),
|
||||
parseMatch patVar "_" `(Unused _),
|
||||
parseMatch patVar "F" `(PV "F" _),
|
||||
parseFails patVar "a.b.c"
|
||||
],
|
||||
|
||||
"names" :- [
|
||||
parsesAs qname "x"
|
||||
parsesAs (const qname) "x"
|
||||
(MakePName [<] "x"),
|
||||
parsesAs qname "Data.String.length"
|
||||
parsesAs (const qname) "Data.String.length"
|
||||
(MakePName [< "Data", "String"] "length"),
|
||||
parseFails qname "_"
|
||||
parseFails (const qname) "_"
|
||||
],
|
||||
|
||||
"dimensions" :- [
|
||||
parsesAs dim "0" (K Zero),
|
||||
parsesAs dim "1" (K One),
|
||||
parsesAs dim "𝑖" (V "𝑖"),
|
||||
parseMatch dim "0" `(K Zero _),
|
||||
parseMatch dim "1" `(K One _),
|
||||
parseMatch dim "𝑖" `(V "𝑖" _),
|
||||
parseFails dim "M.x",
|
||||
parseFails dim "_"
|
||||
],
|
||||
|
||||
"quantities" :- [
|
||||
parsesAs qty "0" Zero,
|
||||
parsesAs qty "1" One,
|
||||
parsesAs qty "ω" Any,
|
||||
parsesAs qty "#" Any,
|
||||
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" :- [
|
||||
parsesAs term #"{}"# (Enum []),
|
||||
parsesAs term #"{a}"# (Enum ["a"]),
|
||||
parsesAs term #"{a,}"# (Enum ["a"]),
|
||||
parsesAs term #"{a.b.c.d}"# (Enum ["a.b.c.d"]),
|
||||
parsesAs term #"{"hel lo"}"# (Enum ["hel lo"]),
|
||||
parsesAs term #"{a, b}"# (Enum ["a", "b"]),
|
||||
parsesAs term #"{a, b,}"# (Enum ["a", "b"]),
|
||||
parsesAs term #"{a, b, ","}"# (Enum ["a", "b", ","]),
|
||||
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" :- [
|
||||
parsesAs term #" 'a "# (Tag "a"),
|
||||
parsesAs term #" 'abc "# (Tag "abc"),
|
||||
parsesAs term #" '"abc" "# (Tag "abc"),
|
||||
parsesAs term #" '"a b c" "# (Tag "a b c"),
|
||||
parsesAs term #" 'a b c "# (Tag "a" :@ V "b" :@ V "c")
|
||||
{label = "'a b c # application to two args"}
|
||||
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" :- [
|
||||
parsesAs term "★₀" (TYPE 0),
|
||||
parsesAs term "★1" (TYPE 1),
|
||||
parsesAs term "★ 2" (TYPE 2),
|
||||
parsesAs term "Type₃" (TYPE 3),
|
||||
parsesAs term "Type4" (TYPE 4),
|
||||
parsesAs term "Type 100" (TYPE 100),
|
||||
parsesAs term "(Type 1000)" (TYPE 1000),
|
||||
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" :- [
|
||||
parsesAs term "f" (V "f"),
|
||||
parsesAs term "f.x.y" (V $ MakePName [< "f", "x"] "y"),
|
||||
parsesAs term "f x" (V "f" :@ V "x"),
|
||||
parsesAs term "f x y" (V "f" :@ V "x" :@ V "y"),
|
||||
parsesAs term "(f x) y" (V "f" :@ V "x" :@ V "y"),
|
||||
parsesAs term "f (g x)" (V "f" :@ (V "g" :@ V "x")),
|
||||
parsesAs term "f (g x) y" (V "f" :@ (V "g" :@ V "x") :@ V "y"),
|
||||
parsesAs term "f @p" (V "f" :% V "p"),
|
||||
parsesAs term "f x @p y" (V "f" :@ V "x" :% V "p" :@ V "y")
|
||||
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" :- [
|
||||
parsesAs term "f :: A" (V "f" :# V "A"),
|
||||
parsesAs term "f ∷ A" (V "f" :# V "A"),
|
||||
parsesAs term "f x y ∷ A B C"
|
||||
((V "f" :@ V "x" :@ V "y") :#
|
||||
(V "A" :@ V "B" :@ V "C")),
|
||||
parsesAs term "Type 0 ∷ Type 1 ∷ Type 2"
|
||||
(TYPE 0 :# (TYPE 1 :# TYPE 2))
|
||||
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" :- [
|
||||
parsesAs term "1.(x : A) → B x" $
|
||||
Pi One (Just "x") (V "A") (V "B" :@ V "x"),
|
||||
parsesAs term "1.(x : A) -> B x" $
|
||||
Pi One (Just "x") (V "A") (V "B" :@ V "x"),
|
||||
parsesAs term "ω.(x : A) → B x" $
|
||||
Pi Any (Just "x") (V "A") (V "B" :@ V "x"),
|
||||
parsesAs term "#.(x : A) -> B x" $
|
||||
Pi Any (Just "x") (V "A") (V "B" :@ V "x"),
|
||||
parsesAs term "1.(x y : A) -> B x" $
|
||||
Pi One (Just "x") (V "A") $ Pi One (Just "y") (V "A") (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 "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",
|
||||
parsesAs term "1.A → B"
|
||||
(Pi One Nothing (V "A") (V "B")),
|
||||
parsesAs term "1.(List A) → List B"
|
||||
(Pi One Nothing (V "List" :@ V "A") (V "List" :@ V "B")),
|
||||
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",
|
||||
parsesAs term "(x : A) × B x" $
|
||||
Sig (Just "x") (V "A") (V "B" :@ V "x"),
|
||||
parsesAs term "(x : A) ** B x" $
|
||||
Sig (Just "x") (V "A") (V "B" :@ V "x"),
|
||||
parsesAs term "(x y : A) × B x" $
|
||||
Sig (Just "x") (V "A") $ Sig (Just "y") (V "A") (V "B" :@ V "x"),
|
||||
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",
|
||||
parsesAs term "A × B" $
|
||||
Sig Nothing (V "A") (V "B"),
|
||||
parsesAs term "A ** B" $
|
||||
Sig Nothing (V "A") (V "B"),
|
||||
parsesAs term "A × B × C" $
|
||||
Sig Nothing (V "A") (Sig Nothing (V "B") (V "C")),
|
||||
parsesAs term "(A × B) × C" $
|
||||
Sig Nothing (Sig Nothing (V "A") (V "B")) (V "C")
|
||||
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" :- [
|
||||
parsesAs term "λ x ⇒ x" $ Lam (Just "x") (V "x"),
|
||||
parsesAs term "λ x ⇒ x" $ Lam (Just "x") (V "x"),
|
||||
parsesAs term "fun x => x" $ Lam (Just "x") (V "x"),
|
||||
parsesAs term "δ i ⇒ x @i" $ DLam (Just "i") (V "x" :% V "i"),
|
||||
parsesAs term "dfun i => x @i" $ DLam (Just "i") (V "x" :% V "i"),
|
||||
parsesAs term "λ x y z ⇒ x z y" $
|
||||
Lam (Just "x") $ Lam (Just "y") $ Lam (Just "z") $
|
||||
V "x" :@ V "z" :@ V "y"
|
||||
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" :- [
|
||||
parsesAs term "(x, y)" $
|
||||
Pair (V "x") (V "y"),
|
||||
parsesAs term "(x, y, z)" $
|
||||
Pair (V "x") (Pair (V "y") (V "z")),
|
||||
parsesAs term "((x, y), z)" $
|
||||
Pair (Pair (V "x") (V "y")) (V "z"),
|
||||
parsesAs term "(f x, g @y)" $
|
||||
Pair (V "f" :@ V "x") (V "g" :% V "y"),
|
||||
parsesAs term "((x : A) × B, 0.(x : C) → D)" $
|
||||
Pair (Sig (Just "x") (V "A") (V "B"))
|
||||
(Pi Zero (Just "x") (V "C") (V "D")),
|
||||
parsesAs term "(λ x ⇒ x, δ i ⇒ e @i)" $
|
||||
Pair (Lam (Just "x") (V "x"))
|
||||
(DLam (Just "i") (V "e" :% V "i")),
|
||||
parsesAs term "(x,)" (V "x"), -- i GUESS
|
||||
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" :- [
|
||||
parsesAs term "Eq [i ⇒ A] s t" $
|
||||
Eq (Just "i", V "A") (V "s") (V "t"),
|
||||
parsesAs term "Eq [i ⇒ A B (C @i)] (f x y) (g y z)" $
|
||||
Eq (Just "i", V "A" :@ V "B" :@ (V "C" :% V "i"))
|
||||
(V "f" :@ V "x" :@ V "y") (V "g" :@ V "y" :@ V "z"),
|
||||
parsesAs term "Eq [A] s t" $
|
||||
Eq (Nothing, V "A") (V "s") (V "t"),
|
||||
parsesAs term "s ≡ t : A" $
|
||||
Eq (Nothing, V "A") (V "s") (V "t"),
|
||||
parsesAs term "s == t : A" $
|
||||
Eq (Nothing, V "A") (V "s") (V "t"),
|
||||
parsesAs term "f x y ≡ g y z : A B C" $
|
||||
Eq (Nothing, V "A" :@ V "B" :@ V "C")
|
||||
(V "f" :@ V "x" :@ V "y") (V "g" :@ V "y" :@ V "z"),
|
||||
parsesAs term "(A × B) ≡ (A' × B') : ★₁" $
|
||||
Eq (Nothing, TYPE 1)
|
||||
(Sig Nothing (V "A") (V "B")) (Sig Nothing (V "A'") (V "B'")),
|
||||
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' : ★₁)",
|
||||
parsesAs term "A × B ≡ A' × B' : ★₁" $
|
||||
Sig Nothing (V "A") $
|
||||
Eq (Nothing, TYPE 1)
|
||||
(V "B") (Sig Nothing (V "A'") (V "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",
|
||||
|
|
@ -234,127 +260,144 @@ tests = "parser" :- [
|
|||
],
|
||||
|
||||
"naturals" :- [
|
||||
parsesAs term "ℕ" Nat,
|
||||
parsesAs term "Nat" Nat,
|
||||
parsesAs term "zero" Zero,
|
||||
parsesAs term "succ n" (Succ $ V "n"),
|
||||
parsesAs term "3" (fromNat 3),
|
||||
parsesAs term "succ (succ 5)" (fromNat 7),
|
||||
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" :- [
|
||||
parsesAs term "[1.ℕ]" $ BOX One Nat,
|
||||
parsesAs term "[ω. ℕ × ℕ]" $ BOX Any (Sig Nothing Nat Nat),
|
||||
parsesAs term "[a]" $ Box (V "a"),
|
||||
parsesAs term "[0]" $ Box Zero,
|
||||
parsesAs term "[1]" $ Box (Succ Zero)
|
||||
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" :- [
|
||||
parsesAs term "coe [A] @p @q x" $
|
||||
Coe (Nothing, V "A") (V "p") (V "q") (V "x"),
|
||||
parsesAs term "coe [i ⇒ A] @p @q x" $
|
||||
Coe (Just "i", V "A") (V "p") (V "q") (V "x"),
|
||||
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" :- [
|
||||
parsesAs term "comp [A] @p @q s @r { 0 𝑗 ⇒ s₀; 1 𝑘 ⇒ s₁ }" $
|
||||
Comp (Nothing, V "A") (V "p") (V "q") (V "s") (V "r")
|
||||
(Just "𝑗", V "s₀") (Just "𝑘", V "s₁"),
|
||||
parsesAs term "comp [A] @p @q s @r { 1 𝑗 ⇒ s₀; 0 𝑘 ⇒ s₁; }" $
|
||||
Comp (Nothing, V "A") (V "p") (V "q") (V "s") (V "r")
|
||||
(Just "𝑘", V "s₁") (Just "𝑗", V "s₀"),
|
||||
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" :- [
|
||||
parsesAs term
|
||||
"case1 f s return x ⇒ A x of { (l, r) ⇒ add l r }" $
|
||||
Case One (V "f" :@ V "s")
|
||||
(Just "x", V "A" :@ V "x")
|
||||
(CasePair (Just "l", Just "r")
|
||||
(V "add" :@ V "l" :@ V "r")),
|
||||
parsesAs term
|
||||
"case1 f s return x ⇒ A x of { (l, r) ⇒ add l r; }" $
|
||||
Case One (V "f" :@ V "s")
|
||||
(Just "x", V "A" :@ V "x")
|
||||
(CasePair (Just "l", Just "r")
|
||||
(V "add" :@ V "l" :@ V "r")),
|
||||
parsesAs term
|
||||
"case 1 . f s return x ⇒ A x of { (l, r) ⇒ add l r }" $
|
||||
Case One (V "f" :@ V "s")
|
||||
(Just "x", V "A" :@ V "x")
|
||||
(CasePair (Just "l", Just "r")
|
||||
(V "add" :@ V "l" :@ V "r")),
|
||||
parsesAs term
|
||||
"case1 t return A of { 'x ⇒ p; 'y ⇒ q; 'z ⇒ r }" $
|
||||
Case One (V "t")
|
||||
(Nothing, V "A")
|
||||
(CaseEnum [("x", V "p"), ("y", V "q"), ("z", V "r")]),
|
||||
parsesAs term "caseω t return A of {}" $
|
||||
Case Any (V "t") (Nothing, V "A") (CaseEnum []),
|
||||
parsesAs term "case# t return A of {}" $
|
||||
Case Any (V "t") (Nothing, V "A") (CaseEnum []),
|
||||
parsesAs term "caseω n return A of { 0 ⇒ a; succ n' ⇒ b }" $
|
||||
Case Any (V "n") (Nothing, V "A") $
|
||||
CaseNat (V "a") (Just "n'", Zero, Nothing, V "b"),
|
||||
parsesAs term "caseω n return ℕ of { succ _, 1.ih ⇒ ih; zero ⇒ 0; }" $
|
||||
Case Any (V "n") (Nothing, Nat) $
|
||||
CaseNat Zero (Nothing, One, Just "ih", V "ih"),
|
||||
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" :- [
|
||||
parsesAs definition "defω x : {a} × {b} = ('a, 'b)" $
|
||||
MkPDef Any "x" (Just $ Sig Nothing (Enum ["a"]) (Enum ["b"]))
|
||||
(Pair (Tag "a") (Tag "b")),
|
||||
parsesAs definition "defω x : {a} × {b} = ('a, 'b)" $
|
||||
MkPDef Any "x" (Just $ Sig Nothing (Enum ["a"]) (Enum ["b"]))
|
||||
(Pair (Tag "a") (Tag "b")),
|
||||
parsesAs definition "def# x : {a} ** {b} = ('a, 'b)" $
|
||||
MkPDef Any "x" (Just $ Sig Nothing (Enum ["a"]) (Enum ["b"]))
|
||||
(Pair (Tag "a") (Tag "b")),
|
||||
parsesAs definition "def ω.x : {a} × {b} = ('a, 'b)" $
|
||||
MkPDef Any "x" (Just $ Sig Nothing (Enum ["a"]) (Enum ["b"]))
|
||||
(Pair (Tag "a") (Tag "b")),
|
||||
parsesAs definition "def x : {a} × {b} = ('a, 'b)" $
|
||||
MkPDef Any "x" (Just $ Sig Nothing (Enum ["a"]) (Enum ["b"]))
|
||||
(Pair (Tag "a") (Tag "b")),
|
||||
parsesAs definition "def0 A : ★₀ = {a, b, c}" $
|
||||
MkPDef Zero "A" (Just $ TYPE 0) (Enum ["a", "b", "c"])
|
||||
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" :- [
|
||||
parsesAs input "def0 A : ★₀ = {}; def0 B : ★₁ = A;" $
|
||||
[PD $ PDef $ MkPDef Zero "A" (Just $ TYPE 0) (Enum []),
|
||||
PD $ PDef $ MkPDef Zero "B" (Just $ TYPE 1) (V "A")],
|
||||
parsesAs input "def0 A : ★₀ = {} def0 B : ★₁ = A" $
|
||||
[PD $ PDef $ MkPDef Zero "A" (Just $ TYPE 0) (Enum []),
|
||||
PD $ PDef $ MkPDef Zero "B" (Just $ TYPE 1) (V "A")],
|
||||
parsesAs input "" [] {label = "[empty input]"},
|
||||
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 ";;;;;;;;;;;;;;;;;;;;;;;;;;",
|
||||
parsesAs input "namespace a {}" [PD $ PNs $ MkPNamespace [< "a"] []],
|
||||
parsesAs input "namespace a.b.c {}"
|
||||
[PD $ PNs $ MkPNamespace [< "a", "b", "c"] []],
|
||||
parsesAs input "namespace a {namespace b {}}"
|
||||
[PD $ PNs $ MkPNamespace [< "a"] [PNs $ MkPNamespace [< "b"] []]],
|
||||
parsesAs input "namespace a {def x = 't ∷ {t}}"
|
||||
[PD $ PNs $ MkPNamespace [< "a"]
|
||||
[PDef $ MkPDef Any "x" Nothing (Tag "t" :# Enum ["t"])]],
|
||||
parsesAs input "namespace a {def x = 't ∷ {t}} def y = a.x"
|
||||
[PD $ PNs $ MkPNamespace [< "a"]
|
||||
[PDef $ MkPDef Any "x" Nothing (Tag "t" :# Enum ["t"])],
|
||||
PD $ PDef $ MkPDef Any "y" Nothing (V $ MakePName [< "a"] "x")],
|
||||
parsesAs input #" load "a.quox"; def b = a.b "#
|
||||
[PLoad "a.quox",
|
||||
PD $ PDef $ MkPDef Any "b" Nothing (V $ MakePName [< "a"] "b")]
|
||||
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") _) _])
|
||||
]
|
||||
]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue