summaryrefslogtreecommitdiff
path: root/libraries/integer-gmp/GHC/Integer.lhs
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2009-07-22 01:48:40 +0000
committerIan Lynagh <igloo@earth.li>2009-07-22 01:48:40 +0000
commit8325cd81876a9fcb11fa19e5872dd087daa93aa5 (patch)
treed0fdb869498ecde76124a09a27c4cc8c50069ba6 /libraries/integer-gmp/GHC/Integer.lhs
parent3ee11c4c8613aadd156b7a01e5db6ef3d7734472 (diff)
downloadhaskell-8325cd81876a9fcb11fa19e5872dd087daa93aa5.tar.gz
Add primops for shifting
Diffstat (limited to 'libraries/integer-gmp/GHC/Integer.lhs')
-rw-r--r--libraries/integer-gmp/GHC/Integer.lhs12
1 files changed, 12 insertions, 0 deletions
diff --git a/libraries/integer-gmp/GHC/Integer.lhs b/libraries/integer-gmp/GHC/Integer.lhs
index c32da603a3..971c7e6895 100644
--- a/libraries/integer-gmp/GHC/Integer.lhs
+++ b/libraries/integer-gmp/GHC/Integer.lhs
@@ -40,6 +40,7 @@ module GHC.Integer (
encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
gcdInteger, lcmInteger,
andInteger, orInteger, xorInteger, complementInteger,
+ shiftLInteger, shiftRInteger,
hashInteger,
) where
@@ -67,6 +68,7 @@ import GHC.Integer.GMP.Internals (
decodeDouble#,
int2Integer#, integer2Int#, word2Integer#, integer2Word#,
andInteger#, orInteger#, xorInteger#, complementInteger#,
+ mul2ExpInteger#, fdivQ2ExpInteger#,
#if WORD_SIZE_IN_BITS < 64
int64ToInteger#, integerToInt64#,
word64ToInteger#, integerToWord64#,
@@ -515,6 +517,16 @@ complementInteger (S# x)
= S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
complementInteger (J# s d)
= case complementInteger# s d of (# s', d' #) -> J# s' d'
+
+shiftLInteger :: Integer -> Int# -> Integer
+shiftLInteger j@(S# _) i = shiftLInteger (toBig j) i
+shiftLInteger (J# s d) i = case mul2ExpInteger# s d i of
+ (# s', d' #) -> J# s' d'
+
+shiftRInteger :: Integer -> Int# -> Integer
+shiftRInteger j@(S# _) i = shiftRInteger (toBig j) i
+shiftRInteger (J# s d) i = case fdivQ2ExpInteger# s d i of
+ (# s', d' #) -> J# s' d'
\end{code}
%*********************************************************