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