1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
import Data.WideWord
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Classes
import Data.Semiring hiding ((+),(*))
import Data.Proxy (Proxy (Proxy))
import Data.Bits
import Foreign.Storable
import Data.Primitive.Types (Prim)
import Data.Maybe (catMaybes)
import Data.Word (Word64)
#if ! MIN_VERSION_base (4,11,0)
import Data.Semigroup
#endif
main :: IO ()
main = lawsCheckMany allPropsApplied
allPropsApplied :: [(String, [Laws])]
allPropsApplied =
[ ("Int128", allLaws (Proxy :: Proxy Int128))
, ("Word64", allLaws (Proxy :: Proxy Word64))
, ("Word128", allLaws (Proxy :: Proxy Word128))
, ("Word256", allLaws (Proxy :: Proxy Word256))
]
allLaws
:: ( Arbitrary a
, Bits a
, Bounded a
, Enum a
, Eq a
, FiniteBits a
, Integral a
, Ord a
, Prim a
, Read a
, Semiring a
, Semigroup a
, Show a
, Storable a
)
=> Proxy a -> [Laws]
allLaws p =
map ($ p)
[ bitsLaws
, boundedEnumLaws
, eqLaws
, integralLaws
, ordLaws
, semiringLaws
, semigroupLaws
, storableLaws
, primLaws
, numLaws
]
instance Arbitrary Word128 where
arbitrary =
Word128 <$> arbitraryBoundedIntegral <*> arbitraryBoundedIntegral
instance Arbitrary Word256 where
arbitrary =
Word256
<$> arbitraryBoundedIntegral <*> arbitraryBoundedIntegral
<*> arbitraryBoundedIntegral <*> arbitraryBoundedIntegral
shrink x
| x == 0 = []
| x == 1 = [0]
| x == 2 = [0,1]
| x == 3 = [0,1,2]
| otherwise =
let y = x `shiftR` 1
z = y + 1
w = div (x * 9) 10
p = div (x * 7) 8
in catMaybes
[ if y < x then Just y else Nothing
, if z < x then Just z else Nothing
, if w < x then Just w else Nothing
, if p < x then Just p else Nothing
]
instance Arbitrary Int128 where
arbitrary = Int128 <$> arbitrary <*> arbitrary
-- These are used to make sure that 'Num' behaves properly.
instance Semiring Word128 where
zero = 0
one = 1
plus = (+)
times = (*)
instance Semiring Word256 where
zero = 0
one = 1
plus = (+)
times = (*)
instance Semiring Int128 where
zero = 0
one = 1
plus = (+)
times = (*)
-- These are used to make sure that plus is associative
instance Semigroup Word128 where
(<>) = (+)
instance Semigroup Word64 where
(<>) = (+)
instance Semigroup Word256 where
(<>) = (+)
instance Semigroup Int128 where
(<>) = (+)
|
