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