quox/tests/Tests/Reduce.idr

134 lines
4.1 KiB
Idris
Raw Normal View History

2022-05-25 10:10:19 -04:00
module Tests.Reduce
import Quox.Syntax as Lib
import Quox.Equal
2023-02-22 01:40:19 -05:00
import TypingImpls
2023-05-01 21:06:25 -04:00
import AstExtra
2022-05-25 10:10:19 -04:00
import TAP
2023-05-01 21:06:25 -04:00
import Control.Eff
%hide Prelude.App
%hide Pretty.App
2022-05-25 10:10:19 -04:00
2023-04-15 09:13:01 -04:00
parameters {0 isRedex : RedexTest tm} {auto _ : Whnf tm isRedex} {d, n : Nat}
{auto _ : (Eq (tm d n), Show (tm d n))}
2023-04-01 13:16:43 -04:00
{default empty defs : Definitions}
2023-04-15 09:13:01 -04:00
private
testWhnf : String -> WhnfContext d n -> tm d n -> tm d n -> Test
testWhnf label ctx from to = test "\{label} (whnf)" $ do
2023-05-01 21:06:25 -04:00
result <- mapFst toInfo $ runWhnf $ whnf0 defs ctx from
2023-02-22 01:40:19 -05:00
unless (result == to) $ Left [("exp", show to), ("got", show result)]
2022-05-25 10:10:19 -04:00
2023-04-15 09:13:01 -04:00
private
testNoStep : String -> WhnfContext d n -> tm d n -> Test
testNoStep label ctx e = testWhnf label ctx e e
2022-05-25 10:10:19 -04:00
2023-04-15 09:13:01 -04:00
private
2023-05-01 21:06:25 -04:00
ctx : Context (\n => (BindName, Term 0 n)) n -> WhnfContext 0 n
2023-04-15 09:13:01 -04:00
ctx xs = let (ns, ts) = unzip xs in MkWhnfContext [<] ns ts
2022-05-25 10:10:19 -04:00
2023-04-15 09:13:01 -04:00
export
tests : Test
2022-05-25 10:10:19 -04:00
tests = "whnf" :- [
"head constructors" :- [
2023-05-01 21:06:25 -04:00
testNoStep "★₀" empty $ ^TYPE 0,
testNoStep "1.A → B" empty $
^Arr One (^FT "A") (^FT "B"),
testNoStep "(x: A) ⊸ B x" empty $
^PiY One "x" (^FT "A") (E $ ^App (^F "B") (^BVT 0)),
testNoStep "λ x ⇒ x" empty $
^LamY "x" (^BVT 0),
testNoStep "f a" empty $
E $ ^App (^F "f") (^FT "a")
2022-05-25 10:10:19 -04:00
],
"neutrals" :- [
2023-05-01 21:06:25 -04:00
testNoStep "x" (ctx [< ("A", ^Nat)]) $ ^BV 0,
testNoStep "a" empty $ ^F "a",
testNoStep "f a" empty $ ^App (^F "f") (^FT "a"),
testNoStep "★₀ ∷ ★₁" empty $ ^Ann (^TYPE 0) (^TYPE 1)
2022-05-25 10:10:19 -04:00
],
"redexes" :- [
2023-05-01 21:06:25 -04:00
testWhnf "a ∷ A" empty
(^Ann (^FT "a") (^FT "A"))
(^F "a"),
testWhnf "★₁ ∷ ★₃" empty
(E $ ^Ann (^TYPE 1) (^TYPE 3))
(^TYPE 1),
testWhnf "(λ x ⇒ x ∷ 1.A → A) a" empty
(^App (^Ann (^LamY "x" (^BVT 0)) (^Arr One (^FT "A") (^FT "A")))
(^FT "a"))
(^F "a")
2022-05-25 10:10:19 -04:00
],
"definitions" :- [
2023-04-15 09:13:01 -04:00
testWhnf "a (transparent)" empty
2023-05-01 21:06:25 -04:00
{defs = fromList [("a", ^mkDef gzero (^TYPE 1) (^TYPE 0))]}
(^F "a") (^Ann (^TYPE 0) (^TYPE 1)),
testNoStep "a (opaque)" empty
{defs = fromList [("a", ^mkPostulate gzero (^TYPE 1))]}
(^F "a")
],
2022-05-25 10:10:19 -04:00
"elim closure" :- [
2023-05-01 21:06:25 -04:00
testWhnf "x{}" (ctx [< ("x", ^Nat)])
(CloE (Sub (^BV 0) id))
(^BV 0),
2023-04-15 09:13:01 -04:00
testWhnf "x{a/x}" empty
2023-05-01 21:06:25 -04:00
(CloE (Sub (^BV 0) (^F "a" ::: id)))
(^F "a"),
testWhnf "x{a/y}" (ctx [< ("x", ^Nat)])
(CloE (Sub (^BV 0) (^BV 0 ::: ^F "a" ::: id)))
(^BV 0),
2023-04-15 09:13:01 -04:00
testWhnf "x{(y{a/y})/x}" empty
2023-05-01 21:06:25 -04:00
(CloE (Sub (^BV 0) ((CloE (Sub (^BV 0) (^F "a" ::: id))) ::: id)))
(^F "a"),
2023-04-15 09:13:01 -04:00
testWhnf "(x y){f/x,a/y}" empty
2023-05-01 21:06:25 -04:00
(CloE (Sub (^App (^BV 0) (^BVT 1)) (^F "f" ::: ^F "a" ::: id)))
(^App (^F "f") (^FT "a")),
testWhnf "(y ∷ x){A/x}" (ctx [< ("x", ^Nat)])
(CloE (Sub (^Ann (^BVT 1) (^BVT 0)) (^F "A" ::: id)))
(^BV 0),
testWhnf "(y ∷ x){A/x,a/y}" empty
(CloE (Sub (^Ann (^BVT 1) (^BVT 0)) (^F "A" ::: ^F "a" ::: id)))
(^F "a")
2022-05-25 10:10:19 -04:00
],
"term closure" :- [
2023-05-01 21:06:25 -04:00
testWhnf "(λ y ⇒ x){a/x}" empty
(CloT (Sub (^LamN (^BVT 0)) (^F "a" ::: id)))
(^LamN (^FT "a")),
2023-04-15 09:13:01 -04:00
testWhnf "(λy. y){a/x}" empty
2023-05-01 21:06:25 -04:00
(CloT (Sub (^LamY "y" (^BVT 0)) (^F "a" ::: id)))
(^LamY "y" (^BVT 0))
2022-05-25 10:10:19 -04:00
],
2023-05-01 21:06:25 -04:00
"looking inside `E`" :- [
testWhnf "(λx. x ∷ A ⊸ A) a" empty
(E $ ^App (^Ann (^LamY "x" (^BVT 0)) (^Arr One (^FT "A") (^FT "A")))
(^FT "a"))
(^FT "a")
2022-05-25 10:10:19 -04:00
],
"nested redex" :- [
2023-05-01 21:06:25 -04:00
testNoStep "λ y ⇒ ((λ x ⇒ x) ∷ 1.A → A) y" empty $
^LamY "y" (E $
^App (^Ann (^LamY "x" (^BVT 0)) (^Arr One (^FT "A") (^FT "A")))
(^BVT 0)),
testNoStep "f (((λ x ⇒ x) ∷ 1.A → A) a)" empty $
^App (^F "f")
(E $ ^App (^Ann (^LamY "x" (^BVT 0)) (^Arr One (^FT "A") (^FT "A")))
(^FT "a")),
testNoStep "λx. (y x){x/x,a/y}" (ctx [< ("y", ^Nat)]) $
^LamY "x" (CloT $ Sub (E $ ^App (^BV 1) (^BVT 0))
(^BV 0 ::: ^F "a" ::: id)),
testNoStep "f (y x){x/x,a/y}" (ctx [< ("y", ^Nat)]) $
^App (^F "f")
(CloT (Sub (E $ ^App (^BV 1) (^BVT 0))
(^BV 0 ::: ^F "a" ::: id)))
2022-05-25 10:10:19 -04:00
]
]