Make function intToSBigNat# preserve sign (fixes #14085)
[ghc.git] / testsuite / tests / lib / integer / integerGmpInternals.hs
1 {-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
2
3 module Main (main) where
4
5 import Data.List (group)
6 import Data.Bits
7 import Data.Word
8 import Control.Monad
9
10 import GHC.Word
11 import GHC.Base
12 import GHC.Integer.GMP.Internals (Integer(S#,Jp#,Jn#))
13 import qualified GHC.Integer.GMP.Internals as I
14
15 -- NOTE: Some of the following operations were provided with
16 -- integer-gmp-0.5.1, but were not ported to integer-gmp-1.0.0 (yet);
17 -- so we use naive reference-implementations instead for the meantime
18 -- in order to keep the reference-output untouched.
19
20 recipModInteger :: Integer -> Integer -> Integer
21 recipModInteger = I.recipModInteger
22
23 -- FIXME: Lacks GMP2 version
24 gcdExtInteger :: Integer -> Integer -> (Integer, Integer)
25 gcdExtInteger a b = case I.gcdExtInteger a b of (# g, s #) -> (g, s)
26
27 -- FIXME: Lacks GMP2 version
28 powModSecInteger :: Integer -> Integer -> Integer -> Integer
29 powModSecInteger = powModInteger
30
31 powModInteger :: Integer -> Integer -> Integer -> Integer
32 powModInteger = I.powModInteger
33
34 -- FIXME: Lacks GMP2 version
35 powInteger :: Integer -> Word -> Integer
36 powInteger x e = x^e
37
38 exportInteger :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word
39 exportInteger = I.exportIntegerToMutableByteArray
40
41 exportIntegerAddr :: Integer -> Addr# -> Int# -> IO Word
42 exportIntegerAddr = I.exportIntegerToAddr
43
44 importInteger :: ByteArray# -> Word# -> Word# -> Int# -> Integer
45 importInteger = I.importIntegerFromByteArray
46
47 importIntegerAddr :: Addr# -> Word# -> Int# -> IO Integer
48 importIntegerAddr a l e = I.importIntegerFromAddr a l e
49
50 -- helpers
51 data MBA = MBA { unMBA :: !(MutableByteArray# RealWorld) }
52 data BA = BA { unBA :: !ByteArray# }
53
54 newByteArray :: Word# -> IO MBA
55 newByteArray sz = IO $ \s -> case newPinnedByteArray# (word2Int# sz) s of (# s, arr #) -> (# s, MBA arr #)
56
57 indexByteArray :: ByteArray# -> Word# -> Word8
58 indexByteArray a# n# = W8# (indexWord8Array# a# (word2Int# n#))
59
60 -- indexMutableByteArray :: MutableByteArray# RealWorld -> Word# -> IO Word8
61 -- indexMutableByteArray a# n# = IO $ \s -> case readWord8Array# a# (word2Int# n#) s of (# s', v #) -> (# s', W# v #)
62
63 writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()
64 writeByteArray arr i (W8# w) = IO $ \s -> case writeWord8Array# arr i w s of s -> (# s, () #)
65
66 lengthByteArray :: ByteArray# -> Word
67 lengthByteArray ba = W# (int2Word# (sizeofByteArray# ba))
68
69 unpackByteArray :: ByteArray# -> [Word8]
70 unpackByteArray ba | n == 0 = []
71 | otherwise = [ indexByteArray ba i | W# i <- [0 .. n-1] ]
72 where
73 n = lengthByteArray ba
74
75 freezeByteArray :: MutableByteArray# RealWorld -> IO BA
76 freezeByteArray arr = IO $ \s -> case unsafeFreezeByteArray# arr s of (# s, arr #) -> (# s, BA arr #)
77
78 ----------------------------------------------------------------------------
79 main :: IO ()
80 main = do
81 print $ powModInteger b e m
82 print $ powModInteger b e (m-1)
83 print $ powModSecInteger b e (m-1)
84 print $ gcdExtInteger b e
85 print $ gcdExtInteger e b
86 print $ gcdExtInteger x y
87 print $ gcdExtInteger y x
88 print $ gcdExtInteger x (-y)
89 print $ gcdExtInteger (-x) y
90 print $ gcdExtInteger (-x) (-y)
91 print $ powInteger 12345 0
92 print $ powInteger 12345 1
93 print $ powInteger 12345 30
94 print $ [ (x,i) | x <- [-7..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ]
95 print $ I.nextPrimeInteger b
96 print $ I.nextPrimeInteger e
97 print $ [ k | k <- [ 0 .. 200 ], S# (I.testPrimeInteger k 25#) `elem` [1,2] ]
98 print $ rle [ S# (I.testPrimeInteger k 25#) | k <- [ x .. x + 1000 ] ]
99 print $ rle [ S# (I.testPrimeInteger k 25#) | k <- [ e .. e + 1000 ] ]
100
101 -- import/export primitives
102 print $ [ W# (I.sizeInBaseInteger x 2#) | x <- [b1024,b*e,b,e,m,x,y,-1,0,1] ]
103 print $ [ W# (I.sizeInBaseInteger x 256#) | x <- [b1024,b*e,b,e,m,x,y,-1,0,1] ]
104
105 BA ba <- do
106 MBA mba <- newByteArray 128##
107 forM_ (zip [0..127] [0x01..]) $ \(I# i, w) -> do
108 writeByteArray mba i w
109
110 let a = byteArrayContents# (unsafeCoerce# mba)
111
112 print =<< importIntegerAddr a 0## 1#
113 print =<< importIntegerAddr a 0## 0#
114
115 print =<< importIntegerAddr (plusAddr# a 22#) 1## 1#
116 print =<< importIntegerAddr (plusAddr# a 97#) 1## 0#
117
118 print =<< importIntegerAddr a 23## 1#
119 print =<< importIntegerAddr a 23## 0#
120
121 -- no-op
122 print =<< exportIntegerAddr 0 (plusAddr# a 0#) 1#
123
124 -- write into array
125 print =<< exportIntegerAddr b (plusAddr# a 5#) 1#
126 print =<< exportIntegerAddr e (plusAddr# a 50#) 0#
127
128 print =<< exportInteger m mba 85## 1#
129 print =<< exportInteger m mba 105## 0#
130
131 print =<< importIntegerAddr (plusAddr# a 85#) 17## 1#
132 print =<< importIntegerAddr (plusAddr# a 105#) 17## 0#
133
134 -- read back full array
135 print =<< importIntegerAddr a 128## 1#
136 print =<< importIntegerAddr a 128## 0#
137
138 freezeByteArray mba
139
140 print $ importInteger ba 0## 0## 1#
141 print $ importInteger ba 0## 0## 0#
142
143 print $ importInteger ba 5## 29## 1#
144 print $ importInteger ba 50## 29## 0#
145
146 print $ importInteger ba 0## 128## 1#
147 print $ importInteger ba 0## 128## 0#
148
149 return ()
150 where
151 b = 2988348162058574136915891421498819466320163312926952423791023078876139
152 e = 2351399303373464486466122544523690094744975233415544072992656881240319
153 m = 10^(40::Int)
154
155 x = 5328841272400314897981163497728751426
156 y = 32052182750761975518649228050096851724
157
158 b1024 = roll (map fromIntegral (take 128 [0x80::Int .. ]))
159
160 rle = map (\x -> (length x, head x)) . group
161
162
163 roll :: [Word8] -> Integer
164 roll = GHC.Base.foldr (\b a -> a `shiftL` 8 .|. fromIntegral b) 0