178 lines
5.3 KiB
Idris
178 lines
5.3 KiB
Idris
module Tests.Equal
|
|
|
|
import Quox.Equal
|
|
import Quox.Pretty
|
|
import TAP
|
|
|
|
export
|
|
ToInfo Equal.Error where
|
|
toInfo (ClashT mode s t) =
|
|
[("clash", "term"),
|
|
("mode", show mode),
|
|
("left", prettyStr True s),
|
|
("right", prettyStr True t)]
|
|
toInfo (ClashU mode k l) =
|
|
[("clash", "universe"),
|
|
("mode", show mode),
|
|
("left", prettyStr True k),
|
|
("right", prettyStr True l)]
|
|
toInfo (ClashQ pi rh) =
|
|
[("clash", "quantity"),
|
|
("left", prettyStr True pi),
|
|
("right", prettyStr True rh)]
|
|
|
|
|
|
M = Either Equal.Error
|
|
|
|
testEq : String -> Lazy (M ()) -> Test
|
|
testEq = test
|
|
|
|
testNeq : String -> Lazy (M ()) -> Test
|
|
testNeq label = testThrows label $ const True
|
|
|
|
|
|
subT : {default 0 d, n : Nat} -> Term d n -> Term d n -> M ()
|
|
subT = Quox.Equal.subT
|
|
%hide Quox.Equal.subT
|
|
|
|
equalT : {default 0 d, n : Nat} -> Term d n -> Term d n -> M ()
|
|
equalT = Quox.Equal.equalT
|
|
%hide Quox.Equal.equalT
|
|
|
|
subE : {default 0 d, n : Nat} -> Elim d n -> Elim d n -> M ()
|
|
subE = Quox.Equal.subE
|
|
%hide Quox.Equal.subE
|
|
|
|
equalE : {default 0 d, n : Nat} -> Elim d n -> Elim d n -> M ()
|
|
equalE = Quox.Equal.equalE
|
|
%hide Quox.Equal.equalE
|
|
|
|
|
|
export
|
|
tests : Test
|
|
tests = "equality & subtyping" :- [
|
|
"universes" :- [
|
|
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)
|
|
],
|
|
|
|
"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" $
|
|
equalE (F "A") (F "A"),
|
|
testNeq "A ≢ B" $
|
|
equalE (F "A") (F "B"),
|
|
testEq "A <: A" $
|
|
subE (F "A") (F "A"),
|
|
testNeq "A ≮: B" $
|
|
subE (F "A") (F "B")
|
|
],
|
|
|
|
todo "bound var",
|
|
|
|
"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",
|
|
|
|
"clashes" :- [
|
|
testNeq "𝒰₀ ≢ 𝒰₀ ⇾ 𝒰₀" $
|
|
equalT (TYPE 0) (Arr Zero (TYPE 0) (TYPE 0)),
|
|
todo "others"
|
|
]
|
|
]
|