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.Real
  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
 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     bit i               = 1 `shiftL` i
 156     x `setBit` i        = x .|. bit i
 157     x `clearBit` i      = x .&. complement (bit i)
 158     x `complementBit` i = x `xor` bit i
 159     x `testBit` i       = (x .&. bit i) /= 0
 160
 161     {-| Shift the argument left by the specified number of bits
 162         (which must be non-negative).
 163
 164         An instance can define either this and 'shiftR' or the unified
 165         'shift', depending on which is more convenient for the type in
 166         question. -}
 167     shiftL            :: a -> Int -> a
 168     x `shiftL`  i = x `shift`  i
 169
 170     {-| Shift the first argument right by the specified number of bits
 171         (which must be non-negative).
 172         Right shifts perform sign extension on signed number types;
 173         i.e. they fill the top bits with 1 if the @x@ is negative
 174         and with 0 otherwise.
 175
 176         An instance can define either this and 'shiftL' or the unified
 177         'shift', depending on which is more convenient for the type in
 178         question. -}
 179     shiftR            :: a -> Int -> a
 180     x `shiftR`  i = x `shift`  (-i)
 181
 182     {-| Rotate the argument left by the specified number of bits
 183         (which must be non-negative).
 184
 185         An instance can define either this and 'rotateR' or the unified
 186         'rotate', depending on which is more convenient for the type in
 187         question. -}
 188     rotateL           :: a -> Int -> a
 189     x `rotateL` i = x `rotate` i
 190
 191     {-| Rotate the argument right by the specified number of bits
 192         (which must be non-negative).
 193
 194         An instance can define either this and 'rotateL' or the unified
 195         'rotate', depending on which is more convenient for the type in
 196         question. -}
 197     rotateR           :: a -> Int -> a
 198     x `rotateR` i = x `rotate` (-i)
 199
 200 instance Bits Int where
 201     {-# INLINE shift #-}
 202
 203 #ifdef __GLASGOW_HASKELL__
 204     (I# x#) .&.   (I# y#)  = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
 205
 206     (I# x#) .|.   (I# y#)  = I# (word2Int# (int2Word# x# `or#`  int2Word# y#))
 207
 208     (I# x#) `xor` (I# y#)  = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
 209
 210     complement (I# x#)     = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
 211
 212     (I# x#) `shift` (I# i#)
 213         | i# >=# 0#        = I# (x# `iShiftL#` i#)
 214         | otherwise        = I# (x# `iShiftRA#` negateInt# i#)
 215
 216     {-# INLINE rotate #-}       -- See Note [Constant folding for rotate]
 217     (I# x#) `rotate` (I# i#) =
 218         I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
 219                        (x'# `uncheckedShiftRL#` (wsib -# i'#))))
 220       where
 221         x'# = int2Word# x#
 222         i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
 223         wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
 224     bitSize  _             = WORD_SIZE_IN_BITS
 225
 226     {-# INLINE shiftR #-}
 227     -- same as the default definition, but we want it inlined (#2376)
 228     x `shiftR`  i = x `shift`  (-i)
 229 #else /* !__GLASGOW_HASKELL__ */
 230
 231 #ifdef __HUGS__
 232     (.&.)                  = primAndInt
 233     (.|.)                  = primOrInt
 234     xor                    = primXorInt
 235     complement             = primComplementInt
 236     shift                  = primShiftInt
 237     bit                    = primBitInt
 238     testBit                = primTestInt
 239     bitSize _              = SIZEOF_HSINT*8
 240 #elif defined(__NHC__)
 241     (.&.)                  = nhc_primIntAnd
 242     (.|.)                  = nhc_primIntOr
 243     xor                    = nhc_primIntXor
 244     complement             = nhc_primIntCompl
 245     shiftL                 = nhc_primIntLsh
 246     shiftR                 = nhc_primIntRsh
 247     bitSize _              = 32
 248 #endif /* __NHC__ */
 249
 250     x `rotate`  i
 251         | i<0 && x<0       = let left = i+bitSize x in
 252                              ((x `shift` i) .&. complement ((-1) `shift` left))
 253                              .|. (x `shift` left)
 254         | i<0              = (x `shift` i) .|. (x `shift` (i+bitSize x))
 255         | i==0             = x
 256         | i>0              = (x `shift` i) .|. (x `shift` (i-bitSize x))
 257
 258 #endif /* !__GLASGOW_HASKELL__ */
 259
 260     isSigned _             = True
 261
 262 #ifdef __NHC__
 263 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
 264 foreign import ccall nhc_primIntOr  :: Int -> Int -> Int
 265 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
 266 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
 267 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
 268 foreign import ccall nhc_primIntCompl :: Int -> Int
 269 #endif /* __NHC__ */
 270
 271 instance Bits Integer where
 272 #if defined(__GLASGOW_HASKELL__)
 273    (.&.) = andInteger
 274    (.|.) = orInteger
 275    xor = xorInteger
 276    complement = complementInteger
 277 #else
 278    -- reduce bitwise binary operations to special cases we can handle
 279
 280    x .&. y   | x<0 && y<0 = complement (complement x `posOr` complement y)
 281              | otherwise  = x `posAnd` y
 282
 283    x .|. y   | x<0 || y<0 = complement (complement x `posAnd` complement y)
 284              | otherwise  = x `posOr` y
 285
 286    x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
 287              | x<0        = complement (complement x `posXOr` y)
 288              |        y<0 = complement (x `posXOr` complement y)
 289              | otherwise  = x `posXOr` y
 290
 291    -- assuming infinite 2's-complement arithmetic
 292    complement a = -1 - a
 293 #endif
 294
 295    shift x i | i >= 0    = x * 2^i
 296              | otherwise = x `div` 2^(-i)
 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