Data/Bits.hs

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