-- | A bitset with one interface. This includes the often-encountered case
-- where @{u,v},{v}@, or sets with a single edge between the old set and a new
-- singleton set are required. Uses are Hamiltonian path problems, and TSP,
-- among others.

module Data.PrimitiveArray.Index.BitSet1 where

import           Control.DeepSeq (NFData(..))
import           Control.Lens (makeLenses)
import           Control.Monad.Except
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.BitSet0 (BitSet(..),LimitType(..))
import           Data.PrimitiveArray.Index.BitSetClasses
import           Data.PrimitiveArray.Index.Class
import           Data.PrimitiveArray.Index.IOC



-- | The bitset with one interface or boundary.

data BitSet1 i ioc = BitSet1 { BitSet1 i ioc -> BitSet ioc
_bitset ∷ !(BitSet ioc), BitSet1 i ioc -> Boundary i ioc
_boundary ∷ !(Boundary i ioc) }
  deriving (BitSet1 i ioc -> BitSet1 i ioc -> Bool
(BitSet1 i ioc -> BitSet1 i ioc -> Bool)
-> (BitSet1 i ioc -> BitSet1 i ioc -> Bool) -> Eq (BitSet1 i ioc)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> Bool
/= :: BitSet1 i ioc -> BitSet1 i ioc -> Bool
$c/= :: forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> Bool
== :: BitSet1 i ioc -> BitSet1 i ioc -> Bool
$c== :: forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> Bool
Eq,Eq (BitSet1 i ioc)
Eq (BitSet1 i ioc)
-> (BitSet1 i ioc -> BitSet1 i ioc -> Ordering)
-> (BitSet1 i ioc -> BitSet1 i ioc -> Bool)
-> (BitSet1 i ioc -> BitSet1 i ioc -> Bool)
-> (BitSet1 i ioc -> BitSet1 i ioc -> Bool)
-> (BitSet1 i ioc -> BitSet1 i ioc -> Bool)
-> (BitSet1 i ioc -> BitSet1 i ioc -> BitSet1 i ioc)
-> (BitSet1 i ioc -> BitSet1 i ioc -> BitSet1 i ioc)
-> Ord (BitSet1 i ioc)
BitSet1 i ioc -> BitSet1 i ioc -> Bool
BitSet1 i ioc -> BitSet1 i ioc -> Ordering
BitSet1 i ioc -> BitSet1 i ioc -> BitSet1 i ioc
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 (i :: k) k (ioc :: k). Eq (BitSet1 i ioc)
forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> Bool
forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> Ordering
forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> BitSet1 i ioc
min :: BitSet1 i ioc -> BitSet1 i ioc -> BitSet1 i ioc
$cmin :: forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> BitSet1 i ioc
max :: BitSet1 i ioc -> BitSet1 i ioc -> BitSet1 i ioc
$cmax :: forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> BitSet1 i ioc
>= :: BitSet1 i ioc -> BitSet1 i ioc -> Bool
$c>= :: forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> Bool
> :: BitSet1 i ioc -> BitSet1 i ioc -> Bool
$c> :: forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> Bool
<= :: BitSet1 i ioc -> BitSet1 i ioc -> Bool
$c<= :: forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> Bool
< :: BitSet1 i ioc -> BitSet1 i ioc -> Bool
$c< :: forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> Bool
compare :: BitSet1 i ioc -> BitSet1 i ioc -> Ordering
$ccompare :: forall k (i :: k) k (ioc :: k).
BitSet1 i ioc -> BitSet1 i ioc -> Ordering
$cp1Ord :: forall k (i :: k) k (ioc :: k). Eq (BitSet1 i ioc)
Ord,(forall x. BitSet1 i ioc -> Rep (BitSet1 i ioc) x)
-> (forall x. Rep (BitSet1 i ioc) x -> BitSet1 i ioc)
-> Generic (BitSet1 i ioc)
forall x. Rep (BitSet1 i ioc) x -> BitSet1 i ioc
forall x. BitSet1 i ioc -> Rep (BitSet1 i ioc) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (i :: k) k (ioc :: k) x.
Rep (BitSet1 i ioc) x -> BitSet1 i ioc
forall k (i :: k) k (ioc :: k) x.
BitSet1 i ioc -> Rep (BitSet1 i ioc) x
$cto :: forall k (i :: k) k (ioc :: k) x.
Rep (BitSet1 i ioc) x -> BitSet1 i ioc
$cfrom :: forall k (i :: k) k (ioc :: k) x.
BitSet1 i ioc -> Rep (BitSet1 i ioc) x
Generic,Int -> BitSet1 i ioc -> ShowS
[BitSet1 i ioc] -> ShowS
BitSet1 i ioc -> String
(Int -> BitSet1 i ioc -> ShowS)
-> (BitSet1 i ioc -> String)
-> ([BitSet1 i ioc] -> ShowS)
-> Show (BitSet1 i ioc)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (i :: k) k (ioc :: k). Int -> BitSet1 i ioc -> ShowS
forall k (i :: k) k (ioc :: k). [BitSet1 i ioc] -> ShowS
forall k (i :: k) k (ioc :: k). BitSet1 i ioc -> String
showList :: [BitSet1 i ioc] -> ShowS
$cshowList :: forall k (i :: k) k (ioc :: k). [BitSet1 i ioc] -> ShowS
show :: BitSet1 i ioc -> String
$cshow :: forall k (i :: k) k (ioc :: k). BitSet1 i ioc -> String
showsPrec :: Int -> BitSet1 i ioc -> ShowS
$cshowsPrec :: forall k (i :: k) k (ioc :: k). Int -> BitSet1 i ioc -> ShowS
Show)
makeLenses ''BitSet1

