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