diff --git a/lib/Quox/Syntax/Term/Base.idr b/lib/Quox/Syntax/Term/Base.idr index 8414f74..ea0914a 100644 --- a/lib/Quox/Syntax/Term/Base.idr +++ b/lib/Quox/Syntax/Term/Base.idr @@ -235,6 +235,11 @@ public export %inline BVT : (i : Nat) -> (0 _ : LT i n) => Term q d n BVT i = E $ BV i +public export +makeNat : Nat -> Term q d n +makeNat 0 = Zero +makeNat (S k) = Succ $ makeNat k + public export enum : List TagVal -> Term q d n enum = Enum . SortedSet.fromList diff --git a/tests/Tests/Equal.idr b/tests/Tests/Equal.idr index 3380c1b..863d4ca 100644 --- a/tests/Tests/Equal.idr +++ b/tests/Tests/Equal.idr @@ -17,7 +17,8 @@ defGlobals = fromList ("b", mkPostulate Any $ FT "B"), ("f", mkPostulate Any $ Arr One (FT "A") (FT "A")), ("id", mkDef Any (Arr One (FT "A") (FT "A")) ([< "x"] :\\ BVT 0)), - ("eq-AB", mkPostulate Zero $ Eq0 (TYPE 0) (FT "A") (FT "B"))] + ("eq-AB", mkPostulate Zero $ Eq0 (TYPE 0) (FT "A") (FT "B")), + ("two", mkDef Any Nat (Succ (Succ Zero)))] parameters (label : String) (act : Lazy (M ())) {default defGlobals globals : Definitions Three} @@ -71,7 +72,7 @@ tests = "equality & subtyping" :- [ subT empty (TYPE 2) (TYPE 1) (TYPE 0) ], - "pi" :- [ + "function types" :- [ note #""๐ด โŠธ ๐ต" for (1ยท๐ด) โ†’ ๐ต"#, note #""๐ด โ‡พ ๐ต" for (0ยท๐ด) โ†’ ๐ต"#, testEq "โ˜…โ‚€ โ‡พ โ˜…โ‚€ = โ˜…โ‚€ โ‡พ โ˜…โ‚€" $ @@ -417,6 +418,76 @@ tests = "equality & subtyping" :- [ (F "f") ], + "natural numbers" :- [ + testEq "zero = zero" $ equalT empty Nat Zero Zero, + testEq "succ two = succ two" $ + equalT empty Nat (Succ (FT "two")) (Succ (FT "two")), + testNeq "succ two โ‰  two" $ + equalT empty Nat (Succ (FT "two")) (FT "two"), + testNeq "zero โ‰  succ zero" $ + equalT empty Nat Zero (Succ Zero), + testEq "0=1 โŠข zero = succ zero" $ + equalT empty01 Nat Zero (Succ Zero) + ], + + "natural elim" :- [ + testEq "caseฯ‰ 0 return {a,b} of {zero โ‡’ 'a; succ _ โ‡’ 'b} = 'a" $ + equalT empty + (enum ["a", "b"]) + (E $ CaseNat Any Zero (Zero :# Nat) + (SN $ enum ["a", "b"]) + (Tag "a") + (SN $ Tag "b")) + (Tag "a"), + testEq "caseฯ‰ 1 return {a,b} of {zero โ‡’ 'a; succ _ โ‡’ 'b} = 'b" $ + equalT empty + (enum ["a", "b"]) + (E $ CaseNat Any Zero (Succ Zero :# Nat) + (SN $ enum ["a", "b"]) + (Tag "a") + (SN $ Tag "b")) + (Tag "b"), + testEq "caseฯ‰ 4 return โ„• of {0 โ‡’ 0; succ n โ‡’ n} = 3" $ + equalT empty + Nat + (E $ CaseNat Any Zero (makeNat 4 :# Nat) + (SN Nat) + Zero + (SY [< "n", Unused] $ BVT 1)) + (makeNat 3) + ], + + todo "pair types", + + "pairs" :- [ + testEq "('a, 'b) = ('a, 'b) : {a} ร— {b}" $ + equalT empty + (enum ["a"] `And` enum ["b"]) + (Tag "a" `Pair` Tag "b") + (Tag "a" `Pair` Tag "b"), + testNeq "('a, 'b) โ‰  ('b, 'a) : {a,b} ร— {a,b}" $ + equalT empty + (enum ["a", "b"] `And` enum ["a", "b"]) + (Tag "a" `Pair` Tag "b") + (Tag "b" `Pair` Tag "a"), + testEq "0=1 โŠข ('a, 'b) = ('b, 'a) : {a,b} ร— {a,b}" $ + equalT empty01 + (enum ["a", "b"] `And` enum ["a", "b"]) + (Tag "a" `Pair` Tag "b") + (Tag "b" `Pair` Tag "a"), + testEq "0=1 โŠข ('a, 'b) = ('b, 'a) : โ„•" $ + equalT empty01 + Nat + (Tag "a" `Pair` Tag "b") + (Tag "b" `Pair` Tag "a") + ], + + todo "pair elim", + + todo "enum types", + todo "enum", + todo "enum elim", + "elim closure" :- [ testEq "#0{a} = a" $ equalE empty (CloE (BV 0) (F "a" ::: id)) (F "a"),