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

pass the subject quantity through equality etc

Browse source 
in preparation for non-linear η laws
This commit is contained in:
rhiannon morris 2023-09-18 18:21:30 +02:00
parent 3fe9b96f05
commit e6c06a5c81
17 changed files with 654 additions and 605 deletions
Download patch file Download diff file Expand all files Collapse all files

68
tests/Tests/Equal.idr
View file

@ -12,15 +12,15 @@ import AstExtra
defGlobals : Definitions
defGlobals = fromList
[("A", ^mkPostulate gzero (^TYPE 0)),
("B", ^mkPostulate gzero (^TYPE 0)),
("a", ^mkPostulate gany (^FT "A" 0)),
("a'", ^mkPostulate gany (^FT "A" 0)),
("b", ^mkPostulate gany (^FT "B" 0)),
("f", ^mkPostulate gany (^Arr One (^FT "A" 0) (^FT "A" 0))),
("id", ^mkDef gany (^Arr One (^FT "A" 0) (^FT "A" 0)) (^LamY "x" (^BVT 0))),
("eq-AB", ^mkPostulate gzero (^Eq0 (^TYPE 0) (^FT "A" 0) (^FT "B" 0))),
("two", ^mkDef gany (^Nat) (^Succ (^Succ (^Zero))))]
[("A", ^mkPostulate GZero (^TYPE 0)),
("B", ^mkPostulate GZero (^TYPE 0)),
("a", ^mkPostulate GAny (^FT "A" 0)),
("a'", ^mkPostulate GAny (^FT "A" 0)),
("b", ^mkPostulate GAny (^FT "B" 0)),
("f", ^mkPostulate GAny (^Arr One (^FT "A" 0) (^FT "A" 0))),
("id", ^mkDef GAny (^Arr One (^FT "A" 0) (^FT "A" 0)) (^LamY "x" (^BVT 0))),
("eq-AB", ^mkPostulate GZero (^Eq0 (^TYPE 0) (^FT "A" 0) (^FT "B" 0))),
("two", ^mkDef GAny (^Nat) (^Succ (^Succ (^Zero))))]
parameters (label : String) (act : Eff Equal ())
{default defGlobals globals : Definitions}
@ -32,15 +32,17 @@ parameters (label : String) (act : Eff Equal ())
parameters (ctx : TyContext d n)
subT, equalT : Term d n -> Term d n -> Term d n -> Eff TC ()
subT ty s t = lift $ Term.sub noLoc ctx ty s t
equalT ty s t = lift $ Term.equal noLoc ctx ty s t
subT, equalT : {default SOne sg : SQty} ->
Term d n -> Term d n -> Term d n -> Eff TC ()
subT ty s t {sg} = lift $ Term.sub noLoc ctx sg ty s t
equalT ty s t {sg} = lift $ Term.equal noLoc ctx sg ty s t
equalTy : Term d n -> Term d n -> Eff TC ()
equalTy s t = lift $ Term.equalType noLoc ctx s t
subE, equalE : Elim d n -> Elim d n -> Eff TC ()
subE e f = lift $ Elim.sub noLoc ctx e f
equalE e f = lift $ Elim.equal noLoc ctx e f
subE, equalE : {default SOne sg : SQty} ->
Elim d n -> Elim d n -> Eff TC ()
subE e f {sg} = lift $ Elim.sub noLoc ctx sg e f
equalE e f {sg} = lift $ Elim.equal noLoc ctx sg e f
export
@ -154,7 +156,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 gzero (^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" 0) (^TYPE 0) (^TYPE 0)),
@ -174,7 +176,7 @@ tests = "equality & subtyping" :- [
testEq "p : (a ≡ a' : A), q : (a ≡ a' : A) ∥ ⊢ p = q (free)"
{globals =
let def = ^mkPostulate gzero
let def = ^mkPostulate GZero
(^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0))
in defGlobals `mergeLeft` fromList [("p", def), ("q", def)]} $
equalE empty (^F "p" 0) (^F "q" 0),
@ -193,32 +195,32 @@ tests = "equality & subtyping" :- [
testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : EE ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
[("E", ^mkDef gzero (^TYPE 0)
[("E", ^mkDef GZero (^TYPE 0)
(^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0))),
("EE", ^mkDef gzero (^TYPE 0) (^FT "E" 0))]} $
("EE", ^mkDef GZero (^TYPE 0) (^FT "E" 0))]} $
equalE
(extendTyN [< (Any, "x", ^FT "EE" 0), (Any, "y", ^FT "EE" 0)] empty)
(^BV 0) (^BV 1),
testEq "E ≔ a ≡ a' : A, EE ≔ E ∥ x : EE, y : E ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
[("E", ^mkDef gzero (^TYPE 0)
[("E", ^mkDef GZero (^TYPE 0)
(^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0))),
("EE", ^mkDef gzero (^TYPE 0) (^FT "E" 0))]} $
("EE", ^mkDef GZero (^TYPE 0) (^FT "E" 0))]} $
equalE
(extendTyN [< (Any, "x", ^FT "EE" 0), (Any, "y", ^FT "E" 0)] empty)
(^BV 0) (^BV 1),
testEq "E ≔ a ≡ a' : A ∥ x : E, y : E ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
[("E", ^mkDef gzero (^TYPE 0)
[("E", ^mkDef GZero (^TYPE 0)
(^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0)))]} $
equalE (extendTyN [< (Any, "x", ^FT "E" 0), (Any, "y", ^FT "E" 0)] empty)
(^BV 0) (^BV 1),
testEq "E ≔ a ≡ a' : A ∥ x : (E×E), y : (E×E) ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
[("E", ^mkDef gzero (^TYPE 0)
[("E", ^mkDef GZero (^TYPE 0)
(^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0)))]} $
let ty : forall n. Term 0 n := ^Sig (^FT "E" 0) (SN $ ^FT "E" 0) in
equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
@ -226,9 +228,9 @@ tests = "equality & subtyping" :- [
testEq "E ≔ a ≡ a' : A, W ≔ E × E ∥ x : W, y : E×E ⊢ x = y"
{globals = defGlobals `mergeLeft` fromList
[("E", ^mkDef gzero (^TYPE 0)
[("E", ^mkDef GZero (^TYPE 0)
(^Eq0 (^FT "A" 0) (^FT "a" 0) (^FT "a'" 0))),
("W", ^mkDef gzero (^TYPE 0) (^And (^FT "E" 0) (^FT "E" 0)))]} $
("W", ^mkDef GZero (^TYPE 0) (^And (^FT "E" 0) (^FT "E" 0)))]} $
equalE
(extendTyN [< (Any, "x", ^FT "W" 0),
(Any, "y", ^And (^FT "E" 0) (^FT "E" 0))] empty)
@ -278,11 +280,11 @@ tests = "equality & subtyping" :- [
"free var" :-
let au_bu = fromList
[("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
("B", ^mkDef gany (^TYPE 1) (^TYPE 0))]
[("A", ^mkDef GAny (^TYPE 1) (^TYPE 0)),
("B", ^mkDef GAny (^TYPE 1) (^TYPE 0))]
au_ba = fromList
[("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
("B", ^mkDef gany (^TYPE 1) (^FT "A" 0))]
[("A", ^mkDef GAny (^TYPE 1) (^TYPE 0)),
("B", ^mkDef GAny (^TYPE 1) (^FT "A" 0))]
in [
testEq "A = A" $
equalE empty (^F "A" 0) (^F "A" 0),
@ -303,13 +305,13 @@ tests = "equality & subtyping" :- [
testNeq "A ≮: B" $
subE empty (^F "A" 0) (^F "B" 0),
testEq "A : ★₃ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
{globals = fromList [("A", ^mkDef gany (^TYPE 3) (^TYPE 0)),
("B", ^mkDef gany (^TYPE 3) (^TYPE 2))]} $
{globals = fromList [("A", ^mkDef GAny (^TYPE 3) (^TYPE 0)),
("B", ^mkDef GAny (^TYPE 3) (^TYPE 2))]} $
subE empty (^F "A" 0) (^F "B" 0),
note "(A and B in different universes)",
testEq "A : ★₁ ≔ ★₀, B : ★₃ ≔ ★₂ ⊢ A <: B"
{globals = fromList [("A", ^mkDef gany (^TYPE 1) (^TYPE 0)),
("B", ^mkDef gany (^TYPE 3) (^TYPE 2))]} $
{globals = fromList [("A", ^mkDef GAny (^TYPE 1) (^TYPE 0)),
("B", ^mkDef GAny (^TYPE 3) (^TYPE 2))]} $
subE empty (^F "A" 0) (^F "B" 0),
testEq "0=1 ⊢ A <: B" $
subE empty01 (^F "A" 0) (^F "B" 0)

2
tests/Tests/FromPTerm.idr
View file

@ -85,7 +85,7 @@ tests = "PTerm → Term" :- [
],
"terms" :-
let defs = fromList [("f", mkDef gany (Nat noLoc) (Zero noLoc) noLoc)]
let defs = fromList [("f", mkDef GAny (Nat noLoc) (Zero noLoc) noLoc)]
-- doesn't have to be well typed yet, just well scoped
fromPTerm = runFromParser {defs} .
fromPTermWith [< "𝑖", "𝑗"] [< "A", "x", "y", "z"]

7
tests/Tests/Reduce.idr
View file

@ -19,10 +19,11 @@ runWhnf act = runSTErr $ do
parameters {0 isRedex : RedexTest tm} {auto _ : CanWhnf tm isRedex} {d, n : Nat}
{auto _ : (Eq (tm d n), Show (tm d n))}
{default empty defs : Definitions}
{default SOne sg : SQty}
private
testWhnf : String -> WhnfContext d n -> tm d n -> tm d n -> Test
testWhnf label ctx from to = test "\{label} (whnf)" $ do
result <- mapFst toInfo $ runWhnf $ whnf0 defs ctx from
result <- mapFst toInfo $ runWhnf $ whnf0 defs ctx sg from
unless (result == to) $ Left [("exp", show to), ("got", show result)]
private
@ -71,10 +72,10 @@ tests = "whnf" :- [
"definitions" :- [
testWhnf "a (transparent)" empty
{defs = fromList [("a", ^mkDef gzero (^TYPE 1) (^TYPE 0))]}
{defs = fromList [("a", ^mkDef GZero (^TYPE 1) (^TYPE 0))]}
(^F "a" 0) (^Ann (^TYPE 0) (^TYPE 1)),
testNoStep "a (opaque)" empty
{defs = fromList [("a", ^mkPostulate gzero (^TYPE 1))]}
{defs = fromList [("a", ^mkPostulate GZero (^TYPE 1))]}
(^F "a" 0)
],

234
tests/Tests/Typechecker.idr
View file

@ -87,28 +87,28 @@ apps = foldl (\f, s => ^App f s)
defGlobals : Definitions
defGlobals = fromList
[("A", ^mkPostulate gzero (^TYPE 0)),
("B", ^mkPostulate gzero (^TYPE 0)),
("C", ^mkPostulate gzero (^TYPE 1)),
("D", ^mkPostulate gzero (^TYPE 1)),
("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
[("A", ^mkPostulate GZero (^TYPE 0)),
("B", ^mkPostulate GZero (^TYPE 0)),
("C", ^mkPostulate GZero (^TYPE 1)),
("D", ^mkPostulate GZero (^TYPE 1)),
("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" 0) (^Arr One (^FT "A" 0) (^FT "B" 0)))),
("p", ^mkPostulate gany
("p", ^mkPostulate GAny
(^PiY One "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))),
("q", ^mkPostulate gany
("q", ^mkPostulate GAny
(^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)]
("refl", ^mkDef GAny reflTy reflDef),
("fst", ^mkDef GAny fstTy fstDef),
("snd", ^mkDef GAny sndTy sndDef)]
parameters (label : String) (act : Lazy (Eff Test ()))
{default defGlobals globals : Definitions}
@ -168,7 +168,7 @@ tests = "typechecker" :- [
testTC "0 · ★₀ ⇐ ★₁ # by checkType" $
checkType_ empty (^TYPE 0) (Just 1),
testTC "0 · ★₀ ⇐ ★₁ # by check" $
check_ empty szero (^TYPE 0) (^TYPE 1),
check_ empty SZero (^TYPE 0) (^TYPE 1),
testTC "0 · ★₀ ⇐ ★₂" $
checkType_ empty (^TYPE 0) (Just 2),
testTC "0 · ★₀ ⇐ ★_" $
@ -180,241 +180,241 @@ tests = "typechecker" :- [
testTC "0=1 ⊢ 0 · ★₁ ⇐ ★₀" $
checkType_ empty01 (^TYPE 1) (Just 0),
testTCFail "1 · ★₀ ⇍ ★₁ # by check" $
check_ empty sone (^TYPE 0) (^TYPE 1)
check_ empty SOne (^TYPE 0) (^TYPE 1)
],
"function types" :- [
note "A, B : ★₀; C, D : ★₁; P : 0.A → ★₀",
testTC "0 · 1.A → B ⇐ ★₀" $
check_ empty szero (^Arr One (^FT "A" 0) (^FT "B" 0)) (^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" 0) (^FT "B" 0)) (^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" 0) (^FT "D" 0)) (^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" 0) (^FT "D" 0)) (^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
check_ empty SZero
(^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" 0) (^FT "P" 0)) (^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" 0) (^FT "P" 0)) (^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" 0) (^FT "A" 0)) (^TYPE 0),
check_ empty SZero (^And (^FT "A" 0) (^FT "A" 0)) (^TYPE 0),
testTCFail "0 · A × P ⇍ ★₀" $
check_ empty szero (^And (^FT "A" 0) (^FT "P" 0)) (^TYPE 0),
check_ empty SZero (^And (^FT "A" 0) (^FT "P" 0)) (^TYPE 0),
testTC "0 · (x : A) × P x ⇐ ★₀" $
check_ empty szero
check_ empty SZero
(^SigY "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))
(^TYPE 0),
testTC "0 · (x : A) × P x ⇐ ★₁" $
check_ empty szero
check_ empty SZero
(^SigY "x" (^FT "A" 0) (E $ ^App (^F "P" 0) (^BVT 0)))
(^TYPE 1),
testTC "0 · (A : ★₀) × A ⇐ ★₁" $
check_ empty szero
check_ empty SZero
(^SigY "A" (^TYPE 0) (^BVT 0))
(^TYPE 1),
testTCFail "0 · (A : ★₀) × A ⇍ ★₀" $
check_ empty szero
check_ empty SZero
(^SigY "A" (^TYPE 0) (^BVT 0))
(^TYPE 0),
testTCFail "1 · A × A ⇍ ★₀" $
check_ empty sone
check_ empty SOne
(^And (^FT "A" 0) (^FT "A" 0))
(^TYPE 0)
],
"enum types" :- [
testTC "0 · {} ⇐ ★₀" $ check_ empty szero (^enum []) (^TYPE 0),
testTC "0 · {} ⇐ ★₃" $ check_ empty 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_ empty szero (^enum ["a", "b", "c"]) (^TYPE 0),
check_ empty SZero (^enum ["a", "b", "c"]) (^TYPE 0),
testTC "0 · {a,b,c} ⇐ ★₃" $
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)
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 empty szero (^F "A" 0) (^TYPE 0),
inferAs empty SZero (^F "A" 0) (^TYPE 0),
testTC "0 · [A] ⇐ ★₀" $
check_ empty szero (^FT "A" 0) (^TYPE 0),
check_ empty SZero (^FT "A" 0) (^TYPE 0),
note "subtyping",
testTC "0 · [A] ⇐ ★₁" $
check_ empty szero (^FT "A" 0) (^TYPE 1),
check_ empty SZero (^FT "A" 0) (^TYPE 1),
note "(fail) runtime-relevant type",
testTCFail "1 · A ⇏ ★₀" $
infer_ empty sone (^F "A" 0),
infer_ empty SOne (^F "A" 0),
testTC "1 . f ⇒ 1.A → A" $
inferAs empty sone (^F "f" 0) (^Arr One (^FT "A" 0) (^FT "A" 0)),
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" 0) (^Arr One (^FT "A" 0) (^FT "A" 0)),
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" 0) (^Arr Zero (^FT "A" 0) (^FT "A" 0)),
check_ empty SOne (^FT "f" 0) (^Arr Zero (^FT "A" 0) (^FT "A" 0)),
testTCFail "1 . f ⇍ ω.A → A" $
check_ empty sone (^FT "f" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)),
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
check_ empty SOne
(^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
check_ empty SOne
(^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
check_ empty SOne
(^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ω" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)),
inferAs empty SOne (^F "fω" 0) (^Arr Any (^FT "A" 0) (^FT "A" 0)),
testTC "1 . (λ x ⇒ fω x) ⇐ ω.A → A" $
check_ empty sone
check_ empty SOne
(^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
check_ empty SOne
(^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
check_ empty SOne
(^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" 0) reflTy,
testTC "1 · [refl] ⇐ ⋯" $ check_ empty sone (^FT "refl" 0) 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" 0)]) sone
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" 0)]) sone (^BVT 0) (^FT "A" 0) [< 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" 0)]) sone
inferAsQ (ctx [< ("x", ^FT "A" 0)]) SOne
(^App (^App (^F "f2" 0) (^BVT 0)) (^BVT 0)) (^FT "B" 0) [< Any]
],
"lambda" :- [
note "linear & unrestricted identity",
testTC "1 · (λ x ⇒ x) ⇐ A → A" $
check_ empty sone
check_ empty SOne
(^LamY "x" (^BVT 0))
(^Arr One (^FT "A" 0) (^FT "A" 0)),
testTC "1 · (λ x ⇒ x) ⇐ ω.A → A" $
check_ empty sone
check_ empty SOne
(^LamY "x" (^BVT 0))
(^Arr Any (^FT "A" 0) (^FT "A" 0)),
note "(fail) zero binding used relevantly",
testTCFail "1 · (λ x ⇒ x) ⇍ 0.A → A" $
check_ empty sone
check_ empty SOne
(^LamY "x" (^BVT 0))
(^Arr Zero (^FT "A" 0) (^FT "A" 0)),
note "(but ok in overall erased context)",
testTC "0 · (λ x ⇒ x) ⇐ A ⇾ A" $
check_ empty szero
check_ empty SZero
(^LamY "x" (^BVT 0))
(^Arr Zero (^FT "A" 0) (^FT "A" 0)),
testTC "1 · (λ A x ⇒ refl A x) ⇐ ⋯ # (type of refl)" $
check_ empty sone
check_ empty SOne
(^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
check_ empty SOne reflDef reflTy
],
"pairs" :- [
testTC "1 · (a, a) ⇐ A × A" $
check_ empty sone
check_ empty SOne
(^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" 0)]) sone
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
check_ empty SOne
(^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" 0) (^FT "A" 0))]) sone
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" 0) (^FT "A" 0))]) sone
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" 0) (^FT "A" 0))]) szero
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" 0) (^FT "A" 0))]) sone
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" 0) (^FT "B" 0))]) sone
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" 0) [< Any],
testTC "x : A × B ⊢ 0 · (case1 x return A of (l,r) ⇒ l) ⇒ A ⊳ 0·x" $
inferAsQ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) szero
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" 0) [< Zero],
testTCFail "x : A × B ⊢ 1 · (case1 x return A of (l,r) ⇒ l) ⇏" $
infer_ (ctx [< ("x", ^And (^FT "A" 0) (^FT "B" 0))]) sone
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 " ≔ (λ A B p ⇒ caseω p return A of (x, y) ⇒ x)",
testTC "0 · ‹type of fst› ⇐ ★₁" $
check_ empty szero fstTy (^TYPE 1),
check_ empty SZero fstTy (^TYPE 1),
testTC "1 · ‹def of fst› ⇐ ‹type of fst›" $
check_ empty 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_ empty szero sndTy (^TYPE 1),
check_ empty SZero sndTy (^TYPE 1),
testTC "1 · ‹def of snd› ⇐ ‹type of snd›" $
check_ empty sone sndDef sndTy,
check_ empty SOne sndDef sndTy,
testTC "0 · snd A P ⇒ ω.(p : (x : A) × P x) → P (fst A P p)" $
inferAs empty szero
inferAs empty SZero
(^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
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
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
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
inferAs empty SZero
(apps (^F "fst" 1)
[^TYPE 0, ^LamN (^TYPE 0), ^Pair (^FT "A" 0) (^FT "B" 0)])
(^TYPE 0)
@ -422,23 +422,23 @@ tests = "typechecker" :- [
"enums" :- [
testTC "1 · 'a ⇐ {a}" $
check_ empty sone (^Tag "a") (^enum ["a"]),
check_ empty SOne (^Tag "a") (^enum ["a"]),
testTC "1 · 'a ⇐ {a, b, c}" $
check_ empty sone (^Tag "a") (^enum ["a", "b", "c"]),
check_ empty SOne (^Tag "a") (^enum ["a", "b", "c"]),
testTCFail "1 · 'a ⇍ {b, c}" $
check_ empty sone (^Tag "a") (^enum ["b", "c"]),
check_ empty SOne (^Tag "a") (^enum ["b", "c"]),
testTC "0=1 ⊢ 1 · 'a ⇐ {b, c}" $
check_ empty01 sone (^Tag "a") (^enum ["b", "c"])
check_ empty01 SOne (^Tag "a") (^enum ["b", "c"])
],
"enum matching" :- [
testTC "ω.x : {tt} ⊢ 1 · case1 x return {tt} of { 'tt ⇒ 'tt } ⇒ {tt}" $
inferAs (ctx [< ("x", ^enum ["tt"])]) sone
inferAs (ctx [< ("x", ^enum ["tt"])]) SOne
(^CaseEnum One (^BV 0) (SN (^enum ["tt"]))
(singleton "tt" (^Tag "tt")))
(^enum ["tt"]),
testTCFail "ω.x : {tt} ⊢ 1 · case1 x return {tt} of { 'ff ⇒ 'tt } ⇏" $
infer_ (ctx [< ("x", ^enum ["tt"])]) sone
infer_ (ctx [< ("x", ^enum ["tt"])]) SOne
(^CaseEnum One (^BV 0) (SN (^enum ["tt"]))
(singleton "ff" (^Tag "tt")))
],
@ -447,44 +447,44 @@ tests = "typechecker" :- [
testTC "0 · ℕ ≡ ℕ : ★₀ ⇐ Type" $
checkType_ empty (^Eq0 (^TYPE 0) nat nat) Nothing,
testTC "0 · ℕ ≡ ℕ : ★₀ ⇐ ★₁" $
check_ empty szero (^Eq0 (^TYPE 0) nat nat) (^TYPE 1),
check_ empty SZero (^Eq0 (^TYPE 0) nat nat) (^TYPE 1),
testTCFail "1 · ℕ ≡ ℕ : ★₀ ⇍ ★₁" $
check_ empty sone (^Eq0 (^TYPE 0) nat nat) (^TYPE 1),
check_ empty SOne (^Eq0 (^TYPE 0) nat nat) (^TYPE 1),
testTC "0 · ℕ ≡ ℕ : ★₀ ⇐ ★₂" $
check_ empty szero (^Eq0 (^TYPE 0) nat nat) (^TYPE 2),
check_ empty SZero (^Eq0 (^TYPE 0) nat nat) (^TYPE 2),
testTC "0 · ℕ ≡ ℕ : ★₁ ⇐ ★₂" $
check_ empty szero (^Eq0 (^TYPE 1) nat nat) (^TYPE 2),
check_ empty SZero (^Eq0 (^TYPE 1) nat nat) (^TYPE 2),
testTCFail "0 · ℕ ≡ ℕ : ★₁ ⇍ ★₁" $
check_ empty szero (^Eq0 (^TYPE 1) nat nat) (^TYPE 1),
check_ empty SZero (^Eq0 (^TYPE 1) nat nat) (^TYPE 1),
testTCFail "0 ≡ 'beep : {beep} ⇍ Type" $
checkType_ empty
(^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" 0) (^FT "B" 0)),
("x", ^FT "A" 0), ("y", ^FT "B" 0)]) szero
("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" 0) (^FT "B" 0)),
("x", ^FT "A" 0), ("y", ^FT "B" 0)]) szero
("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" 0))
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
check_ empty SZero
(^LamY "p" (^LamY "q" (^DLamN (^BVT 1))))
(^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
check_ empty SZero
(^LamY "p" (^LamY "q" (^DLamN (^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))
@ -493,15 +493,15 @@ tests = "typechecker" :- [
],
"natural numbers" :- [
testTC "0 · ℕ ⇐ ★₀" $ check_ empty szero nat (^TYPE 0),
testTC "0 · ℕ ⇐ ★₇" $ check_ empty szero nat (^TYPE 7),
testTCFail "1 · ℕ ⇍ ★₀" $ check_ empty sone nat (^TYPE 0),
testTC "1 · zero ⇐ ℕ" $ check_ empty sone (^Zero) nat,
testTCFail "1 · zero ⇍ ℕ×ℕ" $ check_ empty sone (^Zero) (^And nat nat),
testTC "0 · ℕ ⇐ ★₀" $ check_ empty SZero nat (^TYPE 0),
testTC "0 · ℕ ⇐ ★₇" $ check_ empty SZero nat (^TYPE 7),
testTCFail "1 · ℕ ⇍ ★₀" $ check_ empty SOne nat (^TYPE 0),
testTC "1 · zero ⇐ ℕ" $ check_ empty SOne (^Zero) nat,
testTCFail "1 · zero ⇍ ℕ×ℕ" $ check_ empty SOne (^Zero) (^And nat nat),
testTC "ω·n : ℕ ⊢ 1 · succ n ⇐ ℕ" $
check_ (ctx [< ("n", nat)]) sone (^Succ (^BVT 0)) nat,
check_ (ctx [< ("n", nat)]) SOne (^Succ (^BVT 0)) nat,
testTC "1 · λ n ⇒ succ n ⇐ 1.ℕ → ℕ" $
check_ empty sone
check_ empty SOne
(^LamY "n" (^Succ (^BVT 0)))
(^Arr One nat nat)
],
@ -510,7 +510,7 @@ tests = "typechecker" :- [
note "1 · λ n ⇒ case1 n return ℕ of { zero ⇒ 0; succ n ⇒ n }",
note " ⇐ 1.ℕ → ℕ",
testTC "pred" $
check_ empty sone
check_ empty SOne
(^LamY "n" (E $
^CaseNat One Zero (^BV 0) (SN nat)
(^Zero) (SY [< "n", ^BN Unused] $ ^BVT 1)))
@ -518,7 +518,7 @@ tests = "typechecker" :- [
note "1 · λ m n ⇒ case1 m return ℕ of { zero ⇒ n; succ _, 1.p ⇒ succ p }",
note " ⇐ 1.ℕ → 1.ℕ → 1.ℕ",
testTC "plus" $
check_ empty sone
check_ empty SOne
(^LamY "m" (^LamY "n" (E $
^CaseNat One One (^BV 1) (SN nat)
(^BVT 0)
@ -528,11 +528,11 @@ tests = "typechecker" :- [
"box types" :- [
testTC "0 · [0.ℕ] ⇐ ★₀" $
check_ empty szero (^BOX Zero nat) (^TYPE 0),
check_ empty SZero (^BOX Zero nat) (^TYPE 0),
testTC "0 · [0.★₀] ⇐ ★₁" $
check_ empty szero (^BOX Zero (^TYPE 0)) (^TYPE 1),
check_ empty SZero (^BOX Zero (^TYPE 0)) (^TYPE 1),
testTCFail "0 · [0.★₀] ⇍ ★₀" $
check_ empty szero (^BOX Zero (^TYPE 0)) (^TYPE 0)
check_ empty SZero (^BOX Zero (^TYPE 0)) (^TYPE 0)
],
todo "box values",
@ -540,7 +540,7 @@ tests = "typechecker" :- [
"type-case" :- [
testTC "0 · type-case ℕ ∷ ★₀ return ★₀ of { _ ⇒ ℕ } ⇒ ★₀" $
inferAs empty szero
inferAs empty SZero
(^TypeCase (^Ann nat (^TYPE 0)) (^TYPE 0) empty nat)
(^TYPE 0)
],
@ -555,7 +555,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_ empty sone
check_ empty SOne
([< "x", "y", "xy"] :\\ [< "i"] :\\% E (F "p" :@ E (BV 0 :% BV 0)))
(PiY Zero "x" (FT "A") $
PiY Zero "y" (FT "A") $
@ -568,7 +568,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_ empty sone
check_ empty SOne
([< "eq"] :\\ [< "i"] :\\% [< "x"] :\\ E (BV 1 :@ BVT 0 :% BV 0))
(PiY One "eq"
(PiY One "x" (FT "A")