Data/Bits.hs

   1 {-# OPTIONS_GHC -fno-implicit-prelude #-}
   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 the argument left by the specified number of bits.
  88         Right shifts (signed) are specified by giving a negative value.
  89
  90         An instance can define either this unified 'shift' or 'shiftL' and
  91         'shiftR', depending on which is more convenient for the type in
  92         question. -}
  93     shift             :: a -> Int -> a
  94
  95     x `shift`   i | i<0  = x `shiftR` (-i)
  96                   | i==0 = x
  97                   | i>0  = x `shiftL` i
  98
  99     {-| Rotate the argument left by the specified number of bits.
 100         Right rotates are specified by giving a negative value.
 101
 102         For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
 103
 104         An instance can define either this unified 'rotate' or 'rotateL' and
 105         'rotateR', depending on which is more convenient for the type in
 106         question. -}
 107     rotate            :: a -> Int -> a
 108
 109     x `rotate`  i | i<0  = x `rotateR` (-i)
 110                   | i==0 = x
 111                   | i>0  = x `rotateL` i
 112
 113     {-
 114     -- Rotation can be implemented in terms of two shifts, but care is
 115     -- needed for negative values.  This suggested implementation assumes
 116     -- 2's-complement arithmetic.  It is commented out because it would
 117     -- require an extra context (Ord a) on the signature of 'rotate'.
 118     x `rotate`  i | i<0 && isSigned x && x<0
 119                          = let left = i+bitSize x in
 120                            ((x `shift` i) .&. complement ((-1) `shift` left))
 121                            .|. (x `shift` left)
 122                   | i<0  = (x `shift` i) .|. (x `shift` (i+bitSize x))
 123                   | i==0 = x
 124                   | i>0  = (x `shift` i) .|. (x `shift` (i-bitSize x))
 125     -}
 126
 127     -- | @bit i@ is a value with the @i@th bit set
 128     bit               :: Int -> a
 129
 130     -- | @x \`setBit\` i@ is the same as @x .|. bit i@
 131     setBit            :: a -> Int -> a
 132
 133     -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
 134     clearBit          :: a -> Int -> a
 135
 136     -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
 137     complementBit     :: a -> Int -> a
 138
 139     -- | Return 'True' if the @n@th bit of the argument is 1
 140     testBit           :: a -> Int -> Bool
 141
 142     {-| Return the number of bits in the type of the argument.  The actual
 143         value of the argument is ignored.  The function 'bitSize' is
 144         undefined for types that do not have a fixed bitsize, like 'Integer'.
 145         -}
 146     bitSize           :: a -> Int
 147
 148     {-| Return 'True' if the argument is a signed type.  The actual
 149         value of the argument is ignored -}
 150     isSigned          :: a -> Bool
 151
 152     bit i               = 1 `shiftL` i
 153     x `setBit` i        = x .|. bit i
 154     x `clearBit` i      = x .&. complement (bit i)
 155     x `complementBit` i = x `xor` bit i
 156     x `testBit` i       = (x .&. bit i) /= 0
 157
 158     {-| Shift the argument left by the specified number of bits
 159         (which must be non-negative).
 160
 161         An instance can define either this and 'shiftR' or the unified
 162         'shift', depending on which is more convenient for the type in
 163         question. -}
 164     shiftL            :: a -> Int -> a
 165     x `shiftL`  i = x `shift`  i
 166
 167     {-| Shift the argument right (signed) by the specified number of bits
 168         (which must be non-negative).
 169
 170         An instance can define either this and 'shiftL' or the unified
 171         'shift', depending on which is more convenient for the type in
 172         question. -}
 173     shiftR            :: a -> Int -> a
 174     x `shiftR`  i = x `shift`  (-i)
 175
 176     {-| Rotate the argument left by the specified number of bits
 177         (which must be non-negative).
 178
 179         An instance can define either this and 'rotateR' or the unified
 180         'rotate', depending on which is more convenient for the type in
 181         question. -}
 182     rotateL           :: a -> Int -> a
 183     x `rotateL` i = x `rotate` i
 184
 185     {-| Rotate the argument right by the specified number of bits
 186         (which must be non-negative).
 187
 188         An instance can define either this and 'rotateL' or the unified
 189         'rotate', depending on which is more convenient for the type in
 190         question. -}
 191     rotateR           :: a -> Int -> a
 192     x `rotateR` i = x `rotate` (-i)
 193
 194 instance Bits Int where
 195     {-# INLINE shift #-}
 196
 197 #ifdef __GLASGOW_HASKELL__
 198     (I# x#) .&.   (I# y#)  = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
 199     (I# x#) .|.   (I# y#)  = I# (word2Int# (int2Word# x# `or#`  int2Word# y#))
 200     (I# x#) `xor` (I# y#)  = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
 201     complement (I# x#)     = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
 202     (I# x#) `shift` (I# i#)
 203         | i# >=# 0#        = I# (x# `iShiftL#` i#)
 204         | otherwise        = I# (x# `iShiftRA#` negateInt# i#)
 205     (I# x#) `rotate` (I# i#) =
 206         I# (word2Int# ((x'# `shiftL#` i'#) `or#`
 207                        (x'# `shiftRL#` (wsib -# i'#))))
 208         where
 209         x'# = int2Word# x#
 210         i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
 211         wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
 212     bitSize  _             = WORD_SIZE_IN_BITS
 213 #else /* !__GLASGOW_HASKELL__ */
 214
 215 #ifdef __HUGS__
 216     (.&.)                  = primAndInt
 217     (.|.)                  = primOrInt
 218     xor                    = primXorInt
 219     complement             = primComplementInt
 220     shift                  = primShiftInt
 221     bit                    = primBitInt
 222     testBit                = primTestInt
 223     bitSize _              = SIZEOF_HSINT*8
 224 #elif defined(__NHC__)
 225     (.&.)                  = nhc_primIntAnd
 226     (.|.)                  = nhc_primIntOr
 227     xor                    = nhc_primIntXor
 228     complement             = nhc_primIntCompl
 229     shiftL                 = nhc_primIntLsh
 230     shiftR                 = nhc_primIntRsh
 231     bitSize _              = 32
 232 #endif /* __NHC__ */
 233
 234     x `rotate`  i
 235         | i<0 && x<0       = let left = i+bitSize x in
 236                              ((x `shift` i) .&. complement ((-1) `shift` left))
 237                              .|. (x `shift` left)
 238         | i<0              = (x `shift` i) .|. (x `shift` (i+bitSize x))
 239         | i==0             = x
 240         | i>0              = (x `shift` i) .|. (x `shift` (i-bitSize x))
 241
 242 #endif /* !__GLASGOW_HASKELL__ */
 243
 244     isSigned _             = True
 245
 246 #ifdef __NHC__
 247 foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
 248 foreign import ccall nhc_primIntOr  :: Int -> Int -> Int
 249 foreign import ccall nhc_primIntXor :: Int -> Int -> Int
 250 foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
 251 foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
 252 foreign import ccall nhc_primIntCompl :: Int -> Int
 253 #endif /* __NHC__ */
 254
 255 instance Bits Integer where
 256 #ifdef __GLASGOW_HASKELL__
 257    (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
 258    x@(S# _) .&. y = toBig x .&. y
 259    x .&. y@(S# _) = x .&. toBig y
 260    (J# s1 d1) .&. (J# s2 d2) =
 261         case andInteger# s1 d1 s2 d2 of
 262           (# s, d #) -> J# s d
 263
 264    (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
 265    x@(S# _) .|. y = toBig x .|. y
 266    x .|. y@(S# _) = x .|. toBig y
 267    (J# s1 d1) .|. (J# s2 d2) =
 268         case orInteger# s1 d1 s2 d2 of
 269           (# s, d #) -> J# s d
 270
 271    (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
 272    x@(S# _) `xor` y = toBig x `xor` y
 273    x `xor` y@(S# _) = x `xor` toBig y
 274    (J# s1 d1) `xor` (J# s2 d2) =
 275         case xorInteger# s1 d1 s2 d2 of
 276           (# s, d #) -> J# s d
 277
 278    complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
 279    complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
 280 #else
 281    -- reduce bitwise binary operations to special cases we can handle
 282
 283    x .&. y   | x<0 && y<0 = complement (complement x `posOr` complement y)
 284              | otherwise  = x `posAnd` y
 285
 286    x .|. y   | x<0 || y<0 = complement (complement x `posAnd` complement y)
 287              | otherwise  = x `posOr` y
 288
 289    x `xor` y | x<0 && y<0 = complement x `posXOr` complement y
 290              | x<0        = complement (complement x `posXOr` y)
 291              |        y<0 = complement (x `posXOr` complement y)
 292              | otherwise  = x `posXOr` y
 293
 294    -- assuming infinite 2's-complement arithmetic
 295    complement a = -1 - a
 296 #endif
 297
 298    shift x i | i >= 0    = x * 2^i
 299              | otherwise = x `div` 2^(-i)
 300
 301    rotate x i = shift x i   -- since an Integer never wraps around
 302
 303    bitSize _  = error "Data.Bits.bitSize(Integer)"
 304    isSigned _ = True
 305
 306 #ifndef __GLASGOW_HASKELL__
 307 -- Crude implementation of bitwise operations on Integers: convert them
 308 -- to finite lists of Ints (least significant first), zip and convert
 309 -- back again.
 310
 311 -- posAnd requires at least one argument non-negative
 312 -- posOr and posXOr require both arguments non-negative
 313
 314 posAnd, posOr, posXOr :: Integer -> Integer -> Integer
 315 posAnd x y   = fromInts $ zipWith (.&.) (toInts x) (toInts y)
 316 posOr x y    = fromInts $ longZipWith (.|.) (toInts x) (toInts y)
 317 posXOr x y   = fromInts $ longZipWith xor (toInts x) (toInts y)
 318
 319 longZipWith :: (a -> a -> a) -> [a] -> [a] -> [a]
 320 longZipWith f xs [] = xs
 321 longZipWith f [] ys = ys
 322 longZipWith f (x:xs) (y:ys) = f x y:longZipWith f xs ys
 323
 324 toInts :: Integer -> [Int]
 325 toInts n
 326     | n == 0 = []
 327     | otherwise = mkInt (n `mod` numInts):toInts (n `div` numInts)
 328   where mkInt n | n > toInteger(maxBound::Int) = fromInteger (n-numInts)
 329                 | otherwise = fromInteger n
 330
 331 fromInts :: [Int] -> Integer
 332 fromInts = foldr catInt 0
 333     where catInt d n = (if d<0 then n+1 else n)*numInts + toInteger d
 334
 335 numInts = toInteger (maxBound::Int) - toInteger (minBound::Int) + 1
 336 #endif /* !__GLASGOW_HASKELL__ */