module Data.EnumBitSet (
T(Cons, decons),
fromEnum,
fromEnums,
toEnums,
intToEnums,
mostSignificantPosition,
singletonByPosition,
null,
empty,
singleton,
disjoint,
subset,
(.&.),
(.-.),
(.|.),
xor,
unions,
get,
put,
accessor,
set,
clear,
flip,
fromBool,
) where
import qualified Data.EnumBitSet.Utility as U
import qualified Data.Bits as B
import Data.Bits (Bits, )
import Data.Monoid (Monoid(mempty, mappend), )
import Data.Semigroup (Semigroup((<>)), )
import qualified Foreign.Storable.Newtype as Store
import Foreign.Storable (Storable(sizeOf, alignment, peek, poke), )
import qualified Data.Accessor.Basic as Acc
import qualified Prelude as P
import Prelude hiding (fromEnum, toEnum, null, flip, )
newtype T word index = Cons {T word index -> word
decons :: word}
deriving (T word index -> T word index -> Bool
(T word index -> T word index -> Bool)
-> (T word index -> T word index -> Bool) -> Eq (T word index)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall word index. Eq word => T word index -> T word index -> Bool
/= :: T word index -> T word index -> Bool
$c/= :: forall word index. Eq word => T word index -> T word index -> Bool
== :: T word index -> T word index -> Bool
$c== :: forall word index. Eq word => T word index -> T word index -> Bool
Eq)
instance (Enum a, Storable w) => Storable (T w a) where
sizeOf :: T w a -> Int
sizeOf = (T w a -> w) -> T w a -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.sizeOf T w a -> w
forall word index. T word index -> word
decons
alignment :: T w a -> Int
alignment = (T w a -> w) -> T w a -> Int
forall core wrapper.
Storable core =>
(wrapper -> core) -> wrapper -> Int
Store.alignment T w a -> w
forall word index. T word index -> word
decons
peek :: Ptr (T w a) -> IO (T w a)
peek = (w -> T w a) -> Ptr (T w a) -> IO (T w a)
forall core wrapper.
Storable core =>
(core -> wrapper) -> Ptr wrapper -> IO wrapper
Store.peek w -> T w a
forall word index. word -> T word index
Cons
poke :: Ptr (T w a) -> T w a -> IO ()
poke = (T w a -> w) -> Ptr (T w a) -> T w a -> IO ()
forall core wrapper.
Storable core =>
(wrapper -> core) -> Ptr wrapper -> wrapper -> IO ()
Store.poke T w a -> w
forall word index. T word index -> word
decons
instance (Enum a, Bits w) => Semigroup (T w a) where
<> :: T w a -> T w a -> T w a
(<>) = T w a -> T w a -> T w a
forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
(.|.)
instance (Enum a, Bits w) => Monoid (T w a) where
mempty :: T w a
mempty = T w a
forall a w. (Enum a, Bits w) => T w a
empty
mappend :: T w a -> T w a -> T w a
mappend = T w a -> T w a -> T w a
forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
(.|.)
fromEnum :: (Enum a, Bits w) => a -> T w a
= w -> T w a
forall word index. word -> T word index
Cons (w -> T w a) -> (a -> w) -> a -> T w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> w
forall a. Bits a => Int -> a
B.bit (Int -> w) -> (a -> Int) -> a -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
P.fromEnum
fromEnums :: (Enum a, Bits w) => [a] -> T w a
= w -> T w a
forall word index. word -> T word index
Cons (w -> T w a) -> ([a] -> w) -> [a] -> T w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w -> Int -> w) -> w -> [Int] -> w
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl w -> Int -> w
forall a. Bits a => a -> Int -> a
B.setBit w
forall w. Bits w => w
U.empty ([Int] -> w) -> ([a] -> [Int]) -> [a] -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. Enum a => a -> Int
P.fromEnum
toEnums :: (Enum a, Bits w) => T w a -> [a]
toEnums :: T w a -> [a]
toEnums =
((a, w) -> a) -> [(a, w)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, w) -> a
forall a b. (a, b) -> a
fst ([(a, w)] -> [a]) -> (T w a -> [(a, w)]) -> T w a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, w) -> Bool) -> [(a, w)] -> [(a, w)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((w -> Int -> Bool) -> Int -> w -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
P.flip w -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit Int
0 (w -> Bool) -> ((a, w) -> w) -> (a, w) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> w
forall a b. (a, b) -> b
snd) ([(a, w)] -> [(a, w)]) -> (T w a -> [(a, w)]) -> T w a -> [(a, w)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[a] -> [w] -> [(a, w)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> a
forall a. Enum a => Int -> a
P.toEnum Int
0 ..] ([w] -> [(a, w)]) -> (T w a -> [w]) -> T w a -> [(a, w)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(w -> Bool) -> [w] -> [w]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (w
forall w. Bits w => w
U.empty w -> w -> Bool
forall a. Eq a => a -> a -> Bool
/= ) ([w] -> [w]) -> (T w a -> [w]) -> T w a -> [w]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w -> w) -> w -> [w]
forall a. (a -> a) -> a -> [a]
iterate ((w -> Int -> w) -> Int -> w -> w
forall a b c. (a -> b -> c) -> b -> a -> c
P.flip w -> Int -> w
forall a. Bits a => a -> Int -> a
B.shiftR Int
1) (w -> [w]) -> (T w a -> w) -> T w a -> [w]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
T w a -> w
forall word index. T word index -> word
decons
intToEnums :: (Enum a, Integral w) => T w a -> [a]
intToEnums :: T w a -> [a]
intToEnums =
((a, w) -> a) -> [(a, w)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, w) -> a
forall a b. (a, b) -> a
fst ([(a, w)] -> [a]) -> (T w a -> [(a, w)]) -> T w a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, w) -> Bool) -> [(a, w)] -> [(a, w)]
forall a. (a -> Bool) -> [a] -> [a]
filter (w -> Bool
forall a. Integral a => a -> Bool
odd (w -> Bool) -> ((a, w) -> w) -> (a, w) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> w
forall a b. (a, b) -> b
snd) ([(a, w)] -> [(a, w)]) -> (T w a -> [(a, w)]) -> T w a -> [(a, w)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[a] -> [w] -> [(a, w)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> a
forall a. Enum a => Int -> a
P.toEnum Int
0 ..] ([w] -> [(a, w)]) -> (T w a -> [w]) -> T w a -> [(a, w)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(w -> Bool) -> [w] -> [w]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (w
0w -> w -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([w] -> [w]) -> (T w a -> [w]) -> T w a -> [w]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w -> w) -> w -> [w]
forall a. (a -> a) -> a -> [a]
iterate ((w -> w -> w) -> w -> w -> w
forall a b c. (a -> b -> c) -> b -> a -> c
P.flip w -> w -> w
forall a. Integral a => a -> a -> a
div w
2) (w -> [w]) -> (T w a -> w) -> T w a -> [w]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
T w a -> w
forall word index. T word index -> word
decons
{-# INLINE mostSignificantPosition #-}
mostSignificantPosition :: (Bits w, Storable w) => T w a -> Int
mostSignificantPosition :: T w a -> Int
mostSignificantPosition (Cons w
x) =
(w, Int) -> Int
forall a b. (a, b) -> b
snd ((w, Int) -> Int) -> (w, Int) -> Int
forall a b. (a -> b) -> a -> b
$
((w, Int) -> Int -> (w, Int)) -> (w, Int) -> [Int] -> (w, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
(\(w
x0,Int
pos) Int
testPos ->
let x1 :: w
x1 = w -> Int -> w
forall a. Bits a => a -> Int -> a
B.shiftR w
x0 Int
testPos
in if w
x1 w -> w -> Bool
forall a. Eq a => a -> a -> Bool
== w
forall w. Bits w => w
U.empty
then (w
x0, Int
pos)
else (w
x1, Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
testPos))
(w
x,Int
0) ([Int] -> (w, Int)) -> [Int] -> (w, Int)
forall a b. (a -> b) -> a -> b
$
[Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
(Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< w -> Int
forall a. Storable a => a -> Int
sizeOf w
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
(Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*) Int
1
{-# INLINE singletonByPosition #-}
singletonByPosition :: (Bits w) => Int -> T w a
singletonByPosition :: Int -> T w a
singletonByPosition = w -> T w a
forall word index. word -> T word index
Cons (w -> T w a) -> (Int -> w) -> Int -> T w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Int -> w
forall a. Bits a => a -> Int -> a
B.setBit w
forall w. Bits w => w
U.empty
null :: (Enum a, Bits w) => T w a -> Bool
null :: T w a -> Bool
null (Cons w
x) = w
xw -> w -> Bool
forall a. Eq a => a -> a -> Bool
==w
forall w. Bits w => w
U.empty
empty :: (Enum a, Bits w) => T w a
empty :: T w a
empty = w -> T w a
forall word index. word -> T word index
Cons w
forall w. Bits w => w
U.empty
disjoint :: (Enum a, Bits w) => T w a -> T w a -> Bool
disjoint :: T w a -> T w a -> Bool
disjoint T w a
x T w a
y = T w a -> Bool
forall a w. (Enum a, Bits w) => T w a -> Bool
null (T w a
x T w a -> T w a -> T w a
forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
.&. T w a
y)
subset :: (Enum a, Bits w) => T w a -> T w a -> Bool
subset :: T w a -> T w a -> Bool
subset T w a
x T w a
y = T w a -> Bool
forall a w. (Enum a, Bits w) => T w a -> Bool
null (T w a
x T w a -> T w a -> T w a
forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
.-. T w a
y)
{-# INLINE lift2 #-}
lift2 :: (w -> w -> w) -> (T w a -> T w a -> T w a)
lift2 :: (w -> w -> w) -> T w a -> T w a -> T w a
lift2 w -> w -> w
f (Cons w
x) (Cons w
y) = w -> T w a
forall word index. word -> T word index
Cons (w -> w -> w
f w
x w
y)
infixl 7 .&., .-.
infixl 5 .|.
(.&.), (.-.), (.|.), xor :: (Enum a, Bits w) => T w a -> T w a -> T w a
.&. :: T w a -> T w a -> T w a
(.&.) = (w -> w -> w) -> T w a -> T w a -> T w a
forall w a. (w -> w -> w) -> T w a -> T w a -> T w a
lift2 w -> w -> w
forall a. Bits a => a -> a -> a
(B..&.)
.|. :: T w a -> T w a -> T w a
(.|.) = (w -> w -> w) -> T w a -> T w a -> T w a
forall w a. (w -> w -> w) -> T w a -> T w a -> T w a
lift2 w -> w -> w
forall a. Bits a => a -> a -> a
(B..|.)
.-. :: T w a -> T w a -> T w a
(.-.) = (w -> w -> w) -> T w a -> T w a -> T w a
forall w a. (w -> w -> w) -> T w a -> T w a -> T w a
lift2 (\w
x w
y -> w
x w -> w -> w
forall a. Bits a => a -> a -> a
B..&. w -> w
forall a. Bits a => a -> a
B.complement w
y)
xor :: T w a -> T w a -> T w a
xor = (w -> w -> w) -> T w a -> T w a -> T w a
forall w a. (w -> w -> w) -> T w a -> T w a -> T w a
lift2 w -> w -> w
forall a. Bits a => a -> a -> a
B.xor
unions :: (Enum a, Bits w) => [T w a] -> T w a
unions :: [T w a] -> T w a
unions = (T w a -> T w a -> T w a) -> T w a -> [T w a] -> T w a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl T w a -> T w a -> T w a
forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
(.|.) T w a
forall a w. (Enum a, Bits w) => T w a
empty
get :: (Enum a, Bits w) => a -> T w a -> Bool
get :: a -> T w a -> Bool
get a
n = (w -> Int -> Bool) -> Int -> w -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
P.flip w -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit (a -> Int
forall a. Enum a => a -> Int
P.fromEnum a
n) (w -> Bool) -> (T w a -> w) -> T w a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T w a -> w
forall word index. T word index -> word
decons
put :: (Enum a, Bits w) => a -> Bool -> T w a -> T w a
put :: a -> Bool -> T w a -> T w a
put a
n Bool
b T w a
s =
a -> Bool -> T w a
forall a w. (Enum a, Bits w) => a -> Bool -> T w a
fromBool a
n Bool
b T w a -> T w a -> T w a
forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
.|. a -> T w a -> T w a
forall a w. (Enum a, Bits w) => a -> T w a -> T w a
clear a
n T w a
s
accessor :: (Enum a, Bits w) => a -> Acc.T (T w a) Bool
accessor :: a -> T (T w a) Bool
accessor a
x = (Bool -> T w a -> T w a) -> (T w a -> Bool) -> T (T w a) Bool
forall a r. (a -> r -> r) -> (r -> a) -> T r a
Acc.fromSetGet (a -> Bool -> T w a -> T w a
forall a w. (Enum a, Bits w) => a -> Bool -> T w a -> T w a
put a
x) (a -> T w a -> Bool
forall a w. (Enum a, Bits w) => a -> T w a -> Bool
get a
x)
{-# INLINE lift1 #-}
lift1 ::
(Enum a, Bits w) =>
(w -> Int -> w) -> (a -> T w a -> T w a)
lift1 :: (w -> Int -> w) -> a -> T w a -> T w a
lift1 w -> Int -> w
f a
n (Cons w
vec) = w -> T w a
forall word index. word -> T word index
Cons (w -> Int -> w
f w
vec (a -> Int
forall a. Enum a => a -> Int
P.fromEnum a
n))
singleton :: (Enum a, Bits w) => a -> T w a
singleton :: a -> T w a
singleton = (a -> T w a -> T w a) -> T w a -> a -> T w a
forall a b c. (a -> b -> c) -> b -> a -> c
P.flip a -> T w a -> T w a
forall a w. (Enum a, Bits w) => a -> T w a -> T w a
set T w a
forall a w. (Enum a, Bits w) => T w a
empty
set :: (Enum a, Bits w) => a -> T w a -> T w a
set :: a -> T w a -> T w a
set = (w -> Int -> w) -> a -> T w a -> T w a
forall a w.
(Enum a, Bits w) =>
(w -> Int -> w) -> a -> T w a -> T w a
lift1 w -> Int -> w
forall a. Bits a => a -> Int -> a
B.setBit
clear :: (Enum a, Bits w) => a -> T w a -> T w a
clear :: a -> T w a -> T w a
clear = (w -> Int -> w) -> a -> T w a -> T w a
forall a w.
(Enum a, Bits w) =>
(w -> Int -> w) -> a -> T w a -> T w a
lift1 w -> Int -> w
forall a. Bits a => a -> Int -> a
B.clearBit
flip :: (Enum a, Bits w) => a -> T w a -> T w a
flip :: a -> T w a -> T w a
flip = (w -> Int -> w) -> a -> T w a -> T w a
forall a w.
(Enum a, Bits w) =>
(w -> Int -> w) -> a -> T w a -> T w a
lift1 w -> Int -> w
forall a. Bits a => a -> Int -> a
B.complementBit
fromBool :: (Enum a, Bits w) => a -> Bool -> T w a
fromBool :: a -> Bool -> T w a
fromBool a
n Bool
b =
w -> T w a
forall word index. word -> T word index
Cons (w -> T w a) -> w -> T w a
forall a b. (a -> b) -> a -> b
$ if Bool
b then Int -> w
forall a. Bits a => Int -> a
B.bit (a -> Int
forall a. Enum a => a -> Int
P.fromEnum a
n) else w
forall w. Bits w => w
U.empty