Data.Bits

module Data.Bits where
import qualified Builtin

infixl 5 .|.
infixl 6 `xor`
infixl 7 .&.
infixl 8 `shiftL`,`shiftR`

class (Eq a,Num a) => Bits a where
    (.|.),(.&.),xor :: a->a->a
    shiftL,shiftR,shift :: a -> Int -> a
    bitSize :: a -> Int

    complement :: a -> a
    complement x = x `xor` (-1)

    shift x n = if n<0 then shiftR x (-n) else shiftL x n

    rotate,rotateL,rotateR :: a -> Int -> a
    rotate x n = if n<0 then rotateR x (-n) else rotateL x n
    rotateL x n = shiftL x n .|. shiftR x (bitSize x-n) .&. (shiftL 1 n-1)

    isSigned :: a -> Bool

class Bits a => FiniteBits a where
  finiteBitSize :: a -> Int

instance Bits Int where
  (.|.) = Builtin.orInt
  (.&.) = Builtin.andInt
  xor = Builtin.xorInt
  shiftL = Builtin.shiftLInt
  shiftR = Builtin.shiftRInt
  bitSize _ = Builtin.bitSizeInt
  isSigned _ = True
  
instance FiniteBits Int where finiteBitSize _ = Builtin.bitSizeInt
{-
foreign import orInteger :: Integer->Integer->Integer
foreign import andInteger :: Integer->Integer->Integer
foreign import xorInteger :: Integer->Integer->Integer
foreign import shiftLInteger :: Integer->Int->Integer
foreign import shiftRInteger :: Integer->Int->Integer

instance Bits Integer where
  (.|.) = orInteger
  (.&.) = andInteger
  xor = xorInteger
  shiftL = shiftLInteger
  shiftR = shiftRInteger
-}

testBitDefault x i = (x .&. bit i) /= 0
bitDefault i = shiftL 1 i

bit i = bitDefault i
testBit x i = testBitDefault x i

setBit x i = x .|. bit i
clearBit x i = x .&. complement (bit i)

complementBit x i = x `xor` bit i

popCount x = length [()|i<-[0..bitSize x-1],testBit x i]