use NContext/SnocVect for scope name lists etc

This commit is contained in:
rhiannon morris 2023-03-16 18:18:49 +01:00
parent 32f38238ef
commit 6dc7177be5
12 changed files with 165 additions and 134 deletions

View file

@ -16,7 +16,7 @@ defGlobals = fromList
("a'", mkPostulate Any $ FT "A"),
("b", mkPostulate Any $ FT "B"),
("f", mkPostulate Any $ Arr One (FT "A") (FT "A")),
("id", mkDef Any (Arr One (FT "A") (FT "A")) (["x"] :\\ BVT 0)),
("id", mkDef Any (Arr One (FT "A") (FT "A")) ([< "x"] :\\ BVT 0)),
("eq-AB", mkPostulate Zero $ Eq0 (TYPE 0) (FT "A") (FT "B"))]
parameters (label : String) (act : Lazy (M ()))
@ -126,31 +126,31 @@ tests = "equality & subtyping" :- [
"lambda" :- [
testEq "λ x ⇒ [x] = λ x ⇒ [x]" $
equalT empty (Arr One (FT "A") (FT "A"))
(["x"] :\\ BVT 0)
(["x"] :\\ BVT 0),
([< "x"] :\\ BVT 0)
([< "x"] :\\ BVT 0),
testEq "λ x ⇒ [x] <: λ x ⇒ [x]" $
subT empty (Arr One (FT "A") (FT "A"))
(["x"] :\\ BVT 0)
(["x"] :\\ BVT 0),
([< "x"] :\\ BVT 0)
([< "x"] :\\ BVT 0),
testEq "λ x ⇒ [x] = λ y ⇒ [y]" $
equalT empty (Arr One (FT "A") (FT "A"))
(["x"] :\\ BVT 0)
(["y"] :\\ BVT 0),
([< "x"] :\\ BVT 0)
([< "y"] :\\ BVT 0),
testEq "λ x ⇒ [x] <: λ y ⇒ [y]" $
equalT empty (Arr One (FT "A") (FT "A"))
(["x"] :\\ BVT 0)
(["y"] :\\ BVT 0),
([< "x"] :\\ BVT 0)
([< "y"] :\\ BVT 0),
testNeq "λ x y ⇒ [x] ≠ λ x y ⇒ [y]" $
equalT empty (Arr One (FT "A") $ Arr One (FT "A") (FT "A"))
(["x", "y"] :\\ BVT 1)
(["x", "y"] :\\ BVT 0),
([< "x", "y"] :\\ BVT 1)
([< "x", "y"] :\\ BVT 0),
testEq "λ x ⇒ [a] = λ x ⇒ [a] (Y vs N)" $
equalT empty (Arr Zero (FT "B") (FT "A"))
(Lam $ SY ["x"] $ FT "a")
(Lam $ SN $ FT "a"),
(Lam $ SY [< "x"] $ FT "a")
(Lam $ SN $ FT "a"),
testEq "λ x ⇒ [f [x]] = [f] (η)" $
equalT empty (Arr One (FT "A") (FT "A"))
(["x"] :\\ E (F "f" :@ BVT 0))
([< "x"] :\\ E (F "f" :@ BVT 0))
(FT "f")
],
@ -168,7 +168,7 @@ tests = "equality & subtyping" :- [
"equalities and uip" :-
let refl : Term q d n -> Term q d n -> Elim q d n
refl a x = (DLam $ S ["_"] $ N x) :# (Eq0 a x x)
refl a x = (DLam $ S [< "_"] $ N x) :# (Eq0 a x x)
in
[
note #""refl [A] x" is an abbreviation for "(δ i ⇒ x)(x ≡ x : A)""#,
@ -217,7 +217,7 @@ tests = "equality & subtyping" :- [
{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
Sig (FT "E") $ S [< "_"] $ N $ FT "E" in
equalE (extendTyN [< (Any, "x", ty), (Any, "y", ty)] empty)
(BV 0) (BV 1),
@ -250,12 +250,12 @@ tests = "equality & subtyping" :- [
(FT "b"),
testEq "(λy ⇒ [#1]){a} = λy ⇒ [a] : B ⇾ A (N)" $
equalT empty (Arr Zero (FT "B") (FT "A"))
(CloT (Lam $ S ["y"] $ N $ BVT 0) (F "a" ::: id))
(Lam $ S ["y"] $ N $ FT "a"),
(CloT (Lam $ S [< "y"] $ N $ BVT 0) (F "a" ::: id))
(Lam $ S [< "y"] $ N $ FT "a"),
testEq "(λy ⇒ [#1]){a} = λy ⇒ [a] : B ⇾ A (Y)" $
equalT empty (Arr Zero (FT "B") (FT "A"))
(CloT (["y"] :\\ BVT 1) (F "a" ::: id))
(["y"] :\\ FT "a")
(CloT ([< "y"] :\\ BVT 1) (F "a" ::: id))
([< "y"] :\\ FT "a")
],
"term d-closure" :- [
@ -267,8 +267,8 @@ tests = "equality & subtyping" :- [
equalTD 1
(extendDim "𝑗" empty)
(Eq0 (FT "A") (FT "a") (FT "a"))
(DCloT (["i"] :\\% FT "a") (K Zero ::: id))
(["i"] :\\% FT "a"),
(DCloT ([< "i"] :\\% FT "a") (K Zero ::: id))
([< "i"] :\\% FT "a"),
note "it is hard to think of well-typed terms with big dctxs"
],
@ -334,20 +334,20 @@ tests = "equality & subtyping" :- [
subE empty (F "f" :@ FT "a") (F "f" :@ FT "a"),
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a = ([a ∷ A] ∷ A) (β)" $
equalE empty
(((["x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
(E (FT "a" :# FT "A") :# FT "A"),
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a = a (βυ)" $
equalE empty
(((["x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
(F "a"),
testEq "(λ g ⇒ [g [a]] ∷ ⋯)) [f] = (λ y ⇒ [f [y]] ∷ ⋯) [a] (β↘↙)" $
let a = FT "A"; a2a = (Arr One a a) in
equalE empty
(((["g"] :\\ E (BV 0 :@ FT "a")) :# Arr One a2a a) :@ FT "f")
(((["y"] :\\ E (F "f" :@ BVT 0)) :# a2a) :@ FT "a"),
((([< "g"] :\\ E (BV 0 :@ FT "a")) :# Arr One a2a a) :@ FT "f")
((([< "y"] :\\ E (F "f" :@ BVT 0)) :# a2a) :@ FT "a"),
testEq "(λ x ⇒ [x] ∷ A ⊸ A) a <: a" $
subE empty
(((["x"] :\\ BVT 0) :# (Arr One (FT "A") (FT "A"))) :@ FT "a")
((([< "x"] :\\ BVT 0) :# (Arr One (FT "A") (FT "A"))) :@ FT "a")
(F "a"),
note "id : A ⊸ A ≔ λ x ⇒ [x]",
testEq "id [a] = a" $ equalE empty (F "id" :@ FT "a") (F "a"),
@ -407,13 +407,13 @@ tests = "equality & subtyping" :- [
"annotation" :- [
testEq "(λ x ⇒ f [x]) ∷ A ⊸ A = [f] ∷ A ⊸ A" $
equalE empty
((["x"] :\\ E (F "f" :@ BVT 0)) :# Arr One (FT "A") (FT "A"))
(([< "x"] :\\ E (F "f" :@ BVT 0)) :# Arr One (FT "A") (FT "A"))
(FT "f" :# Arr One (FT "A") (FT "A")),
testEq "[f] ∷ A ⊸ A = f" $
equalE empty (FT "f" :# Arr One (FT "A") (FT "A")) (F "f"),
testEq "(λ x ⇒ f [x]) ∷ A ⊸ A = f" $
equalE empty
((["x"] :\\ E (F "f" :@ BVT 0)) :# Arr One (FT "A") (FT "A"))
(([< "x"] :\\ E (F "f" :@ BVT 0)) :# Arr One (FT "A") (FT "A"))
(F "f")
],

View file

@ -83,12 +83,14 @@ tests = "PTerm → Term" :- [
parsesAs term fromPTerm' "x" $ BVT 2,
parseFails term fromPTerm' "𝑖",
parsesAs term fromPTerm' "f" $ FT "f",
parsesAs term fromPTerm' "λ w ⇒ w" $ ["w"] :\\ BVT 0,
parsesAs term fromPTerm' "λ w ⇒ x" $ ["w"] :\\ BVT 3,
parsesAs term fromPTerm' "λ x ⇒ x" $ ["x"] :\\ BVT 0,
parsesAs term fromPTerm' "λ w ⇒ w" $ [< "w"] :\\ BVT 0,
parsesAs term fromPTerm' "λ w ⇒ x" $ [< "w"] :\\ BVT 3,
parsesAs term fromPTerm' "λ x ⇒ x" $ [< "x"] :\\ BVT 0,
parsesAs term fromPTerm' "λ a b ⇒ f a b" $
["a", "b"] :\\ E (F "f" :@@ [BVT 1, BVT 0]),
[< "a", "b"] :\\ E (F "f" :@@ [BVT 1, BVT 0]),
parsesAs term fromPTerm' "f @𝑖" $
E $ F "f" :% BV 1
]
],
todo "everything else"
]

View file

@ -29,9 +29,9 @@ tests = "whnf" :- [
testNoStep "[A] ⊸ [B]" $
Arr One (FT "A") (FT "B"),
testNoStep "(x: [A]) ⊸ [B [x]]" $
Pi One (FT "A") (S ["x"] $ Y $ E $ F "B" :@ BVT 0),
Pi One (FT "A") (S [< "x"] $ Y $ E $ F "B" :@ BVT 0),
testNoStep "λx. [x]" $
Lam $ S ["x"] $ Y $ BVT 0,
Lam $ S [< "x"] $ Y $ BVT 0,
testNoStep "[f [a]]" $
E $ F "f" :@ FT "a"
],
@ -51,7 +51,7 @@ tests = "whnf" :- [
(E (TYPE 1 :# TYPE 3))
(TYPE 1),
testWhnf "(λx. [x] ∷ [A] ⊸ [A]) [a]"
(((["x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
(F "a")
],
@ -87,28 +87,28 @@ tests = "whnf" :- [
"term closure" :- [
testWhnf "(λy. x){a/x}"
(CloT (Lam $ S ["y"] $ N $ BVT 0) (F "a" ::: id))
(Lam $ S ["y"] $ N $ FT "a"),
(CloT (Lam $ S [< "y"] $ N $ BVT 0) (F "a" ::: id))
(Lam $ S [< "y"] $ N $ FT "a"),
testWhnf "(λy. y){a/x}"
(CloT (["y"] :\\ BVT 0) (F "a" ::: id))
(["y"] :\\ BVT 0)
(CloT ([< "y"] :\\ BVT 0) (F "a" ::: id))
([< "y"] :\\ BVT 0)
],
"looking inside […]" :- [
testWhnf "[(λx. x ∷ A ⊸ A) [a]]"
(E $ ((["x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
(E $ (([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
(FT "a")
],
"nested redex" :- [
note "whnf only looks at top level redexes",
testNoStep "λy. [(λx. [x] ∷ [A] ⊸ [A]) [y]]" $
["y"] :\\ E (((["x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ BVT 0),
[< "y"] :\\ E ((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ BVT 0),
testNoStep "f [(λx. [x] ∷ [A] ⊸ [A]) [a]]" $
F "a" :@
E (((["x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a"),
E ((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a"),
testNoStep "λx. [y [x]]{x/x,a/y}" {n = 1} $
["x"] :\\ CloT (E $ BV 1 :@ BVT 0) (BV 0 ::: F "a" ::: id),
[< "x"] :\\ CloT (E $ BV 1 :@ BVT 0) (BV 0 ::: F "a" ::: id),
testNoStep "f ([y [x]]{x/x,a/y})" {n = 1} $
F "f" :@ CloT (E $ BV 1 :@ BVT 0) (BV 0 ::: F "a" ::: id)
]

View file

@ -41,7 +41,7 @@ reflTy =
Eq0 (BVT 1) (BVT 0) (BVT 0)
reflDef : IsQty q => Term q d n
reflDef = ["A","x"] :\\ ["i"] :\\% BVT 0
reflDef = [< "A","x"] :\\ [< "i"] :\\% BVT 0
fstTy : Term Three d n
@ -52,8 +52,8 @@ fstTy =
fstDef : Term Three d n
fstDef =
(["A","B","p"] :\\
E (CasePair Any (BV 0) (SN $ BVT 2) (SY ["x","y"] $ BVT 1)))
([< "A","B","p"] :\\
E (CasePair Any (BV 0) (SN $ BVT 2) (SY [< "x","y"] $ BVT 1)))
sndTy : Term Three d n
sndTy =
@ -64,10 +64,10 @@ sndTy =
sndDef : Term Three d n
sndDef =
(["A","B","p"] :\\
([< "A","B","p"] :\\
E (CasePair Any (BV 0)
(SY ["p"] $ E $ BV 2 :@ E (F "fst" :@@ [BVT 3, BVT 2, BVT 0]))
(SY ["x","y"] $ BVT 0)))
(SY [< "p"] $ E $ BV 2 :@ E (F "fst" :@@ [BVT 3, BVT 2, BVT 0]))
(SY [< "x","y"] $ BVT 0)))
defGlobals : Definitions Three
@ -270,18 +270,18 @@ tests = "typechecker" :- [
"lambda" :- [
note "linear & unrestricted identity",
testTC "1 · (λ x ⇒ x) ⇐ A ⊸ A" $
check_ empty 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_ empty 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_ empty 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_ empty 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_ empty sone
(["A", "x"] :\\ E (F "refl" :@@ [BVT 1, BVT 0]))
([< "A", "x"] :\\ E (F "refl" :@@ [BVT 1, BVT 0]))
reflTy,
testTC "1 · (λ A x ⇒ δ i ⇒ x) ⇐ ⋯ # (def. and type of refl)" $
check_ empty sone reflDef reflTy
@ -295,7 +295,7 @@ tests = "typechecker" :- [
(Pair (BVT 0) (BVT 0)) (FT "A" `And` FT "A") [< Any],
testTC "1 · (a, δ i ⇒ a) ⇐ (x : A) × (x ≡ a)" $
check_ empty sone
(Pair (FT "a") (["i"] :\\% FT "a"))
(Pair (FT "a") ([< "i"] :\\% FT "a"))
(Sig_ "x" (FT "A") $ Eq0 (FT "A") (BVT 0) (FT "a"))
],
@ -303,36 +303,36 @@ tests = "typechecker" :- [
testTC "x : A × A ⊢ 1 · (case1 x return B of (l,r) ⇒ f2 l r) ⇒ B ⊳ 1·x" $
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]))
(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 [< ("x", FT "A" `And` FT "A")]) sone
(CasePair Any (BV 0) (SN $ FT "B")
(SY ["l", "r"] $ E $ F "f2" :@@ [BVT 1, BVT 0]))
(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 [< ("x", FT "A" `And` FT "A")]) szero
(CasePair Any (BV 0) (SN $ FT "B")
(SY ["l", "r"] $ E $ F "f2" :@@ [BVT 1, BVT 0]))
(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 [< ("x", FT "A" `And` FT "A")]) sone
(CasePair Zero (BV 0) (SN $ FT "B")
(SY ["l", "r"] $ E $ F "f2" :@@ [BVT 1, BVT 0])),
(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 [< ("x", FT "A" `And` FT "B")]) sone
(CasePair Any (BV 0) (SN $ FT "A")
(SY ["l", "r"] $ BVT 1))
(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 [< ("x", FT "A" `And` FT "B")]) szero
(CasePair One (BV 0) (SN $ FT "A")
(SY ["l", "r"] $ BVT 1))
(SY [< "l", "r"] $ BVT 1))
(FT "A") [< Zero],
testTCFail "x : A × B ⊢ 1 · (case1 x return A of (l,r) ⇒ l) ⇏" $
infer_ (ctx [< ("x", FT "A" `And` FT "B")]) sone
(CasePair One (BV 0) (SN $ FT "A")
(SY ["l", "r"] $ BVT 1)),
(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 ⇐ ★₂" $
@ -347,9 +347,9 @@ tests = "typechecker" :- [
check_ empty sone sndDef sndTy,
testTC "0 · snd ★₀ (λ x ⇒ x) ⇒ (ω·p : (A : ★₀) × A) → fst ★₀ (λ x ⇒ x) p" $
inferAs empty szero
(F "snd" :@@ [TYPE 0, ["x"] :\\ BVT 0])
(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]))
(E $ F "fst" :@@ [TYPE 0, [< "x"] :\\ BVT 0, BVT 0]))
],
"enums" :- [
@ -369,13 +369,13 @@ tests = "typechecker" :- [
(Eq0 (FT "A") (FT "a") (FT "a")),
testTC "0 · (λ p q ⇒ δ i ⇒ p) ⇐ (ω·p q : a ≡ a') → p ≡ q" $
check_ empty szero
(["p","q"] :\\ ["i"] :\\% BVT 1)
([< "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_ empty szero
(["p","q"] :\\ ["i"] :\\% BVT 0)
([< "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")) $
Eq0 (Eq0 (FT "A") (FT "a") (FT "a")) (BVT 1) (BVT 0))
@ -388,7 +388,7 @@ tests = "typechecker" :- [
note " ⇐ (0·x y : A) → (1·xy : x ≡ y) → Eq [i ⇒ P (xy i)] (p x) (p y)",
testTC "cong" $
check_ empty sone
(["x", "y", "xy"] :\\ ["i"] :\\% E (F "p" :@ E (BV 0 :% BV 0)))
([< "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)) $
@ -401,7 +401,7 @@ tests = "typechecker" :- [
note " ⇐ (1·eq : (1·x : A) → p x ≡ q x) → p ≡ q",
testTC "funext" $
check_ empty sone
(["eq"] :\\ ["i"] :\\% ["x"] :\\ E (BV 1 :@ BVT 0 :% BV 0))
([< "eq"] :\\ [< "i"] :\\% [< "x"] :\\ E (BV 1 :@ BVT 0 :% BV 0))
(Pi_ One "eq"
(Pi_ One "x" (FT "A")
(Eq0 (E $ F "P" :@ BVT 0)