X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FBits.hs;h=c9230c59bffc61acf927ea9da6721c4f87c4a27e;hb=5ba076a7ebba87a34293dca92d8b3d8ea0dd9648;hp=a1a6e8bc70355abab4fcac8bee3a500d96059b83;hpb=a513eda725b201857f1bd77d6a22f8f5fa26a49a;p=ghc-base.git

diff --git a/Data/Bits.hs b/Data/Bits.hs
index a1a6e8b..c9230c5 100644
--- a/Data/Bits.hs
+++ b/Data/Bits.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Bits
@@ -48,7 +49,6 @@ module Data.Bits (
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Num
-import GHC.Real
 import GHC.Base
 #endif
 
@@ -95,9 +95,9 @@ class Num a => Bits a where
         question. -}
     shift             :: a -> Int -> a
 
-    x `shift`   i | i<0  = x `shiftR` (-i)
-                  | i==0 = x
-                  | i>0  = x `shiftL` i
+    x `shift`   i | i<0       = x `shiftR` (-i)
+                  | i>0       = x `shiftL` i
+                  | otherwise = x
 
     {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
         or right by @-i@ bits otherwise.
@@ -109,9 +109,9 @@ class Num a => Bits a where
         question. -}
     rotate            :: a -> Int -> a
 
-    x `rotate`  i | i<0  = x `rotateR` (-i)
-                  | i==0 = x
-                  | i>0  = x `rotateL` i
+    x `rotate`  i | i<0       = x `rotateR` (-i)
+                  | i>0       = x `rotateL` i
+                  | otherwise = x
 
     {-
     -- Rotation can be implemented in terms of two shifts, but care is
@@ -127,7 +127,7 @@ class Num a => Bits a where
                   | i>0  = (x `shift` i) .|. (x `shift` (i-bitSize x))
     -}
 
-    -- | @bit i@ is a value with the @i@th bit set
+    -- | @bit i@ is a value with the @i@th bit set and all other bits clear
     bit               :: Int -> a
 
     -- | @x \`setBit\` i@ is the same as @x .|. bit i@
@@ -152,6 +152,11 @@ class Num a => Bits a where
         value of the argument is ignored -}
     isSigned          :: a -> Bool
 
+    {-# INLINE bit #-}
+    {-# INLINE setBit #-}
+    {-# INLINE clearBit #-}
+    {-# INLINE complementBit #-}
+    {-# INLINE testBit #-}
     bit i               = 1 `shiftL` i
     x `setBit` i        = x .|. bit i
     x `clearBit` i      = x .&. complement (bit i)
@@ -165,6 +170,7 @@ class Num a => Bits a where
         'shift', depending on which is more convenient for the type in
         question. -}
     shiftL            :: a -> Int -> a
+    {-# INLINE shiftL #-}
     x `shiftL`  i = x `shift`  i
 
     {-| Shift the first argument right by the specified number of bits
@@ -177,6 +183,7 @@ class Num a => Bits a where
         'shift', depending on which is more convenient for the type in
         question. -}
     shiftR            :: a -> Int -> a
+    {-# INLINE shiftR #-}
     x `shiftR`  i = x `shift`  (-i)
 
     {-| Rotate the argument left by the specified number of bits
@@ -186,6 +193,7 @@ class Num a => Bits a where
         'rotate', depending on which is more convenient for the type in
         question. -}
     rotateL           :: a -> Int -> a
+    {-# INLINE rotateL #-}
     x `rotateL` i = x `rotate` i
 
     {-| Rotate the argument right by the specified number of bits
@@ -195,6 +203,7 @@ class Num a => Bits a where
         'rotate', depending on which is more convenient for the type in
         question. -}
     rotateR           :: a -> Int -> a
+    {-# INLINE rotateR #-}
     x `rotateR` i = x `rotate` (-i)
 
 instance Bits Int where
@@ -202,20 +211,27 @@ instance Bits Int where
 
 #ifdef __GLASGOW_HASKELL__
     (I# x#) .&.   (I# y#)  = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
+
     (I# x#) .|.   (I# y#)  = I# (word2Int# (int2Word# x# `or#`  int2Word# y#))
