coercions and compositions
This commit is contained in:
parent
468ae7e444
commit
a5ccf0215a
25 changed files with 1344 additions and 651 deletions
|
|
@ -155,30 +155,9 @@ tests = "pretty printing terms" :- [
|
|||
"type-case" :- [
|
||||
testPrettyE [<] [<]
|
||||
{label = "type-case ℕ ∷ ★₀ return ★₀ of { ⋯ }"}
|
||||
(TypeCase (Nat :# TYPE 0) (TYPE 0) Nat (SN Nat) (SN Nat) Nat
|
||||
(SN Nat) Nat (SN Nat))
|
||||
"""
|
||||
type-case ℕ ∷ ★₀ return ★₀ of {
|
||||
★ ⇒ ℕ;
|
||||
(_ → _) ⇒ ℕ;
|
||||
(_ × _) ⇒ ℕ;
|
||||
{} ⇒ ℕ;
|
||||
Eq _ _ _ _ _ ⇒ ℕ;
|
||||
ℕ ⇒ ℕ;
|
||||
[_] ⇒ ℕ
|
||||
}
|
||||
"""
|
||||
"""
|
||||
type-case Nat :: Type0 return Type0 of {
|
||||
Type => Nat;
|
||||
(_ -> _) => Nat;
|
||||
(_ ** _) => Nat;
|
||||
{} => Nat;
|
||||
Eq _ _ _ _ _ => Nat;
|
||||
Nat => Nat;
|
||||
[_] => Nat
|
||||
}
|
||||
"""
|
||||
(TypeCase (Nat :# TYPE 0) (TYPE 0) empty Nat)
|
||||
"type-case ℕ ∷ ★₀ return ★₀ of { _ ⇒ ℕ }"
|
||||
"type-case Nat :: Type0 return Type0 of { _ => Nat }"
|
||||
],
|
||||
|
||||
"annotations" :- [
|
||||
|
|
|
|||
|
|
@ -7,108 +7,113 @@ import TypingImpls
|
|||
import TAP
|
||||
|
||||
|
||||
parameters {0 isRedex : RedexTest tm} {auto _ : Whnf tm isRedex err}
|
||||
{auto _ : ToInfo err}
|
||||
{auto _ : forall d, n. Eq (tm d n)}
|
||||
{auto _ : forall d, n. Show (tm d n)}
|
||||
parameters {0 isRedex : RedexTest tm} {auto _ : Whnf tm isRedex} {d, n : Nat}
|
||||
{auto _ : (Eq (tm d n), Show (tm d n))}
|
||||
{default empty defs : Definitions}
|
||||
{default 0 d, n : Nat}
|
||||
testWhnf : String -> tm d n -> tm d n -> Test
|
||||
testWhnf label from to = test "\{label} (whnf)" $ do
|
||||
result <- bimap toInfo fst $ whnf defs from
|
||||
private
|
||||
testWhnf : String -> WhnfContext d n -> tm d n -> tm d n -> Test
|
||||
testWhnf label ctx from to = test "\{label} (whnf)" $ do
|
||||
result <- bimap toInfo fst $ whnf defs ctx from
|
||||
unless (result == to) $ Left [("exp", show to), ("got", show result)]
|
||||
|
||||
testNoStep : String -> tm d n -> Test
|
||||
testNoStep label e = testWhnf label e e
|
||||
private
|
||||
testNoStep : String -> WhnfContext d n -> tm d n -> Test
|
||||
testNoStep label ctx e = testWhnf label ctx e e
|
||||
|
||||
private
|
||||
ctx : Context (\n => (BaseName, Term 0 n)) n -> WhnfContext 0 n
|
||||
ctx xs = let (ns, ts) = unzip xs in MkWhnfContext [<] ns ts
|
||||
|
||||
|
||||
export
|
||||
tests : Test
|
||||
tests = "whnf" :- [
|
||||
"head constructors" :- [
|
||||
testNoStep "★₀" $ TYPE 0,
|
||||
testNoStep "[A] ⊸ [B]" $
|
||||
testNoStep "★₀" empty $ TYPE 0,
|
||||
testNoStep "[A] ⊸ [B]" empty $
|
||||
Arr One (FT "A") (FT "B"),
|
||||
testNoStep "(x: [A]) ⊸ [B [x]]" $
|
||||
testNoStep "(x: [A]) ⊸ [B [x]]" empty $
|
||||
Pi One (FT "A") (S [< "x"] $ Y $ E $ F "B" :@ BVT 0),
|
||||
testNoStep "λx. [x]" $
|
||||
testNoStep "λx. [x]" empty $
|
||||
Lam $ S [< "x"] $ Y $ BVT 0,
|
||||
testNoStep "[f [a]]" $
|
||||
testNoStep "[f [a]]" empty $
|
||||
E $ F "f" :@ FT "a"
|
||||
],
|
||||
|
||||
"neutrals" :- [
|
||||
testNoStep "x" {n = 1} $ BV 0,
|
||||
testNoStep "a" $ F "a",
|
||||
testNoStep "f [a]" $ F "f" :@ FT "a",
|
||||
testNoStep "★₀ ∷ ★₁" $ TYPE 0 :# TYPE 1
|
||||
testNoStep "x" (ctx [< ("A", Nat)]) $ BV 0,
|
||||
testNoStep "a" empty $ F "a",
|
||||
testNoStep "f [a]" empty $ F "f" :@ FT "a",
|
||||
testNoStep "★₀ ∷ ★₁" empty $ TYPE 0 :# TYPE 1
|
||||
],
|
||||
|
||||
"redexes" :- [
|
||||
testWhnf "[a] ∷ [A]"
|
||||
testWhnf "[a] ∷ [A]" empty
|
||||
(FT "a" :# FT "A")
|
||||
(F "a"),
|
||||
testWhnf "[★₁ ∷ ★₃]"
|
||||
testWhnf "[★₁ ∷ ★₃]" empty
|
||||
(E (TYPE 1 :# TYPE 3))
|
||||
(TYPE 1),
|
||||
testWhnf "(λx. [x] ∷ [A] ⊸ [A]) [a]"
|
||||
testWhnf "(λx. [x] ∷ [A] ⊸ [A]) [a]" empty
|
||||
((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
|
||||
(F "a")
|
||||
],
|
||||
|
||||
"definitions" :- [
|
||||
testWhnf "a (transparent)"
|
||||
testWhnf "a (transparent)" empty
|
||||
{defs = fromList [("a", mkDef gzero (TYPE 1) (TYPE 0))]}
|
||||
(F "a") (TYPE 0 :# TYPE 1)
|
||||
],
|
||||
|
||||
"elim closure" :- [
|
||||
testWhnf "x{}" {n = 1}
|
||||
testWhnf "x{}" (ctx [< ("A", Nat)])
|
||||
(CloE (BV 0) id)
|
||||
(BV 0),
|
||||
testWhnf "x{a/x}"
|
||||
testWhnf "x{a/x}" empty
|
||||
(CloE (BV 0) (F "a" ::: id))
|
||||
(F "a"),
|
||||
testWhnf "x{x/x,a/y}" {n = 1}
|
||||
testWhnf "x{x/x,a/y}" (ctx [< ("A", Nat)])
|
||||
(CloE (BV 0) (BV 0 ::: F "a" ::: id))
|
||||
(BV 0),
|
||||
testWhnf "x{(y{a/y})/x}"
|
||||
testWhnf "x{(y{a/y})/x}" empty
|
||||
(CloE (BV 0) ((CloE (BV 0) (F "a" ::: id)) ::: id))
|
||||
(F "a"),
|
||||
testWhnf "(x y){f/x,a/y}"
|
||||
testWhnf "(x y){f/x,a/y}" empty
|
||||
(CloE (BV 0 :@ BVT 1) (F "f" ::: F "a" ::: id))
|
||||
(F "f" :@ FT "a"),
|
||||
testWhnf "([y] ∷ [x]){A/x}" {n = 1}
|
||||
testWhnf "([y] ∷ [x]){A/x}" (ctx [< ("A", Nat)])
|
||||
(CloE (BVT 1 :# BVT 0) (F "A" ::: id))
|
||||
(BV 0),
|
||||
testWhnf "([y] ∷ [x]){A/x,a/y}"
|
||||
testWhnf "([y] ∷ [x]){A/x,a/y}" empty
|
||||
(CloE (BVT 1 :# BVT 0) (F "A" ::: F "a" ::: id))
|
||||
(F "a")
|
||||
],
|
||||
|
||||
"term closure" :- [
|
||||
testWhnf "(λy. x){a/x}"
|
||||
testWhnf "(λy. x){a/x}" empty
|
||||
(CloT (Lam $ S [< "y"] $ N $ BVT 0) (F "a" ::: id))
|
||||
(Lam $ S [< "y"] $ N $ FT "a"),
|
||||
testWhnf "(λy. y){a/x}"
|
||||
testWhnf "(λy. y){a/x}" empty
|
||||
(CloT ([< "y"] :\\ BVT 0) (F "a" ::: id))
|
||||
([< "y"] :\\ BVT 0)
|
||||
],
|
||||
|
||||
"looking inside […]" :- [
|
||||
testWhnf "[(λx. x ∷ A ⊸ A) [a]]"
|
||||
testWhnf "[(λx. x ∷ A ⊸ A) [a]]" empty
|
||||
(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]]" $
|
||||
testNoStep "λy. [(λx. [x] ∷ [A] ⊸ [A]) [y]]" empty $
|
||||
[< "y"] :\\ E ((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ BVT 0),
|
||||
testNoStep "f [(λx. [x] ∷ [A] ⊸ [A]) [a]]" $
|
||||
testNoStep "f [(λx. [x] ∷ [A] ⊸ [A]) [a]]" empty $
|
||||
F "a" :@
|
||||
E ((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a"),
|
||||
testNoStep "λx. [y [x]]{x/x,a/y}" {n = 1} $
|
||||
testNoStep "λx. [y [x]]{x/x,a/y}" (ctx [< ("A", Nat)]) $
|
||||
[< "x"] :\\ CloT (E $ BV 1 :@ BVT 0) (BV 0 ::: F "a" ::: id),
|
||||
testNoStep "f ([y [x]]{x/x,a/y})" {n = 1} $
|
||||
testNoStep "f ([y [x]]{x/x,a/y})" (ctx [< ("A", Nat)]) $
|
||||
F "f" :@ CloT (E $ BV 1 :@ BVT 0) (BV 0 ::: F "a" ::: id)
|
||||
]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -451,8 +451,7 @@ tests = "typechecker" :- [
|
|||
"type-case" :- [
|
||||
testTC "0 · type-case ℕ ∷ ★₀ return ★₀ of { _ ⇒ ℕ } ⇒ ★₀" $
|
||||
inferAs empty szero
|
||||
(TypeCase (Nat :# TYPE 0) (TYPE 0) Nat (SN Nat) (SN Nat) Nat
|
||||
(SN Nat) Nat (SN Nat))
|
||||
(TypeCase (Nat :# TYPE 0) (TYPE 0) empty Nat)
|
||||
(TYPE 0)
|
||||
],
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue