{-|
Module      : Data.Bits.Pext.Prim
Description : Parallel extract operations (emulated)
Copyright   : (c) John Ky, 2018-2019
License     : BSD-3-Clause
Maintainer  : newhoggy@gmail.com
Stability   : stable
-}
module Data.Bits.Pext.Slow
  ( SlowPext(..)
  ) where

import Data.Bits
import GHC.Word

slowPext64
  :: Word64 -- ^ the bitmap from which bits will be extracted
  -> Word64 -- ^ the bitmap selecting the bits that are to be extracted
  -> Word64 -- ^ the bitmap containing the extract bits with higher-order bits cleared
slowPext64 :: Word64 -> Word64 -> Word64
slowPext64 = Word64 -> Int -> Int -> Word64 -> Word64 -> Word64
slowPext64' Word64
0 Int
0 Int
0

slowPext64' :: Word64 -> Int -> Int -> Word64 -> Word64 -> Word64
slowPext64' :: Word64 -> Int -> Int -> Word64 -> Word64 -> Word64
slowPext64' Word64
result Int
offset Int
index Word64
src Word64
mask = if Int
index Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
64
  then if Word64
maskBit Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0
          then Word64 -> Int -> Int -> Word64 -> Word64 -> Word64
slowPext64' Word64
nextResult (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word64
src Word64
mask
          else Word64 -> Int -> Int -> Word64 -> Word64 -> Word64
slowPext64' Word64
result      Int
offset      (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word64
src Word64
mask
  else Word64
result
  where srcBit :: Word64
srcBit      = (Word64
src  Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
index) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
1
        maskBit :: Word64
maskBit     = (Word64
mask Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
index) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
1
        nextResult :: Word64
nextResult  = Word64
result Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
srcBit Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
offset)

-- | Bitwise parallel extract (emulated).  Extract bits from the source at
-- the locations described by the mask.
class SlowPext a where
  slowPext
    :: a -- ^ the bitmap from which bits will be extracted
    -> a -- ^ the bitmap selecting the bits that are to be extracted
    -> a -- ^ the bitmap containing the extract bits with higher-order bits cleared

instance SlowPext Word where
  slowPext :: Word -> Word -> Word
slowPext Word
s Word
m = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64 -> Word64
slowPext64 (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s) (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
m))

instance SlowPext Word8 where
  slowPext :: Word8 -> Word8 -> Word8
slowPext Word8
s Word8
m = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64 -> Word64
slowPext64 (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
s) (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
m))

instance SlowPext Word16 where
  slowPext :: Word16 -> Word16 -> Word16
slowPext Word16
s Word16
m = Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64 -> Word64
slowPext64 (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
s) (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
m))

instance SlowPext Word32 where
  slowPext :: Word32 -> Word32 -> Word32
slowPext Word32
s Word32
m = Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64 -> Word64
slowPext64 (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
s) (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
m))

instance SlowPext Word64 where
  slowPext :: Word64 -> Word64 -> Word64
slowPext Word64
s Word64
m = Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64 -> Word64
slowPext64 (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
s) (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
m))