derivingUnbox "BitSet1"
  [t| forall i ioc . BitSet1 i ioc → (Int,Int)           |]
  [| \ (BitSet1 (BitSet set) (Boundary bnd)) → (set,bnd) |]
  [| \ (set,bnd) → BitSet1 (BitSet set) (Boundary bnd)   |]


-- |
--
-- NOTE We linearize a bitset as follows: we need @2^number-of-bits *
-- number-of-bits@ elements. The first is due to having a binary set structure.
-- The second is due to pointing to each of those elements as being the
-- boundary. This overcommits on memory since only those bits can be a boundary
-- bits that are actually set. Furthermore, in case no bit is set at all, then
-- there should be no boundary. This is currently rather awkwardly done by
-- restricting enumeration and mapping the 0-set to boundary 0.
--
-- | TODO The size calculations are off by a factor of two, exactly. Each
-- bitset (say) @00110@ has a mirror image @11001@, whose elements do not have
-- to be indexed. It has to be investigated if a version with exact memory
-- bounds is slower in indexing.

instance Index (BitSet1 bnd ioc) where
  -- This is the number of bits. Meaning that @LtNumBits1 3@ yields @[0,1,2]@.
  -- TODO Should we rename this to @NumberOfBits1@? Or have a newtype @NumBits@?
  newtype LimitType (BitSet1 bnd ioc) = LtNumBits1 Int
  -- Calculate the linear index for a set. Spread out by the possible number of
  -- bits to fit the actual boundary results. Add the boundary index.
  linearIndex :: LimitType (BitSet1 bnd ioc) -> BitSet1 bnd ioc -> Int
linearIndex (LtNumBits1 pc) (BitSet1 BitSet ioc
set (Boundary Int
bnd))
    = LimitType (BitSet ioc) -> BitSet ioc -> Int
