Data/Bits.hs

   1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Data.Bits
   5 -- Copyright   :  (c) The University of Glasgow 2001
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  portable
  11 --
  12 -- This module defines bitwise operations for signed and unsigned
  13 -- integers.  Instances of the class 'Bits' for the 'Int' and
  14 -- 'Integer' types are available from this module, and instances for
  15 -- explicitly sized integral types are available from the
  16 -- "Data.Int" and "Data.Word" modules.
  17 --
  18 -----------------------------------------------------------------------------
  19
  20 module Data.Bits (
  21   Bits(
  22     (.&.), (.|.), xor, -- :: a -> a -> a
  23     complement,        -- :: a -> a
  24     shift,             -- :: a -> Int -> a
  25     rotate,            -- :: a -> Int -> a
  26     bit,               -- :: Int -> a
  27     setBit,            -- :: a -> Int -> a
  28     clearBit,          -- :: a -> Int -> a
  29     complementBit,     -- :: a -> Int -> a
  30     testBit,           -- :: a -> Int -> Bool
  31     bitSize,           -- :: a -> Int
  32     isSigned,          -- :: a -> Bool
  33     shiftL, shiftR,    -- :: a -> Int -> a
  34     rotateL, rotateR   -- :: a -> Int -> a
  35   )
  36
  37   -- instance Bits Int
  38   -- instance Bits Integer
  39  ) where
  40
  41 -- Defines the @Bits@ class containing bit-based operations.
  42 -- See library document for details on the semantics of the
  43 -- individual operations.
  44
  45 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
  46 #include "MachDeps.h"
  47 #endif
  48
  49 #ifdef __GLASGOW_HASKELL__
  50 import GHC.Num
  51 import GHC.Base
  52 #endif
  53
  54 #ifdef __HUGS__
  55 import Hugs.Bits
  56 #endif
  57
  58 infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
  59 infixl 7 .&.
  60 infixl 6 `xor`
  61 infixl 5 .|.
  62
  63 {-|
  64 The 'Bits' class defines bitwise operations over integral types.
  65
  66 * Bits are numbered from 0 with bit 0 being the least
  67   significant bit.
  68
  69 Minimal complete definition: '.&.', '.|.', 'xor', 'complement',
  70 ('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')),
  71 'bitSize' and 'isSigned'.
  72 -}
  73 class Num a => Bits a where
  74     -- | Bitwise \"and\"
  75     (.&.) :: a -> a -> a
  76
  77     -- | Bitwise \"or\"
  78     (.|.) :: a -> a -> a
  79
  80     -- | Bitwise \"xor\"
  81     xor :: a -> a -> a
  82
  83     {-| Reverse all the bits in the argument -}
  84     complement        :: a -> a
  85
  86     {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,
  87         or right by @-i@ bits otherwise.
  88         Right shifts perform sign extension on signed number types;
  89         i.e. they fill the top bits with 1 if the @x@ is negative
  90         and with 0 otherwise.
  91
  92         An instance can define either this unified 'shift' or 'shiftL' and
  93         'shiftR', depending on which is more convenient for the type in
  94         question. -}
  95     shift             :: a -> Int -> a
  96
  97     x `shift`   i | i<0       = x `shiftR` (-i)
  98                   | i>0       = x `shiftL` i
  99                   | otherwise = x
 100
 101     {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
 102         or right by @-i@ bits otherwise.
 103
 104         For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
 105
 106         An instance can define either this unified 'rotate' or 'rotateL' and
 107         'rotateR', depending on which is more convenient for the type in
 108         question. -}
 109     rotate            :: a -> Int -> a
 110
 111     x `rotate`  i | i<0       = x `rotateR` (-i)
 112                   | i>0       = x `rotateL` i
 113                   | otherwise = x
 114
 115     {-
 116     -- Rotation can be implemented in terms of two shifts, but care is
 117     -- needed for negative values.  This suggested implementation assumes
 118     -- 2's-complement arithmetic.  It is commented out because it would
 119     -- require an extra context (Ord a) on the signature of 'rotate'.
 120     x `rotate`  i | i<0 && isSigned x && x<0
 121                          = let left = i+bitSize x in
 122                            ((x `shift` i) .&. complement ((-1) `shift` left))
 123                            .|. (x `shift` left)
 124                   | i<0  = (x `shift` i) .|. (x `shift` (i+bitSize x))
 125                   | i==0 = x
 126                   | i>0  = (x `shift` i) .|. (x `shift` (i-bitSize x))
 127     -}
 128
 129     -- | @bit i@ is a value with the @i@th bit set
 130     bit               :: Int -> a
 131
 132     -- | @x \`setBit\` i@ is the same as @x .|. bit i@
 133     setBit            :: a -> Int -> a
 134
 135     -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
 136     clearBit          :: a -> Int -> a
 137
 138     -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
 139     complementBit     :: a -> Int -> a
 140
 141     -- | Return 'True' if the @n@th bit of the argument is 1
 142     testBit           :: a -> Int -> Bool
 143
 144     {-| Return the number of bits in the type of the argument.  The actual
 145         value of the argument is ignored.  The function 'bitSize' is
 146         undefined for types that do not have a fixed bitsize, like 'Integer'.
 147         -}
 148     bitSize           :: a -> Int
 149
 150     {-| Return 'True' if the argument is a signed type.  The actual
 151         value of the argument is ignored -}
 152     isSigned          :: a -> Bool
 153
 154     bit i               = 1 `shiftL` i
 155     x `setBit` i        = x .|. bit i
 156     x `clearBit` i      = x .&. complement (bit i)
 157     x `complementBit` i = x `xor` bit i
 158     x `testBit` i       = (x .&. bit i) /= 0
 159
 160     {-| Shift the argument left by the specified number of bits
 161         (which must be non-negative).
 162
 163         An instance can define either this and 'shiftR' or the unified
 164         'shift', depending on which is more convenient for the type in
 165         question. -}
 166     shiftL            :: a -> Int -> a
 167     x `shiftL`  i = x `shift`  i
 168
 169     {-| Shift the first argument right by the specified number of bits
 170         (which must be non-negative).
 171         Right shifts perform sign extension on signed number types;
 172         i.e. they fill the top bits with 1 if the @x@ is negative
 173         and with 0 otherwise.
 174
 175         An instance can define either this and 'shiftL' or the unified
 176         'shift', depending on which is more convenient for the type in
 177         question. -}
 178     shiftR            :: a -> Int -> a
 179     x `shiftR`  i = x `shift`  (-i)
 180
 181     {-| Rotate the argument left by the specified number of bits
 182         (which must be non-negative).
 183
 184         An instance can define either this and 'rotateR' or the unified
 185         'rotate', depending on which is more convenient for the type in
 186         question. -}
 187     rotateL           :: a -> Int -> a
 188     x `rotateL` i = x `rotate` i
 189
 190     {-| Rotate the argument right by the specified number of bits
 191         (which must be non-negative).
 192
 193         An instance can define either this and 'rotateL' or the unified
 194         'rotate', depending on which is more convenient for the type in
 195         question. -}
 196     rotateR           :: a -> Int -> a
 197     x `rotateR` i = x `rotate` (-i)
 198
 199 instance Bits Int where
 200     {-# INLINE shift #-}
 201
 202 #ifdef __GLASGOW_HASKELL__
 203     (I# x#) .&.   (I# y#)  = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
 204
 205     (I# x#) .|.   (I# y#)  = I# (word2Int# (int2Word# x# `or#`  int2Word# y#))
 206
 207     (I# x#) `xor` (I# y#)  = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
 208
 209     complement (I# x#)     = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
 210
 211     (I# x#) `shift` (I# i#)
 212         | i# >=# 0#        = I# (x# `iShiftL#` i#)
 213         | otherwise        = I# (x# `iShiftRA#` negateInt# i#)
 214
 215     {-# INLINE rotate #-}       -- See Note [Constant folding for rotate]
 216     (I# x#) `rotate` (I# i#) =
 217         I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
 218                        (x'# `uncheckedShiftRL#` (wsib -# i'#))))
 219       where
 220         !x'# = int2Word# x#
 221         !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
 222         !wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
 223     bitSize  _             = WORD_SIZE_IN_BITS
 224
 225     {-# INLINE shiftR #-}
 226     -- same as the default definition, but we want it inlined (#2376)
 227     x `shiftR`  i = x `shift`  (-i)
 228 #else /* !__GLASGOW_HASKELL__ */
 229
 230 #ifdef __HUGS__
 231     (.&.)                  = primAndInt
 232     (.|.)                  = primOrInt
 233     xor                    = primXorInt
 234     complement             = primComplementInt
 235     shift                  = primShiftInt
 236     bit                    = primBitInt
 237     testBit                = primTestInt
 238     bitSize _              = SIZEOF_HSINT*8
 239 #elif defined(__NHC__)
 240     (.&.)                  = nhc_primIntAnd
 241     (.|.)                  = nhc_primIntOr
 242     xor                    = nhc_primIntXor
 243     complement             = nhc_primIntCompl
 244     shiftL                 = nhc_primIntLsh
 245     shiftR                 = nhc_primIntRsh
 246     bitSize _              = 32
 247 #endif /* __NHC__ */
 248
 249     x `rotate`  i
 250         | i<0 && x<0       = let left = i+bitSize x in
 251                              ((x `shift` i) .&. complement ((-1) `shift` left))
 252                              .|. (x `shift` left)
 253         | i<0              = (x `shift` i) .|. (x `shift` (i+bitSize x))
 254         | i==0             = x
 255         | i>0              = (x `shift` i) .|. (x `shift` (i-bitSize x))
 256
 257 #endif /* !__GLASGOW_HASKELL__ */
 258
 259     isSigned _             = True
 260
 261 #ifdef __NHC__
 262 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
 263 foreign import ccall nhc_primIntOr  :: Int -> Int -> Int
 264 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
 265 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
 266 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
 267 foreign import ccall nhc_primIntCompl :: Int -> Int
 268 #endif /* __NHC__ */
 269
 270 instance Bits Integer where
 271 #if defined(__GLASGOW_HASKELL__)
 272    (.&.) = andInteger
 273    (.|.) = orInteger
 274    xor = xorInteger
 275    complement = complementInteger
 276    shift x i@(I# i#) | i >= 0    = shiftLInteger x i#
 277                      | otherwise = shiftRInteger x (negateInt# i#)
 278 #else
 279    -- reduce bitwise binary operations to special cases we can handle
 280
 281    x .&. y   | x<0 && y<0 = complement (complement x `posOr` complement y)
 282              | otherwise  = x `posAnd` y
 283
 284    x .|. y   | x<0 || y<0 = complement (complement x `posAnd` complement y)
 285              | otherwise  = x `posOr` y
 286
 287    x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
 288              | x<0        = complement (complement x `posXOr` y)
 289              |        y<0 = complement (x `posXOr` complement y)
 290              | otherwise  = x `posXOr` y
 291
 292    -- assuming infinite 2's-complement arithmetic
 293    complement a = -1 - a
 294    shift x i | i >= 0    = x * 2^i
 295              | otherwise = x `div` 2^(-i)
 296 #endif
 297
 298    rotate x i = shift x i   -- since an Integer never wraps around
 299
 300    bitSize _  = error "Data.Bits.bitSize(Integer)"
 301    isSigned _ = True
 302
 303 #if !defined(__GLASGOW_HASKELL__)
 304 -- Crude implementation of bitwise operations on Integers: convert them
 305 -- to finite lists of Ints (least significant first), zip and convert
 306 -- back again.
 307
 308 -- posAnd requires at least one argument non-negative
 309 -- posOr and posXOr require both arguments non-negative
 310
 311 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
 312 posAnd x y   = fromInts $ zipWith (.&.) (toInts x) (toInts y)
 313 posOr x y    = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
 314 posXOr x y   = fromInts $ longZipWith xor (toInts x) (toInts y)
 315
 316 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
 317 longZipWith f xs [] = xs
 318 longZipWith f [] ys = ys
 319 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
 320
 321 toInts :: Integer -> [Int]
 322 toInts n
 323     | n == 0 = []
 324     | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
 325   where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
 326                 | otherwise = fromInteger n
 327
 328 fromInts :: [Int] -> Integer
 329 fromInts = foldr catInt 0
 330     where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
 331
 332 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
 333 #endif /* !__GLASGOW_HASKELL__ */
 334
 335 {-      Note [Constant folding for rotate]
 336         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 337 The INLINE on the Int instance of rotate enables it to be constant
 338 folded.  For example:
 339      sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
 340 goes to:
 341    Main.$wfold =
 342      \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
 343        case ww1_sOb of wild_XM {
 344          __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
 345          10000000 -> ww_sO7
 346 whereas before it was left as a call to $wrotate.
 347
 348 All other Bits instances seem to inline well enough on their
 349 own to enable constant folding; for example 'shift':
 350      sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
 351  goes to:
 352      Main.$wfold =
 353        \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
 354          case ww1_sOf of wild_XM {
 355            __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
 356            10000000 -> ww_sOb
 357          }
 358 -}
 359
 360