-- | The most basic bitset structure. Alone, not particularly useful, because
-- two sets @{u,v},{v',w}@ have no way of annotating the connection between the
-- sets. Together with boundaries this yields sets for useful DP algorithms.

module Data.PrimitiveArray.Index.BitSet0 where

import           Control.DeepSeq (NFData(..))
import           Control.Lens (makeLenses)
import           Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey)
import           Data.Binary (Binary)
import           Data.Bits
import           Data.Bits.Extras
import           Data.Hashable (Hashable)
import           Data.Serialize (Serialize)
import           Data.Vector.Unboxed.Deriving
import           Data.Vector.Unboxed (Unbox(..))
import           Debug.Trace
import           GHC.Generics (Generic)
import qualified Data.Vector.Fusion.Stream.Monadic as SM
import           Test.QuickCheck

import           Data.Bits.Ordered
import           Data.PrimitiveArray.Index.Class
import           Data.PrimitiveArray.Index.IOC
import           Data.PrimitiveArray.Index.BitSetClasses



-- | Newtype for a bitset.
--
-- @Int@ integrates better with the rest of the framework. But we should
-- consider moving to @Word@-based indexing, if possible.

newtype BitSet t = BitSet { BitSet t -> Int
_bitSet :: Int }
  deriving stock (BitSet t -> BitSet t -> Bool
(BitSet t -> BitSet t -> Bool)
-> (BitSet t -> BitSet t -> Bool) -> Eq (BitSet t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (t :: k). BitSet t -> BitSet t -> Bool
/= :: BitSet t -> BitSet t -> Bool
$c/= :: forall k (t :: k). BitSet t -> BitSet t -> Bool
== :: BitSet t -> BitSet t -> Bool
$c== :: forall k (t :: k). BitSet t -> BitSet t -> Bool
Eq,Eq (BitSet t)
Eq (BitSet t)
-> (BitSet t -> BitSet t -> Ordering)
-> (BitSet t -> BitSet t -> Bool)
-> (BitSet t -> BitSet t -> Bool)
-> (BitSet t -> BitSet t -> Bool)
-> (BitSet t -> BitSet t -> Bool)
-> (BitSet t -> BitSet t -> BitSet t)
-> (BitSet t -> BitSet t -> BitSet t)
-> Ord (BitSet t)
BitSet t -> BitSet t -> Bool
BitSet t -> BitSet t -> Ordering
BitSet t -> BitSet t -> BitSet t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (t :: k). Eq (BitSet t)
forall k (t :: k). BitSet t -> BitSet t -> Bool
forall k (t :: k). BitSet t -> BitSet t -> Ordering
forall k (t :: k). BitSet t -> BitSet t -> BitSet t
min :: BitSet t -> BitSet t -> BitSet t
$cmin :: forall k (t :: k). BitSet t -> BitSet t -> BitSet t
max :: BitSet t -> BitSet t -> BitSet t
$cmax :: forall k (t :: k). BitSet t -> BitSet t -> BitSet t
>= :: BitSet t -> BitSet t -> Bool
$c>= :: forall k (t :: k). BitSet t -> BitSet t -> Bool
> :: BitSet t -> BitSet t -> Bool
$c> :: forall k (t :: k). BitSet t -> BitSet t -> Bool
<= :: BitSet t -> BitSet t -> Bool
$c<= :: forall k (t :: k). BitSet t -> BitSet t -> Bool
< :: BitSet t -> BitSet t -> Bool
$c< :: forall k (t :: k). BitSet t -> BitSet t -> Bool
compare :: BitSet t -> BitSet t -> Ordering
$ccompare :: forall k (t :: k). BitSet t -> BitSet t -> Ordering
$cp1Ord :: forall k (t :: k). Eq (BitSet t)
Ord,(forall x. BitSet t -> Rep (BitSet t) x)
-> (forall x. Rep (BitSet t) x -> BitSet t) -> Generic (BitSet t)
forall x. Rep (BitSet t) x -> BitSet t
forall x. BitSet t -> Rep (BitSet t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (t :: k) x. Rep (BitSet t) x -> BitSet t
forall k (t :: k) x. BitSet t -> Rep (BitSet t) x
$cto :: forall k (t :: k) x. Rep (BitSet t) x -> BitSet t
$cfrom :: forall k (t :: k) x. BitSet t -> Rep (BitSet t) x
Generic)
  deriving newtype (Bits (BitSet t)
Bits (BitSet t)
-> (BitSet t -> Int)
-> (BitSet t -> Int)
-> (BitSet t -> Int)
-> FiniteBits (BitSet t)
BitSet t -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
forall k (t :: k). Bits (BitSet t)
forall k (t :: k). BitSet t -> Int
countTrailingZeros :: BitSet t -> Int
$ccountTrailingZeros :: forall k (t :: k). BitSet t -> Int
countLeadingZeros :: BitSet t -> Int
$ccountLeadingZeros :: forall k (t :: k). BitSet t -> Int
finiteBitSize :: BitSet t -> Int
$cfiniteBitSize :: forall k (t :: k). BitSet t -> Int
$cp1FiniteBits :: forall k (t :: k). Bits (BitSet t)
FiniteBits,Num (BitSet t)
FiniteBits (BitSet t)
Num (BitSet t)
-> FiniteBits (BitSet t)
-> (BitSet t -> Int)
-> (BitSet t -> Int)
-> (BitSet t -> Int)
-> Ranked (BitSet t)
BitSet t -> Int
forall t.
Num t
-> FiniteBits t
-> (t -> Int)
-> (t -> Int)
-> (t -> Int)
-> Ranked t
forall k (t :: k). Num (BitSet t)
forall k (t :: k). FiniteBits (BitSet t)
forall k (t :: k). BitSet t -> Int
nlz :: BitSet t -> Int
$cnlz :: forall k (t :: k). BitSet t -> Int
rank :: BitSet t -> Int
$crank :: forall k (t :: k). BitSet t -> Int
lsb :: BitSet t -> Int
$clsb :: forall k (t :: k). BitSet t -> Int
$cp2Ranked :: forall k (t :: k). FiniteBits (BitSet t)
$cp1Ranked :: forall k (t :: k). Num (BitSet t)
Ranked,Integer -> BitSet t
BitSet t -> BitSet t
BitSet t -> BitSet t -> BitSet t
(BitSet t -> BitSet t -> BitSet t)
-> (BitSet t -> BitSet t -> BitSet t)
-> (BitSet t -> BitSet t -> BitSet t)
-> (BitSet t -> BitSet t)
-> (BitSet t -> BitSet t)
-> (BitSet t -> BitSet t)
-> (Integer -> BitSet t)
-> Num (BitSet t)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall k (t :: k). Integer -> BitSet t
forall k (t :: k). BitSet t -> BitSet t
forall k (t :: k). BitSet t -> BitSet t -> BitSet t
fromInteger :: Integer -> BitSet t
$cfromInteger :: forall k (t :: k). Integer -> BitSet t
signum :: BitSet t -> BitSet t
$csignum :: forall k (t :: k). BitSet t -> BitSet t
abs :: BitSet t -> BitSet t
$cabs :: forall k (t :: k). BitSet t -> BitSet t
negate :: BitSet t -> BitSet t
$cnegate :: forall k (t :: k). BitSet t -> BitSet t
* :: BitSet t -> BitSet t -> BitSet t
$c* :: forall k (t :: k). BitSet t -> BitSet t -> BitSet t
- :: BitSet t -> BitSet t -> BitSet t
$c- :: forall k (t :: k). BitSet t -> BitSet t -> BitSet t
+ :: BitSet t -> BitSet t -> BitSet t
$c+ :: forall k (t :: k). BitSet t -> BitSet t -> BitSet t
Num,Eq (BitSet t)
BitSet t
Eq (BitSet t)
-> (BitSet t -> BitSet t -> BitSet t)
-> (BitSet t -> BitSet t -> BitSet t)
-> (BitSet t -> BitSet t -> BitSet t)
-> (BitSet t -> BitSet t)
-> (BitSet t -> Int -> BitSet t)
-> (BitSet t -> Int -> BitSet t)
-> BitSet t
-> (Int -> BitSet t)
-> (BitSet t -> Int -> BitSet t)
-> (BitSet t -> Int -> BitSet t)
-> (BitSet t -> Int -> BitSet t)
-> (BitSet t -> Int -> Bool)
-> (BitSet t -> Maybe Int)
-> (BitSet t -> Int)
-> (BitSet t -> Bool)
-> (BitSet t -> Int -> BitSet t)
-> (BitSet t -> Int -> BitSet t)
-> (BitSet t -> Int -> BitSet t)
-> (BitSet t -> Int -> BitSet t)
-> (BitSet t -> Int -> BitSet t)
-> (BitSet t -> Int -> BitSet t)
-> (BitSet t -> Int)
-> Bits (BitSet t)
Int -> BitSet t
BitSet t -> Bool
BitSet t -> Int
BitSet t -> Maybe Int
BitSet t -> BitSet t
BitSet t -> Int -> Bool
BitSet t -> Int -> BitSet t
BitSet t -> BitSet t -> BitSet t
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
forall k (t :: k). Eq (BitSet t)
forall k (t :: k). BitSet t
forall k (t :: k). Int -> BitSet t
forall k (t :: k). BitSet t -> Bool
forall k (t :: k). BitSet t -> Int
forall k (t :: k). BitSet t -> Maybe Int
forall k (t :: k). BitSet t -> BitSet t
forall k (t :: k). BitSet t -> Int -> Bool
forall k (t :: k). BitSet t -> Int -> BitSet t
forall k (t :: k). BitSet t -> BitSet t -> BitSet t
popCount :: BitSet t -> Int
$cpopCount :: forall k (t :: k). BitSet t -> Int
rotateR :: BitSet t -> Int -> BitSet t
$crotateR :: forall k (t :: k). BitSet t -> Int -> BitSet t
rotateL :: BitSet t -> Int -> BitSet t
$crotateL :: forall k (t :: k). BitSet t -> Int -> BitSet t
unsafeShiftR :: BitSet t -> Int -> BitSet t
$cunsafeShiftR :: forall k (t :: k). BitSet t -> Int -> BitSet t
shiftR :: BitSet t -> Int -> BitSet t
$cshiftR :: forall k (t :: k). BitSet t -> Int -> BitSet t
unsafeShiftL :: BitSet t -> Int -> BitSet t
$cunsafeShiftL :: forall k (t :: k). BitSet t -> Int -> BitSet t
shiftL :: BitSet t -> Int -> BitSet t
$cshiftL :: forall k (t :: k). BitSet t -> Int -> BitSet t
isSigned :: BitSet t -> Bool
$cisSigned :: forall k (t :: k). BitSet t -> Bool
bitSize :: BitSet t -> Int
$cbitSize :: forall k (t :: k). BitSet t -> Int
bitSizeMaybe :: BitSet t -> Maybe Int
$cbitSizeMaybe :: forall k (t :: k). BitSet t -> Maybe Int
testBit :: BitSet t -> Int -> Bool
$ctestBit :: forall k (t :: k). BitSet t -> Int -> Bool
complementBit :: BitSet t -> Int -> BitSet t
$ccomplementBit :: forall k (t :: k). BitSet t -> Int -> BitSet t
clearBit :: BitSet t -> Int -> BitSet t
$cclearBit :: forall k (t :: k). BitSet t -> Int -> BitSet t
setBit :: BitSet t -> Int -> BitSet t
$csetBit :: forall k (t :: k). BitSet t -> Int -> BitSet t
bit :: Int -> BitSet t
$cbit :: forall k (t :: k). Int -> BitSet t
zeroBits :: BitSet t
$czeroBits :: forall k (t :: k). BitSet t
rotate :: BitSet t -> Int -> BitSet t
$crotate :: forall k (t :: k). BitSet t -> Int -> BitSet t
shift :: BitSet t -> Int -> BitSet t
$cshift :: forall k (t :: k). BitSet t -> Int -> BitSet t
complement :: BitSet t -> BitSet t
$ccomplement :: forall k (t :: k). BitSet t -> BitSet t
xor :: BitSet t -> BitSet t -> BitSet t
$cxor :: forall k (t :: k). BitSet t -> BitSet t -> BitSet t
.|. :: BitSet t -> BitSet t -> BitSet t
$c.|. :: forall k (t :: k). BitSet t -> BitSet t -> BitSet t
.&. :: BitSet t -> BitSet t -> BitSet t
$c.&. :: forall k (t :: k). BitSet t -> BitSet t -> BitSet t
$cp1Bits :: forall k (t :: k). Eq (BitSet t)
Bits)
makeLenses ''BitSet

instance FromJSON     (BitSet t)
instance FromJSONKey  (BitSet t)
instance ToJSON       (BitSet t)
instance ToJSONKey    (BitSet t)
instance Binary       (BitSet t)
instance Serialize    (BitSet t)
instance Hashable     (BitSet t)

derivingUnbox "BitSet"
  [t| forall t . BitSet t → Int |]
  [| \(BitSet s) → s            |]
  [| BitSet                     |]

instance Show (BitSet t) where
  show :: BitSet t -> String
show (BitSet Int
s) = String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Int] -> String
forall a. Show a => a -> String
show ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [Int]
forall t. Ranked t => t -> [Int]
activeBitsL Int
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance NFData (BitSet t) where
  rnf :: BitSet t -> ()
rnf (BitSet Int
s) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
s
  {-# Inline rnf #-}

instance Index (BitSet t) where
  newtype LimitType (BitSet t) = LtBitSet Int
  linearIndex :: LimitType (BitSet t) -> BitSet t -> Int
linearIndex LimitType (BitSet t)
_ (BitSet Int
z) = Int
z
  {-# Inline linearIndex #-}
  size :: LimitType (BitSet t) -> Int
size (LtBitSet pc) = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
pc -- 2 ^ popCount h - 2 ^ popCount l + 1
  {-# Inline size #-}
  inBounds :: LimitType (BitSet t) -> BitSet t -> Bool
inBounds (LtBitSet h) BitSet t
z = BitSet t -> Int
forall a. Bits a => a -> Int
popCount BitSet t
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h
  {-# Inline inBounds #-}
  zeroBound :: BitSet t
zeroBound = Int -> BitSet t
forall k (t :: k). Int -> BitSet t
BitSet Int
0
  {-# Inline zeroBound #-}
  zeroBound' :: LimitType (BitSet t)
zeroBound' = Int -> LimitType (BitSet t)
forall k (t :: k). Int -> LimitType (BitSet t)
LtBitSet Int
0
  {-# Inline zeroBound' #-}
  totalSize :: LimitType (BitSet t) -> [Integer]
totalSize (LtBitSet n) = [Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n]
  {-# Inline totalSize #-}
  fromLinearIndex :: LimitType (BitSet t) -> Int -> BitSet t
fromLinearIndex LimitType (BitSet t)
_ = Int -> BitSet t
forall k (t :: k). Int -> BitSet t
BitSet
  {-# Inline [0] fromLinearIndex #-}
  showBound :: LimitType (BitSet t) -> [String]
showBound (LtBitSet b) = [String
"LtBitSet " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b]
  showIndex :: BitSet t -> [String]
showIndex (BitSet Int
b) = [String
"BitSet " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b]

instance SetPredSucc (BitSet t) where
  setSucc :: Int -> Int -> BitSet t -> Maybe (BitSet t)
setSucc Int
l Int
h BitSet t
s
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ch                        = Maybe (BitSet t)
forall a. Maybe a
Nothing
    | Just BitSet t
s' <- Int -> BitSet t -> Maybe (BitSet t)
forall t. Ranked t => Int -> t -> Maybe t
popPermutation Int
ch BitSet t
s = BitSet t -> Maybe (BitSet t)
forall a. a -> Maybe a
Just BitSet t
s'
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ch                       = Maybe (BitSet t)
forall a. Maybe a
Nothing
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ch                        = BitSet t -> Maybe (BitSet t)
forall a. a -> Maybe a
Just (BitSet t -> Maybe (BitSet t))
-> (Int -> BitSet t) -> Int -> Maybe (BitSet t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BitSet t
forall k (t :: k). Int -> BitSet t
BitSet (Int -> Maybe (BitSet t)) -> Int -> Maybe (BitSet t)
forall a b. (a -> b) -> a -> b
$ Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
csInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
    where ch :: Int
ch = Int -> Int
forall a. Bits a => a -> Int
popCount Int
h
          cs :: Int
cs = BitSet t -> Int
forall a. Bits a => a -> Int
popCount BitSet t
s
  {-# Inline setSucc #-}
  setPred :: Int -> Int -> BitSet t -> Maybe (BitSet t)
setPred Int
l Int
h BitSet t
s
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cl                        = Maybe (BitSet t)
forall a. Maybe a
Nothing
    | Just BitSet t
s' <- Int -> BitSet t -> Maybe (BitSet t)
forall t. Ranked t => Int -> t -> Maybe t
popPermutation Int
ch BitSet t
s = BitSet t -> Maybe (BitSet t)
forall a. a -> Maybe a
Just BitSet t
s'
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cl                       = Maybe (BitSet t)
forall a. Maybe a
Nothing
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
cl                        = BitSet t -> Maybe (BitSet t)
forall a. a -> Maybe a
Just (BitSet t -> Maybe (BitSet t))
-> (Int -> BitSet t) -> Int -> Maybe (BitSet t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BitSet t
forall k (t :: k). Int -> BitSet t
BitSet (Int -> Maybe (BitSet t)) -> Int -> Maybe (BitSet t)
forall a b. (a -> b) -> a -> b
$ Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
csInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
    where cl :: Int
cl = Int -> Int
forall a. Bits a => a -> Int
popCount Int
l
          ch :: Int
ch = Int -> Int
forall a. Bits a => a -> Int
popCount Int
h
          cs :: Int
cs = BitSet t -> Int
forall a. Bits a => a -> Int
popCount BitSet t
s
  {-# Inline setPred #-}

instance IndexStream z => IndexStream (z:.BitSet I) where
  streamUp :: LimitType (z :. BitSet I)
-> LimitType (z :. BitSet I) -> Stream m (z :. BitSet I)
streamUp   (ls:..LtBitSet l) (hs:..LtBitSet h) = (z -> m (z, Maybe (BitSet I)))
-> ((z, Maybe (BitSet I))
    -> m (Step (z, Maybe (BitSet I)) (z :. BitSet I)))
-> Stream m z
-> Stream m (z :. BitSet I)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
SM.flatten (Int -> Int -> z -> m (z, Maybe (BitSet I))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int -> Int -> t -> m (t, Maybe (BitSet ioc))
streamUpMk   Int
l Int
h) (Int
-> Int
-> (z, Maybe (BitSet I))
-> m (Step (z, Maybe (BitSet I)) (z :. BitSet I))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int
-> Int
-> (t, Maybe (BitSet ioc))
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
streamUpStep   Int
l Int
h) (Stream m z -> Stream m (z :. BitSet I))
-> Stream m z -> Stream m (z :. BitSet I)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp   LimitType z
ls LimitType z
hs
  streamDown :: LimitType (z :. BitSet I)
-> LimitType (z :. BitSet I) -> Stream m (z :. BitSet I)
streamDown (ls:..LtBitSet l) (hs:..LtBitSet h) = (z -> m (z, Maybe (BitSet I)))
-> ((z, Maybe (BitSet I))
    -> m (Step (z, Maybe (BitSet I)) (z :. BitSet I)))
-> Stream m z
-> Stream m (z :. BitSet I)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
SM.flatten (Int -> Int -> z -> m (z, Maybe (BitSet I))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int -> Int -> t -> m (t, Maybe (BitSet ioc))
streamDownMk Int
l Int
h) (Int
-> Int
-> (z, Maybe (BitSet I))
-> m (Step (z, Maybe (BitSet I)) (z :. BitSet I))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int
-> Int
-> (t, Maybe (BitSet ioc))
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
streamDownStep Int
l Int
h) (Stream m z -> Stream m (z :. BitSet I))
-> Stream m z -> Stream m (z :. BitSet I)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown LimitType z
ls LimitType z
hs
  {-# Inline streamUp   #-}
  {-# Inline streamDown #-}

instance IndexStream z ⇒ IndexStream (z:.BitSet O) where
  streamUp :: LimitType (z :. BitSet O)
-> LimitType (z :. BitSet O) -> Stream m (z :. BitSet O)
streamUp   (ls:..LtBitSet l) (hs:..LtBitSet h) = (z -> m (z, Maybe (BitSet O)))
-> ((z, Maybe (BitSet O))
    -> m (Step (z, Maybe (BitSet O)) (z :. BitSet O)))
-> Stream m z
-> Stream m (z :. BitSet O)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
SM.flatten (Int -> Int -> z -> m (z, Maybe (BitSet O))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int -> Int -> t -> m (t, Maybe (BitSet ioc))
streamDownMk Int
l Int
h) (Int
-> Int
-> (z, Maybe (BitSet O))
-> m (Step (z, Maybe (BitSet O)) (z :. BitSet O))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int
-> Int
-> (t, Maybe (BitSet ioc))
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
streamDownStep Int
l Int
h) (Stream m z -> Stream m (z :. BitSet O))
-> Stream m z -> Stream m (z :. BitSet O)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp   LimitType z
ls LimitType z
hs
  streamDown :: LimitType (z :. BitSet O)
-> LimitType (z :. BitSet O) -> Stream m (z :. BitSet O)
streamDown (ls:..LtBitSet l) (hs:..LtBitSet h) = (z -> m (z, Maybe (BitSet O)))
-> ((z, Maybe (BitSet O))
    -> m (Step (z, Maybe (BitSet O)) (z :. BitSet O)))
-> Stream m z
-> Stream m (z :. BitSet O)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
SM.flatten (Int -> Int -> z -> m (z, Maybe (BitSet O))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int -> Int -> t -> m (t, Maybe (BitSet ioc))
streamUpMk   Int
l Int
h) (Int
-> Int
-> (z, Maybe (BitSet O))
-> m (Step (z, Maybe (BitSet O)) (z :. BitSet O))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int
-> Int
-> (t, Maybe (BitSet ioc))
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
streamUpStep   Int
l Int
h) (Stream m z -> Stream m (z :. BitSet O))
-> Stream m z -> Stream m (z :. BitSet O)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown LimitType z
ls LimitType z
hs
  {-# Inline streamUp   #-}
  {-# Inline streamDown #-}

instance IndexStream z ⇒ IndexStream (z:.BitSet C) where
  streamUp :: LimitType (z :. BitSet C)
-> LimitType (z :. BitSet C) -> Stream m (z :. BitSet C)
streamUp   (ls:..LtBitSet l) (hs:..LtBitSet h) = (z -> m (z, Maybe (BitSet C)))
-> ((z, Maybe (BitSet C))
    -> m (Step (z, Maybe (BitSet C)) (z :. BitSet C)))
-> Stream m z
-> Stream m (z :. BitSet C)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
SM.flatten (Int -> Int -> z -> m (z, Maybe (BitSet C))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int -> Int -> t -> m (t, Maybe (BitSet ioc))
streamUpMk   Int
l Int
h) (Int
-> Int
-> (z, Maybe (BitSet C))
-> m (Step (z, Maybe (BitSet C)) (z :. BitSet C))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int
-> Int
-> (t, Maybe (BitSet ioc))
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
streamUpStep   Int
l Int
h) (Stream m z -> Stream m (z :. BitSet C))
-> Stream m z -> Stream m (z :. BitSet C)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp   LimitType z
ls LimitType z
hs
  streamDown :: LimitType (z :. BitSet C)
-> LimitType (z :. BitSet C) -> Stream m (z :. BitSet C)
streamDown (ls:..LtBitSet l) (hs:..LtBitSet h) = (z -> m (z, Maybe (BitSet C)))
-> ((z, Maybe (BitSet C))
    -> m (Step (z, Maybe (BitSet C)) (z :. BitSet C)))
-> Stream m z
-> Stream m (z :. BitSet C)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
SM.flatten (Int -> Int -> z -> m (z, Maybe (BitSet C))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int -> Int -> t -> m (t, Maybe (BitSet ioc))
streamDownMk Int
l Int
h) (Int
-> Int
-> (z, Maybe (BitSet C))
-> m (Step (z, Maybe (BitSet C)) (z :. BitSet C))
forall k (m :: * -> *) t (ioc :: k).
Monad m =>
Int
-> Int
-> (t, Maybe (BitSet ioc))
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
streamDownStep Int
l Int
h) (Stream m z -> Stream m (z :. BitSet C))
-> Stream m z -> Stream m (z :. BitSet C)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown LimitType z
ls LimitType z
hs
  {-# Inline streamUp   #-}
  {-# Inline streamDown #-}

instance IndexStream (Z:.BitSet t) ⇒ IndexStream (BitSet t) where
  streamUp :: LimitType (BitSet t) -> LimitType (BitSet t) -> Stream m (BitSet t)
streamUp LimitType (BitSet t)
l LimitType (BitSet t)
h = ((Z :. BitSet t) -> BitSet t)
-> Stream m (Z :. BitSet t) -> Stream m (BitSet t)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
SM.map (\(Z
Z:.BitSet t
i) -> BitSet t
i) (Stream m (Z :. BitSet t) -> Stream m (BitSet t))
-> Stream m (Z :. BitSet t) -> Stream m (BitSet t)
forall a b. (a -> b) -> a -> b
$ LimitType (Z :. BitSet t)
-> LimitType (Z :. BitSet t) -> Stream m (Z :. BitSet t)
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp (LimitType Z
ZZLimitType Z -> LimitType (BitSet t) -> LimitType (Z :. BitSet t)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (BitSet t)
l) (LimitType Z
ZZLimitType Z -> LimitType (BitSet t) -> LimitType (Z :. BitSet t)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (BitSet t)
h)
  {-# Inline streamUp #-}
  streamDown :: LimitType (BitSet t) -> LimitType (BitSet t) -> Stream m (BitSet t)
streamDown LimitType (BitSet t)
l LimitType (BitSet t)
h = ((Z :. BitSet t) -> BitSet t)
-> Stream m (Z :. BitSet t) -> Stream m (BitSet t)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
SM.map (\(Z
Z:.BitSet t
i) -> BitSet t
i) (Stream m (Z :. BitSet t) -> Stream m (BitSet t))
-> Stream m (Z :. BitSet t) -> Stream m (BitSet t)
forall a b. (a -> b) -> a -> b
$ LimitType (Z :. BitSet t)
-> LimitType (Z :. BitSet t) -> Stream m (Z :. BitSet t)
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown (LimitType Z
ZZLimitType Z -> LimitType (BitSet t) -> LimitType (Z :. BitSet t)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (BitSet t)
l) (LimitType Z
ZZLimitType Z -> LimitType (BitSet t) -> LimitType (Z :. BitSet t)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..LimitType (BitSet t)
h)
  {-# Inline streamDown #-}

streamUpMk ∷ Monad m ⇒ Int → Int → t → m (t, Maybe (BitSet ioc))
streamUpMk :: Int -> Int -> t -> m (t, Maybe (BitSet ioc))
streamUpMk Int
l Int
h t
z = (t, Maybe (BitSet ioc)) -> m (t, Maybe (BitSet ioc))
forall (m :: * -> *) a. Monad m => a -> m a
return (t
z, if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h then BitSet ioc -> Maybe (BitSet ioc)
forall a. a -> Maybe a
Just (Int -> BitSet ioc
forall k (t :: k). Int -> BitSet t
BitSet (Int -> BitSet ioc) -> Int -> BitSet ioc
forall a b. (a -> b) -> a -> b
$ Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) else Maybe (BitSet ioc)
forall a. Maybe a
Nothing)
{-# Inline [0] streamUpMk #-}

streamUpStep ∷ Monad m ⇒ Int → Int → (t, Maybe (BitSet ioc)) → m (SM.Step (t, Maybe (BitSet ioc)) (t:.BitSet ioc))
streamUpStep :: Int
-> Int
-> (t, Maybe (BitSet ioc))
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
streamUpStep Int
l Int
h (t
z , Maybe (BitSet ioc)
Nothing) = Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
 -> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)))
-> Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
forall a b. (a -> b) -> a -> b
$ Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
forall s a. Step s a
SM.Done
streamUpStep Int
l Int
h (t
z , Just BitSet ioc
t ) = Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
 -> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)))
-> Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
forall a b. (a -> b) -> a -> b
$ (t :. BitSet ioc)
-> (t, Maybe (BitSet ioc))
-> Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
forall a s. a -> s -> Step s a
SM.Yield (t
zt -> BitSet ioc -> t :. BitSet ioc
forall a b. a -> b -> a :. b
:.BitSet ioc
t) (t
z, Int -> Int -> BitSet ioc -> Maybe (BitSet ioc)
forall s. SetPredSucc s => Int -> Int -> s -> Maybe s
setSucc (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) BitSet ioc
t)
{-# Inline [0] streamUpStep #-}

streamDownMk ∷ Monad m ⇒ Int → Int → t → m (t, Maybe (BitSet ioc))
streamDownMk :: Int -> Int -> t -> m (t, Maybe (BitSet ioc))
streamDownMk Int
l Int
h t
z = (t, Maybe (BitSet ioc)) -> m (t, Maybe (BitSet ioc))
forall (m :: * -> *) a. Monad m => a -> m a
return (t
z, if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
h then BitSet ioc -> Maybe (BitSet ioc)
forall a. a -> Maybe a
Just (Int -> BitSet ioc
forall k (t :: k). Int -> BitSet t
BitSet (Int -> BitSet ioc) -> Int -> BitSet ioc
forall a b. (a -> b) -> a -> b
$ Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) else Maybe (BitSet ioc)
forall a. Maybe a
Nothing)
{-# Inline [0] streamDownMk #-}

streamDownStep ∷ Monad m ⇒ Int → Int → (t, Maybe (BitSet ioc)) → m (SM.Step (t, Maybe (BitSet ioc)) (t:.BitSet ioc))
streamDownStep :: Int
-> Int
-> (t, Maybe (BitSet ioc))
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
streamDownStep Int
l Int
h (t
z , Maybe (BitSet ioc)
Nothing) = Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
 -> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)))
-> Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
forall a b. (a -> b) -> a -> b
$ Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
forall s a. Step s a
SM.Done
streamDownStep Int
l Int
h (t
z , Just BitSet ioc
t ) = Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
 -> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)))
-> Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
-> m (Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc))
forall a b. (a -> b) -> a -> b
$ (t :. BitSet ioc)
-> (t, Maybe (BitSet ioc))
-> Step (t, Maybe (BitSet ioc)) (t :. BitSet ioc)
forall a s. a -> s -> Step s a
SM.Yield (t
zt -> BitSet ioc -> t :. BitSet ioc
forall a b. a -> b -> a :. b
:.BitSet ioc
t) (t
z , Int -> Int -> BitSet ioc -> Maybe (BitSet ioc)
forall s. SetPredSucc s => Int -> Int -> s -> Maybe s
setPred (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) BitSet ioc
t)
{-# Inline [0] streamDownStep #-}

instance Arbitrary (BitSet t) where
  arbitrary :: Gen (BitSet t)
arbitrary = Int -> BitSet t
forall k (t :: k). Int -> BitSet t
BitSet (Int -> BitSet t) -> Gen Int -> Gen (BitSet t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0,Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
arbitraryBitSetMaxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  shrink :: BitSet t -> [BitSet t]
shrink BitSet t
s = let s' :: [BitSet t]
s' = [ BitSet t
s BitSet t -> Int -> BitSet t
forall a. Bits a => a -> Int -> a
`clearBit` Int
a | Int
a <- BitSet t -> [Int]
forall t. Ranked t => t -> [Int]
activeBitsL BitSet t
s ]
             in  [BitSet t]
s' [BitSet t] -> [BitSet t] -> [BitSet t]
forall a. [a] -> [a] -> [a]
++ (BitSet t -> [BitSet t]) -> [BitSet t] -> [BitSet t]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BitSet t -> [BitSet t]
forall a. Arbitrary a => a -> [a]
shrink [BitSet t]
s'