some reduction tests & fixes

This commit is contained in:
rhiannon morris 2022-05-25 16:10:19 +02:00
parent bd57a976a8
commit bc9344c6ba
4 changed files with 154 additions and 17 deletions

View file

@ -1,6 +1,6 @@
module Tests.Equal
import Quox.Equal
import Quox.Equal as Lib
import Quox.Pretty
import TAP
@ -32,20 +32,20 @@ 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
subT = Lib.subT
%hide Lib.subT
equalT : {default 0 d, n : Nat} -> Term d n -> Term d n -> M ()
equalT = Quox.Equal.equalT
%hide Quox.Equal.equalT
equalT = Lib.equalT
%hide Lib.equalT
subE : {default 0 d, n : Nat} -> Elim d n -> Elim d n -> M ()
subE = Quox.Equal.subE
%hide Quox.Equal.subE
subE = Lib.subE
%hide Lib.subE
equalE : {default 0 d, n : Nat} -> Elim d n -> Elim d n -> M ()
equalE = Quox.Equal.equalE
%hide Quox.Equal.equalE
equalE = Lib.equalE
%hide Lib.equalE
export
@ -112,19 +112,35 @@ tests = "equality & subtyping" :- [
"lambda" :- [
testEq "λ x ⇒ [x] ≡ λ x ⇒ [x]" $
equalT (Lam "x" (TUsed (BVT 0))) (Lam "x" (TUsed (BVT 0))),
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))),
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))),
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))),
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)))))
equalT (Lam "x" $ TUsed $ Lam "y" $ TUsed $ BVT 1)
(Lam "x" $ TUsed $ Lam "y" $ TUsed $ BVT 0),
testEq "λ x ⇒ [a] ≡ λ x ⇒ [a] (TUsed vs TUnused)" $
equalT (Lam "x" $ TUsed $ FT "a")
(Lam "x" $ TUnused $ FT "a")
],
todo "term closure",
"term closure" :- [
testEq "[x]{} ≡ [x]" $
equalT (CloT (BVT 0) id) (BVT 0) {n = 1},
testEq "[x]{a/x} ≡ [a]" $
equalT (CloT (BVT 0) (F "a" ::: id)) (FT "a"),
testEq "[x]{a/x,b/y} ≡ [a]" $
equalT (CloT (BVT 0) (F "a" ::: F "b" ::: id)) (FT "a"),
testEq "(λy. [x]){y/y, a/x} ≡ λy. [a] (TUnused)" $
equalT (CloT (Lam "y" $ TUnused $ BVT 0) (F "a" ::: id))
(Lam "y" $ TUnused $ FT "a"),
testEq "(λy. [x]){y/y, a/x} ≡ λy. [a] (TUsed)" $
equalT (CloT (Lam "y" $ TUsed $ BVT 1) (F "a" ::: id))
(Lam "y" $ TUsed $ FT "a")
],
todo "term d-closure",