module Data.PrimitiveArray.Index.BitSetClasses where
import Control.DeepSeq (NFData(..))
import Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey)
import Data.Binary (Binary)
import Data.Hashable (Hashable)
import Data.Serialize (Serialize)
import Data.Vector.Unboxed.Deriving
import GHC.Generics (Generic)
import qualified Data.Vector.Fusion.Stream.Monadic as SM
import qualified Data.Vector.Unboxed as VU
import Data.Bits.Ordered
import Data.PrimitiveArray.Index.Class
import Data.PrimitiveArray.Index.IOC
newtype Boundary boundaryType ioc = Boundary { getBoundary ∷ Int }
deriving (Eq,Ord,Generic,Num)
instance Show (Boundary i t) where
show (Boundary i) = "(I:" ++ show i ++ ")"
derivingUnbox "Boundary"
[t| forall i t . Boundary i t → Int |]
[| \(Boundary i) → i |]
[| Boundary |]
instance Binary (Boundary i t)
instance Serialize (Boundary i t)
instance ToJSON (Boundary i t)
instance FromJSON (Boundary i t)
instance Hashable (Boundary i t)
instance NFData (Boundary i t) where
rnf (Boundary i) = rnf i
{-# Inline rnf #-}
instance Index (Boundary i t) where
newtype LimitType (Boundary i t) = LtBoundary Int
linearIndex _ (Boundary z) = z
{-# INLINE linearIndex #-}
size (LtBoundary h) = h + 1
{-# INLINE size #-}
inBounds (LtBoundary h) z = 0 <= z && getBoundary z <= h
{-# INLINE inBounds #-}
zeroBound = Boundary 0
{-# Inline zeroBound #-}
zeroBound' = LtBoundary 0
{-# Inline zeroBound' #-}
totalSize (LtBoundary n) = [fromIntegral n]
{-# Inline totalSize #-}
instance IndexStream z ⇒ IndexStream (z:.Boundary k I) where
streamUp (ls:..LtBoundary l) (hs:..LtBoundary h) = SM.flatten (streamUpBndMk l h) (streamUpBndStep l h) $ streamUp ls hs
streamDown (ls:..LtBoundary l) (hs:..LtBoundary h) = SM.flatten (streamDownBndMk l h) (streamDownBndStep l h) $ streamDown ls hs
{-# Inline streamUp #-}
{-# Inline streamDown #-}
instance IndexStream (Z:.Boundary k I) ⇒ IndexStream (Boundary k I) where
streamUp l h = SM.map (\(Z:.i) -> i) $ streamUp (ZZ:..l) (ZZ:..h)
{-# Inline streamUp #-}
streamDown l h = SM.map (\(Z:.i) -> i) $ streamDown (ZZ:..l) (ZZ:..h)
{-# Inline streamDown #-}
streamUpBndMk l h z = return (z, l)
{-# Inline [0] streamUpBndMk #-}
streamUpBndStep l h (z , k)
| k > h = return $ SM.Done
| otherwise = return $ SM.Yield (z:.Boundary k) (z, k+1)
{-# Inline [0] streamUpBndStep #-}
streamDownBndMk l h z = return (z, h)
{-# Inline [0] streamDownBndMk #-}
streamDownBndStep l h (z , k)
| k < l = return $ SM.Done
| otherwise = return $ SM.Yield (z:.Boundary k) (z,k-1)
{-# Inline [0] streamDownBndStep #-}
data First
data Last
data Any
class SetPredSucc s where
setSucc ∷ Int → Int → s → Maybe s
setPred ∷ Int → Int → s → Maybe s
type family Mask s ∷ *
data Fixed t = Fixed { getFixedMask :: (Mask t) , getFixed :: !t }
class ApplyMask s where
applyMask :: Mask s -> s -> s
arbitraryBitSetMax ∷ Int
arbitraryBitSetMax = 6