more equality & tests
This commit is contained in:
parent
3b9da2a1e5
commit
a6f43a772e
7 changed files with 361 additions and 207 deletions
|
|
@ -15,7 +15,7 @@ M = ReaderT (Definitions Three) $ Either (Error Three)
|
|||
reflTy : IsQty q => Term q d n
|
||||
reflTy =
|
||||
Pi zero "A" (TYPE 0) $ TUsed $
|
||||
Pi zero "x" (BVT 0) $ TUsed $
|
||||
Pi one "x" (BVT 0) $ TUsed $
|
||||
Eq0 (BVT 1) (BVT 0) (BVT 0)
|
||||
|
||||
reflDef : IsQty q => Term q d n
|
||||
|
|
@ -27,9 +27,13 @@ defGlobals = fromList
|
|||
("B", mkAbstract Zero $ TYPE 0),
|
||||
("C", mkAbstract Zero $ TYPE 1),
|
||||
("D", mkAbstract Zero $ TYPE 1),
|
||||
("P", mkAbstract Zero $ Arr Any (FT "A") (TYPE 0)),
|
||||
("a", mkAbstract Any $ FT "A"),
|
||||
("b", mkAbstract Any $ FT "B"),
|
||||
("f", mkAbstract Any $ Arr One (FT "A") (FT "A")),
|
||||
("g", mkAbstract Any $ Arr One (FT "A") (FT "B")),
|
||||
("p", mkAbstract Any $ Pi One "x" (FT "A") $ TUsed $ E $ F "P" :@ BVT 0),
|
||||
("q", mkAbstract Any $ Pi One "x" (FT "A") $ TUsed $ E $ F "P" :@ BVT 0),
|
||||
("refl", mkDef Any reflTy reflDef)]
|
||||
|
||||
parameters (label : String) (act : Lazy (M ()))
|
||||
|
|
@ -79,60 +83,81 @@ tests = "typechecker" :- [
|
|||
|
||||
"function types" :- [
|
||||
note "A, B : ★₀; C, D : ★₁",
|
||||
testTC "0 · (1·A) → B ⇐ ★₀" $
|
||||
testTC "0 · A ⊸ B ⇐ ★₀" $
|
||||
check_ (ctx [<]) szero (Arr One (FT "A") (FT "B")) (TYPE 0),
|
||||
testTC "0 · (1·A) → B ⇐ ★₁👈" $
|
||||
note "subtyping",
|
||||
testTC "0 · A ⊸ B ⇐ ★₁" $
|
||||
check_ (ctx [<]) szero (Arr One (FT "A") (FT "B")) (TYPE 1),
|
||||
testTC "0 · (1·C) → D ⇐ ★₁" $
|
||||
testTC "0 · C ⊸ D ⇐ ★₁" $
|
||||
check_ (ctx [<]) szero (Arr One (FT "C") (FT "D")) (TYPE 1),
|
||||
testTCFail "0 · (1·C) → D ⇍ ★₀" $
|
||||
testTCFail "0 · C ⊸ D ⇍ ★₀" $
|
||||
check_ (ctx [<]) szero (Arr One (FT "C") (FT "D")) (TYPE 0)
|
||||
],
|
||||
|
||||
"free vars" :- [
|
||||
note "A : ★₀",
|
||||
testTC "0 · A ⇒ ★₀" $
|
||||
inferAs (ctx [<]) szero (F "A") (TYPE 0),
|
||||
testTC "0 · A ⇐👈 ★₀" $
|
||||
note "check",
|
||||
testTC "0 · A ⇐ ★₀" $
|
||||
check_ (ctx [<]) szero (FT "A") (TYPE 0),
|
||||
testTC "0 · A ⇐ ★₁👈" $
|
||||
note "subtyping",
|
||||
testTC "0 · A ⇐ ★₁" $
|
||||
check_ (ctx [<]) szero (FT "A") (TYPE 1),
|
||||
testTCFail "1👈 · A ⇏ ★₀" $
|
||||
note "(fail) runtime-relevant type",
|
||||
testTCFail "1 · A ⇏ ★₀" $
|
||||
infer_ (ctx [<]) sone (F "A"),
|
||||
note "refl : (0·A : ★₀) → (0·x : A) → (x ≡ x : A) ≔ (λ A x ⇒ λᴰ _ ⇒ x)",
|
||||
testTC "1 · refl ⇒ {type of refl}" $
|
||||
inferAs (ctx [<]) sone (F "refl") reflTy,
|
||||
testTC "1 · refl ⇐ {type of refl}" $
|
||||
check_ (ctx [<]) sone (FT "refl") reflTy
|
||||
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
|
||||
],
|
||||
|
||||
"lambda" :- [
|
||||
testTC #"1 · (λ A x ⇒ refl A x) ⇐ {type of refl, see "free vars"}"# $
|
||||
note "linear & unrestricted identity",
|
||||
testTC "1 · (λ x ⇒ x) ⇐ A ⊸ A" $
|
||||
check_ (ctx [<]) 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")),
|
||||
note "(fail) zero binding used relevantly",
|
||||
testTCFail "1 · (λ x ⇒ x) ⇍ A ⇾ A" $
|
||||
check_ (ctx [<]) 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")),
|
||||
testTC "1 · (λ A x ⇒ refl A x) ⇐ ⋯ # (type of refl)" $
|
||||
check_ (ctx [<]) sone
|
||||
(["A", "x"] :\\ E (F "refl" :@@ [BVT 1, BVT 0]))
|
||||
reflTy
|
||||
reflTy,
|
||||
testTC "1 · (λ A x ⇒ λᴰ i ⇒ x) ⇐ ⋯ # (def. and type of refl)" $
|
||||
check_ (ctx [<]) sone reflDef reflTy
|
||||
],
|
||||
|
||||
"misc" :- [
|
||||
testTC "funext"
|
||||
{globals = fromList
|
||||
[("A", mkAbstract Zero $ TYPE 0),
|
||||
("B", mkAbstract Zero $ Arr Any (FT "A") (TYPE 0)),
|
||||
("f", mkAbstract Any $
|
||||
Pi Any "x" (FT "A") $ TUsed $ E $ F "B" :@ BVT 0),
|
||||
("g", mkAbstract Any $
|
||||
Pi Any "x" (FT "A") $ TUsed $ E $ F "B" :@ BVT 0)]} $
|
||||
-- 0·A : Type, 0·B : ω·A → Type,
|
||||
-- ω·f, g : (ω·x : A) → B x
|
||||
-- ⊢
|
||||
-- 0·funext : (ω·eq : (0·x : A) → f x ≡ g x) → f ≡ g
|
||||
-- = λ eq ⇒ λᴰ i ⇒ λ x ⇒ eq x i
|
||||
check_ (ctx [<]) szero
|
||||
note "0·A : Type, 0·P : A → Type, ω·p : (1·x : A) → P x",
|
||||
note "⊢",
|
||||
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
|
||||
(["x", "y", "xy"] :\\ ["i"] :\\% E (F "p" :@ E (BV 0 :% BV 0)))
|
||||
(Pi Zero "x" (FT "A") $ TUsed $
|
||||
Pi Zero "y" (FT "A") $ TUsed $
|
||||
Pi One "xy" (Eq0 (FT "A") (BVT 1) (BVT 0)) $ TUsed $
|
||||
Eq "i" (DUsed $ E $ F "P" :@ E (BV 0 :% BV 0))
|
||||
(E $ F "p" :@ BVT 2) (E $ F "p" :@ BVT 1)),
|
||||
note "0·A : Type, 0·P : ω·A → Type,",
|
||||
note "ω·p, q : (1·x : A) → P x",
|
||||
note "⊢",
|
||||
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
|
||||
(["eq"] :\\ ["i"] :\\% ["x"] :\\ E (BV 1 :@ BVT 0 :% BV 0))
|
||||
(Pi Any "eq"
|
||||
(Pi Zero "x" (FT "A") $ TUsed $
|
||||
Eq0 (E $ F "B" :@ BVT 0)
|
||||
(E $ F "f" :@ BVT 0) (E $ F "g" :@ BVT 0)) $ TUsed $
|
||||
Eq0 (Pi Any "x" (FT "A") $ TUsed $ E $ F "B" :@ BVT 0)
|
||||
(FT "f") (FT "g"))
|
||||
(Pi One "eq"
|
||||
(Pi One "x" (FT "A") $ TUsed $
|
||||
Eq0 (E $ F "P" :@ BVT 0)
|
||||
(E $ F "p" :@ BVT 0) (E $ F "q" :@ BVT 0)) $ TUsed $
|
||||
Eq0 (Pi Any "x" (FT "A") $ TUsed $ E $ F "P" :@ BVT 0)
|
||||
(FT "p") (FT "q"))
|
||||
]
|
||||
]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue