remove IsQty interface
This commit is contained in:
parent
5fdba77d04
commit
ba2818a865
24 changed files with 729 additions and 889 deletions
|
|
@ -2,28 +2,24 @@ module Tests.Equal
|
|||
|
||||
import Quox.Equal
|
||||
import Quox.Typechecker
|
||||
import Quox.Syntax.Qty.Three
|
||||
import public TypingImpls
|
||||
import TAP
|
||||
import Quox.EffExtra
|
||||
|
||||
0 M : Type -> Type
|
||||
M = TC Three
|
||||
|
||||
defGlobals : Definitions Three
|
||||
defGlobals : Definitions
|
||||
defGlobals = fromList
|
||||
[("A", mkPostulate Zero $ TYPE 0),
|
||||
("B", mkPostulate Zero $ TYPE 0),
|
||||
("a", mkPostulate Any $ FT "A"),
|
||||
("a'", mkPostulate Any $ FT "A"),
|
||||
("b", mkPostulate Any $ FT "B"),
|
||||
("f", mkPostulate Any $ Arr One (FT "A") (FT "A")),
|
||||
("id", mkDef Any (Arr One (FT "A") (FT "A")) ([< "x"] :\\ BVT 0)),
|
||||
("eq-AB", mkPostulate Zero $ Eq0 (TYPE 0) (FT "A") (FT "B")),
|
||||
("two", mkDef Any Nat (Succ (Succ Zero)))]
|
||||
[("A", mkPostulate gzero $ TYPE 0),
|
||||
("B", mkPostulate gzero $ TYPE 0),
|
||||
("a", mkPostulate gany $ FT "A"),
|
||||
("a'", mkPostulate gany $ FT "A"),
|
||||
("b", mkPostulate gany $ FT "B"),
|
||||
("f", mkPostulate gany $ Arr One (FT "A") (FT "A")),
|
||||
("id", mkDef gany (Arr One (FT "A") (FT "A")) ([< "x"] :\\ BVT 0)),
|
||||
("eq-AB", mkPostulate gzero $ Eq0 (TYPE 0) (FT "A") (FT "B")),
|
||||
("two", mkDef gany Nat (Succ (Succ Zero)))]
|
||||
|
||||
parameters (label : String) (act : Lazy (M ()))
|
||||
{default defGlobals globals : Definitions Three}
|
||||
parameters (label : String) (act : Lazy (TC ()))
|
||||
{default defGlobals globals : Definitions}
|
||||
testEq : Test
|
||||
testEq = test label $ runTC globals act
|
||||
|
||||
|
|
@ -31,29 +27,29 @@ parameters (label : String) (act : Lazy (M ()))
|
|||
testNeq = testThrows label (const True) $ runTC globals act $> "()"
|
||||
|
||||
|
||||
parameters (0 d : Nat) (ctx : TyContext Three d n)
|
||||
subTD, equalTD : Term Three d n -> Term Three d n -> Term Three d n -> M ()
|
||||
parameters (0 d : Nat) (ctx : TyContext d n)
|
||||
subTD, equalTD : Term d n -> Term d n -> Term d n -> TC ()
|
||||
subTD ty s t = Term.sub ctx ty s t
|
||||
equalTD ty s t = Term.equal ctx ty s t
|
||||
equalTyD : Term Three d n -> Term Three d n -> M ()
|
||||
equalTyD : Term d n -> Term d n -> TC ()
|
||||
equalTyD s t = Term.equalType ctx s t
|
||||
|
||||
subED, equalED : Elim Three d n -> Elim Three d n -> M ()
|
||||
subED, equalED : Elim d n -> Elim d n -> TC ()
|
||||
subED e f = Elim.sub ctx e f
|
||||
equalED e f = Elim.equal ctx e f
|
||||
|
||||
parameters (ctx : TyContext Three 0 n)
|
||||
subT, equalT : Term Three 0 n -> Term Three 0 n -> Term Three 0 n -> M ()
|
||||
parameters (ctx : TyContext 0 n)
|
||||
subT, equalT : Term 0 n -> Term 0 n -> Term 0 n -> TC ()
|
||||
subT = subTD 0 ctx
|
||||
equalT = equalTD 0 ctx
|
||||
equalTy : Term Three 0 n -> Term Three 0 n -> M ()
|
||||
equalTy : Term 0 n -> Term 0 n -> TC ()
|
||||
equalTy = equalTyD 0 ctx
|
||||
|
||||
subE, equalE : Elim Three 0 n -> Elim Three 0 n -> M ()
|
||||
subE, equalE : Elim 0 n -> Elim 0 n -> TC ()
|
||||
subE = subED 0 ctx
|
||||
equalE = equalED 0 ctx
|
||||
|
||||
empty01 : TyContext q 0 0
|
||||
empty01 : TyContext 0 0
|
||||
empty01 = eqDim (K Zero) (K One) empty
|
||||
|
||||
|
||||
|
|
@ -166,7 +162,7 @@ tests = "equality & subtyping" :- [
|
|||
let tm = Eq0 (TYPE 1) (TYPE 0) (TYPE 0) in
|
||||
equalT empty (TYPE 2) tm tm,
|
||||
testEq "A ≔ ★₁ ⊢ (★₀ ≡ ★₀ : ★₁) = (★₀ ≡ ★₀ : A)"
|
||||
{globals = fromList [("A", mkDef zero (TYPE 2) (TYPE 1))]} $
|
||||
{globals = fromList [("A", mkDef gzero (TYPE 2) (TYPE 1))]} $
|
||||
equalT empty (TYPE 2)
|
||||
(Eq0 (TYPE 1) (TYPE 0) (TYPE 0))
|
||||
(Eq0 (FT "A") (TYPE 0) (TYPE 0)),
|
||||
|
|
@ -174,7 +170,7 @@ tests = "equality & subtyping" :- [
|
|||
],
|
||||
|
||||
"equalities and uip" :-
|
||||
let refl : Term q d n -> Term q d n -> Elim q d n
|
||||
let refl : Term d n -> Term d n -> Elim d n
|
||||
refl a x = (DLam $ S [< "_"] $ N x) :# (Eq0 a x x)
|
||||
in
|
||||
[
|
||||
|
|
@ -185,53 +181,53 @@ tests = "equality & subtyping" :- [
|
|||
|
||||
testEq "p : (a ≡ a' : A), q : (a ≡ a' : A) ∥ ⊢ p = q (free)"
|
||||
{globals =
|
||||
let def = mkPostulate Zero $ Eq0 (FT "A") (FT "a") (FT "a'") in
|
||||
let def = mkPostulate gzero $ Eq0 (FT "A") (FT "a") (FT "a'") in
|
||||
defGlobals `mergeLeft` fromList [("p", def), ("q", def)]} $
|
||||
equalE empty (F "p") (F "q"),
|
||||
|
||||
testEq "∥ x : (a ≡ a' : A), y : (a ≡ a' : A) ⊢ x = y (bound)" $
|
||||
let ty : forall n. Term Three 0 n := Eq0 (FT "A") (FT "a") (FT "a'") in
|
||||
let ty : forall n. Term 0 n := Eq0 (FT "A") (FT "a") (FT "a'") in
|
||||
equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
|
||||
(BV 0) (BV 1),
|
||||
|
||||
testEq "∥ x : [(a ≡ a' : A) ∷ Type 0], y : [ditto] ⊢ x = y" $
|
||||
let ty : forall n. Term Three 0 n :=
|
||||
let ty : forall n. Term 0 n :=
|
||||
E (Eq0 (FT "A") (FT "a") (FT "a'") :# TYPE 0) in
|
||||
equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
|
||||
(BV 0) (BV 1),
|
||||
|
||||
testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : EE ⊢ x = y"
|
||||
{globals = defGlobals `mergeLeft` fromList
|
||||
[("E", mkDef zero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
|
||||
("EE", mkDef zero (TYPE 0) (FT "E"))]} $
|
||||
[("E", mkDef gzero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
|
||||
("EE", mkDef gzero (TYPE 0) (FT "E"))]} $
|
||||
equalE (extendTyN [< (Any, "x", FT "EE"), (Any, "y", FT "EE")] empty)
|
||||
(BV 0) (BV 1),
|
||||
|
||||
testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : E ⊢ x = y"
|
||||
{globals = defGlobals `mergeLeft` fromList
|
||||
[("E", mkDef zero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
|
||||
("EE", mkDef zero (TYPE 0) (FT "E"))]} $
|
||||
[("E", mkDef gzero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
|
||||
("EE", mkDef gzero (TYPE 0) (FT "E"))]} $
|
||||
equalE (extendTyN [< (Any, "x", FT "EE"), (Any, "y", FT "E")] empty)
|
||||
(BV 0) (BV 1),
|
||||
|
||||
testEq "E ≔ a ≡ a' : A ∥ x : E, y : E ⊢ x = y"
|
||||
{globals = defGlobals `mergeLeft` fromList
|
||||
[("E", mkDef zero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'")))]} $
|
||||
[("E", mkDef gzero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'")))]} $
|
||||
equalE (extendTyN [< (Any, "x", FT "E"), (Any, "y", FT "E")] empty)
|
||||
(BV 0) (BV 1),
|
||||
|
||||
testEq "E ≔ a ≡ a' : A ∥ x : (E×E), y : (E×E) ⊢ x = y"
|
||||
{globals = defGlobals `mergeLeft` fromList
|
||||
[("E", mkDef zero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'")))]} $
|
||||
let ty : forall n. Term Three 0 n :=
|
||||
[("E", mkDef gzero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'")))]} $
|
||||
let ty : forall n. Term 0 n :=
|
||||
Sig (FT "E") $ S [< "_"] $ N $ FT "E" in
|
||||
equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
|
||||
(BV 0) (BV 1),
|
||||
|
||||
testEq "E ≔ a ≡ a' : A, W ≔ E × E ∥ x : W, y : W ⊢ x = y"
|
||||
{globals = defGlobals `mergeLeft` fromList
|
||||
[("E", mkDef zero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
|
||||
("W", mkDef zero (TYPE 0) (FT "E" `And` FT "E"))]} $
|
||||
[("E", mkDef gzero (TYPE 0) (Eq0 (FT "A") (FT "a") (FT "a'"))),
|
||||
("W", mkDef gzero (TYPE 0) (FT "E" `And` FT "E"))]} $
|
||||
equalE
|
||||
(extendTyN [< (Any, "x", FT "W"), (Any, "y", FT "W")] empty)
|
||||
(BV 0) (BV 1)
|
||||
|
|
@ -281,11 +277,11 @@ tests = "equality & subtyping" :- [
|
|||
|
||||
"free var" :-
|
||||
let au_bu = fromList
|
||||
[("A", mkDef Any (TYPE 1) (TYPE 0)),
|
||||
("B", mkDef Any (TYPE 1) (TYPE 0))]
|
||||
[("A", mkDef gany (TYPE 1) (TYPE 0)),
|
||||
("B", mkDef gany (TYPE 1) (TYPE 0))]
|
||||
au_ba = fromList
|
||||
[("A", mkDef Any (TYPE 1) (TYPE 0)),
|
||||
("B", mkDef Any (TYPE 1) (FT "A"))]
|
||||
[("A", mkDef gany (TYPE 1) (TYPE 0)),
|
||||
("B", mkDef gany (TYPE 1) (FT "A"))]
|
||||
in [
|
||||
testEq "A = A" $
|
||||
equalE empty (F "A") (F "A"),
|
||||
|
|
@ -306,13 +302,13 @@ tests = "equality & subtyping" :- [
|
|||
testNeq "A ≮: B" $
|
||||
subE empty (F "A") (F "B"),
|
||||
testEq "A : ★₃ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
|
||||
{globals = fromList [("A", mkDef Any (TYPE 3) (TYPE 0)),
|
||||
("B", mkDef Any (TYPE 3) (TYPE 2))]} $
|
||||
{globals = fromList [("A", mkDef gany (TYPE 3) (TYPE 0)),
|
||||
("B", mkDef gany (TYPE 3) (TYPE 2))]} $
|
||||
subE empty (F "A") (F "B"),
|
||||
note "(A and B in different universes)",
|
||||
testEq "A : ★₁ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
|
||||
{globals = fromList [("A", mkDef Any (TYPE 1) (TYPE 0)),
|
||||
("B", mkDef Any (TYPE 3) (TYPE 2))]} $
|
||||
{globals = fromList [("A", mkDef gany (TYPE 1) (TYPE 0)),
|
||||
("B", mkDef gany (TYPE 3) (TYPE 2))]} $
|
||||
subE empty (F "A") (F "B"),
|
||||
testEq "0=1 ⊢ A <: B" $
|
||||
subE empty01 (F "A") (F "B")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue