quox/tests/Tests/FreeVars.idr

106 lines
3.4 KiB
Idris
Raw Normal View History

module Tests.FreeVars
import Quox.Pretty
import Quox.Syntax
import Quox.FreeVars
import AstExtra
import TAP
import Derive.Prelude
%language ElabReflection
private
data FailureType = Dim | Term
%runElab derive "FailureType" [Show]
private
record Failure where
constructor Fail
type : FailureType
expected, got : FreeVars n
private
ToInfo Failure where
toInfo f = [("type", show f.type),
("expected", show f.expected),
("got", show f.got)]
private
testFreeVars : {d, n : Nat} -> (HasFreeVars (f d), HasFreeDVars f) =>
(f d n -> String) -> f d n -> FreeVars' d -> FreeVars' n -> Test
testFreeVars lbl tm dims terms =
test (lbl tm) $ do
let dims = FV dims; terms = FV terms
dims' = fdv tm; terms' = fv tm
unless (dims == dims') $ Left $ Fail Dim dims dims'
unless (terms == terms') $ Left $ Fail Term terms terms'
Right ()
private
2023-09-19 12:05:43 -04:00
Doc80 : Type
Doc80 = Doc $ Opts 80
private
prettyWith : (a -> Eff Pretty Doc80) -> a -> String
prettyWith f = trim . render _ . runPretty . f
parameters {d, n : Nat} (ds : BContext d) (ts : BContext n)
private
2023-09-19 12:05:43 -04:00
withContext : Doc80 -> Eff Pretty Doc80
withContext doc =
if null ds && null ts then pure $ hsep ["", doc]
else pure $ sep [hsep [!(ctx1 ds), "|", !(ctx1 ts), ""], doc]
where
2023-09-19 12:05:43 -04:00
ctx1 : forall k. BContext k -> Eff Pretty Doc80
ctx1 [<] = pure "·"
ctx1 ctx = fillSeparateTight !commaD . toList' <$>
traverse' (pure . prettyBind') ctx
private
testFreeVarsT : Term d n -> FreeVars' d -> FreeVars' n -> Test
testFreeVarsT = testFreeVars $ prettyWith $ withContext <=< prettyTerm ds ts
private
testFreeVarsE : Elim d n -> FreeVars' d -> FreeVars' n -> Test
testFreeVarsE = testFreeVars $ prettyWith $ withContext <=< prettyElim ds ts
export
tests : Test
tests = "free variables" :- [
testFreeVarsT [<] [<] (^TYPE 0) [<] [<],
testFreeVarsT [<"i", "j"] [<] (^TYPE 0) [<False, False] [<],
testFreeVarsT [<] [<"x", "y"] (^TYPE 0) [<] [<False, False],
testFreeVarsT [<"i"] [<"x"] (^TYPE 0) [<False] [<False],
testFreeVarsE [<] [<] (^F "f" 0) [<] [<],
testFreeVarsE [<] [<] (^F "f" 6) [<] [<],
testFreeVarsE [<"i"] [<] (^F "f" 0) [<False] [<],
testFreeVarsE [<] [<"x"] (^F "f" 0) [<] [<False],
testFreeVarsE [<] [<"x"] (^BV 0) [<] [<True],
testFreeVarsE [<"i"] [<"x"] (^BV 0) [<False] [<True],
testFreeVarsE [<] [<"x","y"] (^BV 1) [<] [<True,False],
testFreeVarsE [<] [<"x","y"] (^BV 0) [<] [<False,True],
testFreeVarsE [<] [<"x","y","z"] (^BV 1) [<] [<False,True,False],
testFreeVarsE [<] [<"x","y"] (^App (^BV 1) (^BVT 0)) [<] [<True,True],
testFreeVarsE [<] [<"x","y","z"] (^App (^BV 1) (^BVT 0))
[<] [<False,True,True],
testFreeVarsE [<] [<"x","y"] (^App (^BV 1) (^TYPE 1)) [<] [<True,False],
testFreeVarsT [<"i"] [<"x"] (^LamY "y" (^BVT 0)) [<False] [<False],
testFreeVarsT [<"i"] [<"x"] (^LamN (^BVT 0)) [<False] [<True],
testFreeVarsE [<"i","j"] [<] (^DApp (^F "eq" 0) (^BV 0)) [<False,True] [<],
testFreeVarsE [<"i","j"] [<] (^DApp (^F "eq" 0) (^BV 1)) [<True,False] [<],
testFreeVarsE [<"i","j"] [<] (^DApp (^F "eq" 0) (^K Zero)) [<False,False] [<],
testFreeVarsT [<"i","j"] [<] (^DLamY "k" (E $ ^DApp (^F "eq" 0) (^BV 0)))
[<False,False] [<],
testFreeVarsT [<"i","j"] [<] (^DLamN (E $ ^DApp (^F "eq" 0) (^BV 0)))
[<False,True] [<],
todo "others"
]