module Data.FlagSet.PackedRecord (
   getIntByMask, putIntByMask, accessorIntByMask,
   getIntByRange, putIntByRange, accessorIntByRange,
   ) where

import Data.FlagSet (T(Cons), Mask(Mask), )

import qualified Data.Bits as B
import Data.Bits (Bits, (.&.), (.|.), )

import qualified Data.Accessor.Basic as Acc

import Data.EnumBitSet.Utility ((.-.), )


leastSigBit :: (Num w, Bits w) => w -> w
leastSigBit :: w -> w
leastSigBit w
m = (-w
m) w -> w -> w
forall a. Bits a => a -> a -> a
.&. w
m

getIntByMask ::
   (Bits w, Integral w, Integral i) =>
   Mask w a b -> T w a -> i
getIntByMask :: Mask w a b -> T w a -> i
getIntByMask (Mask w
m) (Cons w
fs) =
   -- I hope that the division is converted to a shift
   w -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (w -> i) -> w -> i
forall a b. (a -> b) -> a -> b
$ w -> w -> w
forall a. Integral a => a -> a -> a
div (w
m w -> w -> w
forall a. Bits a => a -> a -> a
.&. w
fs) (w -> w
forall w. (Num w, Bits w) => w -> w
leastSigBit w
m)

putIntByMask ::
   (Bits w, Integral w, Integral i) =>
   Mask w a b -> i -> T w a -> T w a
putIntByMask :: Mask w a b -> i -> T w a -> T w a
putIntByMask (Mask w
m) i
i (Cons w
fs) =
   w -> T w a
forall word a. word -> T word a
Cons (w -> T w a) -> w -> T w a
forall a b. (a -> b) -> a -> b
$ (w
fs w -> w -> w
forall a. Bits a => a -> a -> a
.-. w
m) w -> w -> w
forall a. Bits a => a -> a -> a
.|. (i -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i w -> w -> w
forall a. Num a => a -> a -> a
* w -> w
forall w. (Num w, Bits w) => w -> w
leastSigBit w
m)

accessorIntByMask ::
   (Bits w, Integral w, Integral i) =>
   Mask w a b -> Acc.T (T w a) i
accessorIntByMask :: Mask w a b -> T (T w a) i
accessorIntByMask Mask w a b
m =
   (i -> T w a -> T w a) -> (T w a -> i) -> T (T w a) i
forall a r. (a -> r -> r) -> (r -> a) -> T r a
Acc.fromSetGet (Mask w a b -> i -> T w a -> T w a
forall w i a b.
(Bits w, Integral w, Integral i) =>
Mask w a b -> i -> T w a -> T w a
putIntByMask Mask w a b
m) (Mask w a b -> T w a -> i
forall w i a b.
(Bits w, Integral w, Integral i) =>
Mask w a b -> T w a -> i
getIntByMask Mask w a b
m)


maskFromNumber ::
   (Num w, Bits w) =>
   Int -> w
maskFromNumber :: Int -> w
maskFromNumber Int
number =
   w -> Int -> w
forall a. Bits a => a -> Int -> a
B.shiftL w
1 Int
number w -> w -> w
forall a. Num a => a -> a -> a
- w
1

getIntByRange ::
   (Bits w, Integral w, Integral i) =>
   Int -> Int -> T w a -> i
getIntByRange :: Int -> Int -> T w a -> i
getIntByRange Int
number Int
start (Cons w
fs) =
   w -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (w -> i) -> w -> i
forall a b. (a -> b) -> a -> b
$ w -> Int -> w
forall a. Bits a => a -> Int -> a
B.shiftR w
fs Int
start w -> w -> w
forall a. Bits a => a -> a -> a
.&. Int -> w
forall w. (Num w, Bits w) => Int -> w
maskFromNumber Int
number

putIntByRange ::
   (Bits w, Integral w, Integral i) =>
   Int -> Int -> i -> T w a -> T w a
putIntByRange :: Int -> Int -> i -> T w a -> T w a
putIntByRange Int
number Int
start i
i (Cons w
fs) =
   w -> T w a
forall word a. word -> T word a
Cons (w -> T w a) -> w -> T w a
forall a b. (a -> b) -> a -> b
$
      (w
fs w -> w -> w
forall a. Bits a => a -> a -> a
.-. w -> Int -> w
forall a. Bits a => a -> Int -> a
B.shiftL (Int -> w
forall w. (Num w, Bits w) => Int -> w
maskFromNumber Int
number) Int
start)
      w -> w -> w
forall a. Bits a => a -> a -> a
.|.
      w -> Int -> w
forall a. Bits a => a -> Int -> a
B.shiftL (i -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i) Int
start

accessorIntByRange ::
   (Bits w, Integral w, Integral i) =>
   Int -> Int -> Acc.T (T w a) i
accessorIntByRange :: Int -> Int -> T (T w a) i
accessorIntByRange Int
number Int
start =
   (i -> T w a -> T w a) -> (T w a -> i) -> T (T w a) i
forall a r. (a -> r -> r) -> (r -> a) -> T r a
Acc.fromSetGet (Int -> Int -> i -> T w a -> T w a
forall w i a.
(Bits w, Integral w, Integral i) =>
Int -> Int -> i -> T w a -> T w a
putIntByRange Int
number Int
start) (Int -> Int -> T w a -> i
forall w i a.
(Bits w, Integral w, Integral i) =>
Int -> Int -> T w a -> i
getIntByRange Int
number Int
start)