[commit: ghc] master: integer-gmp: Make minusInteger more efficient (02f893e)
git at git.haskell.org
git at git.haskell.org
Sat Jun 4 07:33:01 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/02f893eb4fe3f75f0a9dc7e723568f4c75de5785/ghc
>---------------------------------------------------------------
commit 02f893eb4fe3f75f0a9dc7e723568f4c75de5785
Author: Alan Mock <alan at alanmock.com>
Date: Fri Jun 3 22:16:27 2016 +0200
integer-gmp: Make minusInteger more efficient
Give `minusInteger` its own implementation.
Previously `minusInteger` used `plusInteger` and `negateInteger`, which
meant it always allocated. Now it works more like `plusInteger`.
Reviewers: goldfire, hvr, bgamari, austin
Reviewed By: hvr, bgamari, austin
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2278
GHC Trac Issues: #12129
>---------------------------------------------------------------
02f893eb4fe3f75f0a9dc7e723568f4c75de5785
libraries/integer-gmp/changelog.md | 4 +++
libraries/integer-gmp/src/GHC/Integer/Type.hs | 40 ++++++++++++++++++++--
testsuite/tests/lib/integer/all.T | 2 +-
testsuite/tests/lib/integer/plusMinusInteger.hs | 36 +++++++++++++++++++
.../tests/lib/integer/plusMinusInteger.stdout | 1 +
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 5245e23..cdee847 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 9ed17fc..6506ebf 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 c0b39b0..327f577 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 0000000..ec8d7e6
--- /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 0000000..c227083
--- /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 81a5535..d039f68 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,
More information about the ghc-commits
mailing list