summaryrefslogtreecommitdiff
path: root/testsuite/tests/lib
diff options
context:
space:
mode:
authorHerbert Valerio Riedel <hvr@gnu.org>2014-11-28 17:13:33 +0100
committerHerbert Valerio Riedel <hvr@gnu.org>2014-11-28 17:21:30 +0100
commit2eecf348a62c47abd2f5de5f7eac5f7a3a779107 (patch)
treef28795ae193ad0aa399af9cfb1d70a41cff20bfc /testsuite/tests/lib
parent8d7831108644584f710515b39b9fc97fbeca7a4c (diff)
downloadhaskell-2eecf348a62c47abd2f5de5f7eac5f7a3a779107.tar.gz
Re-activate `integerGmpInternals` test (#9281)
The `integerGmpInternals` test was disabled in c774b28f76ee4c220f7c1c9fd81585e0e3af0e8a as many of the primitives tested in that test weren't available yet w/ `integer-gmp2`. However, most operations have been reimplemented by now, with the exception of recipModInteger :: Integer -> Integer -> Integer gcdExtInteger :: Integer -> Integer -> (Integer, Integer) powModSecInteger :: Integer -> Integer -> Integer -> Integer powModInteger :: Integer -> Integer -> Integer -> Integer powInteger :: Integer -> Word -> Integer which are still missing, and will (time permitting) be reimplemented over time.
Diffstat (limited to 'testsuite/tests/lib')
-rw-r--r--testsuite/tests/lib/integer/all.T3
-rw-r--r--testsuite/tests/lib/integer/integerGmpInternals.hs78
2 files changed, 55 insertions, 26 deletions
diff --git a/testsuite/tests/lib/integer/all.T b/testsuite/tests/lib/integer/all.T
index 55154265fc..7b5e5f2dbe 100644
--- a/testsuite/tests/lib/integer/all.T
+++ b/testsuite/tests/lib/integer/all.T
@@ -1,8 +1,7 @@
test('integerBits', normal, compile_and_run, [''])
test('integerConversions', normal, compile_and_run, [''])
-## 'integerGmpInternals' disabled till the extra primitives are re-implemented
# skip ghci as it doesn't support unboxed tuples
-# test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, [''])
+test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, [''])
test('integerConstantFolding',
[ extra_clean(['integerConstantFolding.simpl'])
, when(compiler_debugged(), expect_broken(8525))],
diff --git a/testsuite/tests/lib/integer/integerGmpInternals.hs b/testsuite/tests/lib/integer/integerGmpInternals.hs
index c709a22cee..5db0b099ae 100644
--- a/testsuite/tests/lib/integer/integerGmpInternals.hs
+++ b/testsuite/tests/lib/integer/integerGmpInternals.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash, UnboxedTuples #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
module Main (main) where
@@ -12,11 +12,58 @@ import GHC.Base
import GHC.Integer.GMP.Internals (Integer(S#,Jp#,Jn#))
import qualified GHC.Integer.GMP.Internals as I
+-- NOTE: Some of the following operations were provided with
+-- integer-gmp-0.5.1, but were not ported to integer-gmp-1.0.0 (yet);
+-- so we use naive reference-implementations instead for the meantime
+-- in order to keep the reference-output untouched.
+
+-- FIXME: Lacks GMP2 version
+-- stolen from `arithmoi` package
+recipModInteger :: Integer -> Integer -> Integer
+recipModInteger k 0 = if k == 1 || k == (-1) then k else 0
+recipModInteger k m = case gcdExtInteger k' m' of
+ (1, u) -> if u < 0 then m' + u else u
+ _ -> 0
+ where
+ m' = abs m
+ k' | k >= m' || k < 0 = k `mod` m'
+ | otherwise = k
+
+-- FIXME: Lacks GMP2 version
gcdExtInteger :: Integer -> Integer -> (Integer, Integer)
-gcdExtInteger a b = case I.gcdExtInteger a b of (# a, b #) -> (a,b)
+gcdExtInteger a b = (d, u) -- stolen from `arithmoi` package
+ where
+ (d, x, y) = eGCD 0 1 1 0 (abs a) (abs b)
+ u | a < 0 = negate x
+ | otherwise = x
+ v | b < 0 = negate y
+ | otherwise = y
+ eGCD !n1 o1 !n2 o2 r s
+ | s == 0 = (r, o1, o2)
+ | otherwise = case r `quotRem` s of
+ (q, t) -> eGCD (o1 - q*n1) n1 (o2 - q*n2) n2 s t
+
+-- FIXME: Lacks GMP2 version
+powModSecInteger :: Integer -> Integer -> Integer -> Integer
+powModSecInteger = powModInteger
+
+-- FIXME: Lacks GMP2 version
+powModInteger :: Integer -> Integer -> Integer -> Integer
+powModInteger b0 e0 m
+ | e0 >= 0 = go b0 e0 1
+ | otherwise = error "non-neg exponent required"
+ where
+ go !b e !r
+ | odd e = go b' e' (r*b `mod` m)
+ | e == 0 = r
+ | otherwise = go b' e' r
+ where
+ b' = b*b `mod` m
+ e' = e `unsafeShiftR` 1 -- slightly faster than "e `div` 2"
+-- FIXME: Lacks GMP2 version
powInteger :: Integer -> Word -> Integer
-powInteger b (W# w#) = I.powInteger b w#
+powInteger x e = x^e
exportInteger :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word
exportInteger = I.exportIntegerToMutableByteArray
@@ -30,23 +77,6 @@ importInteger = I.importIntegerFromByteArray
importIntegerAddr :: Addr# -> Word# -> Int# -> IO Integer
importIntegerAddr a l e = I.importIntegerFromAddr a l e
-{- Reference implementation for 'powModInteger'
-
-powModIntegerHs :: Integer -> Integer -> Integer -> Integer
-powModIntegerHs b0 e0 m
- | e0 >= 0 = go b0 e0 1
- | otherwise = error "non-neg exponent required"
- where
- go !b e !r
- | odd e = go b' e' (r*b `mod` m)
- | e == 0 = r
- | otherwise = go b' e' r
- where
- b' = b*b `mod` m
- e' = e `unsafeShiftR` 1 -- slightly faster than "e `div` 2"
-
--}
-
-- helpers
data MBA = MBA { unMBA :: !(MutableByteArray# RealWorld) }
data BA = BA { unBA :: !ByteArray# }
@@ -78,9 +108,9 @@ freezeByteArray arr = IO $ \s -> case unsafeFreezeByteArray# arr s of (# s, arr
----------------------------------------------------------------------------
main :: IO ()
main = do
- print $ I.powModInteger b e m
- print $ I.powModInteger b e (m-1)
- print $ I.powModSecInteger b e (m-1)
+ print $ powModInteger b e m
+ print $ powModInteger b e (m-1)
+ print $ powModSecInteger b e (m-1)
print $ gcdExtInteger b e
print $ gcdExtInteger e b
print $ gcdExtInteger x y
@@ -88,7 +118,7 @@ main = do
print $ powInteger 12345 0
print $ powInteger 12345 1
print $ powInteger 12345 30
- print $ [ (x,i) | x <- [0..71], let i = I.recipModInteger x (2*3*11*11*17*17), i /= 0 ]
+ print $ [ (x,i) | x <- [0..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ]
print $ I.nextPrimeInteger b
print $ I.nextPrimeInteger e
print $ [ k | k <- [ 0 .. 200 ], S# (I.testPrimeInteger k 25#) `elem` [1,2] ]