rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

crude but effective stratification

Browse source
This commit is contained in:
rhiannon morris 2023-05-21 20:09:34 +02:00
parent e4a20cc632
commit 42aa07c9c8
31 changed files with 817 additions and 582 deletions
Download patch file Download diff file Expand all files Collapse all files

251
tests/Tests/Typechecker.idr
View file

@ -49,8 +49,8 @@ reflDef = ^LamY "A" (^LamY "x" (^DLamY "i" (^BVT 0)))
fstTy : Term d n
fstTy =
^PiY Zero "A" (^TYPE 1)
(^PiY Zero "B" (^Arr Any (^BVT 0) (^TYPE 1))
^PiY Zero "A" (^TYPE 0)
(^PiY Zero "B" (^Arr Any (^BVT 0) (^TYPE 0))
(^Arr Any (^SigY "x" (^BVT 1) (E $ ^App (^BV 1) (^BVT 0))) (^BVT 1)))
fstDef : Term d n
@ -61,11 +61,11 @@ fstDef =
sndTy : Term d n
sndTy =
^PiY Zero "A" (^TYPE 1)
(^PiY Zero "B" (^Arr Any (^BVT 0) (^TYPE 1))
^PiY Zero "A" (^TYPE 0)
(^PiY Zero "B" (^Arr Any (^BVT 0) (^TYPE 0))
(^PiY Any "p" (^SigY "x" (^BVT 1) (E $ ^App (^BV 1) (^BVT 0)))
(E $ ^App (^BV 1)
(E $ ^App (^App (^App (^F "fst") (^BVT 2)) (^BVT 1)) (^BVT 0)))))
(E $ ^App (^App (^App (^F "fst" 0) (^BVT 2)) (^BVT 1)) (^BVT 0)))))
sndDef : Term d n
sndDef =
@ -74,12 +74,15 @@ sndDef =
(E $ ^CasePair Any (^BV 0)
(SY [< "p"] $ E $
^App (^BV 2)
(E $ ^App (^App (^App (^F "fst") (^BVT 3)) (^BVT 2)) (^BVT 0)))
(E $ ^App (^App (^App (^F "fst" 0) (^BVT 3)) (^BVT 2)) (^BVT 0)))
(SY [< "x", "y"] $ ^BVT 0))))
nat : Term d n
nat = ^Nat
apps : Elim d n -> List (Term d n) -> Elim d n
apps = foldl (\f, s => ^App f s)
defGlobals : Definitions
defGlobals = fromList
@ -87,19 +90,21 @@ defGlobals = fromList
("B", ^mkPostulate gzero (^TYPE 0)),
("C", ^mkPostulate gzero (^TYPE 1)),
("D", ^mkPostulate gzero (^TYPE 1)),
("P", ^mkPostulate gzero (^Arr Any (^FT "A") (^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"))),
("fω", ^mkPostulate gany (^Arr Any (^FT "A") (^FT "A"))),
("g", ^mkPostulate gany (^Arr One (^FT "A") (^FT "B"))),
("P", ^mkPostulate gzero (^Arr Any (^FT "A" 0) (^TYPE 0))),
("a", ^mkPostulate gany (^FT "A" 0)),
("a'", ^mkPostulate gany (^FT "A" 0)),
("b", ^mkPostulate gany (^FT "B" 0)),
("c", ^mkPostulate gany (^FT "C" 0)),
("d", ^mkPostulate gany (^FT "D" 0)),
("f", ^mkPostulate gany (^Arr One (^FT "A" 0) (^FT "A" 0))),
("fω", ^mkPostulate gany (^Arr Any (^FT "A" 0) (^FT "A" 0))),
("g", ^mkPostulate gany (^Arr One (^FT "A" 0) (^FT "B" 0))),
("f2", ^mkPostulate gany
(^Arr One (^FT "A") (^Arr One (^FT "A") (^FT "B")))),
(^Arr One (^FT "A" 0) (^Arr One (^FT "A" 0) (^FT "B" 0)))),
("p", ^mkPostulate gany
(^PiY One "x" (^FT "A") (E $ ^App (^F "P") (^BVT 0)))),
(^PiY One "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))),
("q", ^mkPostulate gany
(^PiY One "x" (^FT "A") (E $ ^App (^F "P") (^BVT 0)))),
(^PiY One "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))),
("refl", ^mkDef gany reflTy reflDef),
("fst", ^mkDef gany fstTy fstDef),
("snd", ^mkDef gany sndTy sndDef)]
@ -180,36 +185,36 @@ tests = "typechecker" :- [
"function types" :- [
note "A, B : ★₀; C, D : ★₁; P : 0.A → ★₀",
testTC "0 · 1.A → B ⇐ ★₀" $
check_ empty szero (^Arr One (^FT "A") (^FT "B")) (^TYPE 0),
check_ empty szero (^Arr One (^FT "A" 0) (^FT "B" 0)) (^TYPE 0),
note "subtyping",
testTC "0 · 1.A → B ⇐ ★₁" $
check_ empty szero (^Arr One (^FT "A") (^FT "B")) (^TYPE 1),
check_ empty szero (^Arr One (^FT "A" 0) (^FT "B" 0)) (^TYPE 1),
testTC "0 · 1.C → D ⇐ ★₁" $
check_ empty szero (^Arr One (^FT "C") (^FT "D")) (^TYPE 1),
check_ empty szero (^Arr One (^FT "C" 0) (^FT "D" 0)) (^TYPE 1),
testTCFail "0 · 1.C → D ⇍ ★₀" $
check_ empty szero (^Arr One (^FT "C") (^FT "D")) (^TYPE 0),
check_ empty szero (^Arr One (^FT "C" 0) (^FT "D" 0)) (^TYPE 0),
testTC "0 · 1.(x : A) → P x ⇐ ★₀" $
check_ empty szero
(^PiY One "x" (^FT "A") (E $ ^App (^F "P") (^BVT 0)))
(^PiY One "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))
(^TYPE 0),
testTCFail "0 · 1.A → P ⇍ ★₀" $
check_ empty szero (^Arr One (^FT "A") (^FT "P")) (^TYPE 0),
check_ empty szero (^Arr One (^FT "A" 0) (^FT "P" 0)) (^TYPE 0),
testTC "0=1 ⊢ 0 · 1.A → P ⇐ ★₀" $
check_ empty01 szero (^Arr One (^FT "A") (^FT "P")) (^TYPE 0)
check_ empty01 szero (^Arr One (^FT "A" 0) (^FT "P" 0)) (^TYPE 0)
],
"pair types" :- [
testTC "0 · A × A ⇐ ★₀" $
check_ empty szero (^And (^FT "A") (^FT "A")) (^TYPE 0),
check_ empty szero (^And (^FT "A" 0) (^FT "A" 0)) (^TYPE 0),
testTCFail "0 · A × P ⇍ ★₀" $
check_ empty szero (^And (^FT "A") (^FT "P")) (^TYPE 0),
check_ empty szero (^And (^FT "A" 0) (^FT "P" 0)) (^TYPE 0),
testTC "0 · (x : A) × P x ⇐ ★₀" $
check_ empty szero
(^SigY "x" (^FT "A") (E $ ^App (^F "P") (^BVT 0)))
(^SigY "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))
(^TYPE 0),
testTC "0 · (x : A) × P x ⇐ ★₁" $
check_ empty szero
(^SigY "x" (^FT "A") (E $ ^App (^F "P") (^BVT 0)))
(^SigY "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))
(^TYPE 1),
testTC "0 · (A : ★₀) × A ⇐ ★₁" $
check_ empty szero
@ -221,7 +226,7 @@ tests = "typechecker" :- [
(^TYPE 0),
testTCFail "1 · A × A ⇍ ★₀" $
check_ empty sone
(^And (^FT "A") (^FT "A"))
(^And (^FT "A" 0) (^FT "A" 0))
(^TYPE 0)
],
@ -239,64 +244,64 @@ tests = "typechecker" :- [
"free vars" :- [
note "A : ★₀",
testTC "0 · A ⇒ ★₀" $
inferAs empty szero (^F "A") (^TYPE 0),
inferAs empty szero (^F "A" 0) (^TYPE 0),
testTC "0 · [A] ⇐ ★₀" $
check_ empty szero (^FT "A") (^TYPE 0),
check_ empty szero (^FT "A" 0) (^TYPE 0),
note "subtyping",
testTC "0 · [A] ⇐ ★₁" $
check_ empty szero (^FT "A") (^TYPE 1),
check_ empty szero (^FT "A" 0) (^TYPE 1),
note "(fail) runtime-relevant type",
testTCFail "1 · A ⇏ ★₀" $
infer_ empty sone (^F "A"),
infer_ empty sone (^F "A" 0),
testTC "1 . f ⇒ 1.A → A" $
inferAs empty sone (^F "f") (^Arr One (^FT "A") (^FT "A")),
inferAs empty sone (^F "f" 0) (^Arr One (^FT "A" 0) (^FT "A" 0)),
testTC "1 . f ⇐ 1.A → A" $
check_ empty sone (^FT "f") (^Arr One (^FT "A") (^FT "A")),
check_ empty sone (^FT "f" 0) (^Arr One (^FT "A" 0) (^FT "A" 0)),
testTCFail "1 . f ⇍ 0.A → A" $
check_ empty sone (^FT "f") (^Arr Zero (^FT "A") (^FT "A")),
check_ empty sone (^FT "f" 0) (^Arr Zero (^FT "A" 0) (^FT "A" 0)),
testTCFail "1 . f ⇍ ω.A → A" $
check_ empty sone (^FT "f") (^Arr Any (^FT "A") (^FT "A")),
check_ empty sone (^FT "f" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)),
testTC "1 . (λ x ⇒ f x) ⇐ 1.A → A" $
check_ empty sone
(^LamY "x" (E $ ^App (^F "f") (^BVT 0)))
(^Arr One (^FT "A") (^FT "A")),
(^LamY "x" (E $ ^App (^F "f" 0) (^BVT 0)))
(^Arr One (^FT "A" 0) (^FT "A" 0)),
testTC "1 . (λ x ⇒ f x) ⇐ ω.A → A" $
check_ empty sone
(^LamY "x" (E $ ^App (^F "f") (^BVT 0)))
(^Arr Any (^FT "A") (^FT "A")),
(^LamY "x" (E $ ^App (^F "f" 0) (^BVT 0)))
(^Arr Any (^FT "A" 0) (^FT "A" 0)),
testTCFail "1 . (λ x ⇒ f x) ⇍ 0.A → A" $
check_ empty sone
(^LamY "x" (E $ ^App (^F "f") (^BVT 0)))
(^Arr Zero (^FT "A") (^FT "A")),
(^LamY "x" (E $ ^App (^F "f" 0) (^BVT 0)))
(^Arr Zero (^FT "A" 0) (^FT "A" 0)),
testTC "1 . fω ⇒ ω.A → A" $
inferAs empty sone (^F "fω") (^Arr Any (^FT "A") (^FT "A")),
inferAs empty sone (^F "fω" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)),
testTC "1 . (λ x ⇒ fω x) ⇐ ω.A → A" $
check_ empty sone
(^LamY "x" (E $ ^App (^F "fω") (^BVT 0)))
(^Arr Any (^FT "A") (^FT "A")),
(^LamY "x" (E $ ^App (^F "fω" 0) (^BVT 0)))
(^Arr Any (^FT "A" 0) (^FT "A" 0)),
testTCFail "1 . (λ x ⇒ fω x) ⇍ 0.A → A" $
check_ empty sone
(^LamY "x" (E $ ^App (^F "fω") (^BVT 0)))
(^Arr Zero (^FT "A") (^FT "A")),
(^LamY "x" (E $ ^App (^F "fω" 0) (^BVT 0)))
(^Arr Zero (^FT "A" 0) (^FT "A" 0)),
testTCFail "1 . (λ x ⇒ fω x) ⇍ 1.A → A" $
check_ empty sone
(^LamY "x" (E $ ^App (^F "fω") (^BVT 0)))
(^Arr One (^FT "A") (^FT "A")),
(^LamY "x" (E $ ^App (^F "fω" 0) (^BVT 0)))
(^Arr One (^FT "A" 0) (^FT "A" 0)),
note "refl : (0·A : ★₀) → (1·x : A) → (x ≡ x : A) ≔ (λ A x ⇒ δ _ ⇒ x)",
testTC "1 · refl ⇒ ⋯" $ inferAs empty sone (^F "refl") reflTy,
testTC "1 · [refl] ⇐ ⋯" $ check_ empty sone (^FT "refl") reflTy
testTC "1 · refl ⇒ ⋯" $ inferAs empty sone (^F "refl" 0) reflTy,
testTC "1 · [refl] ⇐ ⋯" $ check_ empty sone (^FT "refl" 0) reflTy
],
"bound vars" :- [
testTC "x : A ⊢ 1 · x ⇒ A ⊳ 1·x" $
inferAsQ (ctx [< ("x", ^FT "A")]) sone
(^BV 0) (^FT "A") [< One],
inferAsQ (ctx [< ("x", ^FT "A" 0)]) sone
(^BV 0) (^FT "A" 0) [< One],
testTC "x : A ⊢ 1 · x ⇐ A ⊳ 1·x" $
checkQ (ctx [< ("x", ^FT "A")]) sone (^BVT 0) (^FT "A") [< One],
checkQ (ctx [< ("x", ^FT "A" 0)]) sone (^BVT 0) (^FT "A" 0) [< One],
note "f2 : 1.A → 1.A → B",
testTC "x : A ⊢ 1 · f2 x x ⇒ B ⊳ ω·x" $
inferAsQ (ctx [< ("x", ^FT "A")]) sone
(^App (^App (^F "f2") (^BVT 0)) (^BVT 0)) (^FT "B") [< Any]
inferAsQ (ctx [< ("x", ^FT "A" 0)]) sone
(^App (^App (^F "f2" 0) (^BVT 0)) (^BVT 0)) (^FT "B" 0) [< Any]
],
"lambda" :- [
@ -304,24 +309,25 @@ tests = "typechecker" :- [
testTC "1 · (λ x ⇒ x) ⇐ A → A" $
check_ empty sone
(^LamY "x" (^BVT 0))
(^Arr One (^FT "A") (^FT "A")),
(^Arr One (^FT "A" 0) (^FT "A" 0)),
testTC "1 · (λ x ⇒ x) ⇐ ω.A → A" $
check_ empty sone
(^LamY "x" (^BVT 0))
(^Arr Any (^FT "A") (^FT "A")),
(^Arr Any (^FT "A" 0) (^FT "A" 0)),
note "(fail) zero binding used relevantly",
testTCFail "1 · (λ x ⇒ x) ⇍ 0.A → A" $
check_ empty sone
(^LamY "x" (^BVT 0))
(^Arr Zero (^FT "A") (^FT "A")),
(^Arr Zero (^FT "A" 0) (^FT "A" 0)),
note "(but ok in overall erased context)",
testTC "0 · (λ x ⇒ x) ⇐ A ⇾ A" $
check_ empty szero
(^LamY "x" (^BVT 0))
(^Arr Zero (^FT "A") (^FT "A")),
(^Arr Zero (^FT "A" 0) (^FT "A" 0)),
testTC "1 · (λ A x ⇒ refl A x) ⇐ ⋯ # (type of refl)" $
check_ empty sone
(^LamY "A" (^LamY "x" (E $ ^App (^App (^F "refl") (^BVT 1)) (^BVT 0))))
(^LamY "A" (^LamY "x"
(E $ ^App (^App (^F "refl" 0) (^BVT 1)) (^BVT 0))))
reflTy,
testTC "1 · (λ A x ⇒ δ i ⇒ x) ⇐ ⋯ # (def. and type of refl)" $
check_ empty sone reflDef reflTy
@ -330,68 +336,87 @@ tests = "typechecker" :- [
"pairs" :- [
testTC "1 · (a, a) ⇐ A × A" $
check_ empty sone
(^Pair (^FT "a") (^FT "a")) (^And (^FT "A") (^FT "A")),
(^Pair (^FT "a" 0) (^FT "a" 0)) (^And (^FT "A" 0) (^FT "A" 0)),
testTC "x : A ⊢ 1 · (x, x) ⇐ A × A ⊳ ω·x" $
checkQ (ctx [< ("x", ^FT "A")]) sone
(^Pair (^BVT 0) (^BVT 0)) (^And (^FT "A") (^FT "A")) [< Any],
checkQ (ctx [< ("x", ^FT "A" 0)]) sone
(^Pair (^BVT 0) (^BVT 0)) (^And (^FT "A" 0) (^FT "A" 0)) [< Any],
testTC "1 · (a, δ i ⇒ a) ⇐ (x : A) × (x ≡ a)" $
check_ empty sone
(^Pair (^FT "a") (^DLamN (^FT "a")))
(^SigY "x" (^FT "A") (^Eq0 (^FT "A") (^BVT 0) (^FT "a")))
(^Pair (^FT "a" 0) (^DLamN (^FT "a" 0)))
(^SigY "x" (^FT "A" 0) (^Eq0 (^FT "A" 0) (^BVT 0) (^FT "a" 0)))
],
"unpairing" :- [
testTC "x : A × A ⊢ 1 · (case1 x return B of (l,r) ⇒ f2 l r) ⇒ B ⊳ 1·x" $
inferAsQ (ctx [< ("x", ^And (^FT "A") (^FT "A"))]) sone
(^CasePair One (^BV 0) (SN $ ^FT "B")
(SY [< "l", "r"] $ E $ ^App (^App (^F "f2") (^BVT 1)) (^BVT 0)))
(^FT "B") [< One],
inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) sone
(^CasePair One (^BV 0) (SN $ ^FT "B" 0)
(SY [< "l", "r"] $ E $ ^App (^App (^F "f2" 0) (^BVT 1)) (^BVT 0)))
(^FT "B" 0) [< One],
testTC "x : A × A ⊢ 1 · (caseω x return B of (l,r) ⇒ f2 l r) ⇒ B ⊳ ω·x" $
inferAsQ (ctx [< ("x", ^And (^FT "A") (^FT "A"))]) sone
(^CasePair Any (^BV 0) (SN $ ^FT "B")
(SY [< "l", "r"] $ E $ ^App (^App (^F "f2") (^BVT 1)) (^BVT 0)))
(^FT "B") [< Any],
inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) sone
(^CasePair Any (^BV 0) (SN $ ^FT "B" 0)
(SY [< "l", "r"] $ E $ ^App (^App (^F "f2" 0) (^BVT 1)) (^BVT 0)))
(^FT "B" 0) [< Any],
testTC "x : A × A ⊢ 0 · (caseω x return B of (l,r) ⇒ f2 l r) ⇒ B ⊳ 0·x" $
inferAsQ (ctx [< ("x", ^And (^FT "A") (^FT "A"))]) szero
(^CasePair Any (^BV 0) (SN $ ^FT "B")
(SY [< "l", "r"] $ E $ ^App (^App (^F "f2") (^BVT 1)) (^BVT 0)))
(^FT "B") [< Zero],
inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) szero
(^CasePair Any (^BV 0) (SN $ ^FT "B" 0)
(SY [< "l", "r"] $ E $ ^App (^App (^F "f2" 0) (^BVT 1)) (^BVT 0)))
(^FT "B" 0) [< Zero],
testTCFail "x : A × A ⊢ 1 · (case0 x return B of (l,r) ⇒ f2 l r) ⇏" $
infer_ (ctx [< ("x", ^And (^FT "A") (^FT "A"))]) sone
(^CasePair Zero (^BV 0) (SN $ ^FT "B")
(SY [< "l", "r"] $ E $ ^App (^App (^F "f2") (^BVT 1)) (^BVT 0))),
infer_ (ctx [< ("x", ^And (^FT "A" 0) (^FT "A" 0))]) sone
(^CasePair Zero (^BV 0) (SN $ ^FT "B" 0)
(SY [< "l", "r"] $ E $ ^App (^App (^F "f2" 0) (^BVT 1)) (^BVT 0))),
testTC "x : A × B ⊢ 1 · (caseω x return A of (l,r) ⇒ l) ⇒ A ⊳ ω·x" $
inferAsQ (ctx [< ("x", ^And (^FT "A") (^FT "B"))]) sone
(^CasePair Any (^BV 0) (SN $ ^FT "A")
inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) sone
(^CasePair Any (^BV 0) (SN $ ^FT "A" 0)
(SY [< "l", "r"] $ ^BVT 1))
(^FT "A") [< Any],
(^FT "A" 0) [< Any],
testTC "x : A × B ⊢ 0 · (case1 x return A of (l,r) ⇒ l) ⇒ A ⊳ 0·x" $
inferAsQ (ctx [< ("x", ^And (^FT "A") (^FT "B"))]) szero
(^CasePair One (^BV 0) (SN $ ^FT "A")
inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) szero
(^CasePair One (^BV 0) (SN $ ^FT "A" 0)
(SY [< "l", "r"] $ ^BVT 1))
(^FT "A") [< Zero],
(^FT "A" 0) [< Zero],
testTCFail "x : A × B ⊢ 1 · (case1 x return A of (l,r) ⇒ l) ⇏" $
infer_ (ctx [< ("x", ^And (^FT "A") (^FT "B"))]) sone
(^CasePair One (^BV 0) (SN $ ^FT "A")
infer_ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) sone
(^CasePair One (^BV 0) (SN $ ^FT "A" 0)
(SY [< "l", "r"] $ ^BVT 1)),
note "fst : (0·A : ★₁) → (0·B : A ↠ ★₁) → ((x : A) × B x) ↠ A",
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_ empty szero fstTy (^TYPE 2),
testTC "0 · ‹type of fst› ⇐ ★₁" $
check_ empty szero fstTy (^TYPE 1),
testTC "1 · ‹def of fst› ⇐ ‹type of fst›" $
check_ empty sone fstDef fstTy,
note "snd : (0·A : ★₁) → (0·B : A ↠ ★₁) → (ω·p : (x : A) × B x) → B (fst A B p)",
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_ empty szero sndTy (^TYPE 2),
testTC "0 · ‹type of snd› ⇐ ★₁" $
check_ empty szero sndTy (^TYPE 1),
testTC "1 · ‹def of snd› ⇐ ‹type of snd›" $
check_ empty sone sndDef sndTy,
testTC "0 · snd ★₀ (λ x ⇒ x) ⇒ (ω·p : (A : ★₀) × A) → fst ★₀ (λ x ⇒ x) p" $
testTC "0 · snd A P ⇒ ω.(p : (x : A) × P x) → P (fst A P p)" $
inferAs empty szero
(^App (^App (^F "snd") (^TYPE 0)) (^LamY "x" (^BVT 0)))
(^PiY Any "p" (^SigY "A" (^TYPE 0) (^BVT 0))
(E $ ^App (^App (^App (^F "fst") (^TYPE 0)) (^LamY "x" (^BVT 0)))
(^BVT 0)))
(^App (^App (^F "snd" 0) (^FT "A" 0)) (^FT "P" 0))
(^PiY Any "p" (^SigY "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))
(E $ ^App (^F "P" 0)
(E $ apps (^F "fst" 0) [^FT "A" 0, ^FT "P" 0, ^BVT 0]))),
testTC "1 · fst A (λ _ ⇒ B) (a, b) ⇒ A" $
inferAs empty sone
(apps (^F "fst" 0)
[^FT "A" 0, ^LamN (^FT "B" 0), ^Pair (^FT "a" 0) (^FT "b" 0)])
(^FT "A" 0),
testTC "1 · fst¹ A (λ _ ⇒ B) (a, b) ⇒ A" $
inferAs empty sone
(apps (^F "fst" 1)
[^FT "A" 0, ^LamN (^FT "B" 0), ^Pair (^FT "a" 0) (^FT "b" 0)])
(^FT "A" 0),
testTCFail "1 · fst ★⁰ (λ _ ⇒ ★⁰) (A, B) ⇏" $
infer_ empty sone
(apps (^F "fst" 0)
[^TYPE 0, ^LamN (^TYPE 0), ^Pair (^FT "A" 0) (^FT "B" 0)]),
testTC "0 · fst¹ ★⁰ (λ _ ⇒ ★⁰) (A, B) ⇒ ★⁰" $
inferAs empty szero
(apps (^F "fst" 1)
[^TYPE 0, ^LamN (^TYPE 0), ^Pair (^FT "A" 0) (^FT "B" 0)])
(^TYPE 0)
],
"enums" :- [
@ -435,33 +460,35 @@ tests = "typechecker" :- [
(^Eq0 (^enum ["beep"]) (^Zero) (^Tag "beep"))
Nothing,
testTC "ab : A ≡ B : ★₀, x : A, y : B ⊢ 0 · Eq [i ⇒ ab i] x y ⇐ ★₀" $
check_ (ctx [< ("ab", ^Eq0 (^TYPE 0) (^FT "A") (^FT "B")),
("x", ^FT "A"), ("y", ^FT "B")]) szero
check_ (ctx [< ("ab", ^Eq0 (^TYPE 0) (^FT "A" 0) (^FT "B" 0)),
("x", ^FT "A" 0), ("y", ^FT "B" 0)]) szero
(^EqY "i" (E $ ^DApp (^BV 2) (^BV 0)) (^BVT 1) (^BVT 0))
(^TYPE 0),
testTCFail "ab : A ≡ B : ★₀, x : A, y : B ⊢ Eq [i ⇒ ab i] y x ⇍ Type" $
check_ (ctx [< ("ab", ^Eq0 (^TYPE 0) (^FT "A") (^FT "B")),
("x", ^FT "A"), ("y", ^FT "B")]) szero
check_ (ctx [< ("ab", ^Eq0 (^TYPE 0) (^FT "A" 0) (^FT "B" 0)),
("x", ^FT "A" 0), ("y", ^FT "B" 0)]) szero
(^EqY "i" (E $ ^DApp (^BV 2) (^BV 0)) (^BVT 0) (^BVT 1))
(^TYPE 0)
],
"equalities" :- [
testTC "1 · (δ i ⇒ a) ⇐ a ≡ a" $
check_ empty sone (^DLamN (^FT "a"))
(^Eq0 (^FT "A") (^FT "a") (^FT "a")),
check_ empty sone (^DLamN (^FT "a" 0))
(^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0)),
testTC "0 · (λ p q ⇒ δ i ⇒ p) ⇐ (ω·p q : a ≡ a') → p ≡ q # uip" $
check_ empty szero
(^LamY "p" (^LamY "q" (^DLamN (^BVT 1))))
(^PiY Any "p" (^Eq0 (^FT "A") (^FT "a") (^FT "a"))
(^PiY Any "q" (^Eq0 (^FT "A") (^FT "a") (^FT "a"))
(^Eq0 (^Eq0 (^FT "A") (^FT "a") (^FT "a")) (^BVT 1) (^BVT 0)))),
(^PiY Any "p" (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
(^PiY Any "q" (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
(^Eq0 (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
(^BVT 1) (^BVT 0)))),
testTC "0 · (λ p q ⇒ δ i ⇒ q) ⇐ (ω·p q : a ≡ a') → p ≡ q # uip(2)" $
check_ empty szero
(^LamY "p" (^LamY "q" (^DLamN (^BVT 0))))
(^PiY Any "p" (^Eq0 (^FT "A") (^FT "a") (^FT "a"))
(^PiY Any "q" (^Eq0 (^FT "A") (^FT "a") (^FT "a"))
(^Eq0 (^Eq0 (^FT "A") (^FT "a") (^FT "a")) (^BVT 1) (^BVT 0))))
(^PiY Any "p" (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
(^PiY Any "q" (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
(^Eq0 (^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a" 0))
(^BVT 1) (^BVT 0))))
],
"natural numbers" :- [