+
     (I# x#) `xor` (I# y#)  = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+
     complement (I# x#)     = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
+
     (I# x#) `shift` (I# i#)
         | i# >=# 0#        = I# (x# `iShiftL#` i#)
         | otherwise        = I# (x# `iShiftRA#` negateInt# i#)
+
+    {-# INLINE rotate #-} 	-- See Note [Constant folding for rotate]
     (I# x#) `rotate` (I# i#) =
         I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                        (x'# `uncheckedShiftRL#` (wsib -# i'#))))
-        where
-        x'# = int2Word# x#
-        i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
-        wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
+      where
+        !x'# = int2Word# x#
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+        !wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
     bitSize  _             = WORD_SIZE_IN_BITS
+
 #else /* !__GLASGOW_HASKELL__ */
 
 #ifdef __HUGS__
@@ -259,30 +275,13 @@ foreign import ccall nhc_primIntCompl :: Int -> Int
 #endif /* __NHC__ */
 
 instance Bits Integer where
-#ifdef __GLASGOW_HASKELL__
-   (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
-   x@(S# _) .&. y = toBig x .&. y
-   x .&. y@(S# _) = x .&. toBig y
-   (J# s1 d1) .&. (J# s2 d2) = 
-        case andInteger# s1 d1 s2 d2 of
-          (# s, d #) -> J# s d
-
-   (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
-   x@(S# _) .|. y = toBig x .|. y
-   x .|. y@(S# _) = x .|. toBig y
-   (J# s1 d1) .|. (J# s2 d2) = 
-        case orInteger# s1 d1 s2 d2 of
-          (# s, d #) -> J# s d
-   
-   (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
-   x@(S# _) `xor` y = toBig x `xor` y
-   x `xor` y@(S# _) = x `xor` toBig y
-   (J# s1 d1) `xor` (J# s2 d2) =
-        case xorInteger# s1 d1 s2 d2 of
-          (# s, d #) -> J# s d
-   
-   complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
-   complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
+#if defined(__GLASGOW_HASKELL__)
+   (.&.) = andInteger
+   (.|.) = orInteger
+   xor = xorInteger
+   complement = complementInteger
+   shift x i@(I# i#) | i >= 0    = shiftLInteger x i#
+                     | otherwise = shiftRInteger x (negateInt# i#)
 #else
    -- reduce bitwise binary operations to special cases we can handle
 
@@ -299,17 +298,16 @@ instance Bits Integer where
 
    -- assuming infinite 2's-complement arithmetic
    complement a = -1 - a
-#endif
-
    shift x i | i >= 0    = x * 2^i
              | otherwise = x `div` 2^(-i)
+#endif
 
    rotate x i = shift x i   -- since an Integer never wraps around
 
    bitSize _  = error "Data.Bits.bitSize(Integer)"
    isSigned _ = True
 
-#ifndef __GLASGOW_HASKELL__
+#if !defined(__GLASGOW_HASKELL__)
 -- Crude implementation of bitwise operations on Integers: convert them
 -- to finite lists of Ints (least significant first), zip and convert
 -- back again.
@@ -340,3 +338,30 @@ fromInts = foldr catInt 0
 
 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
 #endif /* !__GLASGOW_HASKELL__ */
+
+{- 	Note [Constant folding for rotate]
+	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The INLINE on the Int instance of rotate enables it to be constant
+folded.  For example:
+     sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
+goes to:
+   Main.$wfold =
+     \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
+       case ww1_sOb of wild_XM {
+         __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
+         10000000 -> ww_sO7
+whereas before it was left as a call to $wrotate.
+
+All other Bits instances seem to inline well enough on their
+own to enable constant folding; for example 'shift':
+     sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
+ goes to:
+     Main.$wfold =
+       \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
+         case ww1_sOf of wild_XM {
+           __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
+           10000000 -> ww_sOb
+         }
+-} 
+     
+