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 #else
 277    -- reduce bitwise binary operations to special cases we can handle
 278
 279    x .&. y   | x<0 && y<0 = complement (complement x `posOr` complement y)
 280              | otherwise  = x `posAnd` y
 281
 282    x .|. y   | x<0 || y<0 = complement (complement x `posAnd` complement y)
 283              | otherwise  = x `posOr` y
 284
 285    x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
 286              | x<0        = complement (complement x `posXOr` y)
 287              |        y<0 = complement (x `posXOr` complement y)
 288              | otherwise  = x `posXOr` y
 289
 290    -- assuming infinite 2's-complement arithmetic
 291    complement a = -1 - a
 292 #endif
 293
 294    shift x i@(I# i#) | i >= 0    = shiftLInteger x i#
 295                      | otherwise = shiftRInteger x (negateInt# i#)
 296
 297    rotate x i = shift x i   -- since an Integer never wraps around
 298
 299    bitSize _  = error "Data.Bits.bitSize(Integer)"
 300    isSigned _ = True
 301
 302 #if !defined(__GLASGOW_HASKELL__)
 303 -- Crude implementation of bitwise operations on Integers: convert them
 304 -- to finite lists of Ints (least significant first), zip and convert
 305 -- back again.
 306
 307 -- posAnd requires at least one argument non-negative
 308 -- posOr and posXOr require both arguments non-negative
 309
 310 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
 311 posAnd x y   = fromInts $ zipWith (.&.) (toInts x) (toInts y)
 312 posOr x y    = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
 313 posXOr x y   = fromInts $ longZipWith xor (toInts x) (toInts y)
 314
 315 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
 316 longZipWith f xs [] = xs
 317 longZipWith f [] ys = ys
 318 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
 319
 320 toInts :: Integer -> [Int]
 321 toInts n
 322     | n == 0 = []
 323     | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
 324   where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
 325                 | otherwise = fromInteger n
 326
 327 fromInts :: [Int] -> Integer
 328 fromInts = foldr catInt 0
 329     where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
 330
 331 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
 332 #endif /* !__GLASGOW_HASKELL__ */
 333
 334 {-      Note [Constant folding for rotate]
 335         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 336 The INLINE on the Int instance of rotate enables it to be constant
 337 folded.  For example:
 338      sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
 339 goes to:
 340    Main.$wfold =
 341      \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
 342        case ww1_sOb of wild_XM {
 343          __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
 344          10000000 -> ww_sO7
 345 whereas before it was left as a call to $wrotate.
 346
 347 All other Bits instances seem to inline well enough on their
 348 own to enable constant folding; for example 'shift':
 349      sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
 350  goes to:
 351      Main.$wfold =
 352        \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
 353          case ww1_sOf of wild_XM {
 354            __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
 355            10000000 -> ww_sOb
 356          }
 357 -}
 358
 359