forall i. Index i => LimitType i -> i -> Int
linearIndex (Int -> LimitType (BitSet ioc)
forall k (t :: k). Int -> LimitType (BitSet t)
LtBitSet Int
pc) BitSet ioc
set Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bnd
  {-# Inline linearIndex #-}
  size :: LimitType (BitSet1 bnd ioc) -> Int
size (LtNumBits1 pc) = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  {-# Inline size #-}
  inBounds :: LimitType (BitSet1 bnd ioc) -> BitSet1 bnd ioc -> Bool
inBounds (LtNumBits1 pc) (BitSet1 BitSet ioc
set Boundary bnd ioc
bnd) = BitSet ioc -> Int
forall a. Bits a => a -> Int
popCount BitSet ioc
set Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pc Bool -> Bool -> Bool
&& Boundary bnd ioc
0 Boundary bnd ioc -> Boundary bnd ioc -> Bool
forall a. Ord a => a -> a -> Bool
<= Boundary bnd ioc
bnd Bool -> Bool -> Bool
&& Boundary bnd ioc -> Int
forall k1 (boundaryType :: k1) k2 (ioc :: k2).
Boundary boundaryType ioc -> Int
getBoundary Boundary bnd ioc
bnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pc
  {-# Inline inBounds #-}
  zeroBound :: BitSet1 bnd ioc
zeroBound = BitSet ioc -> Boundary bnd ioc -> BitSet1 bnd ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
forall i. Index i => i
zeroBound Boundary bnd ioc
forall i. Index i => i
zeroBound
  {-# Inline zeroBound #-}
  zeroBound' :: LimitType (BitSet1 bnd ioc)
zeroBound' = Int -> LimitType (BitSet1 bnd ioc)
forall k k (bnd :: k) (ioc :: k).
Int -> LimitType (BitSet1 bnd ioc)
LtNumBits1 Int
0
  {-# Inline zeroBound' #-}
  totalSize :: LimitType (BitSet1 bnd ioc) -> [Integer]
totalSize (LtNumBits1 pc) =
    let z :: Integer
z = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pc
    in  [Integer
z Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
z]
  fromLinearIndex :: LimitType (BitSet1 bnd ioc) -> Int -> BitSet1 bnd ioc
fromLinearIndex (LtNumBits1 pc) Int
z = String -> BitSet1 bnd ioc
forall a. HasCallStack => String -> a
error String
"implement me"
  showBound :: LimitType (BitSet1 bnd ioc) -> [String]
showBound = String -> LimitType (BitSet1 bnd ioc) -> [String]
forall a. HasCallStack => String -> a
error String
"implement me"
  showIndex :: BitSet1 bnd ioc -> [String]
showIndex = String -> BitSet1 bnd ioc -> [String]
forall a. HasCallStack => String -> a
error String
"implement me"

deriving instance Show (LimitType (BitSet1 bnd ioc))

instance IndexStream z ⇒ IndexStream (z:.BitSet1 i I) where
  streamUp :: LimitType (z :. BitSet1 i I)
-> LimitType (z :. BitSet1 i I) -> Stream m (z :. BitSet1 i I)
streamUp   (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = (z -> m (z, Maybe (BitSet1 i I)))
-> ((z, Maybe (BitSet1 i I))
    -> m (Step (z, Maybe (BitSet1 i I)) (z :. BitSet1 i I)))
-> Stream m z
-> Stream m (z :. BitSet1 i 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 (BitSet1 i I))
forall k k (m :: * -> *) z (c :: k) (ioc :: k).
Monad m =>
Int -> Int -> z -> m (z, Maybe (BitSet1 c ioc))
streamUpMk   Int
l Int
h) (Int
-> Int
-> (z, Maybe (BitSet1 i I))
-> m (Step (z, Maybe (BitSet1 i I)) (z :. BitSet1 i I))
forall k k (m :: * -> *) t (c :: k) (ioc :: k).
Monad m =>
Int
-> Int
-> (t, Maybe (BitSet1 c ioc))
-> m (Step (t, Maybe (BitSet1 c ioc)) (t :. BitSet1 c ioc))
streamUpStep   Int
l Int
h) (Stream m z -> Stream m (z :. BitSet1 i I))
-> Stream m z -> Stream m (z :. BitSet1 i 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 :. BitSet1 i I)
-> LimitType (z :. BitSet1 i I) -> Stream m (z :. BitSet1 i I)
streamDown (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = (z -> m (z, Maybe (BitSet1 i I)))
-> ((z, Maybe (BitSet1 i I))
    -> m (Step (z, Maybe (BitSet1 i I)) (z :. BitSet1 i I)))
-> Stream m z
-> Stream m (z :. BitSet1 i 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 (BitSet1 i I))
forall k k (m :: * -> *) z (c :: k) (ioc :: k).
Monad m =>
Int -> Int -> z -> m (z, Maybe (BitSet1 c ioc))
streamDownMk Int
l Int
h) (Int
-> Int
-> (z, Maybe (BitSet1 i I))
-> m (Step (z, Maybe (BitSet1 i I)) (z :. BitSet1 i I))
forall k k (m :: * -> *) t (c :: k) (ioc :: k).
Monad m =>
Int
-> Int
-> (t, Maybe (BitSet1 c ioc))
-> m (Step (t, Maybe (BitSet1 c ioc)) (t :. BitSet1 c ioc))
streamDownStep Int
l Int
h) (Stream m z -> Stream m (z :. BitSet1 i I))
-> Stream m z -> Stream m (z :. BitSet1 i 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:.BitSet1 i O) where
  streamUp :: LimitType (z :. BitSet1 i O)
-> LimitType (z :. BitSet1 i O) -> Stream m (z :. BitSet1 i O)
streamUp   (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = (z -> m (z, Maybe (BitSet1 i O)))
-> ((z, Maybe (BitSet1 i O))
    -> m (Step (z, Maybe (BitSet1 i O)) (z :. BitSet1 i O)))
-> Stream m z
-> Stream m (z :. BitSet1 i 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 (BitSet1 i O))
forall k k (m :: * -> *) z (c :: k) (ioc :: k).
Monad m =>
Int -> Int -> z -> m (z, Maybe (BitSet1 c ioc))
streamDownMk Int
l Int
h) (Int
-> Int
-> (z, Maybe (BitSet1 i O))
-> m (Step (z, Maybe (BitSet1 i O)) (z :. BitSet1 i O))
forall k k (m :: * -> *) t (c :: k) (ioc :: k).
Monad m =>
Int
-> Int
-> (t, Maybe (BitSet1 c ioc))
-> m (Step (t, Maybe (BitSet1 c ioc)) (t :. BitSet1 c ioc))
streamDownStep Int
l Int
h) (Stream m z -> Stream m (z :. BitSet1 i O))
-> Stream m z -> Stream m (z :. BitSet1 i 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 :. BitSet1 i O)
-> LimitType (z :. BitSet1 i O) -> Stream m (z :. BitSet1 i O)
streamDown (ls:..LtNumBits1 l) (hs:..LtNumBits1 h) = (z -> m (z, Maybe (BitSet1 i O)))
-> ((z, Maybe (BitSet1 i O))
    -> m (Step (z, Maybe (BitSet1 i O)) (z :. BitSet1 i O)))
-> Stream m z
-> Stream m (z :. BitSet1 i 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 (BitSet1 i O))
forall k k (m :: * -> *) z (c :: k) (ioc :: k).
Monad m =>
Int -> Int -> z -> m (z, Maybe (BitSet1 c ioc))
streamUpMk   Int
l Int
h) (Int
-> Int
-> (z, Maybe (BitSet1 i O))
-> m (Step (z, Maybe (BitSet1 i O)) (z :. BitSet1 i O))
forall k k (m :: * -> *) t (c :: k) (ioc :: k).
Monad m =>
Int
-> Int
-> (t, Maybe (BitSet1 c ioc))
-> m (Step (t, Maybe (BitSet1 c ioc)) (t :. BitSet1 c ioc))
streamUpStep   Int
l Int
h) (Stream m z -> Stream m (z :. BitSet1 i O))
-> Stream m z -> Stream m (z :. BitSet1 i 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:.BS1 i C) where
--  streamUp   (ls:..l) (hs:..h) = flatten (streamUpBsIMk   l h) (streamUpBsIStep   l h) $ streamUp   ls hs
--  streamDown (ls:..l) (hs:..h) = flatten (streamDownBsIMk l h) (streamDownBsIStep l h) $ streamDown ls hs
--  {-# Inline streamUp #-}
--  {-# Inline streamDown #-}

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

streamUpMk ∷ Monad m ⇒ Int → Int → z → m (z, Maybe (BitSet1 c ioc))
streamUpMk :: Int -> Int -> z -> m (z, Maybe (BitSet1 c ioc))
streamUpMk Int
l Int
h z
z =
  let set :: BitSet ioc
set = 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
      -- lsbZ set == 0, or no active bits in which case we use 0
      bnd :: Boundary boundaryType ioc
bnd = Boundary boundaryType ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Boundary boundaryType ioc
UndefBoundary
  in  (z, Maybe (BitSet1 c ioc)) -> m (z, Maybe (BitSet1 c ioc))
forall (m :: * -> *) a. Monad m => a -> m a
return (z
z, if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h then BitSet1 c ioc -> Maybe (BitSet1 c ioc)
forall a. a -> Maybe a
Just (BitSet ioc -> Boundary c ioc -> BitSet1 c ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
set Boundary c ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Boundary boundaryType ioc
bnd) else Maybe (BitSet1 c ioc)
forall a. Maybe a
Nothing)
{-# Inline [0] streamUpMk #-}

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

streamDownMk ∷ Monad m ⇒ Int → Int → z → m (z, Maybe (BitSet1 c ioc))
streamDownMk :: Int -> Int -> z -> m (z, Maybe (BitSet1 c ioc))
streamDownMk Int
l Int
h z
z =
  let set :: BitSet ioc
set = 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
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
      bnd :: Boundary boundaryType ioc
bnd = Int -> Boundary boundaryType ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Int -> Boundary boundaryType ioc
Boundary Int
0 -- this is the actual boundary at zero
  in  (z, Maybe (BitSet1 c ioc)) -> m (z, Maybe (BitSet1 c ioc))
forall (m :: * -> *) a. Monad m => a -> m a
return (z
z, if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h then BitSet1 c ioc -> Maybe (BitSet1 c ioc)
forall a. a -> Maybe a
Just (BitSet ioc -> Boundary c ioc -> BitSet1 c ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
set Boundary c ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Boundary boundaryType ioc
bnd) else Maybe (BitSet1 c ioc)
forall a. Maybe a
Nothing)
{-# Inline [0] streamDownMk #-}

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

instance SetPredSucc (BitSet1 t ioc) where
  setSucc :: Int -> Int -> BitSet1 t ioc -> Maybe (BitSet1 t ioc)
setSucc Int
pcl Int
pch (BitSet1 BitSet ioc
s (Boundary Int
is))
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pch                         = Maybe (BitSet1 t ioc)
forall a. Maybe a
Nothing
    | Just Int
is' <- Int -> BitSet ioc -> Maybe Int
forall t. Ranked t => Int -> t -> Maybe Int
maybeNextActive Int
is BitSet ioc
s = BitSet1 t ioc -> Maybe (BitSet1 t ioc)
forall a. a -> Maybe a
Just (BitSet1 t ioc -> Maybe (BitSet1 t ioc))
-> BitSet1 t ioc -> Maybe (BitSet1 t ioc)
forall a b. (a -> b) -> a -> b
$ BitSet ioc -> Boundary t ioc -> BitSet1 t ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
s  (Int -> Boundary t ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Int -> Boundary boundaryType ioc
Boundary Int
is')
    | Just BitSet ioc
s'  <- Int -> BitSet ioc -> Maybe (BitSet ioc)
forall t. Ranked t => Int -> t -> Maybe t
popPermutation Int
pch BitSet ioc
s = BitSet1 t ioc -> Maybe (BitSet1 t ioc)
forall a. a -> Maybe a
Just (BitSet1 t ioc -> Maybe (BitSet1 t ioc))
-> BitSet1 t ioc -> Maybe (BitSet1 t ioc)
forall a b. (a -> b) -> a -> b
$ BitSet ioc -> Boundary t ioc -> BitSet1 t ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
s' (Int -> Boundary t ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Int -> Boundary boundaryType ioc
Boundary (Int -> Boundary t ioc) -> Int -> Boundary t ioc
forall a b. (a -> b) -> a -> b
$ BitSet ioc -> Int
forall t. Ranked t => t -> Int
lsbZ BitSet ioc
s')
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
pch                        = Maybe (BitSet1 t ioc)
forall a. Maybe a
Nothing
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
pch                         = let s' :: BitSet ioc
s' = 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
csInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
                                         in  BitSet1 t ioc -> Maybe (BitSet1 t ioc)
forall a. a -> Maybe a
Just (BitSet ioc -> Boundary t ioc -> BitSet1 t ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
s' (Int -> Boundary t ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Int -> Boundary boundaryType ioc
Boundary (BitSet ioc -> Int
forall t. Ranked t => t -> Int
lsbZ BitSet ioc
s')))
    where cs :: Int
cs = BitSet ioc -> Int
forall a. Bits a => a -> Int
popCount BitSet ioc
s
  {-# Inline setSucc #-}
  setPred :: Int -> Int -> BitSet1 t ioc -> Maybe (BitSet1 t ioc)
setPred Int
pcl Int
pch (BitSet1 BitSet ioc
s (Boundary Int
is))
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
pcl                          = Maybe (BitSet1 t ioc)
forall a. Maybe a
Nothing
    | Just Int
is' <- Int -> BitSet ioc -> Maybe Int
forall t. Ranked t => Int -> t -> Maybe Int
maybeNextActive Int
is BitSet ioc
s  = BitSet1 t ioc -> Maybe (BitSet1 t ioc)
forall a. a -> Maybe a
Just (BitSet1 t ioc -> Maybe (BitSet1 t ioc))
-> BitSet1 t ioc -> Maybe (BitSet1 t ioc)
forall a b. (a -> b) -> a -> b
$ BitSet ioc -> Boundary t ioc -> BitSet1 t ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
s  (Int -> Boundary t ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Int -> Boundary boundaryType ioc
Boundary Int
is')
    | Just BitSet ioc
s'  <- Int -> BitSet ioc -> Maybe (BitSet ioc)
forall t. Ranked t => Int -> t -> Maybe t
popPermutation Int
pch BitSet ioc
s  = BitSet1 t ioc -> Maybe (BitSet1 t ioc)
forall a. a -> Maybe a
Just (BitSet1 t ioc -> Maybe (BitSet1 t ioc))
-> BitSet1 t ioc -> Maybe (BitSet1 t ioc)
forall a b. (a -> b) -> a -> b
$ BitSet ioc -> Boundary t ioc -> BitSet1 t ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
s' (Int -> Boundary t ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Int -> Boundary boundaryType ioc
Boundary (Int -> Boundary t ioc) -> Int -> Boundary t ioc
forall a b. (a -> b) -> a -> b
$ BitSet ioc -> Int
forall t. Ranked t => t -> Int
lsbZ BitSet ioc
s')
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pcl                         = Maybe (BitSet1 t ioc)
forall a. Maybe a
Nothing
    | Int
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pcl                          = let s' :: BitSet ioc
s' = 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
csInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
                                          in  BitSet1 t ioc -> Maybe (BitSet1 t ioc)
forall a. a -> Maybe a
Just (BitSet ioc -> Boundary t ioc -> BitSet1 t ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
s' (Int -> Boundary t ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Int -> Boundary boundaryType ioc
Boundary (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ BitSet ioc -> Int
forall t. Ranked t => t -> Int
lsbZ BitSet ioc
s')))
    where cs :: Int
cs = BitSet ioc -> Int
forall a. Bits a => a -> Int
popCount BitSet ioc
s
  {-# Inline setPred #-}

instance SetPredSucc (FixedMask (BitSet1 t ioc)) where
  setPred :: Int
-> Int
-> FixedMask (BitSet1 t ioc)
-> Maybe (FixedMask (BitSet1 t ioc))
setPred = String
-> Int
-> Int
-> FixedMask (BitSet1 t ioc)
-> Maybe (FixedMask (BitSet1 t ioc))
forall a. HasCallStack => String -> a
error String
"implement me"
  setSucc :: Int
-> Int
-> FixedMask (BitSet1 t ioc)
-> Maybe (FixedMask (BitSet1 t ioc))
setSucc Int
pcl Int
pch (FixedMask Mask (BitSet1 t ioc)
mask BitSet1 t ioc
bs1) = Maybe (FixedMask (BitSet1 t ioc))
forall a. HasCallStack => a
undefined

instance Arbitrary (BitSet1 t ioc) where
  arbitrary :: Gen (BitSet1 t ioc)
arbitrary = do
    BitSet ioc
s <- Gen (BitSet ioc)
forall a. Arbitrary a => Gen a
arbitrary
    if BitSet ioc
sBitSet ioc -> BitSet ioc -> Bool
forall a. Eq a => a -> a -> Bool
==BitSet ioc
0
      then BitSet1 t ioc -> Gen (BitSet1 t ioc)
forall (m :: * -> *) a. Monad m => a -> m a
return (BitSet ioc -> Boundary t ioc -> BitSet1 t ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
s Boundary t ioc
0)
      else do Int
i <- [Int] -> Gen Int
forall a. [a] -> Gen a
elements ([Int] -> Gen Int) -> [Int] -> Gen Int
forall a b. (a -> b) -> a -> b
$ BitSet ioc -> [Int]
forall t. Ranked t => t -> [Int]
activeBitsL BitSet ioc
s
              BitSet1 t ioc -> Gen (BitSet1 t ioc)
forall (m :: * -> *) a. Monad m => a -> m a
return (BitSet ioc -> Boundary t ioc -> BitSet1 t ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
s (Boundary t ioc -> BitSet1 t ioc)
-> Boundary t ioc -> BitSet1 t ioc
forall a b. (a -> b) -> a -> b
$ Int -> Boundary t ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Int -> Boundary boundaryType ioc
Boundary Int
i)
  shrink :: BitSet1 t ioc -> [BitSet1 t ioc]
shrink (BitSet1 BitSet ioc
s Boundary t ioc
i) =
    let s' :: [BitSet1 t ioc]
s' = [ BitSet ioc -> Boundary t ioc -> BitSet1 t ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 (BitSet ioc
s BitSet ioc -> Int -> BitSet ioc
forall a. Bits a => a -> Int -> a
`clearBit` Int
a) Boundary t ioc
i
             | Int
a <- BitSet ioc -> [Int]
forall t. Ranked t => t -> [Int]
activeBitsL BitSet ioc
s
             , Int -> Boundary t ioc
forall k1 k2 (boundaryType :: k1) (ioc :: k2).
Int -> Boundary boundaryType ioc
Boundary Int
a Boundary t ioc -> Boundary t ioc -> Bool
forall a. Eq a => a -> a -> Bool
/= Boundary t ioc
i ]
             [BitSet1 t ioc] -> [BitSet1 t ioc] -> [BitSet1 t ioc]
forall a. [a] -> [a] -> [a]
++ [ BitSet ioc -> Boundary t ioc -> BitSet1 t ioc
forall k k (i :: k) (ioc :: k).
BitSet ioc -> Boundary i ioc -> BitSet1 i ioc
BitSet1 BitSet ioc
0 Boundary t ioc
0 | BitSet ioc -> Int
forall a. Bits a => a -> Int
popCount BitSet ioc
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ]
    in  [BitSet1 t ioc]
s' [BitSet1 t ioc] -> [BitSet1 t ioc] -> [BitSet1 t ioc]
forall a. [a] -> [a] -> [a]
++ (BitSet1 t ioc -> [BitSet1 t ioc])
-> [BitSet1 t ioc] -> [BitSet1 t ioc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BitSet1 t ioc -> [BitSet1 t ioc]
forall a. Arbitrary a => a -> [a]
shrink [BitSet1 t ioc]
s'