put names into contexts, and contexts into errors
This commit is contained in:
parent
f4af1a5a78
commit
86d21caf24
13 changed files with 520 additions and 324 deletions
|
|
@ -46,6 +46,8 @@ parameters (ctx : TyContext Three 0 n)
|
|||
subE = subED 0 ctx
|
||||
equalE = equalED 0 ctx
|
||||
|
||||
empty01 : TyContext q 0 0
|
||||
empty01 = {dctx := ZeroIsOne} empty
|
||||
|
||||
|
||||
export
|
||||
|
|
@ -116,7 +118,7 @@ tests = "equality & subtyping" :- [
|
|||
testEq "0=1 ⊢ A ⇾ B = A ⊸ B" $
|
||||
let tm1 = Arr Zero (FT "A") (FT "B")
|
||||
tm2 = Arr One (FT "A") (FT "B") in
|
||||
equalT (MkTyContext ZeroIsOne [<]) (TYPE 0) tm1 tm2,
|
||||
equalT empty01 (TYPE 0) tm1 tm2,
|
||||
todo "dependent function types",
|
||||
note "[todo] should π ≤ ρ ⊢ (ρ·A) → B <: (π·A) → B?"
|
||||
],
|
||||
|
|
@ -182,47 +184,54 @@ tests = "equality & subtyping" :- [
|
|||
|
||||
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
|
||||
equalE (MkTyContext new [< ty, ty]) (BV 0) (BV 1),
|
||||
equalE (extendTyN [< ("x", ty), ("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 :=
|
||||
E (Eq0 (FT "A") (FT "a") (FT "a'") :# TYPE 0) in
|
||||
equalE (MkTyContext new [< ty, ty]) (BV 0) (BV 1),
|
||||
equalE (extendTyN [< ("x", ty), ("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"))]} $
|
||||
equalE (MkTyContext new [< FT "EE", FT "EE"]) (BV 0) (BV 1),
|
||||
equalE (extendTyN [< ("x", FT "EE"), ("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"))]} $
|
||||
equalE (MkTyContext new [< FT "EE", FT "E"]) (BV 0) (BV 1),
|
||||
equalE (extendTyN [< ("x", FT "EE"), ("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'")))]} $
|
||||
equalE (MkTyContext new [< FT "E", FT "E"]) (BV 0) (BV 1),
|
||||
equalE (extendTyN [< ("x", FT "E"), ("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 :=
|
||||
Sig (FT "E") $ S ["_"] $ N $ FT "E" in
|
||||
equalE (MkTyContext new [< ty, ty]) (BV 0) (BV 1),
|
||||
equalE (extendTyN [< ("x", ty), ("y", ty)] empty) (BV 0) (BV 1),
|
||||
|
||||
testEq "E ≔ a ≡ a' : A, F ≔ E × E ∥ x : F, y : F ⊢ x = y"
|
||||
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"))]} $
|
||||
equalE (MkTyContext new [< FT "W", FT "W"]) (BV 0) (BV 1)
|
||||
equalE
|
||||
(extendTyN [< ("x", FT "W"), ("y", FT "W")] empty)
|
||||
(BV 0) (BV 1)
|
||||
],
|
||||
|
||||
"term closure" :- [
|
||||
testEq "[#0]{} = [#0] : A" $
|
||||
equalT (MkTyContext new [< FT "A"]) (FT "A")
|
||||
equalT (extendTy "x" (FT "A") empty)
|
||||
(FT "A")
|
||||
(CloT (BVT 0) id)
|
||||
(BVT 0),
|
||||
testEq "[#0]{a} = [a] : A" $
|
||||
|
|
@ -249,9 +258,12 @@ tests = "equality & subtyping" :- [
|
|||
|
||||
"term d-closure" :- [
|
||||
testEq "★₀‹𝟎› = ★₀ : ★₁" $
|
||||
equalTD 1 empty (TYPE 1) (DCloT (TYPE 0) (K Zero ::: id)) (TYPE 0),
|
||||
equalTD 1
|
||||
(extendDim "𝑗" empty)
|
||||
(TYPE 1) (DCloT (TYPE 0) (K Zero ::: id)) (TYPE 0),
|
||||
testEq "(δ i ⇒ a)‹𝟎› = (δ i ⇒ a) : (a ≡ a : A)" $
|
||||
equalTD 1 empty
|
||||
equalTD 1
|
||||
(extendDim "𝑗" empty)
|
||||
(Eq0 (FT "A") (FT "a") (FT "a"))
|
||||
(DCloT (["i"] :\\% FT "a") (K Zero ::: id))
|
||||
(["i"] :\\% FT "a"),
|
||||
|
|
@ -271,7 +283,7 @@ tests = "equality & subtyping" :- [
|
|||
testNeq "A ≠ B" $
|
||||
equalE empty (F "A") (F "B"),
|
||||
testEq "0=1 ⊢ A = B" $
|
||||
equalE (MkTyContext ZeroIsOne [<]) (F "A") (F "B"),
|
||||
equalE empty01 (F "A") (F "B"),
|
||||
testEq "A : ★₁ ≔ ★₀ ⊢ A = (★₀ ∷ ★₁)" {globals = au_bu} $
|
||||
equalE empty (F "A") (TYPE 0 :# TYPE 1),
|
||||
testEq "A : ★₁ ≔ ★₀ ⊢ [A] = ★₀" {globals = au_bu} $
|
||||
|
|
@ -294,20 +306,20 @@ tests = "equality & subtyping" :- [
|
|||
("B", mkDef Any (TYPE 3) (TYPE 2))]} $
|
||||
subE empty (F "A") (F "B"),
|
||||
testEq "0=1 ⊢ A <: B" $
|
||||
subE (MkTyContext ZeroIsOne [<]) (F "A") (F "B")
|
||||
subE empty01 (F "A") (F "B")
|
||||
],
|
||||
|
||||
"bound var" :- [
|
||||
testEq "#0 = #0" $
|
||||
equalE (MkTyContext new [< TYPE 0]) (BV 0) (BV 0),
|
||||
equalE (extendTy "A" (TYPE 0) empty) (BV 0) (BV 0),
|
||||
testEq "#0 <: #0" $
|
||||
subE (MkTyContext new [< TYPE 0]) (BV 0) (BV 0),
|
||||
subE (extendTy "A" (TYPE 0) empty) (BV 0) (BV 0),
|
||||
testNeq "#0 ≠ #1" $
|
||||
equalE (MkTyContext new [< TYPE 0, TYPE 0]) (BV 0) (BV 1),
|
||||
equalE (extendTyN [< ("A", TYPE 0), ("B", TYPE 0)] empty) (BV 0) (BV 1),
|
||||
testNeq "#0 ≮: #1" $
|
||||
subE (MkTyContext new [< TYPE 0, TYPE 0]) (BV 0) (BV 1),
|
||||
subE (extendTyN [< ("A", TYPE 0), ("B", TYPE 0)] empty) (BV 0) (BV 1),
|
||||
testEq "0=1 ⊢ #0 = #1" $
|
||||
equalE (MkTyContext ZeroIsOne [< TYPE 0, TYPE 0]) (BV 0) (BV 1)
|
||||
equalE (extendTyN [< ("A", TYPE 0), ("B", TYPE 0)] empty01) (BV 0) (BV 1)
|
||||
],
|
||||
|
||||
"application" :- [
|
||||
|
|
@ -343,26 +355,37 @@ tests = "equality & subtyping" :- [
|
|||
testNeq "eq-AB @0 ≠ eq-AB @1" $
|
||||
equalE empty (F "eq-AB" :% K Zero) (F "eq-AB" :% K One),
|
||||
testEq "𝑖 | ⊢ eq-AB @𝑖 = eq-AB @𝑖" $
|
||||
equalED 1 empty (F "eq-AB" :% BV 0) (F "eq-AB" :% BV 0),
|
||||
equalED 1
|
||||
(extendDim "𝑖" empty)
|
||||
(F "eq-AB" :% BV 0) (F "eq-AB" :% BV 0),
|
||||
testNeq "𝑖 | ⊢ eq-AB @𝑖 ≠ eq-AB @0" $
|
||||
equalED 1 empty (F "eq-AB" :% BV 0) (F "eq-AB" :% K Zero),
|
||||
equalED 1
|
||||
(extendDim "𝑖" empty)
|
||||
(F "eq-AB" :% BV 0) (F "eq-AB" :% K Zero),
|
||||
testEq "𝑖, 𝑖=0 | ⊢ eq-AB @𝑖 = eq-AB @0" $
|
||||
let ctx = MkTyContext (set (BV 0) (K Zero) new) [<] in
|
||||
equalED 1 ctx (F "eq-AB" :% BV 0) (F "eq-AB" :% K Zero),
|
||||
equalED 1
|
||||
(eqDim (BV 0) (K Zero) $ extendDim "𝑖" empty)
|
||||
(F "eq-AB" :% BV 0) (F "eq-AB" :% K Zero),
|
||||
testNeq "𝑖, 𝑖=1 | ⊢ eq-AB @𝑖 ≠ eq-AB @0" $
|
||||
let ctx = MkTyContext (set (BV 0) (K One) new) [<] in
|
||||
equalED 1 ctx (F "eq-AB" :% BV 0) (F "eq-AB" :% K Zero),
|
||||
equalED 1
|
||||
(eqDim (BV 0) (K One) $ extendDim "𝑖" empty)
|
||||
(F "eq-AB" :% BV 0) (F "eq-AB" :% K Zero),
|
||||
testNeq "𝑖, 𝑗 | ⊢ eq-AB @𝑖 ≠ eq-AB @𝑗" $
|
||||
equalED 2 empty (F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
|
||||
equalED 2
|
||||
(extendDim "𝑗" $ extendDim "𝑖" empty)
|
||||
(F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
|
||||
testEq "𝑖, 𝑗, 𝑖=𝑗 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
|
||||
let ctx = MkTyContext (set (BV 0) (BV 1) new) [<] in
|
||||
equalED 2 ctx (F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
|
||||
testNeq "𝑖, 𝑗, 𝑖=0, 𝑗=0 | ⊢ eq-AB @𝑖 ≠ eq-AB @𝑗" $
|
||||
let ctx : TyContext Three 2 0 :=
|
||||
MkTyContext (C [< Just $ K Zero, Just $ K Zero]) [<] in
|
||||
equalED 2 empty (F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
|
||||
equalED 2
|
||||
(eqDim (BV 0) (BV 1) $ extendDim "𝑗" $ extendDim "𝑖" empty)
|
||||
(F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
|
||||
testEq "𝑖, 𝑗, 𝑖=0, 𝑗=0 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
|
||||
equalED 2
|
||||
(eqDim (BV 0) (K Zero) $ eqDim (BV 1) (K Zero) $
|
||||
extendDim "𝑗" $ extendDim "𝑖" empty)
|
||||
(F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
|
||||
testEq "0=1 | ⊢ eq-AB @𝑖 = eq-AB @𝑗" $
|
||||
equalED 2 (MkTyContext ZeroIsOne [<])
|
||||
equalED 2
|
||||
(extendDim "𝑗" $ extendDim "𝑖" empty01)
|
||||
(F "eq-AB" :% BV 1) (F "eq-AB" :% BV 0),
|
||||
testEq "eq-AB @0 = A" $ equalE empty (F "eq-AB" :% K Zero) (F "A"),
|
||||
testEq "eq-AB @1 = B" $ equalE empty (F "eq-AB" :% K One) (F "B"),
|
||||
|
|
@ -393,38 +416,48 @@ tests = "equality & subtyping" :- [
|
|||
testEq "#0{a} = a" $
|
||||
equalE empty (CloE (BV 0) (F "a" ::: id)) (F "a"),
|
||||
testEq "#1{a} = #0" $
|
||||
equalE (MkTyContext new [< FT "A"])
|
||||
equalE (extendTy "x" (FT "A") empty)
|
||||
(CloE (BV 1) (F "a" ::: id)) (BV 0)
|
||||
],
|
||||
|
||||
"elim d-closure" :- [
|
||||
note "0·eq-AB : (A ≡ B : ★₀)",
|
||||
testEq "(eq-AB #0)‹𝟎› = eq-AB 𝟎" $
|
||||
equalED 1 empty
|
||||
equalED 1
|
||||
(extendDim "𝑖" empty)
|
||||
(DCloE (F "eq-AB" :% BV 0) (K Zero ::: id))
|
||||
(F "eq-AB" :% K Zero),
|
||||
testEq "(eq-AB #0)‹𝟎› = A" $
|
||||
equalED 1 empty (DCloE (F "eq-AB" :% BV 0) (K Zero ::: id)) (F "A"),
|
||||
equalED 1
|
||||
(extendDim "𝑖" empty)
|
||||
(DCloE (F "eq-AB" :% BV 0) (K Zero ::: id)) (F "A"),
|
||||
testEq "(eq-AB #0)‹𝟏› = B" $
|
||||
equalED 1 empty (DCloE (F "eq-AB" :% BV 0) (K One ::: id)) (F "B"),
|
||||
equalED 1
|
||||
(extendDim "𝑖" empty)
|
||||
(DCloE (F "eq-AB" :% BV 0) (K One ::: id)) (F "B"),
|
||||
testNeq "(eq-AB #0)‹𝟏› ≠ A" $
|
||||
equalED 1 empty (DCloE (F "eq-AB" :% BV 0) (K One ::: id)) (F "A"),
|
||||
equalED 1
|
||||
(extendDim "𝑖" empty)
|
||||
(DCloE (F "eq-AB" :% BV 0) (K One ::: id)) (F "A"),
|
||||
testEq "(eq-AB #0)‹#0,𝟎› = (eq-AB #0)" $
|
||||
equalED 2 empty
|
||||
equalED 2
|
||||
(extendDim "𝑗" $ extendDim "𝑖" empty)
|
||||
(DCloE (F "eq-AB" :% BV 0) (BV 0 ::: K Zero ::: id))
|
||||
(F "eq-AB" :% BV 0),
|
||||
testNeq "(eq-AB #0)‹𝟎› ≠ (eq-AB 𝟎)" $
|
||||
equalED 2 empty
|
||||
equalED 2
|
||||
(extendDim "𝑗" $ extendDim "𝑖" empty)
|
||||
(DCloE (F "eq-AB" :% BV 0) (BV 0 ::: K Zero ::: id))
|
||||
(F "eq-AB" :% K Zero),
|
||||
testEq "#0‹𝟎› = #0 # term and dim vars distinct" $
|
||||
equalED 1 (MkTyContext new [< FT "A"])
|
||||
equalED 1
|
||||
(extendTy "x" (FT "A") $ extendDim "𝑖" empty)
|
||||
(DCloE (BV 0) (K Zero ::: id)) (BV 0),
|
||||
testEq "a‹𝟎› = a" $
|
||||
equalED 1 empty (DCloE (F "a") (K Zero ::: id)) (F "a"),
|
||||
equalED 1 (extendDim "𝑖" empty) (DCloE (F "a") (K Zero ::: id)) (F "a"),
|
||||
testEq "(f [a])‹𝟎› = f‹𝟎› [a]‹𝟎›" $
|
||||
let th = K Zero ::: id in
|
||||
equalED 1 empty
|
||||
equalED 1 (extendDim "𝑖" empty)
|
||||
(DCloE (F "f" :@ FT "a") th)
|
||||
(DCloE (F "f") th :@ DCloT (FT "a") th)
|
||||
],
|
||||
|
|
@ -433,8 +466,7 @@ tests = "equality & subtyping" :- [
|
|||
testNeq "★₀ ≠ ★₀ ⇾ ★₀" $
|
||||
equalT empty (TYPE 1) (TYPE 0) (Arr Zero (TYPE 0) (TYPE 0)),
|
||||
testEq "0=1 ⊢ ★₀ = ★₀ ⇾ ★₀" $
|
||||
equalT (MkTyContext ZeroIsOne [<])
|
||||
(TYPE 1) (TYPE 0) (Arr Zero (TYPE 0) (TYPE 0)),
|
||||
equalT empty01 (TYPE 1) (TYPE 0) (Arr Zero (TYPE 0) (TYPE 0)),
|
||||
todo "others"
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -98,9 +98,12 @@ parameters (label : String) (act : Lazy (M ()))
|
|||
testTCFail = testThrows label (const True) $ runReaderT globals act
|
||||
|
||||
|
||||
ctx, ctx01 : TContext Three 0 n -> TyContext Three 0 n
|
||||
ctx = MkTyContext new
|
||||
ctx01 = MkTyContext ZeroIsOne
|
||||
ctx, ctx01 : Context (\n => (BaseName, Term Three 0 n)) n -> TyContext Three 0 n
|
||||
ctx tel = MkTyContext new [<] (map snd tel) (map fst tel)
|
||||
ctx01 tel = MkTyContext ZeroIsOne [<] (map snd tel) (map fst tel)
|
||||
|
||||
empty01 : TyContext Three 0 0
|
||||
empty01 = {dctx := ZeroIsOne} empty
|
||||
|
||||
inferredTypeEq : TyContext Three d n -> (exp, got : Term Three d n) -> M ()
|
||||
inferredTypeEq ctx exp got =
|
||||
|
|
@ -159,184 +162,184 @@ tests : Test
|
|||
tests = "typechecker" :- [
|
||||
"universes" :- [
|
||||
testTC "0 · ★₀ ⇐ ★₁ # by checkType" $
|
||||
checkType_ (ctx [<]) (TYPE 0) (Just 1),
|
||||
checkType_ empty (TYPE 0) (Just 1),
|
||||
testTC "0 · ★₀ ⇐ ★₁ # by check" $
|
||||
check_ (ctx [<]) szero (TYPE 0) (TYPE 1),
|
||||
check_ empty szero (TYPE 0) (TYPE 1),
|
||||
testTC "0 · ★₀ ⇐ ★₂" $
|
||||
checkType_ (ctx [<]) (TYPE 0) (Just 2),
|
||||
checkType_ empty (TYPE 0) (Just 2),
|
||||
testTC "0 · ★₀ ⇐ ★_" $
|
||||
checkType_ (ctx [<]) (TYPE 0) Nothing,
|
||||
checkType_ empty (TYPE 0) Nothing,
|
||||
testTCFail "0 · ★₁ ⇍ ★₀" $
|
||||
checkType_ (ctx [<]) (TYPE 1) (Just 0),
|
||||
checkType_ empty (TYPE 1) (Just 0),
|
||||
testTCFail "0 · ★₀ ⇍ ★₀" $
|
||||
checkType_ (ctx [<]) (TYPE 0) (Just 0),
|
||||
checkType_ empty (TYPE 0) (Just 0),
|
||||
testTC "0=1 ⊢ 0 · ★₁ ⇐ ★₀" $
|
||||
checkType_ (ctx01 [<]) (TYPE 1) (Just 0),
|
||||
checkType_ empty01 (TYPE 1) (Just 0),
|
||||
testTCFail "1 · ★₀ ⇍ ★₁ # by check" $
|
||||
check_ (ctx [<]) sone (TYPE 0) (TYPE 1)
|
||||
check_ empty sone (TYPE 0) (TYPE 1)
|
||||
],
|
||||
|
||||
"function types" :- [
|
||||
note "A, B : ★₀; C, D : ★₁; P : A ⇾ ★₀",
|
||||
testTC "0 · A ⊸ B ⇐ ★₀" $
|
||||
check_ (ctx [<]) szero (Arr One (FT "A") (FT "B")) (TYPE 0),
|
||||
check_ empty szero (Arr One (FT "A") (FT "B")) (TYPE 0),
|
||||
note "subtyping",
|
||||
testTC "0 · A ⊸ B ⇐ ★₁" $
|
||||
check_ (ctx [<]) szero (Arr One (FT "A") (FT "B")) (TYPE 1),
|
||||
check_ empty szero (Arr One (FT "A") (FT "B")) (TYPE 1),
|
||||
testTC "0 · C ⊸ D ⇐ ★₁" $
|
||||
check_ (ctx [<]) szero (Arr One (FT "C") (FT "D")) (TYPE 1),
|
||||
check_ empty szero (Arr One (FT "C") (FT "D")) (TYPE 1),
|
||||
testTCFail "0 · C ⊸ D ⇍ ★₀" $
|
||||
check_ (ctx [<]) szero (Arr One (FT "C") (FT "D")) (TYPE 0),
|
||||
check_ empty szero (Arr One (FT "C") (FT "D")) (TYPE 0),
|
||||
testTC "0 · (1·x : A) → P x ⇐ ★₀" $
|
||||
check_ (ctx [<]) szero
|
||||
check_ empty szero
|
||||
(Pi_ One "x" (FT "A") $ E $ F "P" :@ BVT 0)
|
||||
(TYPE 0),
|
||||
testTCFail "0 · A ⊸ P ⇍ ★₀" $
|
||||
check_ (ctx [<]) szero (Arr One (FT "A") $ FT "P") (TYPE 0),
|
||||
check_ empty szero (Arr One (FT "A") $ FT "P") (TYPE 0),
|
||||
testTC "0=1 ⊢ 0 · A ⊸ P ⇐ ★₀" $
|
||||
check_ (ctx01 [<]) szero (Arr One (FT "A") $ FT "P") (TYPE 0)
|
||||
check_ empty01 szero (Arr One (FT "A") $ FT "P") (TYPE 0)
|
||||
],
|
||||
|
||||
"pair types" :- [
|
||||
note #""A × B" for "(_ : A) × B""#,
|
||||
testTC "0 · A × A ⇐ ★₀" $
|
||||
check_ (ctx [<]) szero (FT "A" `And` FT "A") (TYPE 0),
|
||||
check_ empty szero (FT "A" `And` FT "A") (TYPE 0),
|
||||
testTCFail "0 · A × P ⇍ ★₀" $
|
||||
check_ (ctx [<]) szero (FT "A" `And` FT "P") (TYPE 0),
|
||||
check_ empty szero (FT "A" `And` FT "P") (TYPE 0),
|
||||
testTC "0 · (x : A) × P x ⇐ ★₀" $
|
||||
check_ (ctx [<]) szero
|
||||
check_ empty szero
|
||||
(Sig_ "x" (FT "A") $ E $ F "P" :@ BVT 0) (TYPE 0),
|
||||
testTC "0 · (x : A) × P x ⇐ ★₁" $
|
||||
check_ (ctx [<]) szero
|
||||
check_ empty szero
|
||||
(Sig_ "x" (FT "A") $ E $ F "P" :@ BVT 0) (TYPE 1),
|
||||
testTC "0 · (A : ★₀) × A ⇐ ★₁" $
|
||||
check_ (ctx [<]) szero (Sig_ "A" (TYPE 0) $ BVT 0) (TYPE 1),
|
||||
check_ empty szero (Sig_ "A" (TYPE 0) $ BVT 0) (TYPE 1),
|
||||
testTCFail "0 · (A : ★₀) × A ⇍ ★₀" $
|
||||
check_ (ctx [<]) szero (Sig_ "A" (TYPE 0) $ BVT 0) (TYPE 0),
|
||||
check_ empty szero (Sig_ "A" (TYPE 0) $ BVT 0) (TYPE 0),
|
||||
testTCFail "1 · A × A ⇍ ★₀" $
|
||||
check_ (ctx [<]) sone (FT "A" `And` FT "A") (TYPE 0)
|
||||
check_ empty sone (FT "A" `And` FT "A") (TYPE 0)
|
||||
],
|
||||
|
||||
"enum types" :- [
|
||||
testTC "0 · {} ⇐ ★₀" $ check_ (ctx [<]) szero (enum []) (TYPE 0),
|
||||
testTC "0 · {} ⇐ ★₃" $ check_ (ctx [<]) szero (enum []) (TYPE 3),
|
||||
testTC "0 · {} ⇐ ★₀" $ check_ empty szero (enum []) (TYPE 0),
|
||||
testTC "0 · {} ⇐ ★₃" $ check_ empty szero (enum []) (TYPE 3),
|
||||
testTC "0 · {a,b,c} ⇐ ★₀" $
|
||||
check_ (ctx [<]) szero (enum ["a", "b", "c"]) (TYPE 0),
|
||||
check_ empty szero (enum ["a", "b", "c"]) (TYPE 0),
|
||||
testTC "0 · {a,b,c} ⇐ ★₃" $
|
||||
check_ (ctx [<]) szero (enum ["a", "b", "c"]) (TYPE 3),
|
||||
testTCFail "1 · {} ⇍ ★₀" $ check_ (ctx [<]) sone (enum []) (TYPE 0),
|
||||
testTC "0=1 ⊢ 1 · {} ⇐ ★₀" $ check_ (ctx01 [<]) sone (enum []) (TYPE 0)
|
||||
check_ empty szero (enum ["a", "b", "c"]) (TYPE 3),
|
||||
testTCFail "1 · {} ⇍ ★₀" $ check_ empty sone (enum []) (TYPE 0),
|
||||
testTC "0=1 ⊢ 1 · {} ⇐ ★₀" $ check_ empty01 sone (enum []) (TYPE 0)
|
||||
],
|
||||
|
||||
"free vars" :- [
|
||||
note "A : ★₀",
|
||||
testTC "0 · A ⇒ ★₀" $
|
||||
inferAs (ctx [<]) szero (F "A") (TYPE 0),
|
||||
inferAs empty szero (F "A") (TYPE 0),
|
||||
testTC "0 · [A] ⇐ ★₀" $
|
||||
check_ (ctx [<]) szero (FT "A") (TYPE 0),
|
||||
check_ empty szero (FT "A") (TYPE 0),
|
||||
note "subtyping",
|
||||
testTC "0 · [A] ⇐ ★₁" $
|
||||
check_ (ctx [<]) szero (FT "A") (TYPE 1),
|
||||
check_ empty szero (FT "A") (TYPE 1),
|
||||
note "(fail) runtime-relevant type",
|
||||
testTCFail "1 · A ⇏ ★₀" $
|
||||
infer_ (ctx [<]) sone (F "A"),
|
||||
infer_ empty sone (F "A"),
|
||||
note "refl : (0·A : ★₀) → (1·x : A) → (x ≡ x : A) ≔ (λ A x ⇒ δ _ ⇒ x)",
|
||||
testTC "1 · refl ⇒ ⋯" $ inferAs (ctx [<]) sone (F "refl") reflTy,
|
||||
testTC "1 · [refl] ⇐ ⋯" $ check_ (ctx [<]) sone (FT "refl") reflTy
|
||||
testTC "1 · refl ⇒ ⋯" $ inferAs empty sone (F "refl") reflTy,
|
||||
testTC "1 · [refl] ⇐ ⋯" $ check_ empty sone (FT "refl") reflTy
|
||||
],
|
||||
|
||||
"bound vars" :- [
|
||||
testTC "x : A ⊢ 1 · x ⇒ A ⊳ 1·x" $
|
||||
inferAsQ {n = 1} (ctx [< FT "A"]) sone
|
||||
inferAsQ {n = 1} (ctx [< ("x", FT "A")]) sone
|
||||
(BV 0) (FT "A") [< one],
|
||||
testTC "x : A ⊢ 1 · [x] ⇐ A ⊳ 1·x" $
|
||||
checkQ {n = 1} (ctx [< FT "A"]) sone (BVT 0) (FT "A") [< one],
|
||||
checkQ {n = 1} (ctx [< ("x", FT "A")]) sone (BVT 0) (FT "A") [< one],
|
||||
note "f2 : A ⊸ A ⊸ B",
|
||||
testTC "x : A ⊢ 1 · f2 [x] [x] ⇒ B ⊳ ω·x" $
|
||||
inferAsQ {n = 1} (ctx [< FT "A"]) sone
|
||||
inferAsQ {n = 1} (ctx [< ("x", FT "A")]) sone
|
||||
(F "f2" :@@ [BVT 0, BVT 0]) (FT "B") [< Any]
|
||||
],
|
||||
|
||||
"lambda" :- [
|
||||
note "linear & unrestricted identity",
|
||||
testTC "1 · (λ x ⇒ x) ⇐ A ⊸ A" $
|
||||
check_ (ctx [<]) sone (["x"] :\\ BVT 0) (Arr One (FT "A") (FT "A")),
|
||||
check_ empty sone (["x"] :\\ BVT 0) (Arr One (FT "A") (FT "A")),
|
||||
testTC "1 · (λ x ⇒ x) ⇐ A → A" $
|
||||
check_ (ctx [<]) sone (["x"] :\\ BVT 0) (Arr Any (FT "A") (FT "A")),
|
||||
check_ empty sone (["x"] :\\ BVT 0) (Arr Any (FT "A") (FT "A")),
|
||||
note "(fail) zero binding used relevantly",
|
||||
testTCFail "1 · (λ x ⇒ x) ⇍ A ⇾ A" $
|
||||
check_ (ctx [<]) sone (["x"] :\\ BVT 0) (Arr Zero (FT "A") (FT "A")),
|
||||
check_ empty sone (["x"] :\\ BVT 0) (Arr Zero (FT "A") (FT "A")),
|
||||
note "(but ok in overall erased context)",
|
||||
testTC "0 · (λ x ⇒ x) ⇐ A ⇾ A" $
|
||||
check_ (ctx [<]) szero (["x"] :\\ BVT 0) (Arr Zero (FT "A") (FT "A")),
|
||||
check_ empty szero (["x"] :\\ BVT 0) (Arr Zero (FT "A") (FT "A")),
|
||||
testTC "1 · (λ A x ⇒ refl A x) ⇐ ⋯ # (type of refl)" $
|
||||
check_ (ctx [<]) sone
|
||||
check_ empty sone
|
||||
(["A", "x"] :\\ E (F "refl" :@@ [BVT 1, BVT 0]))
|
||||
reflTy,
|
||||
testTC "1 · (λ A x ⇒ δ i ⇒ x) ⇐ ⋯ # (def. and type of refl)" $
|
||||
check_ (ctx [<]) sone reflDef reflTy
|
||||
check_ empty sone reflDef reflTy
|
||||
],
|
||||
|
||||
"pairs" :- [
|
||||
testTC "1 · (a, a) ⇐ A × A" $
|
||||
check_ (ctx [<]) sone (Pair (FT "a") (FT "a")) (FT "A" `And` FT "A"),
|
||||
check_ empty sone (Pair (FT "a") (FT "a")) (FT "A" `And` FT "A"),
|
||||
testTC "x : A ⊢ 1 · (x, x) ⇐ A × A ⊳ ω·x" $
|
||||
checkQ (ctx [< FT "A"]) sone
|
||||
checkQ (ctx [< ("x", FT "A")]) sone
|
||||
(Pair (BVT 0) (BVT 0)) (FT "A" `And` FT "A") [< Any],
|
||||
testTC "1 · (a, δ i ⇒ a) ⇐ (x : A) × (x ≡ a)" $
|
||||
check_ (ctx [<]) sone
|
||||
check_ empty sone
|
||||
(Pair (FT "a") (["i"] :\\% FT "a"))
|
||||
(Sig_ "x" (FT "A") $ Eq0 (FT "A") (BVT 0) (FT "a"))
|
||||
],
|
||||
|
||||
"unpairing" :- [
|
||||
testTC "x : A × A ⊢ 1 · (case1 x return B of (l,r) ⇒ f2 l r) ⇒ B ⊳ 1·x" $
|
||||
inferAsQ (ctx [< FT "A" `And` FT "A"]) sone
|
||||
inferAsQ (ctx [< ("x", FT "A" `And` FT "A")]) sone
|
||||
(CasePair One (BV 0) (SN $ FT "B")
|
||||
(SY ["l", "r"] $ E $ F "f2" :@@ [BVT 1, BVT 0]))
|
||||
(FT "B") [< One],
|
||||
testTC "x : A × A ⊢ 1 · (caseω x return B of (l,r) ⇒ f2 l r) ⇒ B ⊳ ω·x" $
|
||||
inferAsQ (ctx [< FT "A" `And` FT "A"]) sone
|
||||
inferAsQ (ctx [< ("x", FT "A" `And` FT "A")]) sone
|
||||
(CasePair Any (BV 0) (SN $ FT "B")
|
||||
(SY ["l", "r"] $ E $ F "f2" :@@ [BVT 1, BVT 0]))
|
||||
(FT "B") [< Any],
|
||||
testTC "x : A × A ⊢ 0 · (caseω x return B of (l,r) ⇒ f2 l r) ⇒ B ⊳ 0·x" $
|
||||
inferAsQ (ctx [< FT "A" `And` FT "A"]) szero
|
||||
inferAsQ (ctx [< ("x", FT "A" `And` FT "A")]) szero
|
||||
(CasePair Any (BV 0) (SN $ FT "B")
|
||||
(SY ["l", "r"] $ E $ F "f2" :@@ [BVT 1, BVT 0]))
|
||||
(FT "B") [< Zero],
|
||||
testTCFail "x : A × A ⊢ 1 · (case0 x return B of (l,r) ⇒ f2 l r) ⇏" $
|
||||
infer_ (ctx [< FT "A" `And` FT "A"]) sone
|
||||
infer_ (ctx [< ("x", FT "A" `And` FT "A")]) sone
|
||||
(CasePair Zero (BV 0) (SN $ FT "B")
|
||||
(SY ["l", "r"] $ E $ F "f2" :@@ [BVT 1, BVT 0])),
|
||||
testTC "x : A × B ⊢ 1 · (caseω x return A of (l,r) ⇒ l) ⇒ A ⊳ ω·x" $
|
||||
inferAsQ (ctx [< FT "A" `And` FT "B"]) sone
|
||||
inferAsQ (ctx [< ("x", FT "A" `And` FT "B")]) sone
|
||||
(CasePair Any (BV 0) (SN $ FT "A")
|
||||
(SY ["l", "r"] $ BVT 1))
|
||||
(FT "A") [< Any],
|
||||
testTC "x : A × B ⊢ 0 · (case1 x return A of (l,r) ⇒ l) ⇒ A ⊳ 0·x" $
|
||||
inferAsQ (ctx [< FT "A" `And` FT "B"]) szero
|
||||
inferAsQ (ctx [< ("x", FT "A" `And` FT "B")]) szero
|
||||
(CasePair One (BV 0) (SN $ FT "A")
|
||||
(SY ["l", "r"] $ BVT 1))
|
||||
(FT "A") [< Zero],
|
||||
testTCFail "x : A × B ⊢ 1 · (case1 x return A of (l,r) ⇒ l) ⇏" $
|
||||
infer_ (ctx [< FT "A" `And` FT "B"]) sone
|
||||
infer_ (ctx [< ("x", FT "A" `And` FT "B")]) sone
|
||||
(CasePair One (BV 0) (SN $ FT "A")
|
||||
(SY ["l", "r"] $ BVT 1)),
|
||||
note "fst : (0·A : ★₁) → (0·B : A ↠ ★₁) → ((x : A) × B x) ↠ A",
|
||||
note " ≔ (λ A B p ⇒ caseω p return A of (x, y) ⇒ x)",
|
||||
testTC "0 · ‹type of fst› ⇐ ★₂" $
|
||||
check_ (ctx [<]) szero fstTy (TYPE 2),
|
||||
check_ empty szero fstTy (TYPE 2),
|
||||
testTC "1 · ‹def of fst› ⇐ ‹type of fst›" $
|
||||
check_ (ctx [<]) sone fstDef fstTy,
|
||||
check_ empty sone fstDef fstTy,
|
||||
note "snd : (0·A : ★₁) → (0·B : A ↠ ★₁) → (ω·p : (x : A) × B x) → B (fst A B p)",
|
||||
note " ≔ (λ A B p ⇒ caseω p return p ⇒ B (fst A B p) of (x, y) ⇒ y)",
|
||||
testTC "0 · ‹type of snd› ⇐ ★₂" $
|
||||
check_ (ctx [<]) szero sndTy (TYPE 2),
|
||||
check_ empty szero sndTy (TYPE 2),
|
||||
testTC "1 · ‹def of snd› ⇐ ‹type of snd›" $
|
||||
check_ (ctx [<]) sone sndDef sndTy,
|
||||
check_ empty sone sndDef sndTy,
|
||||
testTC "0 · snd ★₀ (λ x ⇒ x) ⇒ (ω·p : (A : ★₀) × A) → fst ★₀ (λ x ⇒ x) p" $
|
||||
inferAs (ctx [<]) szero
|
||||
inferAs empty szero
|
||||
(F "snd" :@@ [TYPE 0, ["x"] :\\ BVT 0])
|
||||
(Pi_ Any "A" (Sig_ "A" (TYPE 0) $ BVT 0) $
|
||||
(E $ F "fst" :@@ [TYPE 0, ["x"] :\\ BVT 0, BVT 0]))
|
||||
|
|
@ -344,27 +347,27 @@ tests = "typechecker" :- [
|
|||
|
||||
"enums" :- [
|
||||
testTC "1 · 'a ⇐ {a}" $
|
||||
check_ (ctx [<]) sone (Tag "a") (enum ["a"]),
|
||||
check_ empty sone (Tag "a") (enum ["a"]),
|
||||
testTC "1 · 'a ⇐ {a, b, c}" $
|
||||
check_ (ctx [<]) sone (Tag "a") (enum ["a", "b", "c"]),
|
||||
check_ empty sone (Tag "a") (enum ["a", "b", "c"]),
|
||||
testTCFail "1 · 'a ⇍ {b, c}" $
|
||||
check_ (ctx [<]) sone (Tag "a") (enum ["b", "c"]),
|
||||
check_ empty sone (Tag "a") (enum ["b", "c"]),
|
||||
testTC "0=1 ⊢ 1 · 'a ⇐ {b, c}" $
|
||||
check_ (ctx01 [<]) sone (Tag "a") (enum ["b", "c"])
|
||||
check_ empty01 sone (Tag "a") (enum ["b", "c"])
|
||||
],
|
||||
|
||||
"equalities" :- [
|
||||
testTC "1 · (δ i ⇒ a) ⇐ a ≡ a" $
|
||||
check_ (ctx [<]) sone (DLam $ SN $ FT "a")
|
||||
check_ empty sone (DLam $ SN $ FT "a")
|
||||
(Eq0 (FT "A") (FT "a") (FT "a")),
|
||||
testTC "0 · (λ p q ⇒ δ i ⇒ p) ⇐ (ω·p q : a ≡ a') → p ≡ q" $
|
||||
check_ (ctx [<]) szero
|
||||
check_ empty szero
|
||||
(["p","q"] :\\ ["i"] :\\% BVT 1)
|
||||
(Pi_ Any "p" (Eq0 (FT "A") (FT "a") (FT "a")) $
|
||||
Pi_ Any "q" (Eq0 (FT "A") (FT "a") (FT "a")) $
|
||||
Eq0 (Eq0 (FT "A") (FT "a") (FT "a")) (BVT 1) (BVT 0)),
|
||||
testTC "0 · (λ p q ⇒ δ i ⇒ q) ⇐ (ω·p q : a ≡ a') → p ≡ q" $
|
||||
check_ (ctx [<]) szero
|
||||
check_ empty szero
|
||||
(["p","q"] :\\ ["i"] :\\% BVT 0)
|
||||
(Pi_ Any "p" (Eq0 (FT "A") (FT "a") (FT "a")) $
|
||||
Pi_ Any "q" (Eq0 (FT "A") (FT "a") (FT "a")) $
|
||||
|
|
@ -377,7 +380,7 @@ tests = "typechecker" :- [
|
|||
note "1 · λ x y xy ⇒ δ i ⇒ p (xy i)",
|
||||
note " ⇐ (0·x y : A) → (1·xy : x ≡ y) → Eq [i ⇒ P (xy i)] (p x) (p y)",
|
||||
testTC "cong" $
|
||||
check_ (ctx [<]) sone
|
||||
check_ empty sone
|
||||
(["x", "y", "xy"] :\\ ["i"] :\\% E (F "p" :@ E (BV 0 :% BV 0)))
|
||||
(Pi_ Zero "x" (FT "A") $
|
||||
Pi_ Zero "y" (FT "A") $
|
||||
|
|
@ -390,7 +393,7 @@ tests = "typechecker" :- [
|
|||
note "1 · λ eq ⇒ δ i ⇒ λ x ⇒ eq x i",
|
||||
note " ⇐ (1·eq : (1·x : A) → p x ≡ q x) → p ≡ q",
|
||||
testTC "funext" $
|
||||
check_ (ctx [<]) sone
|
||||
check_ empty sone
|
||||
(["eq"] :\\ ["i"] :\\% ["x"] :\\ E (BV 1 :@ BVT 0 :% BV 0))
|
||||
(Pi_ One "eq"
|
||||
(Pi_ One "x" (FT "A")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue