some equality tests

This commit is contained in:
rhiannon morris 2022-05-08 20:02:57 +02:00
parent 756bc5b9f3
commit 8a955eebb3

View file

@ -52,50 +52,126 @@ export
tests : Test
tests = "equality & subtyping" :- [
"universes" :- [
testEq "Type 0 == Type 0" $
equalT (TYPE (U 0)) (TYPE (U 0)),
testNeq "Type 0 =/= Type 1" $
equalT (TYPE (U 0)) (TYPE (U 1)),
testNeq "Type 1 =/= Type 0" $
equalT (TYPE (U 1)) (TYPE (U 0)),
testEq "Type 0 <: Type 0" $
subT (TYPE (U 0)) (TYPE (U 0)),
testEq "Type 0 <: Type 1" $
subT (TYPE (U 0)) (TYPE (U 1)),
testNeq "Type 1 </: Type 0" $
subT (TYPE (U 1)) (TYPE (U 0))
testEq "𝒰₀ ≡ 𝒰₀" $
equalT (TYPE 0) (TYPE 0),
testNeq "𝒰₀ ≢ 𝒰₁" $
equalT (TYPE 0) (TYPE 1),
testNeq "𝒰₁ ≢ 𝒰₀" $
equalT (TYPE 1) (TYPE 0),
testEq "𝒰₀ <: 𝒰₀" $
subT (TYPE 0) (TYPE 0),
testEq "𝒰₀ <: 𝒰₁" $
subT (TYPE 0) (TYPE 1),
testNeq "𝒰₁ ≮: 𝒰₀" $
subT (TYPE 1) (TYPE 0)
],
todo "pi",
todo "lambda",
"pi" :- [
-- ⊸ for →₁, ⇾ for →₀
testEq "A ⊸ B ≡ A ⊸ B" $
let tm = Arr One (FT "A") (FT "B") in
equalT tm tm,
testNeq "A ⇾ B ≢ A ⇾ B" $
let tm1 = Arr Zero (FT "A") (FT "B")
tm2 = Arr One (FT "A") (FT "B") in
equalT tm1 tm2,
testEq "A ⊸ B <: A ⊸ B" $
let tm = Arr One (FT "A") (FT "B") in
subT tm tm,
testNeq "A ⇾ B ≮: A ⊸ B" $
let tm1 = Arr Zero (FT "A") (FT "B")
tm2 = Arr One (FT "A") (FT "B") in
subT tm1 tm2,
testEq "𝒰₀ ⇾ 𝒰₀ ≡ 𝒰₀ ⇾ 𝒰₀" $
let tm = Arr Zero (TYPE 0) (TYPE 0) in
equalT tm tm,
testEq "𝒰₀ ⇾ 𝒰₀ <: 𝒰₀ ⇾ 𝒰₀" $
let tm = Arr Zero (TYPE 0) (TYPE 0) in
subT tm tm,
testNeq "𝒰₁ ⊸ 𝒰₀ ≢ 𝒰₀ ⇾ 𝒰₀" $
let tm1 = Arr Zero (TYPE 1) (TYPE 0)
tm2 = Arr Zero (TYPE 0) (TYPE 0) in
equalT tm1 tm2,
testEq "𝒰₁ ⊸ 𝒰₀ <: 𝒰₀ ⊸ 𝒰₀" $
let tm1 = Arr One (TYPE 1) (TYPE 0)
tm2 = Arr One (TYPE 0) (TYPE 0) in
subT tm1 tm2,
testNeq "𝒰₀ ⊸ 𝒰₀ ≢ 𝒰₀ ⇾ 𝒰₁" $
let tm1 = Arr Zero (TYPE 0) (TYPE 0)
tm2 = Arr Zero (TYPE 0) (TYPE 1) in
equalT tm1 tm2,
testEq "𝒰₀ ⊸ 𝒰₀ <: 𝒰₀ ⊸ 𝒰₁" $
let tm1 = Arr One (TYPE 0) (TYPE 0)
tm2 = Arr One (TYPE 0) (TYPE 1) in
subT tm1 tm2,
testEq "𝒰₀ ⊸ 𝒰₀ <: 𝒰₀ ⊸ 𝒰₁" $
let tm1 = Arr One (TYPE 0) (TYPE 0)
tm2 = Arr One (TYPE 0) (TYPE 1) in
subT tm1 tm2
],
"lambda" :- [
testEq "λ x ⇒ [x] ≡ λ x ⇒ [x]" $
equalT (Lam "x" (TUsed (BVT 0))) (Lam "x" (TUsed (BVT 0))),
testEq "λ x ⇒ [x] <: λ x ⇒ [x]" $
equalT (Lam "x" (TUsed (BVT 0))) (Lam "x" (TUsed (BVT 0))),
testEq "λ x ⇒ [x] ≡ λ y ⇒ [y]" $
equalT (Lam "x" (TUsed (BVT 0))) (Lam "y" (TUsed (BVT 0))),
testEq "λ x ⇒ [x] <: λ y ⇒ [y]" $
equalT (Lam "x" (TUsed (BVT 0))) (Lam "y" (TUsed (BVT 0))),
testNeq "λ x y ⇒ [x] ≢ λ x y ⇒ [y]" $
equalT (Lam "x" (TUsed (Lam "y" (TUsed (BVT 1)))))
(Lam "x" (TUsed (Lam "y" (TUsed (BVT 0)))))
],
todo "term closure",
todo "term d-closure",
"free var" :- [
testEq "A == A" $
testEq "A A" $
equalE (F "A") (F "A"),
testNeq "A =/= B" $
testNeq "A B" $
equalE (F "A") (F "B"),
testEq "A <: A" $
subE (F "A") (F "A"),
testNeq "A </: B" $
testNeq "A : B" $
subE (F "A") (F "B")
],
todo "bound var",
"application" :-
let a = F "a"; a' = E a
A = FT "A"
λxx = Lam "x" (TUsed (BVT 0))
A_A = Arr one A A
λxx' = λxx :# A_A
in [
testEq "(λx. x : A -> A) a == ((a : A) : A) (β)" $
equalE (λxx' :@ a') (E (a' :# A) :# A),
testEq "(λx. x : _) a == a (βυ)" $
equalE (λxx' :@ a') a
"application" :- [
testEq "f [a] ≡ f [a]" $
equalE (F "f" :@ FT "a") (F "f" :@ FT "a"),
testEq "f [a] <: f [a]" $
subE (F "f" :@ FT "a") (F "f" :@ FT "a"),
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a ≡ ([a ∷ A] ∷ A) (β)" $
equalE
((Lam "x" (TUsed (BVT 0)) :# (Arr One (FT "A") (FT "A")))
:@ FT "a")
(E (FT "a" :# FT "A") :# FT "A"),
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a ≡ a (βυ)" $
equalE
((Lam "x" (TUsed (BVT 0)) :# (Arr One (FT "A") (FT "A")))
:@ FT "a")
(F "a"),
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a <: a" $
subE
((Lam "x" (TUsed (BVT 0)) :# (Arr One (FT "A") (FT "A")))
:@ FT "a")
(F "a")
],
todo "annotation",
todo "elim closure",
todo "elim d-closure",
todo "clashes"
"clashes" :- [
testNeq "𝒰₀ ≢ 𝒰₀ ⇾ 𝒰₀" $
equalT (TYPE 0) (Arr Zero (TYPE 0) (TYPE 0)),
todo "others"
]
]