quox/tests/Tests/PrettyTerm.idr

241 lines
7.2 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.PrettyTerm
import TAP
import Quox.Syntax
import PrettyExtra
parameters (ds : BContext d) (ns : BContext n)
testPrettyT : Term d n -> (uni, asc : String) ->
{default uni label : String} -> Test
testPrettyT t uni asc {label} =
testPretty (prettyTerm ds ns) t uni asc {label}
testPrettyT1 : Term d n -> (str : String) ->
{default str label : String} -> Test
testPrettyT1 t str {label} = testPrettyT t str str {label}
testPrettyE : Elim d n -> (uni, asc : String) ->
{default uni label : String} -> Test
testPrettyE e uni asc {label} = testPrettyT (E e) uni asc {label}
testPrettyE1 : Elim d n -> (str : String) ->
{default str label : String} -> Test
testPrettyE1 e str {label} = testPrettyT1 (E e) str {label}
prefix 9 ^
(^) : (Loc -> a) -> a
(^) a = a noLoc
FromString BindName where fromString str = BN (fromString str) noLoc
export
tests : Test
tests = "pretty printing terms" :- [
"free vars" :- [
testPrettyE1 [<] [<] (^F "x" 0) "x",
testPrettyE [<] [<] (^F "x" 1) "" "x^1",
testPrettyE1 [<] [<] (^F (MakeName [< "A", "B", "C"] "x") 0) "A.B.C.x",
testPrettyE [<] [<] (^F (MakeName [< "A", "B", "C"] "x") 2)
"A.B.C.x²"
"A.B.C.x^2"
],
"bound vars" :- [
testPrettyE1 [< "𝑖", "𝑗"] [< "x", "y"] (^BV 0) "y",
testPrettyE1 [< "𝑖", "𝑗"] [< "x", "y"] (^BV 1) "x",
testPrettyE1 [< "𝑖", "𝑗"] [< "x", "y"]
(^DApp (^F "eq" 0) (^BV 1))
"eq @𝑖",
testPrettyE1 [< "𝑖", "𝑗"] [< "x", "y"]
(^DApp (^DApp (^F "eq" 0) (^BV 1)) (^BV 0))
"eq @𝑖 @𝑗"
],
"applications" :- [
testPrettyE1 [<] [<]
(^App (^F "f" 0) (^FT "x" 0))
"f x",
testPrettyE1 [<] [<]
(^App (^App (^F "f" 0) (^FT "x" 0)) (^FT "y" 0))
"f x y",
testPrettyE1 [<] [<]
(^DApp (^F "f" 0) (^K Zero))
"f @0",
testPrettyE1 [<] [<]
(^DApp (^App (^F "f" 0) (^FT "x" 0)) (^K Zero))
"f x @0",
testPrettyE1 [<] [<]
(^App (^DApp (^F "g" 0) (^K One)) (^FT "y" 0))
"g @1 y"
],
"lambda" :- [
testPrettyT [<] [<]
(^LamY "x" (^BVT 0))
"λ x ⇒ x"
"fun x => x",
testPrettyT [<] [<]
(^LamN (^FT "a" 0))
"λ _ ⇒ a"
"fun _ => a",
testPrettyT [<] [< "y"]
(^LamY "x" (^BVT 1))
"λ x ⇒ y"
"fun x => y",
testPrettyT [<] [<]
(^LamY "x" (^LamY "y" (^LamY "f"
(E $ ^App (^App (^BV 0) (^BVT 2)) (^BVT 1)))))
"λ x y f ⇒ f x y"
"fun x y f => f x y",
testPrettyT [<] [<]
(^DLam (SN (^FT "a" 0)))
"δ _ ⇒ a"
"dfun _ => a",
testPrettyT [<] [<]
(^DLamY "i" (^FT "x" 0))
"δ i ⇒ x"
"dfun i => x",
testPrettyT [<] [<]
(^LamY "x" (^DLamY "i" (E $ ^DApp (^BV 0) (^BV 0))))
"λ x ⇒ δ i ⇒ x @i"
"fun x => dfun i => x @i"
],
"type universes" :- [
testPrettyT [<] [<] (^TYPE 0) "★⁰" "Type 0",
testPrettyT [<] [<] (^TYPE 100) "★¹⁰⁰" "Type 100"
],
"function types" :- [
testPrettyT [<] [<]
(^Arr One (^FT "A" 0) (^FT "B" 0))
"1.A → B"
"1.A -> B",
testPrettyT [<] [<]
(^PiY One "x" (^FT "A" 0) (E $ ^App (^F "B" 0) (^BVT 0)))
"1.(x : A) → B x"
"1.(x : A) -> B x",
testPrettyT [<] [<]
(^PiY Zero "A" (^TYPE 0) (^Arr Any (^BVT 0) (^BVT 0)))
"0.(A : ★⁰) → ω.A → A"
"0.(A : Type 0) -> #.A -> A",
testPrettyT [<] [<]
(^Arr Any (^Arr Any (^FT "A" 0) (^FT "A" 0)) (^FT "A" 0))
"ω.(ω.A → A) → A"
"#.(#.A -> A) -> A",
testPrettyT [<] [<]
(^Arr Any (^FT "A" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)))
"ω.A → ω.A → A"
"#.A -> #.A -> A",
testPrettyT [<] [<]
(^PiY Zero "P" (^Arr Zero (^FT "A" 0) (^TYPE 0))
(E $ ^App (^BV 0) (^FT "a" 0)))
"0.(P : 0.A → ★⁰) → P a"
"0.(P : 0.A -> Type 0) -> P a"
],
"pair types" :- [
testPrettyT [<] [<]
(^And (^FT "A" 0) (^FT "B" 0))
"A × B"
"A ** B",
testPrettyT [<] [<]
(^SigY "x" (^FT "A" 0) (E $ ^App (^F "B" 0) (^BVT 0)))
"(x : A) × B x"
"(x : A) ** B x",
testPrettyT [<] [<]
(^SigY "x" (^FT "A" 0)
(^SigY "y" (E $ ^App (^F "B" 0) (^BVT 0))
(E $ ^App (^App (^F "C" 0) (^BVT 1)) (^BVT 0))))
"(x : A) × (y : B x) × C x y"
"(x : A) ** (y : B x) ** C x y",
todo "non-dependent, left and right nested"
],
"pairs" :- [
testPrettyT1 [<] [<]
(^Pair (^FT "A" 0) (^FT "B" 0))
"(A, B)",
testPrettyT1 [<] [<]
(^Pair (^FT "A" 0) (^Pair (^FT "B" 0) (^FT "C" 0)))
"(A, B, C)",
testPrettyT1 [<] [<]
(^Pair (^Pair (^FT "A" 0) (^FT "B" 0)) (^FT "C" 0))
"((A, B), C)",
testPrettyT [<] [<]
(^Pair (^LamY "x" (^BVT 0)) (^Arr One (^FT "B₁" 0) (^FT "B₂" 0)))
"(λ x ⇒ x, 1.B₁ → B₂)"
"(fun x => x, 1.B₁ -> B₂)"
],
"enum types" :- [
testPrettyT1 [<] [<] (^enum []) "{}",
testPrettyT1 [<] [<] (^enum ["a"]) "{a}",
testPrettyT1 [<] [<] (^enum ["aa", "bb", "cc"]) "{aa, bb, cc}",
testPrettyT1 [<] [<] (^enum ["a b c"]) #"{"a b c"}"#,
testPrettyT1 [<] [<] (^enum ["\"", ",", "\\"]) #" {"\"", ",", \} "#
{label = #"{"\"", ",", \} # 「\」 is an identifier"#}
],
"tags" :- [
testPrettyT1 [<] [<] (^Tag "a") "'a",
testPrettyT1 [<] [<] (^Tag "hello") "'hello",
testPrettyT1 [<] [<] (^Tag "qualified.tag") "'qualified.tag",
testPrettyT1 [<] [<] (^Tag "non-identifier tag") #"'"non-identifier tag""#,
testPrettyT1 [<] [<] (^Tag #"""#) #" '"\"" "#
],
todo "equality types",
"case" :- [
testPrettyE [<] [<]
(^CasePair One (^F "a" 0) (SN $ ^TYPE 1) (SN $ ^TYPE 0))
"case1 a return ★¹ of { (_, _) ⇒ ★⁰ }"
"case1 a return Type 1 of { (_, _) => Type 0 }",
testPrettyT [<] [<]
(^LamY "u" (E $
^CaseEnum One (^F "u" 0)
(SY [< "x"] $ ^Eq0 (^enum ["tt"]) (^BVT 0) (^Tag "tt"))
(fromList [("tt", ^DLamN (^Tag "tt"))])))
"λ u ⇒ case1 u return x ⇒ x ≡ 'tt : {tt} of { 'tt ⇒ δ _'tt }"
"""
fun u =>
case1 u return x => x == 'tt : {tt} of { 'tt => dfun _ => 'tt }
"""
],
"type-case" :- [
testPrettyE [<] [<]
{label = "type-case ∷ ★⁰ return ★⁰ of {}"}
(^TypeCase (^Ann (^NAT) (^TYPE 0)) (^TYPE 0) empty (^NAT))
"type-case ∷ ★⁰ return ★⁰ of { _ }"
"type-case Nat :: Type 0 return Type 0 of { _ => Nat }"
],
skipWith "(todo: print user-written redundant annotations)" $
"annotations" :- [
testPrettyE [<] [<]
(^Ann (^FT "a" 0) (^FT "A" 0))
"a ∷ A"
"a :: A",
testPrettyE [<] [<]
(^Ann (^FT "a" 0) (E $ ^Ann (^FT "A" 0) (^FT "𝐀" 0)))
"a ∷ A ∷ 𝐀"
"a :: A :: 𝐀",
testPrettyE [<] [<]
(^Ann (E $ ^Ann (^FT "α" 0) (^FT "a" 0)) (^FT "A" 0))
"(α ∷ a) ∷ A"
"(α :: a) :: A",
testPrettyE [<] [<]
(^Ann (^LamY "x" (^BVT 0)) (^Arr One (^FT "A" 0) (^FT "A" 0)))
"(λ x ⇒ x) ∷ 1.A → A"
"(fun x => x) :: 1.A -> A",
testPrettyE [<] [<]
(^Ann (^Arr One (^FT "A" 0) (^FT "A" 0)) (^TYPE 7))
"(1.A → A) ∷ ★⁷"
"(1.A -> A) :: Type 7"
]
]