Data/Bits.hs

   1 {-# OPTIONS -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/core/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  portable
  11 --
  12 -- Bitwise operations.
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module Data.Bits (
  17   Bits(
  18     (.&.), (.|.), xor, -- :: a -> a -> a
  19     complement,        -- :: a -> a
  20     shift,             -- :: a -> Int -> a
  21     rotate,            -- :: a -> Int -> a
  22     bit,               -- :: Int -> a
  23     setBit,            -- :: a -> Int -> a
  24     clearBit,          -- :: a -> Int -> a
  25     complementBit,     -- :: a -> Int -> a
  26     testBit,           -- :: a -> Int -> Bool
  27     bitSize,           -- :: a -> Int
  28     isSigned           -- :: a -> Bool
  29   ),
  30   shiftL, shiftR,      -- :: Bits a => a -> Int -> a
  31   rotateL, rotateR,    -- :: Bits a => a -> Int -> a
  32   -- instance Bits Int
  33   -- instance Bits Integer
  34  ) where
  35
  36 -- Defines the @Bits@ class containing bit-based operations.
  37 -- See library document for details on the semantics of the
  38 -- individual operations.
  39
  40 #ifdef __GLASGOW_HASKELL__
  41 #include "MachDeps.h"
  42 import GHC.Num
  43 import GHC.Real
  44 import GHC.Base
  45 #endif
  46
  47 --ADR: The fixity for .|. conflicts with that for .|. in Fran.
  48 --     Removing all fixities is a fairly safe fix; fixing the "one fixity
  49 --     per symbol per program" limitation in Hugs would take a lot longer.
  50 #ifndef __HUGS__
  51 infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
  52 infixl 7 .&.
  53 infixl 6 `xor`
  54 infixl 5 .|.
  55 #endif
  56
  57 class Num a => Bits a where
  58     (.&.), (.|.), xor :: a -> a -> a
  59     complement        :: a -> a
  60     shift             :: a -> Int -> a
  61     rotate            :: a -> Int -> a
  62     bit               :: Int -> a
  63     setBit            :: a -> Int -> a
  64     clearBit          :: a -> Int -> a
  65     complementBit     :: a -> Int -> a
  66     testBit           :: a -> Int -> Bool
  67     bitSize           :: a -> Int
  68     isSigned          :: a -> Bool
  69
  70     bit i               = 1 `shift` i
  71     x `setBit` i        = x .|. bit i
  72     x `clearBit` i      = x .&. complement (bit i)
  73     x `complementBit` i = x `xor` bit i
  74     x `testBit` i       = (x .&. bit i) /= 0
  75
  76 shiftL, shiftR   :: Bits a => a -> Int -> a
  77 rotateL, rotateR :: Bits a => a -> Int -> a
  78 x `shiftL`  i = x `shift`  i
  79 x `shiftR`  i = x `shift`  (-i)
  80 x `rotateL` i = x `rotate` i
  81 x `rotateR` i = x `rotate` (-i)
  82
  83 #ifdef __GLASGOW_HASKELL__
  84 instance Bits Int where
  85     (I# x#) .&.   (I# y#)  = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
  86     (I# x#) .|.   (I# y#)  = I# (word2Int# (int2Word# x# `or#`  int2Word# y#))
  87     (I# x#) `xor` (I# y#)  = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
  88     complement (I# x#)     = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
  89     (I# x#) `shift` (I# i#)
  90         | i# >=# 0#            = I# (x# `iShiftL#` i#)
  91         | otherwise            = I# (x# `iShiftRA#` negateInt# i#)
  92     (I# x#) `rotate` (I# i#) =
  93         I# (word2Int# ((x'# `shiftL#` i'#) `or#`
  94                        (x'# `shiftRL#` (wsib -# i'#))))
  95         where
  96         x'# = int2Word# x#
  97         i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
  98         wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
  99     bitSize  _                 = WORD_SIZE_IN_BITS
 100     isSigned _                 = True
 101
 102 instance Bits Integer where
 103    (S# x) .&. (S# y) = S# (word2Int# (int2Word# x `and#` int2Word# y))
 104    x@(S# _) .&. y = toBig x .&. y
 105    x .&. y@(S# _) = x .&. toBig y
 106    (J# s1 d1) .&. (J# s2 d2) =
 107         case andInteger# s1 d1 s2 d2 of
 108           (# s, d #) -> J# s d
 109
 110    (S# x) .|. (S# y) = S# (word2Int# (int2Word# x `or#` int2Word# y))
 111    x@(S# _) .|. y = toBig x .|. y
 112    x .|. y@(S# _) = x .|. toBig y
 113    (J# s1 d1) .|. (J# s2 d2) =
 114         case orInteger# s1 d1 s2 d2 of
 115           (# s, d #) -> J# s d
 116
 117    (S# x) `xor` (S# y) = S# (word2Int# (int2Word# x `xor#` int2Word# y))
 118    x@(S# _) `xor` y = toBig x `xor` y
 119    x `xor` y@(S# _) = x `xor` toBig y
 120    (J# s1 d1) `xor` (J# s2 d2) =
 121         case xorInteger# s1 d1 s2 d2 of
 122           (# s, d #) -> J# s d
 123
 124    complement (S# x) = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
 125    complement (J# s d) = case complementInteger# s d of (# s, d #) -> J# s d
 126
 127    shift x i | i >= 0    = x * 2^i
 128              | otherwise = x `div` 2^(-i)
 129
 130    rotate x i = shift x i   -- since an Integer never wraps around
 131
 132    bitSize _  = error "Bits.bitSize(Integer)"
 133    isSigned _ = True
 134 #endif