diff options
| -rw-r--r-- | libraries/integer-gmp/changelog.md | 4 | ||||
| -rw-r--r-- | libraries/integer-gmp/src/GHC/Integer/Type.hs | 40 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/all.T | 2 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/plusMinusInteger.hs | 36 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/plusMinusInteger.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/perf/should_run/all.T | 3 |
6 files changed, 81 insertions, 5 deletions
diff --git a/libraries/integer-gmp/changelog.md b/libraries/integer-gmp/changelog.md index 5245e23aac..cdee847744 100644 --- a/libraries/integer-gmp/changelog.md +++ b/libraries/integer-gmp/changelog.md @@ -1,5 +1,9 @@ # Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp) +## 1.0.0.2 *TBA* + + * Optimize `minusInteger` + ## 1.0.0.1 *Feb 2016* * Bundled with GHC 8.0.1 diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index 9ed17fc1b1..6506ebf2f8 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -418,10 +418,44 @@ plusInteger (Jp# x) (Jn# y) GT -> bigNatToInteger (minusBigNat x y) {-# CONSTANT_FOLDED plusInteger #-} --- TODO --- | Subtract two 'Integer's from each other. +-- | Subtract one 'Integer' from another. minusInteger :: Integer -> Integer -> Integer -minusInteger x y = inline plusInteger x (inline negateInteger y) +minusInteger x (S# 0#) = x +minusInteger (S# 0#) (S# INT_MINBOUND#) = Jp# (wordToBigNat ABS_INT_MINBOUND##) +minusInteger (S# 0#) (S# y#) = S# (negateInt# y#) +minusInteger (S# x#) (S# y#) + = case subIntC# x# y# of + (# z#, 0# #) -> S# z# + (# 0#, _ #) -> Jn# (wordToBigNat2 1## 0##) + (# z#, _ #) + | isTrue# (z# ># 0#) -> Jn# (wordToBigNat ( (int2Word# (negateInt# z#)))) + | True -> Jp# (wordToBigNat ( (int2Word# z#))) +minusInteger (S# x#) (Jp# y) + | isTrue# (x# >=# 0#) = bigNatToNegInteger (minusBigNatWord y (int2Word# x#)) + | True = Jn# (plusBigNatWord y (int2Word# (negateInt# x#))) +minusInteger (S# x#) (Jn# y) + | isTrue# (x# >=# 0#) = Jp# (plusBigNatWord y (int2Word# x#)) + | True = bigNatToInteger (minusBigNatWord y (int2Word# + (negateInt# x#))) +minusInteger (Jp# x) (Jp# y) + = case compareBigNat x y of + LT -> bigNatToNegInteger (minusBigNat y x) + EQ -> S# 0# + GT -> bigNatToInteger (minusBigNat x y) +minusInteger (Jp# x) (Jn# y) = Jp# (plusBigNat x y) +minusInteger (Jn# x) (Jp# y) = Jn# (plusBigNat x y) +minusInteger (Jn# x) (Jn# y) + = case compareBigNat x y of + LT -> bigNatToInteger (minusBigNat y x) + EQ -> S# 0# + GT -> bigNatToNegInteger (minusBigNat x y) +minusInteger (Jp# x) (S# y#) + | isTrue# (y# >=# 0#) = bigNatToInteger (minusBigNatWord x (int2Word# y#)) + | True = Jp# (plusBigNatWord x (int2Word# (negateInt# y#))) +minusInteger (Jn# x) (S# y#) + | isTrue# (y# >=# 0#) = Jn# (plusBigNatWord x (int2Word# y#)) + | True = bigNatToNegInteger (minusBigNatWord x + (int2Word# (negateInt# y#))) {-# CONSTANT_FOLDED minusInteger #-} -- | Multiply two 'Integer's diff --git a/testsuite/tests/lib/integer/all.T b/testsuite/tests/lib/integer/all.T index c0b39b01e4..327f5778f4 100644 --- a/testsuite/tests/lib/integer/all.T +++ b/testsuite/tests/lib/integer/all.T @@ -2,6 +2,7 @@ test('integerBits', normal, compile_and_run, ['']) test('integerConversions', normal, compile_and_run, ['']) # skip ghci as it doesn't support unboxed tuples test('integerGmpInternals', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, ['']) +test('plusMinusInteger', [reqlib('integer-gmp'), omit_ways('ghci')], compile_and_run, ['']) test('integerConstantFolding', [extra_clean(['integerConstantFolding.simpl']), when(compiler_debugged(), expect_broken(11006))], @@ -16,4 +17,3 @@ test('IntegerConversionRules', run_command, ['$MAKE -s --no-print-directory IntegerConversionRules']) test('gcdInteger', normal, compile_and_run, ['']) - diff --git a/testsuite/tests/lib/integer/plusMinusInteger.hs b/testsuite/tests/lib/integer/plusMinusInteger.hs new file mode 100644 index 0000000000..ec8d7e6ab4 --- /dev/null +++ b/testsuite/tests/lib/integer/plusMinusInteger.hs @@ -0,0 +1,36 @@ +module Main (main) where + + +main :: IO () +main = do + print $ length vals + + where + boundaries :: [Integer] + boundaries = [fromIntegral (maxBound :: Int) - 3, + fromIntegral (maxBound :: Int) - 2, + fromIntegral (maxBound :: Int) - 1, + fromIntegral (maxBound :: Int), + fromIntegral (maxBound :: Int) + 1, + fromIntegral (maxBound :: Int) + 2, + fromIntegral (maxBound :: Int) + 3, + + fromIntegral (minBound :: Int) - 3, + fromIntegral (minBound :: Int) - 2, + fromIntegral (minBound :: Int) - 1, + fromIntegral (minBound :: Int), + fromIntegral (minBound :: Int) + 1, + fromIntegral (minBound :: Int) + 2, + fromIntegral (minBound :: Int) + 3, + + fromIntegral (maxBound :: Word) - 3, + fromIntegral (maxBound :: Word) - 2, + fromIntegral (maxBound :: Word) - 1, + fromIntegral (maxBound :: Word), + fromIntegral (maxBound :: Word) + 1, + fromIntegral (maxBound :: Word) + 2, + fromIntegral (maxBound :: Word) + 3, + + -3, -2, -1, 0, 1, 2, 3] + vals = filter (\(x, y) -> x /= y) [(x - y, x + negate y) | + x <- boundaries, y <- boundaries] diff --git a/testsuite/tests/lib/integer/plusMinusInteger.stdout b/testsuite/tests/lib/integer/plusMinusInteger.stdout new file mode 100644 index 0000000000..c227083464 --- /dev/null +++ b/testsuite/tests/lib/integer/plusMinusInteger.stdout @@ -0,0 +1 @@ +0
\ No newline at end of file diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 81a55350e1..d039f68dbf 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -204,9 +204,10 @@ test('T5549', # expected value: 3362958676 (Windows) # 2014-12-01: 4096606332 (Windows) integer-gmp2 - (wordsize(64), 8193140752, 5)]), + (wordsize(64), 5793140200, 5)]), # expected value: 6725846120 (amd64/Linux) # 8193140752 (amd64/Linux) integer-gmp2 + # 5793140200 (amd64/Linux) integer-gmp2 only_ways(['normal']) ], compile_and_run, |