quox/tests/Tests/Reduce.idr

115 lines
3.3 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
2022-05-25 10:10:19 -04:00
import TermImpls
2023-02-22 01:40:19 -05:00
import TypingImpls
2022-05-25 10:10:19 -04:00
import TAP
2023-02-22 01:40:19 -05:00
parameters {0 isRedex : RedexTest tm} {auto _ : Whnf tm isRedex err}
{auto _ : ToInfo err}
2023-04-01 13:16:43 -04:00
{auto _ : forall d, n. Eq (tm d n)}
{auto _ : forall d, n. Show (tm d n)}
{default empty defs : Definitions}
2023-02-22 01:40:19 -05:00
{default 0 d, n : Nat}
2023-04-01 13:16:43 -04:00
testWhnf : String -> tm d n -> tm d n -> Test
2023-02-22 01:40:19 -05:00
testWhnf label from to = test "\{label} (whnf)" $ do
result <- bimap toInfo fst $ whnf defs from
unless (result == to) $ Left [("exp", show to), ("got", show result)]
2022-05-25 10:10:19 -04:00
2023-04-01 13:16:43 -04:00
testNoStep : String -> tm d n -> Test
2023-02-22 01:40:19 -05:00
testNoStep label e = testWhnf label e e
2022-05-25 10:10:19 -04:00
tests = "whnf" :- [
"head constructors" :- [
2023-02-22 01:40:19 -05:00
testNoStep "★₀" $ TYPE 0,
testNoStep "[A] ⊸ [B]" $
2022-05-25 10:10:19 -04:00
Arr One (FT "A") (FT "B"),
2023-02-22 01:40:19 -05:00
testNoStep "(x: [A]) ⊸ [B [x]]" $
Pi One (FT "A") (S [< "x"] $ Y $ E $ F "B" :@ BVT 0),
2023-02-22 01:40:19 -05:00
testNoStep "λx. [x]" $
Lam $ S [< "x"] $ Y $ BVT 0,
2023-02-22 01:40:19 -05:00
testNoStep "[f [a]]" $
2022-05-25 10:10:19 -04:00
E $ F "f" :@ FT "a"
],
"neutrals" :- [
2023-02-22 01:40:19 -05:00
testNoStep "x" {n = 1} $ BV 0,
testNoStep "a" $ F "a",
testNoStep "f [a]" $ F "f" :@ FT "a",
testNoStep "★₀ ∷ ★₁" $ TYPE 0 :# TYPE 1
2022-05-25 10:10:19 -04:00
],
"redexes" :- [
2023-02-22 01:40:19 -05:00
testWhnf "[a] ∷ [A]"
2022-05-25 10:10:19 -04:00
(FT "a" :# FT "A")
(F "a"),
2023-02-22 01:40:19 -05:00
testWhnf "[★₁ ∷ ★₃]"
2022-05-25 10:10:19 -04:00
(E (TYPE 1 :# TYPE 3))
(TYPE 1),
2023-02-22 01:40:19 -05:00
testWhnf "(λx. [x] ∷ [A] ⊸ [A]) [a]"
((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
2022-05-25 10:10:19 -04:00
(F "a")
],
"definitions" :- [
2023-02-22 01:40:19 -05:00
testWhnf "a (transparent)"
2023-04-01 13:16:43 -04:00
{defs = fromList [("a", mkDef gzero (TYPE 1) (TYPE 0))]}
(F "a") (TYPE 0 :# TYPE 1)
],
2022-05-25 10:10:19 -04:00
"elim closure" :- [
2023-02-22 01:40:19 -05:00
testWhnf "x{}" {n = 1}
2022-05-25 10:10:19 -04:00
(CloE (BV 0) id)
(BV 0),
2023-02-22 01:40:19 -05:00
testWhnf "x{a/x}"
2022-05-25 10:10:19 -04:00
(CloE (BV 0) (F "a" ::: id))
(F "a"),
2023-02-22 01:40:19 -05:00
testWhnf "x{x/x,a/y}" {n = 1}
2022-05-25 10:10:19 -04:00
(CloE (BV 0) (BV 0 ::: F "a" ::: id))
(BV 0),
2023-02-22 01:40:19 -05:00
testWhnf "x{(y{a/y})/x}"
2022-05-25 10:10:19 -04:00
(CloE (BV 0) ((CloE (BV 0) (F "a" ::: id)) ::: id))
(F "a"),
2023-02-22 01:40:19 -05:00
testWhnf "(x y){f/x,a/y}"
2022-05-25 10:10:19 -04:00
(CloE (BV 0 :@ BVT 1) (F "f" ::: F "a" ::: id))
(F "f" :@ FT "a"),
2023-02-22 01:40:19 -05:00
testWhnf "([y] ∷ [x]){A/x}" {n = 1}
2022-05-25 10:10:19 -04:00
(CloE (BVT 1 :# BVT 0) (F "A" ::: id))
(BV 0),
2023-02-22 01:40:19 -05:00
testWhnf "([y] ∷ [x]){A/x,a/y}"
2022-05-25 10:10:19 -04:00
(CloE (BVT 1 :# BVT 0) (F "A" ::: F "a" ::: id))
(F "a")
],
"term closure" :- [
2023-02-22 01:40:19 -05:00
testWhnf "(λy. x){a/x}"
(CloT (Lam $ S [< "y"] $ N $ BVT 0) (F "a" ::: id))
(Lam $ S [< "y"] $ N $ FT "a"),
2023-02-22 01:40:19 -05:00
testWhnf "(λy. y){a/x}"
(CloT ([< "y"] :\\ BVT 0) (F "a" ::: id))
([< "y"] :\\ BVT 0)
2022-05-25 10:10:19 -04:00
],
"looking inside […]" :- [
2023-02-22 01:40:19 -05:00
testWhnf "[(λx. x ∷ A ⊸ A) [a]]"
(E $ (([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a")
2022-05-25 10:10:19 -04:00
(FT "a")
],
"nested redex" :- [
note "whnf only looks at top level redexes",
2023-02-22 01:40:19 -05:00
testNoStep "λy. [(λx. [x] ∷ [A] ⊸ [A]) [y]]" $
[< "y"] :\\ E ((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ BVT 0),
2023-02-22 01:40:19 -05:00
testNoStep "f [(λx. [x] ∷ [A] ⊸ [A]) [a]]" $
2022-05-25 10:10:19 -04:00
F "a" :@
E ((([< "x"] :\\ BVT 0) :# Arr One (FT "A") (FT "A")) :@ FT "a"),
2023-02-22 01:40:19 -05:00
testNoStep "λx. [y [x]]{x/x,a/y}" {n = 1} $
[< "x"] :\\ CloT (E $ BV 1 :@ BVT 0) (BV 0 ::: F "a" ::: id),
2023-02-22 01:40:19 -05:00
testNoStep "f ([y [x]]{x/x,a/y})" {n = 1} $
2022-05-27 12:00:06 -04:00
F "f" :@ CloT (E $ BV 1 :@ BVT 0) (BV 0 ::: F "a" ::: id)
2022-05-25 10:10:19 -04:00
]
]