re-add tightening and use it when messing with scopes
e.g. "coe [_ ⇒ A] @p @q s" should immediately reduce to "s", but if the "_ ⇒ A" happened to use an SY it didn't. this will still happen if a wrong SY sneaks in but the alternative is re-traversing the term over and over every time whnf runs
This commit is contained in:
parent
a5ccf0215a
commit
3fb8580f85
16 changed files with 534 additions and 304 deletions
|
|
@ -33,8 +33,8 @@ inj = rethrow . mapFst TCError <=< lift . runExcept
|
|||
|
||||
reflTy : Term d n
|
||||
reflTy =
|
||||
Pi_ Zero "A" (TYPE 0) $
|
||||
Pi_ One "x" (BVT 0) $
|
||||
PiY Zero "A" (TYPE 0) $
|
||||
PiY One "x" (BVT 0) $
|
||||
Eq0 (BVT 1) (BVT 0) (BVT 0)
|
||||
|
||||
reflDef : Term d n
|
||||
|
|
@ -43,9 +43,9 @@ reflDef = [< "A","x"] :\\ [< "i"] :\\% BVT 0
|
|||
|
||||
fstTy : Term d n
|
||||
fstTy =
|
||||
(Pi_ Zero "A" (TYPE 1) $
|
||||
Pi_ Zero "B" (Arr Any (BVT 0) (TYPE 1)) $
|
||||
Arr Any (Sig_ "x" (BVT 1) $ E $ BV 1 :@ BVT 0) (BVT 1))
|
||||
(PiY Zero "A" (TYPE 1) $
|
||||
PiY Zero "B" (Arr Any (BVT 0) (TYPE 1)) $
|
||||
Arr Any (SigY "x" (BVT 1) $ E $ BV 1 :@ BVT 0) (BVT 1))
|
||||
|
||||
fstDef : Term d n
|
||||
fstDef =
|
||||
|
|
@ -54,9 +54,9 @@ fstDef =
|
|||
|
||||
sndTy : Term d n
|
||||
sndTy =
|
||||
(Pi_ Zero "A" (TYPE 1) $
|
||||
Pi_ Zero "B" (Arr Any (BVT 0) (TYPE 1)) $
|
||||
Pi_ Any "p" (Sig_ "x" (BVT 1) $ E $ BV 1 :@ BVT 0) $
|
||||
(PiY Zero "A" (TYPE 1) $
|
||||
PiY Zero "B" (Arr Any (BVT 0) (TYPE 1)) $
|
||||
PiY Any "p" (SigY "x" (BVT 1) $ E $ BV 1 :@ BVT 0) $
|
||||
E (BV 1 :@ E (F "fst" :@@ [BVT 2, BVT 1, BVT 0])))
|
||||
|
||||
sndDef : Term d n
|
||||
|
|
@ -80,8 +80,8 @@ defGlobals = fromList
|
|||
("f", mkPostulate gany $ Arr One (FT "A") (FT "A")),
|
||||
("g", mkPostulate gany $ Arr One (FT "A") (FT "B")),
|
||||
("f2", mkPostulate gany $ Arr One (FT "A") $ Arr One (FT "A") (FT "B")),
|
||||
("p", mkPostulate gany $ Pi_ One "x" (FT "A") $ E $ F "P" :@ BVT 0),
|
||||
("q", mkPostulate gany $ Pi_ One "x" (FT "A") $ E $ F "P" :@ BVT 0),
|
||||
("p", mkPostulate gany $ PiY One "x" (FT "A") $ E $ F "P" :@ BVT 0),
|
||||
("q", mkPostulate gany $ PiY One "x" (FT "A") $ E $ F "P" :@ BVT 0),
|
||||
("refl", mkDef gany reflTy reflDef),
|
||||
("fst", mkDef gany fstTy fstDef),
|
||||
("snd", mkDef gany sndTy sndDef)]
|
||||
|
|
@ -185,7 +185,7 @@ tests = "typechecker" :- [
|
|||
check_ empty szero (Arr One (FT "C") (FT "D")) (TYPE 0),
|
||||
testTC "0 · (1·x : A) → P x ⇐ ★₀" $
|
||||
check_ empty szero
|
||||
(Pi_ One "x" (FT "A") $ E $ F "P" :@ BVT 0)
|
||||
(PiY One "x" (FT "A") $ E $ F "P" :@ BVT 0)
|
||||
(TYPE 0),
|
||||
testTCFail "0 · A ⊸ P ⇍ ★₀" $
|
||||
check_ empty szero (Arr One (FT "A") $ FT "P") (TYPE 0),
|
||||
|
|
@ -201,14 +201,14 @@ tests = "typechecker" :- [
|
|||
check_ empty szero (FT "A" `And` FT "P") (TYPE 0),
|
||||
testTC "0 · (x : A) × P x ⇐ ★₀" $
|
||||
check_ empty szero
|
||||
(Sig_ "x" (FT "A") $ E $ F "P" :@ BVT 0) (TYPE 0),
|
||||
(SigY "x" (FT "A") $ E $ F "P" :@ BVT 0) (TYPE 0),
|
||||
testTC "0 · (x : A) × P x ⇐ ★₁" $
|
||||
check_ empty szero
|
||||
(Sig_ "x" (FT "A") $ E $ F "P" :@ BVT 0) (TYPE 1),
|
||||
(SigY "x" (FT "A") $ E $ F "P" :@ BVT 0) (TYPE 1),
|
||||
testTC "0 · (A : ★₀) × A ⇐ ★₁" $
|
||||
check_ empty szero (Sig_ "A" (TYPE 0) $ BVT 0) (TYPE 1),
|
||||
check_ empty szero (SigY "A" (TYPE 0) $ BVT 0) (TYPE 1),
|
||||
testTCFail "0 · (A : ★₀) × A ⇍ ★₀" $
|
||||
check_ empty szero (Sig_ "A" (TYPE 0) $ BVT 0) (TYPE 0),
|
||||
check_ empty szero (SigY "A" (TYPE 0) $ BVT 0) (TYPE 0),
|
||||
testTCFail "1 · A × A ⇍ ★₀" $
|
||||
check_ empty sone (FT "A" `And` FT "A") (TYPE 0)
|
||||
],
|
||||
|
|
@ -282,7 +282,7 @@ tests = "typechecker" :- [
|
|||
testTC "1 · (a, δ i ⇒ a) ⇐ (x : A) × (x ≡ a)" $
|
||||
check_ empty sone
|
||||
(Pair (FT "a") ([< "i"] :\\% FT "a"))
|
||||
(Sig_ "x" (FT "A") $ Eq0 (FT "A") (BVT 0) (FT "a"))
|
||||
(SigY "x" (FT "A") $ Eq0 (FT "A") (BVT 0) (FT "a"))
|
||||
],
|
||||
|
||||
"unpairing" :- [
|
||||
|
|
@ -334,7 +334,7 @@ tests = "typechecker" :- [
|
|||
testTC "0 · snd ★₀ (λ x ⇒ x) ⇒ (ω·p : (A : ★₀) × A) → fst ★₀ (λ x ⇒ x) p" $
|
||||
inferAs empty szero
|
||||
(F "snd" :@@ [TYPE 0, [< "x"] :\\ BVT 0])
|
||||
(Pi_ Any "A" (Sig_ "A" (TYPE 0) $ BVT 0) $
|
||||
(PiY Any "A" (SigY "A" (TYPE 0) $ BVT 0) $
|
||||
(E $ F "fst" :@@ [TYPE 0, [< "x"] :\\ BVT 0, BVT 0]))
|
||||
],
|
||||
|
||||
|
|
@ -395,14 +395,14 @@ tests = "typechecker" :- [
|
|||
testTC "0 · (λ p q ⇒ δ i ⇒ p) ⇐ (ω·p q : a ≡ a') → p ≡ q" $
|
||||
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")) $
|
||||
(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)),
|
||||
testTC "0 · (λ p q ⇒ δ i ⇒ q) ⇐ (ω·p q : a ≡ a') → p ≡ q" $
|
||||
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")) $
|
||||
(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))
|
||||
],
|
||||
|
||||
|
|
@ -463,10 +463,10 @@ tests = "typechecker" :- [
|
|||
testTC "cong" $
|
||||
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") $
|
||||
Pi_ One "xy" (Eq0 (FT "A") (BVT 1) (BVT 0)) $
|
||||
Eq_ "i" (E $ F "P" :@ E (BV 0 :% BV 0))
|
||||
(PiY Zero "x" (FT "A") $
|
||||
PiY Zero "y" (FT "A") $
|
||||
PiY One "xy" (Eq0 (FT "A") (BVT 1) (BVT 0)) $
|
||||
EqY "i" (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",
|
||||
|
|
@ -476,11 +476,11 @@ tests = "typechecker" :- [
|
|||
testTC "funext" $
|
||||
check_ empty sone
|
||||
([< "eq"] :\\ [< "i"] :\\% [< "x"] :\\ E (BV 1 :@ BVT 0 :% BV 0))
|
||||
(Pi_ One "eq"
|
||||
(Pi_ One "x" (FT "A")
|
||||
(PiY One "eq"
|
||||
(PiY One "x" (FT "A")
|
||||
(Eq0 (E $ F "P" :@ BVT 0)
|
||||
(E $ F "p" :@ BVT 0) (E $ F "q" :@ BVT 0)))
|
||||
(Eq0 (Pi_ Any "x" (FT "A") $ E $ F "P" :@ BVT 0) (FT "p") (FT "q"))),
|
||||
(Eq0 (PiY Any "x" (FT "A") $ E $ F "P" :@ BVT 0) (FT "p") (FT "q"))),
|
||||
todo "absurd (when coerce is in)"
|
||||
-- absurd : (`true ≡ `false : {true, false}) ⇾ (0·A : ★₀) → A ≔
|
||||
-- λ e ⇒
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue