]> Git — Sourcephile - haskell/symantic.git/blob - symantic-lib/Language/Symantic/Lib/Num/Test.hs
Improve the module system.
[haskell/symantic.git] / symantic-lib / Language / Symantic / Lib / Num / Test.hs
1 {-# LANGUAGE UndecidableInstances #-}
2 {-# LANGUAGE StandaloneDeriving #-}
3 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
4 {-# OPTIONS_GHC -fno-warn-orphans #-}
5 module Lib.Num.Test where
6
7 import Test.Tasty
8
9 import Prelude (Num)
10 import Prelude hiding (Num(..))
11
12 import Language.Symantic
13 import Language.Symantic.Lib
14 import Compiling.Test
15
16 -- * Tests
17 type SS =
18 [ Proxy (->)
19 , Proxy Integer
20 , Proxy Num
21 , Proxy Num2
22 , Proxy Int
23 , Proxy Integral
24 , Proxy Foldable
25 , Proxy Traversable
26 , Proxy []
27 ]
28 (==>) = test_readTerm @() @SS
29
30 tests :: TestTree
31 tests = testGroup "Num"
32 [ "42" ==> Right (tyInteger, 42, "42")
33 , "-42" ==> Right (tyInteger, -42, "negate 42")
34 , "- -42" ==> Right (tyInteger, 42, "negate (negate 42)")
35 , "1 + -2" ==> Right (tyInteger, -1, "1 + negate 2")
36 , "-1 + -2" ==> Right (tyInteger, -3, "negate 1 + negate 2")
37 , "-(1 + -2)" ==> Right (tyInteger, 1, "negate (1 + negate 2)")
38 , "(+) 1 2" ==> Right (tyInteger, 3, "1 + 2")
39 , "1 + 2" ==> Right (tyInteger, 3, "1 + 2")
40 , "1 + 2 - 3" ==> Right (tyInteger, 0, "1 + 2 - 3")
41 , "1 + 2 * 3" ==> Right (tyInteger, 7, "1 + 2 * 3")
42 , "3 * 2 + 1" ==> Right (tyInteger, 7, "3 * 2 + 1")
43 , "3 * (2 + 1)" ==> Right (tyInteger, 9, "3 * (2 + 1)")
44 , "4 + 3 * 2 + 1" ==> Right (tyInteger, 11, "4 + 3 * 2 + 1")
45 , "5 * 4 + 3 * 2 + 1" ==> Right (tyInteger, 27, "5 * 4 + 3 * 2 + 1")
46 , "negate`42" ==> Right (tyInteger, -42, "negate 42")
47 , "42`negate" ==> Right (tyInteger, -42, "negate 42")
48 , "42`negate " ==> Right (tyInteger, -42, "negate 42")
49 , "42`negate`negate" ==> Right (tyInteger, 42, "negate (negate 42)")
50 , "42`abs`negate" ==> Right (tyInteger, -42, "negate (abs 42)")
51 , "42`negate`abs" ==> Right (tyInteger, 42, "abs (negate 42)")
52 , "abs`negate`42" ==> Right (tyInteger, 42, "abs (negate 42)")
53 , "negate`abs`42" ==> Right (tyInteger, -42, "negate (abs 42)")
54 , "negate`abs`42`mod`9" ==> Right (tyInteger, 3, "negate (abs 42) `mod` 9")
55 , "negate abs`42" ==> Right (tyInteger, -42, "negate (abs 42)")
56 , "negate 42`abs" ==> Right (tyInteger, -42, "negate (abs 42)")
57 , "(+) negate`2 44" ==> Right (tyInteger, 42, "negate 2 + 44")
58 , "(+) 2`negate 44" ==> Right (tyInteger, 42, "negate 2 + 44")
59 , "(+) (negate`2) 44" ==> Right (tyInteger, 42, "negate 2 + 44")
60 , "abs negate`42" ==> Right (tyInteger, 42, "abs (negate 42)")
61 , "(+) 40 2" ==> Right (tyInteger, 42, "40 + 2")
62 , "(+) 40 -2" ==> Right (tyInteger, 38, "40 + negate 2")
63 , "negate 42 + 42`negate" ==> Right (tyInteger, -84, "negate 42 + negate 42")
64 , "(+) (negate 42) 42`negate" ==> Right (tyInteger, -84, "negate 42 + negate 42")
65 , "(+) negate`42 42`negate" ==> Right (tyInteger, -84, "negate 42 + negate 42")
66 , "42`abs`negate`mod`abs`negate`9" ==> Right (tyInteger, 3, "negate (abs 42) `mod` abs (negate 9)")
67 , "abs`42`negate" ==> Right (tyInteger, 42, "abs (negate 42)")
68 , "negate`42`abs" ==> Right (tyInteger, 42, "abs (negate 42)")
69 , testGroup "Error_Term"
70 [ "(+) 40 - 2" ==> Left (tyInteger,
71 Right $ Error_Term_Beta $ Error_Beta_Unify $
72 Error_Unify_Const_mismatch
73 (TypeVT $ tyFun @_ @'[])
74 (TypeVT $ tyInteger @_ @'[]))
75 ]
76 ]
77
78 -- | A newtype to test prefix and postfix.
79 newtype Num2 a = Num2 a
80 type instance Sym (Proxy Num2) = Sym_Num2
81 class Sym_Num2 (term:: * -> *) where
82
83 instance Sym_Num2 Eval where
84 instance Sym_Num2 View where
85 instance Sym_Num2 (Dup r1 r2) where
86 instance Sym_Num2 term => Sym_Num2 (BetaT term) where
87 instance FixityOf Num2
88 instance ClassInstancesFor Num2
89 instance TypeInstancesFor Num2
90 instance Gram_Term_AtomsFor src ss g Num2
91 instance (Source src, Inj_Sym ss Num) => ModuleFor src ss Num2 where
92 moduleFor _s = ["Num2"] `moduleWhere`
93 [ "abs" `withPrefix` 9 := teNum_abs
94 , "negate" `withPrefix` 10 := teNum_negate
95 , "abs" `withPostfix` 9 := teNum_abs
96 , "negate" `withPostfix` 10 := teNum_negate
97 ]