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