rhiannon morris
30fa93ab4e
add a new `WithSubst tm env to` record that packages a `tm from` with a `Subst env from to`, and write instances for just that. the rest of the AST can be derived
118 lines
3.7 KiB
Idris
118 lines
3.7 KiB
Idris
module Tests.Reduce
|
|
|
|
import Quox.Syntax as Lib
|
|
import Quox.Equal
|
|
import TypingImpls
|
|
import TAP
|
|
|
|
|
|
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}
|
|
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)]
|
|
|
|
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 "★₀" empty $ TYPE 0,
|
|
testNoStep "[A] ⊸ [B]" empty $
|
|
Arr One (FT "A") (FT "B"),
|
|
testNoStep "(x: [A]) ⊸ [B [x]]" empty $
|
|
Pi One (FT "A") (S [< "x"] $ Y $ E $ F "B" :@ BVT 0),
|
|
testNoStep "λx. [x]" empty $
|
|
Lam $ S [< "x"] $ Y $ BVT 0,
|
|
testNoStep "[f [a]]" empty $
|
|
E $ F "f" :@ FT "a"
|
|
],
|
|
|
|
"neutrals" :- [
|
|
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]" empty
|
|
(FT "a" :# FT "A")
|
|
(F "a"),
|
|
testWhnf "[★₁ ∷ ★₃]" empty
|
|
(E (TYPE 1 :# TYPE 3))
|
|
(TYPE 1),
|
|
testWhnf "(λx. [x] ∷ [A] ⊸ [A]) [a]" empty
|
|
((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
|
|
(F "a")
|
|
],
|
|
|
|
"definitions" :- [
|
|
testWhnf "a (transparent)" empty
|
|
{defs = fromList [("a", mkDef gzero (TYPE 1) (TYPE 0))]}
|
|
(F "a") (TYPE 0 :# TYPE 1)
|
|
],
|
|
|
|
"elim closure" :- [
|
|
testWhnf "x{}" (ctx [< ("A", Nat)])
|
|
(CloE (Sub (BV 0) id))
|
|
(BV 0),
|
|
testWhnf "x{a/x}" empty
|
|
(CloE (Sub (BV 0) (F "a" ::: id)))
|
|
(F "a"),
|
|
testWhnf "x{x/x,a/y}" (ctx [< ("A", Nat)])
|
|
(CloE (Sub (BV 0) (BV 0 ::: F "a" ::: id)))
|
|
(BV 0),
|
|
testWhnf "x{(y{a/y})/x}" empty
|
|
(CloE (Sub (BV 0) ((CloE (Sub (BV 0) (F "a" ::: id))) ::: id)))
|
|
(F "a"),
|
|
testWhnf "(x y){f/x,a/y}" empty
|
|
(CloE (Sub (BV 0 :@ BVT 1) (F "f" ::: F "a" ::: id)))
|
|
(F "f" :@ FT "a"),
|
|
testWhnf "([y] ∷ [x]){A/x}" (ctx [< ("A", Nat)])
|
|
(CloE (Sub (BVT 1 :# BVT 0) (F "A" ::: id)))
|
|
(BV 0),
|
|
testWhnf "([y] ∷ [x]){A/x,a/y}" empty
|
|
(CloE (Sub (BVT 1 :# BVT 0) (F "A" ::: F "a" ::: id)))
|
|
(F "a")
|
|
],
|
|
|
|
"term closure" :- [
|
|
testWhnf "(λy. x){a/x}" empty
|
|
(CloT (Sub (Lam $ S [< "y"] $ N $ BVT 0) (F "a" ::: id)))
|
|
(Lam $ S [< "y"] $ N $ FT "a"),
|
|
testWhnf "(λy. y){a/x}" empty
|
|
(CloT (Sub ([< "y"] :\\ BVT 0) (F "a" ::: id)))
|
|
([< "y"] :\\ BVT 0)
|
|
],
|
|
|
|
"looking inside […]" :- [
|
|
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]]" empty $
|
|
[< "y"] :\\ E ((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ BVT 0),
|
|
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}" (ctx [< ("A", Nat)]) $
|
|
[< "x"] :\\ CloT (Sub (E $ BV 1 :@ BVT 0) (BV 0 ::: F "a" ::: id)),
|
|
testNoStep "f ([y [x]]{x/x,a/y})" (ctx [< ("A", Nat)]) $
|
|
F "f" :@ CloT (Sub (E $ BV 1 :@ BVT 0) (BV 0 ::: F "a" ::: id))
|
|
]
|
|
]
|