--
-- Copyright (c) 2009-2010, ERICSSON AB All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
-- 
--     * Redistributions of source code must retain the above copyright notice,
--       this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of the ERICSSON AB nor the names of its contributors
--       may be used to endorse or promote products derived from this software
--       without specific prior written permission.
-- 
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS
-- BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
-- OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
-- THE POSSIBILITY OF SUCH DAMAGE.
--

{-# LANGUAGE UndecidableInstances #-}

-- | Primitive and helper functions supported by Feldspar

module Feldspar.Core.Functions where



import qualified Prelude

import Feldspar.Range
import Feldspar.Core.Types
import Feldspar.Core.Expr
import Feldspar.Core.Reify
import Feldspar.Prelude

import qualified Data.Bits as B

infix  4 ==
infix  4 /=
infix  4 <
infix  4 >
infix  4 <=
infix  4 >=
infixr 3 &&
infixr 3 &&*
infixr 2 ||
infixr 2 ||*
infix  1 ?



-- * Misc.

noSizeProp :: a -> ()
noSizeProp _ = ()

noSizeProp2 :: a -> b -> ()
noSizeProp2 _ _ = ()

class (Prelude.Eq a, Storable a) => Eq a where
  (==) :: Data a -> Data a -> Data Bool
  a == b
    | a Prelude.== b = true
    | otherwise      = function2 "(==)" noSizeProp2 (Prelude.==) a b
  (/=) :: Data a -> Data a -> Data Bool
  a /= b
    | a Prelude.== b = false
    | otherwise      = function2 "(/=)" noSizeProp2 (Prelude./=) a b

optEq :: (Storable a, Size a ~ Range b, Prelude.Ord b, Num b) =>
         Data a -> Data a -> Data Bool
optEq a b
    | a Prelude.== b   = true
    | sa `disjoint` sb = false
    | otherwise        = function2 "(==)" noSizeProp2 (Prelude.==) a b
   where
     sa = dataSize a
     sb = dataSize b

optNeq :: (Storable a, Size a ~ Range b, Prelude.Ord b, Num b) =>
         Data a -> Data a -> Data Bool
optNeq a b
    | a Prelude.== b   = false
    | sa `disjoint` sb = true
    | otherwise        = function2 "(/=)" noSizeProp2 (Prelude./=) a b
   where
     sa = dataSize a
     sb = dataSize b

instance Eq Int where
  a == b = optEq  a b
  a /= b = optNeq a b

instance Eq Signed32 where
  a == b = optEq  a b
  a /= b = optNeq a b

instance Eq Unsigned32 where
  a == b = optEq  a b
  a /= b = optNeq a b

instance Eq Signed16 where
  a == b = optEq  a b
  a /= b = optNeq a b

instance Eq Unsigned16 where
  a == b = optEq  a b
  a /= b = optNeq a b

instance Eq Signed8 where
  a == b = optEq  a b
  a /= b = optNeq a b

instance Eq Unsigned8 where
  a == b = optEq  a b
  a /= b = optNeq a b

instance Eq Float where
  a == b = optEq  a b
  a /= b = optNeq a b

instance Eq Bool

instance Eq ()

class (Prelude.Ord a, Eq a, Storable a) => Ord a where
  (<)  :: Data a -> Data a -> Data Bool
  a < b
    | a Prelude.== b = false
    | otherwise      = function2 "(<)" noSizeProp2 (Prelude.<) a b
  (>)  :: Data a -> Data a -> Data Bool
  a > b
    | a Prelude.== b = false
    | otherwise      = function2 "(>)" noSizeProp2 (Prelude.>) a b
  (<=) :: Data a -> Data a -> Data Bool
  a <= b
    | a Prelude.== b = true
    | otherwise      = function2 "(<=)" noSizeProp2 (Prelude.<=) a b
  (>=) :: Data a -> Data a -> Data Bool
  a >= b
    | a Prelude.== b = true
    | otherwise      = function2 "(>=)" noSizeProp2 (Prelude.>=) a b
  min  ::  Data a -> Data a -> Data a
  min a b = a<b ? (a,b)
  max  :: Data a -> Data a -> Data a
  max a b = a>b ? (a,b)

optLT :: (Storable a, Prelude.Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
         Data a -> Data a -> Data Bool
optLT a b
    | a Prelude.== b      = false
    | sa `rangeLess`   sb = true
    | sb `rangeLessEq` sa = false
    | otherwise           = function2 "(<)" noSizeProp2 (Prelude.<) a b
    where
      sa = dataSize a
      sb = dataSize b

optGT :: (Storable a, Prelude.Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
         Data a -> Data a -> Data Bool
optGT a b
    | a Prelude.== b      = false
    | sb `rangeLess`   sa = true
    | sa `rangeLessEq` sb = false
    | otherwise           = function2 "(>)" noSizeProp2 (Prelude.>) a b
    where
      sa = dataSize a
      sb = dataSize b

optLTE :: (Storable a, Prelude.Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
         Data a -> Data a -> Data Bool
optLTE a b
    | a Prelude.== b      = true
    | sa `rangeLessEq` sb = true
    | sb `rangeLess`   sa = false
    | otherwise           = function2 "(<=)" noSizeProp2 (Prelude.<=) a b
    where
      sa = dataSize a
      sb = dataSize b

optGTE :: (Storable a, Prelude.Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
         Data a -> Data a -> Data Bool
optGTE a b
    | a Prelude.== b      = true
    | sb `rangeLessEq` sa = true
    | sa `rangeLess`   sb = false
    | otherwise           = function2 "(>=)" noSizeProp2 (Prelude.>=) a b
    where
      sa = dataSize a
      sb = dataSize b

optMin :: (Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
          Data a -> Data a -> Data a
optMin a b = cap (rangeMin ra rb) $
    case dataToExpr cond1 of
      Value _ -> cond1 ? (a,b)
      _       -> cond2 ? (b,a)
  where
    cond1 = a<b
    cond2 = b<a
    ra    = dataSize a
    rb    = dataSize b

optMax :: (Ord a, Size a ~ Range b, Prelude.Ord b, Num b) =>
          Data a -> Data a -> Data a
optMax a b = cap (rangeMax ra rb) $
    case dataToExpr cond1 of
      Value _ -> cond1 ? (a,b)
      _       -> cond2 ? (b,a)
  where
    cond1 = a>b
    cond2 = b>a
    ra    = dataSize a
    rb    = dataSize b

instance Ord Int where
  a <  b  = optLT  a b
  a >  b  = optGT  a b
  a <= b  = optLTE a b
  a >= b  = optGTE a b
  min a b = optMin a b
  max a b = optMax a b

instance Ord Unsigned32 where
  a <  b  = optLT  a b
  a >  b  = optGT  a b
  a <= b  = optLTE a b
  a >= b  = optGTE a b
  min a b = optMin a b
  max a b = optMax a b

instance Ord Signed32 where
  a <  b  = optLT  a b
  a >  b  = optGT  a b
  a <= b  = optLTE a b
  a >= b  = optGTE a b
  min a b = optMin a b
  max a b = optMax a b

instance Ord Unsigned16 where
  a <  b  = optLT  a b
  a >  b  = optGT  a b
  a <= b  = optLTE a b
  a >= b  = optGTE a b
  min a b = optMin a b
  max a b = optMax a b

instance Ord Signed16 where
  a <  b  = optLT  a b
  a >  b  = optGT  a b
  a <= b  = optLTE a b
  a >= b  = optGTE a b
  min a b = optMin a b
  max a b = optMax a b

instance Ord Unsigned8 where
  a <  b  = optLT  a b
  a >  b  = optGT  a b
  a <= b  = optLTE a b
  a >= b  = optGTE a b
  min a b = optMin a b
  max a b = optMax a b

instance Ord Signed8 where
  a <  b  = optLT  a b
  a >  b  = optGT  a b
  a <= b  = optLTE a b
  a >= b  = optGTE a b
  min a b = optMin a b
  max a b = optMax a b

instance Ord Float where
  a <  b  = optLT  a b
  a >  b  = optGT  a b
  a <= b  = optLTE a b
  a >= b  = optGTE a b
  min a b = optMin a b
  max a b = optMax a b

not :: Data Bool -> Data Bool
not = function "not" noSizeProp Prelude.not

-- | Selects the elements of the pair depending on the condition
(?) :: Computable a => Data Bool -> (a,a) -> a
cond ? (a,b) = ifThenElse cond (const a) (const b) unit

(&&) :: Data Bool -> Data Bool -> Data Bool
x && y = case (dataToExpr x, dataToExpr y) of
           (Value True, _) -> y
           (Value False,_) -> false
           (_, Value True) -> x
           (_,Value False) -> false
           _               -> function2 "(&&)" noSizeProp2 (Prelude.&&) x y

(||) :: Data Bool -> Data Bool -> Data Bool
x || y = case (dataToExpr x, dataToExpr y) of
           (Value True, _) -> true
           (Value False,_) -> y
           (_, Value True) -> true
           (_,Value False) -> y
           _               -> function2 "(||)" noSizeProp2 (Prelude.||) x y

-- | Lazy conjunction, second argument only run if necessary
(&&*) :: Computable a =>
    (a -> Data Bool) -> (a -> Data Bool) -> (a -> Data Bool)
(f &&* g) a = ifThenElse (f a) g (const false) a

-- | Lazy disjunction, second argument only run if necessary
(||*) :: Computable a =>
    (a -> Data Bool) -> (a -> Data Bool) -> (a -> Data Bool)
(f ||* g) a = ifThenElse (f a) (const true) g a

class (Numeric a, Prelude.Integral a, Ord a, Storable a) =>
    Integral a where
  quot    :: Data a -> Data a -> Data a
  quot    = function2 "quot" (\_ _ -> universal) Prelude.quot
  rem     :: Data a -> Data a -> Data a
  rem     = function2 "rem"  (\_ _ -> universal) Prelude.rem
  div     :: Data a -> Data a -> Data a
  div x y = rem x y /= 0 && (x > 0 && y < 0 || x < 0 && y > 0) ?
            (quotxy - 1, quotxy)
      where quotxy = quot x y
  mod     :: Data a -> Data a -> Data a
  mod x y = remxy  /= 0 && (x > 0 && y < 0 || x < 0 && y > 0) ?
            (remxy + y, remxy)
      where remxy = rem x y
  (^)     :: Data a -> Data a -> Data a
  (^)     = function2 "(^)" (\_ _ -> universal) (Prelude.^)

optRem  :: (Integral a, Size a ~ Range b, Prelude.Ord b, Num b, Enum b) =>
           Data a -> Data a -> Data a
optRem x y
    | abs rx `rangeLess` abs ry = x
    | otherwise                 = function2 "rem"  rangeRem  Prelude.rem x y
    where rx = dataSize x
          ry = dataSize y

optMod :: (Integral a, Size a ~ Range b, Prelude.Ord b, Num b, Enum b) =>
       Data a -> Data a -> Data a
optMod x y = cap (rangeMod rx ry) $
             remxy  /= 0 && (x > 0 && y < 0 || x < 0 && y > 0) ?
             (remxy + y, remxy)
  where remxy = rem x y
        rx    = dataSize x
        ry    = dataSize y

optSignedExp :: (Integral a, Bits a, Storable a,
                Size a ~ Range b, Prelude.Ord b, Num b) =>
                Data a -> Data a -> Data a
optSignedExp m e = case dataToExpr m of
                   -- From Bit Twiddling Hacks
                   -- "Conditionally negate a value without branching"
                   -- Here we negate the value 1 if isOdd is true i.e. when e is
                   -- and odd number
                     Value (-1) -> cap (range (-1) 1) $
                                   let isOdd = e .&. 1
                                   in (1 `xor` (negate isOdd)) + isOdd
                     _ -> optExp m e

optExp :: (Integral a, Storable a) => Data a -> Data a -> Data a
optExp m e = case (dataToExpr m,dataToExpr e) of
               (Value 1,_) -> value 1
               (_,Value 1) -> m
               (_,Value 0) -> value 1
               _           -> function2 "(^)" (\_ _ -> universal) (Prelude.^) m e

instance Integral Int where
  rem = optRem
  mod = optMod
  (^) = optSignedExp

instance Integral Signed32 where
  rem = optRem
  mod = optMod
  (^) = optSignedExp

instance Integral Unsigned32 where
  div = quot
  rem = optRem
  mod = rem
  (^) = optExp

instance Integral Signed16 where
  rem = optRem
  mod = optMod
  (^) = optSignedExp

instance Integral Unsigned16 where
  div = quot
  rem = optRem
  mod = rem
  (^) = optExp

instance Integral Signed8 where
  rem = optRem
  mod = optMod
  (^) = optSignedExp

instance Integral Unsigned8 where
  div = quot
  rem = optRem
  mod = rem
  (^) = optExp



-- * Loops

-- | For-loop
--
-- @`for` start end init body@:
--
--   * @start@\/@end@ are the start\/end indexes.
--
--   * @init@ is the starting state.
--
--   * @body@ computes the next state given the current loop index (ranging over
--     @[start .. end]@) and the current state.
for :: Computable a => Data Int -> Data Int -> a -> (Data Int -> a -> a) -> a
for start end init body = snd $ whileSized szCont szBody cont body' (start,init)
  where
    sziCont = rangeByRange (dataSize start) (dataSize end + 1)
    szCont  = (sziCont,universal)

    sziBody = rangeByRange (dataSize start) (dataSize end)
    szBody  = (sziBody,universal)

    cont  (i,s) = i <= end
    body' (i,s) = (i+1, body i s)



-- | A sequential \"unfolding\" of an vector
--
-- @`unfoldCore` l init step@:
--
--   * @l@ is the length of the resulting vector.
--
--   * @init@ is the initial state.
--
--   * @step@ is a function computing a new element and the next state from the
--     current index and current state. The index is the position of the new
--     element in the output vector.
unfoldCore
    :: (Computable state, Storable a)
    => Data Length
    -> state
    -> (Data Int -> state -> (Data a, state))
    -> (Data [a], state)

unfoldCore l init step = for 0 (l-1) (outp,init) $ \i (o,state) ->
    let (a,state') = step i state
     in (setIx o i a, state')
  where
    outp = array (mapMonotonic fromIntegral (dataSize l) :> universal) []

class (Num a, Storable a) => Numeric a
  where
    fromIntegerNum :: Integer -> Data a
    fromIntegerNum = value . fromInteger

    absNum    :: Data a -> Data a
    signumNum :: Data a -> Data a
    addNum    :: Data a -> Data a -> Data a
    subNum    :: Data a -> Data a -> Data a
    mulNum    :: Data a -> Data a -> Data a

absNum' :: (Numeric a, Num (Size a)) => Data a -> Data a
absNum' = function "abs" abs abs

optAbs :: (Numeric a, Size a ~ Range b, Num b, Prelude.Ord b) =>
          Data a -> Data a
optAbs x | isNatural rx = x
         | otherwise    = absNum' x
  where rx = dataSize x

signumNum' :: (Numeric a, Num (Size a)) => Data a -> Data a
signumNum' = function "signum" signum signum

optSignum :: (Numeric a, Size a ~ Range b, Num b, Prelude.Ord b) => Data a -> Data a
optSignum x | 0  `rangeLess` rx =  1
            | rx `rangeLess` 0  = -1
            | rx Prelude.==  0  =  0
            | otherwise         = signumNum' x
  where rx = dataSize x

optAdd :: (Numeric a, Num (Size a)) => Data a -> Data a -> Data a
optAdd x y = case (dataToExpr x, dataToExpr y) of
               (Value 0, _) -> y
               (_, Value 0) -> x
               _            -> function2 "(+)" (+) (+) x y

optSub  :: (Numeric a, Num (Size a)) => Data a -> Data a -> Data a
optSub x y = case dataToExpr y of
               Value 0 -> x
               _       -> function2 "(-)" (-) (-) x y

optMul :: (Numeric a, Num (Size a)) => Data a -> Data a -> Data a
optMul x y = case (dataToExpr x, dataToExpr y) of
               (Value 0,_) -> value 0
               (_,Value 0) -> value 0
               (Value 1,_) -> y
               (_,Value 1) -> x
               _           -> function2 "(*)" (*) (*) x y

instance Numeric Int
  where
    absNum    = optAbs
    signumNum = optSignum
    addNum    = optAdd
    subNum    = optSub
    mulNum    = optMul

instance Numeric Unsigned32
  where
    absNum    = optAbs
    signumNum = optSignum
    addNum    = optAdd
    subNum    = optSub
    mulNum    = optMul

instance Numeric Signed32
  where
    absNum    = optAbs
    signumNum = optSignum
    addNum    = optAdd
    subNum    = optSub
    mulNum    = optMul

instance Numeric Unsigned16
  where
    absNum    = optAbs
    signumNum = optSignum
    addNum    = optAdd
    subNum    = optSub
    mulNum    = optMul

instance Numeric Signed16
  where
    absNum    = optAbs
    signumNum = optSignum
    addNum    = optAdd
    subNum    = optSub
    mulNum    = optMul

instance Numeric Unsigned8
  where
    absNum    = optAbs
    signumNum = optSignum
    addNum    = optAdd
    subNum    = optSub
    mulNum    = optMul

instance Numeric Signed8
  where
    absNum    = optAbs
    signumNum = optSignum
    addNum    = optAdd
    subNum    = optSub
    mulNum    = optMul

instance Numeric Float
  where
    absNum    = optAbs
    signumNum = optSignum
    addNum    = optAdd
    subNum    = optSub
    mulNum    = optMul

instance Numeric a => Num (Data a)
  where
    fromInteger = fromIntegerNum
    abs         = absNum
    signum      = signumNum
    (+)         = addNum
    (-)         = subNum
    (*)         = mulNum

class (Fractional a, Storable a) => Fractional' a
  where
    fromRationalFrac :: Rational -> Data a
    fromRationalFrac = value . fromRational

    divFrac :: Data a -> Data a -> Data a

instance Fractional' Float
  where
    divFrac = function2 "(/)" (\_ _ -> fullRange) (/)  -- XXX Improve range

instance (Fractional' a, Numeric a) => Fractional (Data a)
  where
    fromRational = fromRationalFrac
    (/)          = divFrac

-- * Bit manipulation

infixl 5 <<,>>
infixl 4 ⊕

-- | The following class provides functions for bit level manipulation
class (B.Bits a, Storable a) => Bits a
  where
  -- Logical operations
  (.&.)         :: Data a -> Data a -> Data a
  (.&.)         =  optAnd
  (.|.)         :: Data a -> Data a -> Data a
  (.|.)         =  optOr
  xor           :: Data a -> Data a -> Data a
  xor           =  optXor
  (⊕)           :: Data a -> Data a -> Data a
  (⊕)           =  xor
  complement    :: Data a -> Data a
  complement    =  function "complement" (const universal) B.complement

  -- Operations on individual bits
  bit           :: Data Int -> Data a
  bit           =  function "bit" (const universal) B.bit
  setBit        :: Data a -> Data Int -> Data a
  setBit        =  function2 "setBit" (\_ _ -> universal) B.setBit
  clearBit      :: Data a -> Data Int -> Data a
  clearBit      =  function2 "clearBit" (\_ _ -> universal) B.clearBit
  complementBit :: Data a -> Data Int -> Data a
  complementBit =  function2 "complementBit" (\_ _ -> universal) B.complementBit
  testBit       :: Data a -> Data Int -> Data Bool
  testBit       =  function2 "testBit" noSizeProp2 B.testBit

  -- Moving bits around
  shiftL        :: Data a -> Data Int -> Data a
  shiftL        =  optZero (function2 "shiftL" (\_ _ -> universal) B.shiftL)
  (<<)          :: Data a -> Data Int -> Data a
  (<<)          =  shiftL
  shiftR        :: Data a -> Data Int -> Data a
  shiftR        =  optZero (function2 "shiftR" (\_ _ -> universal) B.shiftR)
  (>>)          :: Data a -> Data Int -> Data a
  (>>)          =  shiftR
  rotateL       :: Data a -> Data Int -> Data a
  rotateL       =  optZero (function2 "rotateL" (\_ _ -> universal) B.rotateL)
  rotateR       :: Data a -> Data Int -> Data a
  rotateR       =  optZero (function2 "rotateR" (\_ _ -> universal) B.rotateR)
  reverseBits   :: Data a -> Data a
  reverseBits   =  function "reverseBits" (\_ -> universal) revBits

  -- Bulk bit operations
  -- | Returns the number of leading zeroes for unsigned types.
  -- For signed types it returns the number of unnecessary sign bits
  bitScan       :: Data a -> Data Int
  bitScan       =  function "bitScan" (\_ -> universal) scanLeft
  bitCount      :: Data a -> Data Int
  bitCount      =  function "bitCount" (\_ -> universal) countBits

  -- Queries about the type
  bitSize       :: Data a -> Data Int
  bitSize       =  function "bitSize" (const naturalRange) B.bitSize
  isSigned      :: Data a -> Data Bool
  isSigned      =  function "isSigned" noSizeProp B.isSigned

optAnd :: (B.Bits a, Storable a) => Data a -> Data a -> Data a
optAnd x y = case (dataToExpr x, dataToExpr y) of
               (Value 0, _) -> value 0
               (_, Value 0) -> value 0
               (Value x, _) | allOnes x -> y
               (_, Value y) | allOnes y -> x
               _            -> function2 "(.&.)" (\_ _ -> universal) (B..&.) x y

optOr :: (B.Bits a, Storable a) => Data a -> Data a -> Data a
optOr x y = case (dataToExpr x, dataToExpr y) of
              (Value 0, _) -> y
              (_, Value 0) -> x
              (Value x, _) | allOnes x -> value (B.complement 0)
              (_, Value y) | allOnes y -> value (B.complement 0)
              _            -> function2 "(.|.)" (\_ _ -> universal) (B..|.) x y

optXor :: (Bits a, B.Bits a, Storable a) => Data a -> Data a -> Data a
optXor x y = case (dataToExpr x, dataToExpr y) of
               (Value 0, _) -> y
               (_, Value 0) -> x
               (Value x, _) | allOnes x -> complement y
               (_, Value y) | allOnes y -> complement x
               _            -> function2 "xor" (\_ _ -> universal) B.xor x y

allOnes :: (Prelude.Eq a, B.Bits a) => a -> Bool
allOnes x = x Prelude.== B.complement 0

optZero :: (a -> Data Int -> a) -> a -> Data Int -> a
optZero f x y = case dataToExpr y of
                  Value 0 -> x
                  _       -> f x y

scanLeft :: B.Bits b => b -> Int
scanLeft b =
   if B.isSigned b
   then scanLoop b (B.testBit b (B.bitSize b - 1)) (B.bitSize b - 2) 0
         else scanLoop b False (B.bitSize b - 1) 0
  where
    scanLoop b bit i n | i Prelude.< 0                = n
    scanLoop b bit i n | B.testBit b i Prelude./= bit = n
    scanLoop b bit i n | otherwise                    = scanLoop b bit (i-1) (n+1)


countBits :: B.Bits b => b -> Int
countBits b = loop b (B.bitSize b - 1) 0
  where
    loop b i n | i Prelude.< 0 = n
    loop b i n | B.testBit b i = loop b (i-1) (n+1)
    loop b i n | otherwise     = loop b (i-1) n

revBits :: B.Bits b => b -> b
revBits b = revLoop b 0 (0 `asTypeOf` b)
  where
    bitSize = B.bitSize b
    revLoop b i n | i Prelude.>= bitSize  = n
    revLoop b i n | B.testBit b i = revLoop b (i+1) (B.setBit n (bitSize - i - 1))
    revLoop b i n | otherwise     = revLoop b (i+1) n

instance Bits Int

instance Bits Unsigned32

instance Bits Signed32

instance Bits Unsigned16

instance Bits Signed16

instance Bits Unsigned8

instance Bits Signed8