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     {-# INLINE bit #-}
 155     {-# INLINE setBit #-}
 156     {-# INLINE clearBit #-}
 157     {-# INLINE complementBit #-}
 158     {-# INLINE testBit #-}
 159     bit i               = 1 `shiftL` i
 160     x `setBit` i        = x .|. bit i
 161     x `clearBit` i      = x .&. complement (bit i)
 162     x `complementBit` i = x `xor` bit i
 163     x `testBit` i       = (x .&. bit i) /= 0
 164
 165     {-| Shift the argument left by the specified number of bits
 166         (which must be non-negative).
 167
 168         An instance can define either this and 'shiftR' or the unified
 169         'shift', depending on which is more convenient for the type in
 170         question. -}
 171     shiftL            :: a -> Int -> a
 172     {-# INLINE shiftL #-}
 173     x `shiftL`  i = x `shift`  i
 174
 175     {-| Shift the first argument right by the specified number of bits
 176         (which must be non-negative).
 177         Right shifts perform sign extension on signed number types;
 178         i.e. they fill the top bits with 1 if the @x@ is negative
 179         and with 0 otherwise.
 180
 181         An instance can define either this and 'shiftL' or the unified
 182         'shift', depending on which is more convenient for the type in
 183         question. -}
 184     shiftR            :: a -> Int -> a
 185     {-# INLINE shiftR #-}
 186     x `shiftR`  i = x `shift`  (-i)
 187
 188     {-| Rotate the argument left by the specified number of bits
 189         (which must be non-negative).
 190
 191         An instance can define either this and 'rotateR' or the unified
 192         'rotate', depending on which is more convenient for the type in
 193         question. -}
 194     rotateL           :: a -> Int -> a
 195     {-# INLINE rotateL #-}
 196     x `rotateL` i = x `rotate` i
 197
 198     {-| Rotate the argument right by the specified number of bits
 199         (which must be non-negative).
 200
 201         An instance can define either this and 'rotateL' or the unified
 202         'rotate', depending on which is more convenient for the type in
 203         question. -}
 204     rotateR           :: a -> Int -> a
 205     {-# INLINE rotateR #-}
 206     x `rotateR` i = x `rotate` (-i)
 207
 208 instance Bits Int where
 209     {-# INLINE shift #-}
 210
 211 #ifdef __GLASGOW_HASKELL__
 212     (I# x#) .&.   (I# y#)  = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
 213
 214     (I# x#) .|.   (I# y#)  = I# (word2Int# (int2Word# x# `or#`  int2Word# y#))
 215
 216     (I# x#) `xor` (I# y#)  = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
 217
 218     complement (I# x#)     = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
 219
 220     (I# x#) `shift` (I# i#)
 221         | i# >=# 0#        = I# (x# `iShiftL#` i#)
 222         | otherwise        = I# (x# `iShiftRA#` negateInt# i#)
 223
 224     {-# INLINE rotate #-}       -- See Note [Constant folding for rotate]
 225     (I# x#) `rotate` (I# i#) =
 226         I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
 227                        (x'# `uncheckedShiftRL#` (wsib -# i'#))))
 228       where
 229         !x'# = int2Word# x#
 230         !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
 231         !wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
 232     bitSize  _             = WORD_SIZE_IN_BITS
 233
 234 #else /* !__GLASGOW_HASKELL__ */
 235
 236 #ifdef __HUGS__
 237     (.&.)                  = primAndInt
 238     (.|.)                  = primOrInt
 239     xor                    = primXorInt
 240     complement             = primComplementInt
 241     shift                  = primShiftInt
 242     bit                    = primBitInt
 243     testBit                = primTestInt
 244     bitSize _              = SIZEOF_HSINT*8
 245 #elif defined(__NHC__)
 246     (.&.)                  = nhc_primIntAnd
 247     (.|.)                  = nhc_primIntOr
 248     xor                    = nhc_primIntXor
 249     complement             = nhc_primIntCompl
 250     shiftL                 = nhc_primIntLsh
 251     shiftR                 = nhc_primIntRsh
 252     bitSize _              = 32
 253 #endif /* __NHC__ */
 254
 255     x `rotate`  i
 256         | i<0 && x<0       = let left = i+bitSize x in
 257                              ((x `shift` i) .&. complement ((-1) `shift` left))
 258                              .|. (x `shift` left)
 259         | i<0              = (x `shift` i) .|. (x `shift` (i+bitSize x))
 260         | i==0             = x
 261         | i>0              = (x `shift` i) .|. (x `shift` (i-bitSize x))
 262
 263 #endif /* !__GLASGOW_HASKELL__ */
 264
 265     isSigned _             = True
 266
 267 #ifdef __NHC__
 268 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
 269 foreign import ccall nhc_primIntOr  :: Int -> Int -> Int
 270 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
 271 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
 272 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
 273 foreign import ccall nhc_primIntCompl :: Int -> Int
 274 #endif /* __NHC__ */
 275
 276 instance Bits Integer where
 277 #if defined(__GLASGOW_HASKELL__)
 278    (.&.) = andInteger
 279    (.|.) = orInteger
 280    xor = xorInteger
 281    complement = complementInteger
 282    shift x i@(I# i#) | i >= 0    = shiftLInteger x i#
 283                      | otherwise = shiftRInteger x (negateInt# i#)
 284 #else
 285    -- reduce bitwise binary operations to special cases we can handle
 286
 287    x .&. y   | x<0 && y<0 = complement (complement x `posOr` complement y)
 288              | otherwise  = x `posAnd` y
 289
 290    x .|. y   | x<0 || y<0 = complement (complement x `posAnd` complement y)
 291              | otherwise  = x `posOr` y
 292
 293    x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
 294              | x<0        = complement (complement x `posXOr` y)
 295              |        y<0 = complement (x `posXOr` complement y)
 296              | otherwise  = x `posXOr` y
 297
 298    -- assuming infinite 2's-complement arithmetic
 299    complement a = -1 - a
 300    shift x i | i >= 0    = x * 2^i
 301              | otherwise = x `div` 2^(-i)
 302 #endif
 303
 304    rotate x i = shift x i   -- since an Integer never wraps around
 305
 306    bitSize _  = error "Data.Bits.bitSize(Integer)"
 307    isSigned _ = True
 308
 309 #if !defined(__GLASGOW_HASKELL__)
 310 -- Crude implementation of bitwise operations on Integers: convert them
 311 -- to finite lists of Ints (least significant first), zip and convert
 312 -- back again.
 313
 314 -- posAnd requires at least one argument non-negative
 315 -- posOr and posXOr require both arguments non-negative
 316
 317 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
 318 posAnd x y   = fromInts $ zipWith (.&.) (toInts x) (toInts y)
 319 posOr x y    = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
 320 posXOr x y   = fromInts $ longZipWith xor (toInts x) (toInts y)
 321
 322 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
 323 longZipWith f xs [] = xs
 324 longZipWith f [] ys = ys
 325 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
 326
 327 toInts :: Integer -> [Int]
 328 toInts n
 329     | n == 0 = []
 330     | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
 331   where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
 332                 | otherwise = fromInteger n
 333
 334 fromInts :: [Int] -> Integer
 335 fromInts = foldr catInt 0
 336     where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
 337
 338 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
 339 #endif /* !__GLASGOW_HASKELL__ */
 340
 341 {-      Note [Constant folding for rotate]
 342         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 343 The INLINE on the Int instance of rotate enables it to be constant
 344 folded.  For example:
 345      sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
 346 goes to:
 347    Main.$wfold =
 348      \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
 349        case ww1_sOb of wild_XM {
 350          __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
 351          10000000 -> ww_sO7
 352 whereas before it was left as a call to $wrotate.
 353
 354 All other Bits instances seem to inline well enough on their
 355 own to enable constant folding; for example 'shift':
 356      sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
 357  goes to:
 358      Main.$wfold =
 359        \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
 360          case ww1_sOf of wild_XM {
 361            __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
 362            10000000 -> ww_sOb
 363          }
 364 -}
 365
 366