quox/tests/Tests/PrettyTerm.idr

242 lines
7.2 KiB
Idris
Raw Normal View History

2023-03-16 13:19:17 -04:00
module Tests.PrettyTerm
import TAP
import Quox.Syntax
2023-03-25 15:55:28 -04:00
import PrettyExtra
2023-03-16 13:19:17 -04:00
2023-05-14 13:58:46 -04:00
parameters (ds : BContext d) (ns : BContext n)
2023-04-01 13:16:43 -04:00
testPrettyT : Term d n -> (uni, asc : String) ->
{default uni label : String} -> Test
2023-03-25 15:55:28 -04:00
testPrettyT t uni asc {label} =
2023-05-14 13:58:46 -04:00
testPretty (prettyTerm ds ns) t uni asc {label}
2023-03-16 13:19:17 -04:00
2023-04-01 13:16:43 -04:00
testPrettyT1 : Term d n -> (str : String) ->
{default str label : String} -> Test
testPrettyT1 t str {label} = testPrettyT t str str {label}
2023-03-16 13:19:17 -04:00
2023-04-01 13:16:43 -04:00
testPrettyE : Elim d n -> (uni, asc : String) ->
{default uni label : String} -> Test
testPrettyE e uni asc {label} = testPrettyT (E e) uni asc {label}
2023-03-16 13:19:17 -04:00
2023-04-01 13:16:43 -04:00
testPrettyE1 : Elim d n -> (str : String) ->
{default str label : String} -> Test
testPrettyE1 e str {label} = testPrettyT1 (E e) str {label}
2023-03-16 13:19:17 -04:00
2023-05-01 21:06:25 -04:00
prefix 9 ^
(^) : (Loc -> a) -> a
(^) a = a noLoc
FromString BindName where fromString str = BN (fromString str) noLoc
2023-03-16 13:19:17 -04:00
export
tests : Test
tests = "pretty printing terms" :- [
"free vars" :- [
2023-05-21 14:09:34 -04:00
testPrettyE1 [<] [<] (^F "x" 0) "x",
testPrettyE [<] [<] (^F "x" 1) "" "x^1",
2024-04-11 16:08:07 -04:00
testPrettyE1 [<] [<] (^F (MkName [< "A", "B", "C"] "x") 0) "A.B.C.x",
testPrettyE [<] [<] (^F (MkName [< "A", "B", "C"] "x") 2)
2023-05-21 14:09:34 -04:00
"A.B.C.x²"
"A.B.C.x^2"
2023-03-16 13:19:17 -04:00
],
"bound vars" :- [
2023-05-01 21:06:25 -04:00
testPrettyE1 [< "𝑖", "𝑗"] [< "x", "y"] (^BV 0) "y",
testPrettyE1 [< "𝑖", "𝑗"] [< "x", "y"] (^BV 1) "x",
testPrettyE1 [< "𝑖", "𝑗"] [< "x", "y"]
2023-05-21 14:09:34 -04:00
(^DApp (^F "eq" 0) (^BV 1))
2023-05-01 21:06:25 -04:00
"eq @𝑖",
testPrettyE1 [< "𝑖", "𝑗"] [< "x", "y"]
2023-05-21 14:09:34 -04:00
(^DApp (^DApp (^F "eq" 0) (^BV 1)) (^BV 0))
2023-05-01 21:06:25 -04:00
"eq @𝑖 @𝑗"
2023-03-16 13:19:17 -04:00
],
"applications" :- [
2023-05-01 21:06:25 -04:00
testPrettyE1 [<] [<]
2023-05-21 14:09:34 -04:00
(^App (^F "f" 0) (^FT "x" 0))
2023-05-01 21:06:25 -04:00
"f x",
testPrettyE1 [<] [<]
2023-05-21 14:09:34 -04:00
(^App (^App (^F "f" 0) (^FT "x" 0)) (^FT "y" 0))
2023-05-01 21:06:25 -04:00
"f x y",
testPrettyE1 [<] [<]
2023-05-21 14:09:34 -04:00
(^DApp (^F "f" 0) (^K Zero))
2023-05-01 21:06:25 -04:00
"f @0",
testPrettyE1 [<] [<]
2023-05-21 14:09:34 -04:00
(^DApp (^App (^F "f" 0) (^FT "x" 0)) (^K Zero))
2023-05-01 21:06:25 -04:00
"f x @0",
testPrettyE1 [<] [<]
2023-05-21 14:09:34 -04:00
(^App (^DApp (^F "g" 0) (^K One)) (^FT "y" 0))
2023-05-01 21:06:25 -04:00
"g @1 y"
2023-03-16 13:19:17 -04:00
],
"lambda" :- [
testPrettyT [<] [<]
2023-05-01 21:06:25 -04:00
(^LamY "x" (^BVT 0))
"λ x ⇒ x"
"fun x => x",
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^LamN (^FT "a" 0))
2023-05-01 21:06:25 -04:00
"λ _ ⇒ 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)))))
2023-03-16 13:19:17 -04:00
"λ x y f ⇒ f x y"
"fun x y f => f x y",
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^DLam (SN (^FT "a" 0)))
2023-05-01 21:06:25 -04:00
"δ _ ⇒ a"
"dfun _ => a",
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^DLamY "i" (^FT "x" 0))
2023-05-01 21:06:25 -04:00
"δ i ⇒ x"
"dfun i => x",
testPrettyT [<] [<]
(^LamY "x" (^DLamY "i" (E $ ^DApp (^BV 0) (^BV 0))))
2023-03-16 13:19:17 -04:00
"λ x ⇒ δ i ⇒ x @i"
"fun x => dfun i => x @i"
],
"type universes" :- [
2023-05-21 14:09:34 -04:00
testPrettyT [<] [<] (^TYPE 0) "★⁰" "Type 0",
testPrettyT [<] [<] (^TYPE 100) "★¹⁰⁰" "Type 100"
2023-03-16 13:19:17 -04:00
],
"function types" :- [
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^Arr One (^FT "A" 0) (^FT "B" 0))
2023-05-01 21:06:25 -04:00
"1.A → B"
"1.A -> B",
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^PiY One "x" (^FT "A" 0) (E $ ^App (^F "B" 0) (^BVT 0)))
"1.(x : A) → B x"
"1.(x : A) -> B x",
2023-03-16 13:19:17 -04:00
testPrettyT [<] [<]
2023-05-01 21:06:25 -04:00
(^PiY Zero "A" (^TYPE 0) (^Arr Any (^BVT 0) (^BVT 0)))
2023-05-21 14:09:34 -04:00
"0.(A : ★⁰) → ω.A → A"
2023-05-14 13:58:46 -04:00
"0.(A : Type 0) -> #.A -> A",
2023-03-16 13:19:17 -04:00
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^Arr Any (^Arr Any (^FT "A" 0) (^FT "A" 0)) (^FT "A" 0))
"ω.(ω.A → A) → A"
"#.(#.A -> A) -> A",
2023-04-01 16:07:01 -04:00
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^Arr Any (^FT "A" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)))
2023-04-01 16:07:01 -04:00
"ω.A → ω.A → A"
"#.A -> #.A -> A",
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^PiY Zero "P" (^Arr Zero (^FT "A" 0) (^TYPE 0))
(E $ ^App (^BV 0) (^FT "a" 0)))
"0.(P : 0.A → ★⁰) → P a"
2023-05-14 13:58:46 -04:00
"0.(P : 0.A -> Type 0) -> P a"
2023-03-16 13:19:17 -04:00
],
"pair types" :- [
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^And (^FT "A" 0) (^FT "B" 0))
2023-05-01 21:06:25 -04:00
"A × B"
"A ** B",
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^SigY "x" (^FT "A" 0) (E $ ^App (^F "B" 0) (^BVT 0)))
2023-03-16 13:19:17 -04:00
"(x : A) × B x"
"(x : A) ** B x",
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^SigY "x" (^FT "A" 0)
(^SigY "y" (E $ ^App (^F "B" 0) (^BVT 0))
(E $ ^App (^App (^F "C" 0) (^BVT 1)) (^BVT 0))))
2023-03-16 13:19:17 -04:00
"(x : A) × (y : B x) × C x y"
"(x : A) ** (y : B x) ** C x y",
todo "non-dependent, left and right nested"
],
"pairs" :- [
2023-05-01 21:06:25 -04:00
testPrettyT1 [<] [<]
2023-05-21 14:09:34 -04:00
(^Pair (^FT "A" 0) (^FT "B" 0))
2023-05-01 21:06:25 -04:00
"(A, B)",
testPrettyT1 [<] [<]
2023-05-21 14:09:34 -04:00
(^Pair (^FT "A" 0) (^Pair (^FT "B" 0) (^FT "C" 0)))
2023-05-01 21:06:25 -04:00
"(A, B, C)",
testPrettyT1 [<] [<]
2023-05-21 14:09:34 -04:00
(^Pair (^Pair (^FT "A" 0) (^FT "B" 0)) (^FT "C" 0))
2023-05-01 21:06:25 -04:00
"((A, B), C)",
2023-03-16 13:19:17 -04:00
testPrettyT [<] [<]
2023-05-21 14:09:34 -04:00
(^Pair (^LamY "x" (^BVT 0)) (^Arr One (^FT "B₁" 0) (^FT "B₂" 0)))
"(λ x ⇒ x, 1.B₁ → B₂)"
"(fun x => x, 1.B₁ -> B₂)"
2023-03-16 13:19:17 -04:00
],
"enum types" :- [
2023-05-01 21:06:25 -04:00
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"#}
2023-03-16 13:19:17 -04:00
],
"tags" :- [
2023-05-01 21:06:25 -04:00
testPrettyT1 [<] [<] (^Tag "a") "'a",
testPrettyT1 [<] [<] (^Tag "hello") "'hello",
testPrettyT1 [<] [<] (^Tag "qualified.tag") "'qualified.tag",
testPrettyT1 [<] [<] (^Tag "non-identifier tag") #"'"non-identifier tag""#,
testPrettyT1 [<] [<] (^Tag #"""#) #" '"\"" "#
2023-03-16 13:19:17 -04:00
],
todo "equality types",
2023-03-17 21:47:15 -04:00
"case" :- [
testPrettyE [<] [<]
2023-05-21 14:09:34 -04:00
(^CasePair One (^F "a" 0) (SN $ ^TYPE 1) (SN $ ^TYPE 0))
"case1 a return ★¹ of { (_, _) ⇒ ★⁰ }"
2023-05-14 13:58:46 -04:00
"case1 a return Type 1 of { (_, _) => Type 0 }",
2023-03-17 21:47:15 -04:00
testPrettyT [<] [<]
2023-05-01 21:06:25 -04:00
(^LamY "u" (E $
2023-05-21 14:09:34 -04:00
^CaseEnum One (^F "u" 0)
2023-05-01 21:06:25 -04:00
(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 }"
2023-03-17 21:47:15 -04:00
"""
fun u =>
case1 u return x => x == 'tt : {tt} of { 'tt => dfun _ => 'tt }
2023-03-17 21:47:15 -04:00
"""
],
2023-04-03 11:46:23 -04:00
"type-case" :- [
testPrettyE [<] [<]
2023-05-21 14:09:34 -04:00
{label = "type-case ∷ ★⁰ return ★⁰ of { ⋯ }"}
2023-11-02 13:14:22 -04:00
(^TypeCase (^Ann (^NAT) (^TYPE 0)) (^TYPE 0) empty (^NAT))
2023-05-21 14:09:34 -04:00
"type-case ∷ ★⁰ return ★⁰ of { _ ⇒ }"
2023-05-14 13:58:46 -04:00
"type-case Nat :: Type 0 return Type 0 of { _ => Nat }"
2023-04-03 11:46:23 -04:00
],
skipWith "(todo: print user-written redundant annotations)" $
2023-03-17 21:47:15 -04:00
"annotations" :- [
testPrettyE [<] [<]
2023-05-21 14:09:34 -04:00
(^Ann (^FT "a" 0) (^FT "A" 0))
2023-05-01 21:06:25 -04:00
"a ∷ A"
"a :: A",
testPrettyE [<] [<]
2023-05-21 14:09:34 -04:00
(^Ann (^FT "a" 0) (E $ ^Ann (^FT "A" 0) (^FT "𝐀" 0)))
2023-03-17 21:47:15 -04:00
"a ∷ A ∷ 𝐀"
"a :: A :: 𝐀",
testPrettyE [<] [<]
2023-05-21 14:09:34 -04:00
(^Ann (E $ ^Ann (^FT "α" 0) (^FT "a" 0)) (^FT "A" 0))
2023-03-17 21:47:15 -04:00
"(α ∷ a) ∷ A"
"(α :: a) :: A",
testPrettyE [<] [<]
2023-05-21 14:09:34 -04:00
(^Ann (^LamY "x" (^BVT 0)) (^Arr One (^FT "A" 0) (^FT "A" 0)))
"(λ x ⇒ x) ∷ 1.A → A"
"(fun x => x) :: 1.A -> A",
2023-03-17 21:47:15 -04:00
testPrettyE [<] [<]
2023-05-21 14:09:34 -04:00
(^Ann (^Arr One (^FT "A" 0) (^FT "A" 0)) (^TYPE 7))
"(1.A → A) ∷ ★⁷"
2023-05-14 13:58:46 -04:00
"(1.A -> A) :: Type 7"
2023-03-17 21:47:15 -04:00
]
2023-03-16 13:19:17 -04:00
]