{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} module HaskellWorks.Data.RankSelect.Internal.BitSeq ( Elem(..) , Measure(..) , BitSeq(..) , BitSeqFt , (|>#) , (#<|) , ftSplit , atBitCountBelow , atPopCountBelow , splitAt ) where import Control.DeepSeq import Data.Word import GHC.Generics import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Bits.PopCount.PopCount1 import HaskellWorks.Data.FingerTree (ViewL (..), ViewR (..), (<|), (><), (|>)) import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 import Prelude hiding (max, min, splitAt) import qualified HaskellWorks.Data.Cons as HW import qualified HaskellWorks.Data.Container as HW import qualified HaskellWorks.Data.FingerTree as FT import qualified HaskellWorks.Data.Snoc as HW data Elem = Elem { Elem -> Word64 elemBits :: {-# UNPACK #-} !Word64 , Elem -> Word64 elemSize :: {-# UNPACK #-} !Count } deriving (Elem -> Elem -> Bool (Elem -> Elem -> Bool) -> (Elem -> Elem -> Bool) -> Eq Elem forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Elem -> Elem -> Bool $c/= :: Elem -> Elem -> Bool == :: Elem -> Elem -> Bool $c== :: Elem -> Elem -> Bool Eq, Int -> Elem -> ShowS [Elem] -> ShowS Elem -> String (Int -> Elem -> ShowS) -> (Elem -> String) -> ([Elem] -> ShowS) -> Show Elem forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Elem] -> ShowS $cshowList :: [Elem] -> ShowS show :: Elem -> String $cshow :: Elem -> String showsPrec :: Int -> Elem -> ShowS $cshowsPrec :: Int -> Elem -> ShowS Show, (forall x. Elem -> Rep Elem x) -> (forall x. Rep Elem x -> Elem) -> Generic Elem forall x. Rep Elem x -> Elem forall x. Elem -> Rep Elem x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Elem x -> Elem $cfrom :: forall x. Elem -> Rep Elem x Generic) instance NFData Elem data Measure = Measure { Measure -> Word64 measureBitCount :: {-# UNPACK #-} !Count , Measure -> Word64 measurePopCount :: {-# UNPACK #-} !Count } deriving (Measure -> Measure -> Bool (Measure -> Measure -> Bool) -> (Measure -> Measure -> Bool) -> Eq Measure forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Measure -> Measure -> Bool $c/= :: Measure -> Measure -> Bool == :: Measure -> Measure -> Bool $c== :: Measure -> Measure -> Bool Eq, Eq Measure Eq Measure -> (Measure -> Measure -> Ordering) -> (Measure -> Measure -> Bool) -> (Measure -> Measure -> Bool) -> (Measure -> Measure -> Bool) -> (Measure -> Measure -> Bool) -> (Measure -> Measure -> Measure) -> (Measure -> Measure -> Measure) -> Ord Measure Measure -> Measure -> Bool Measure -> Measure -> Ordering Measure -> Measure -> Measure 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 min :: Measure -> Measure -> Measure $cmin :: Measure -> Measure -> Measure max :: Measure -> Measure -> Measure $cmax :: Measure -> Measure -> Measure >= :: Measure -> Measure -> Bool $c>= :: Measure -> Measure -> Bool > :: Measure -> Measure -> Bool $c> :: Measure -> Measure -> Bool <= :: Measure -> Measure -> Bool $c<= :: Measure -> Measure -> Bool < :: Measure -> Measure -> Bool $c< :: Measure -> Measure -> Bool compare :: Measure -> Measure -> Ordering $ccompare :: Measure -> Measure -> Ordering $cp1Ord :: Eq Measure Ord, Int -> Measure -> ShowS [Measure] -> ShowS Measure -> String (Int -> Measure -> ShowS) -> (Measure -> String) -> ([Measure] -> ShowS) -> Show Measure forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Measure] -> ShowS $cshowList :: [Measure] -> ShowS show :: Measure -> String $cshow :: Measure -> String showsPrec :: Int -> Measure -> ShowS $cshowsPrec :: Int -> Measure -> ShowS Show, (forall x. Measure -> Rep Measure x) -> (forall x. Rep Measure x -> Measure) -> Generic Measure forall x. Rep Measure x -> Measure forall x. Measure -> Rep Measure x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Measure x -> Measure $cfrom :: forall x. Measure -> Rep Measure x Generic) instance NFData Measure type BitSeqFt = FT.FingerTree Measure Elem newtype BitSeq = BitSeq { BitSeq -> BitSeqFt parens :: BitSeqFt } deriving (Int -> BitSeq -> ShowS [BitSeq] -> ShowS BitSeq -> String (Int -> BitSeq -> ShowS) -> (BitSeq -> String) -> ([BitSeq] -> ShowS) -> Show BitSeq forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [BitSeq] -> ShowS $cshowList :: [BitSeq] -> ShowS show :: BitSeq -> String $cshow :: BitSeq -> String showsPrec :: Int -> BitSeq -> ShowS $cshowsPrec :: Int -> BitSeq -> ShowS Show, BitSeq -> () (BitSeq -> ()) -> NFData BitSeq forall a. (a -> ()) -> NFData a rnf :: BitSeq -> () $crnf :: BitSeq -> () NFData, (forall x. BitSeq -> Rep BitSeq x) -> (forall x. Rep BitSeq x -> BitSeq) -> Generic BitSeq forall x. Rep BitSeq x -> BitSeq forall x. BitSeq -> Rep BitSeq x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep BitSeq x -> BitSeq $cfrom :: forall x. BitSeq -> Rep BitSeq x Generic) instance Semigroup Measure where Measure a <> :: Measure -> Measure -> Measure <> Measure b = Measure :: Word64 -> Word64 -> Measure Measure { $sel:measureBitCount:Measure :: Word64 measureBitCount = Measure -> Word64 measureBitCount Measure a Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Measure -> Word64 measureBitCount Measure b , $sel:measurePopCount:Measure :: Word64 measurePopCount = Measure -> Word64 measurePopCount Measure a Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Measure -> Word64 measurePopCount Measure b } instance Monoid Measure where mempty :: Measure mempty = Word64 -> Word64 -> Measure Measure Word64 0 Word64 0 mappend :: Measure -> Measure -> Measure mappend = Measure -> Measure -> Measure forall a. Semigroup a => a -> a -> a (<>) instance FT.Measured Measure Elem where measure :: Elem -> Measure measure (Elem Word64 w Word64 size) = Measure :: Word64 -> Word64 -> Measure Measure { $sel:measureBitCount:Measure :: Word64 measureBitCount = Word64 size , $sel:measurePopCount:Measure :: Word64 measurePopCount = Word64 -> Word64 forall v. PopCount1 v => v -> Word64 popCount1 Word64 w } instance HW.Container BitSeq where type Elem BitSeq = Bool instance HW.Cons BitSeq where cons :: Elem BitSeq -> BitSeq -> BitSeq cons Elem BitSeq b (BitSeq BitSeqFt ft) = BitSeqFt -> BitSeq BitSeq (BitSeqFt -> BitSeq) -> BitSeqFt -> BitSeq forall a b. (a -> b) -> a -> b $ case BitSeqFt -> ViewL (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewL (FingerTree v) a FT.viewl BitSeqFt ft of Elem Word64 w Word64 nw :< BitSeqFt rt -> if Word64 nw Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool >= Word64 0 Bool -> Bool -> Bool && Word64 nw Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool < Word64 64 then Word64 -> Word64 -> Elem Elem ((Word64 w Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .<. Word64 1) Word64 -> Word64 -> Word64 forall a. BitWise a => a -> a -> a .|. Word64 bw) (Word64 nw Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Word64 1) Elem BitSeqFt -> BitSeqFt -> BitSeqFt forall v. Cons v => Elem v -> v -> v <| BitSeqFt rt else Word64 -> Word64 -> Elem Elem Word64 bw Word64 1 Elem BitSeqFt -> BitSeqFt -> BitSeqFt forall v. Cons v => Elem v -> v -> v <| BitSeqFt ft ViewL (FingerTree Measure) Elem FT.EmptyL -> Elem -> BitSeqFt forall v a. Measured v a => a -> FingerTree v a FT.singleton (Word64 -> Word64 -> Elem Elem Word64 bw Word64 1) where bw :: Word64 bw = if Bool Elem BitSeq b then Word64 1 else Word64 0 instance HW.Snoc BitSeq where snoc :: BitSeq -> Elem BitSeq -> BitSeq snoc (BitSeq BitSeqFt ft) Elem BitSeq b = BitSeqFt -> BitSeq BitSeq (BitSeqFt -> BitSeq) -> BitSeqFt -> BitSeq forall a b. (a -> b) -> a -> b $ case BitSeqFt -> ViewR (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewR (FingerTree v) a FT.viewr BitSeqFt ft of BitSeqFt lt :> Elem Word64 w Word64 nw -> if Word64 nw Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool >= Word64 0 Bool -> Bool -> Bool && Word64 nw Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool < Word64 64 then Word64 -> Word64 -> Elem Elem (Word64 w Word64 -> Word64 -> Word64 forall a. BitWise a => a -> a -> a .|. (Word64 bw Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .<. Word64 nw)) (Word64 nw Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Word64 1) Elem BitSeqFt -> BitSeqFt -> BitSeqFt forall v. Cons v => Elem v -> v -> v <| BitSeqFt lt else Word64 -> Word64 -> Elem Elem Word64 bw Word64 1 Elem BitSeqFt -> BitSeqFt -> BitSeqFt forall v. Cons v => Elem v -> v -> v <| BitSeqFt lt ViewR (FingerTree Measure) Elem FT.EmptyR -> Elem -> BitSeqFt forall v a. Measured v a => a -> FingerTree v a FT.singleton (Word64 -> Word64 -> Elem Elem Word64 bw Word64 1) where bw :: Word64 bw = if Bool Elem BitSeq b then Word64 1 else Word64 0 instance Semigroup BitSeq where BitSeq BitSeqFt tl <> :: BitSeq -> BitSeq -> BitSeq <> BitSeq BitSeqFt tr = BitSeqFt -> BitSeq BitSeq (BitSeqFt -> BitSeq) -> BitSeqFt -> BitSeq forall a b. (a -> b) -> a -> b $ case BitSeqFt -> ViewR (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewR (FingerTree v) a FT.viewr BitSeqFt tl of BitSeqFt tll :> Elem Word64 wl Word64 nwl -> case BitSeqFt -> ViewL (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewL (FingerTree v) a FT.viewl BitSeqFt tr of Elem Word64 wr Word64 nwr :< BitSeqFt trr -> let nw :: Word64 nw = Word64 nwl Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Word64 nwr in if Word64 nw Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool <= Word64 64 then (BitSeqFt tll BitSeqFt -> Elem BitSeqFt -> BitSeqFt forall v. Snoc v => v -> Elem v -> v |> Word64 -> Word64 -> Elem Elem (Word64 wl Word64 -> Word64 -> Word64 forall a. BitWise a => a -> a -> a .|. (Word64 wr Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .<. Word64 nwl)) Word64 nw) BitSeqFt -> BitSeqFt -> BitSeqFt forall v. (Semigroup v, Container v) => v -> v -> v >< BitSeqFt trr else BitSeqFt tl BitSeqFt -> BitSeqFt -> BitSeqFt forall v. (Semigroup v, Container v) => v -> v -> v >< BitSeqFt tr ViewL (FingerTree Measure) Elem FT.EmptyL -> BitSeqFt tr ViewR (FingerTree Measure) Elem FT.EmptyR -> BitSeqFt forall v a. Measured v a => FingerTree v a FT.empty instance Select1 BitSeq where select1 :: BitSeq -> Word64 -> Word64 select1 (BitSeq BitSeqFt ft) Word64 n = case (Measure -> Bool) -> BitSeqFt -> (BitSeqFt, BitSeqFt) forall v a. Measured v a => (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a) FT.split (Word64 -> Measure -> Bool atPopCountBelow Word64 n) BitSeqFt ft of (BitSeqFt lt, BitSeqFt _) -> case BitSeqFt -> ViewR (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewR (FingerTree v) a FT.viewr BitSeqFt lt of ViewR (FingerTree Measure) Elem FT.EmptyR -> Word64 0 BitSeqFt llt :> Elem Word64 w Word64 _ -> let llpc :: Word64 llpc = Measure -> Word64 measurePopCount (BitSeqFt -> Measure forall v a. Measured v a => a -> v FT.measure BitSeqFt llt :: Measure) in let llbc :: Word64 llbc = Measure -> Word64 measureBitCount (BitSeqFt -> Measure forall v a. Measured v a => a -> v FT.measure BitSeqFt llt :: Measure) in Word64 llbc Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a + Word64 -> Word64 -> Word64 forall v. Select1 v => v -> Word64 -> Word64 select1 Word64 w (Word64 n Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 llpc) instance Rank1 BitSeq where rank1 :: BitSeq -> Word64 -> Word64 rank1 BitSeq bs Word64 n = let (BitSeq lt, BitSeq _) = Word64 -> BitSeq -> (BitSeq, BitSeq) splitAt Word64 n BitSeq bs in BitSeq -> Word64 forall v. PopCount1 v => v -> Word64 popCount1 BitSeq lt instance PopCount1 BitSeq where popCount1 :: BitSeq -> Word64 popCount1 (BitSeq BitSeqFt ft) = Measure -> Word64 measureBitCount (BitSeqFt -> Measure forall v a. Measured v a => a -> v FT.measure BitSeqFt ft :: Measure) (|>#) :: BitSeqFt -> Elem -> BitSeqFt |># :: BitSeqFt -> Elem -> BitSeqFt (|>#) BitSeqFt ft e :: Elem e@(Elem Word64 _ Word64 wn) = if Word64 wn Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool > Word64 0 then BitSeqFt ft BitSeqFt -> Elem BitSeqFt -> BitSeqFt forall v. Snoc v => v -> Elem v -> v |> Elem BitSeqFt Elem e else BitSeqFt ft (#<|) :: Elem ->BitSeqFt -> BitSeqFt #<| :: Elem -> BitSeqFt -> BitSeqFt (#<|) e :: Elem e@(Elem Word64 _ Word64 wn) BitSeqFt ft = if Word64 wn Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool > Word64 0 then Elem BitSeqFt Elem e Elem BitSeqFt -> BitSeqFt -> BitSeqFt forall v. Cons v => Elem v -> v -> v <| BitSeqFt ft else BitSeqFt ft ftSplit :: (Measure -> Bool) -> BitSeqFt -> (BitSeqFt, BitSeqFt) ftSplit :: (Measure -> Bool) -> BitSeqFt -> (BitSeqFt, BitSeqFt) ftSplit Measure -> Bool p BitSeqFt ft = case BitSeqFt -> ViewL (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewL (FingerTree v) a FT.viewl BitSeqFt rt of Elem Word64 w Word64 nw :< BitSeqFt rrt -> let c :: Word64 c = Word64 -> Word64 -> Word64 -> Word64 go Word64 w Word64 nw Word64 nw in (BitSeqFt lt BitSeqFt -> Elem -> BitSeqFt |># Word64 -> Word64 -> Elem Elem Word64 w Word64 c, Word64 -> Word64 -> Elem Elem (Word64 w Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .>. Word64 c) (Word64 nw Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 c) Elem -> BitSeqFt -> BitSeqFt #<| BitSeqFt rrt) ViewL (FingerTree Measure) Elem FT.EmptyL -> (BitSeqFt ft, BitSeqFt forall v a. Measured v a => FingerTree v a FT.empty) where (BitSeqFt lt, BitSeqFt rt) = (Measure -> Bool) -> BitSeqFt -> (BitSeqFt, BitSeqFt) forall v a. Measured v a => (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a) FT.split Measure -> Bool p BitSeqFt ft ltm :: Measure ltm = BitSeqFt -> Measure forall v a. Measured v a => a -> v FT.measure BitSeqFt lt go :: Word64 -> Count -> Count -> Count go :: Word64 -> Word64 -> Word64 -> Word64 go Word64 w Word64 c Word64 nw = if Word64 c Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool > Word64 0 then if Measure -> Bool p (Measure ltm Measure -> Measure -> Measure forall a. Semigroup a => a -> a -> a <> Elem -> Measure forall v a. Measured v a => a -> v FT.measure (Word64 -> Word64 -> Elem Elem (Word64 w Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .<. (Word64 64 Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 c) Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .>. (Word64 64 Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 c)) Word64 c)) then Word64 -> Word64 -> Word64 -> Word64 go Word64 w (Word64 c Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 1) Word64 nw else Word64 c else Word64 0 atBitCountBelow :: Count -> Measure -> Bool atBitCountBelow :: Word64 -> Measure -> Bool atBitCountBelow Word64 n Measure m = Word64 n Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool < Measure -> Word64 measureBitCount (Measure m :: Measure) atPopCountBelow :: Count -> Measure -> Bool atPopCountBelow :: Word64 -> Measure -> Bool atPopCountBelow Word64 n Measure m = Word64 n Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool < Measure -> Word64 measurePopCount (Measure m :: Measure) splitAt :: Count -> BitSeq -> (BitSeq, BitSeq) splitAt :: Word64 -> BitSeq -> (BitSeq, BitSeq) splitAt Word64 n (BitSeq BitSeqFt ft) = case (Measure -> Bool) -> BitSeqFt -> (BitSeqFt, BitSeqFt) forall v a. Measured v a => (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a) FT.split (Word64 -> Measure -> Bool atBitCountBelow Word64 n) BitSeqFt ft of (BitSeqFt lt, BitSeqFt rt) -> let n' :: Word64 n' = Word64 n Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Measure -> Word64 measureBitCount (BitSeqFt -> Measure forall v a. Measured v a => a -> v FT.measure BitSeqFt lt) u :: Word64 u = Word64 64 Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 n' in case BitSeqFt -> ViewL (FingerTree Measure) Elem forall v a. Measured v a => FingerTree v a -> ViewL (FingerTree v) a FT.viewl BitSeqFt rt of Elem Word64 w Word64 nw :< BitSeqFt rrt -> if Word64 n' Word64 -> Word64 -> Bool forall a. Ord a => a -> a -> Bool >= Word64 nw then (BitSeqFt -> BitSeq BitSeq BitSeqFt lt , BitSeqFt -> BitSeq BitSeq BitSeqFt rrt ) else (BitSeqFt -> BitSeq BitSeq (BitSeqFt lt BitSeqFt -> Elem BitSeqFt -> BitSeqFt forall v. Snoc v => v -> Elem v -> v |> Word64 -> Word64 -> Elem Elem ((Word64 w Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .<. Word64 u) Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .>. Word64 u) Word64 n'), BitSeqFt -> BitSeq BitSeq (Word64 -> Word64 -> Elem Elem (Word64 w Word64 -> Word64 -> Word64 forall a. Shift a => a -> Word64 -> a .>. Word64 n') (Word64 nw Word64 -> Word64 -> Word64 forall a. Num a => a -> a -> a - Word64 n') Elem BitSeqFt -> BitSeqFt -> BitSeqFt forall v. Cons v => Elem v -> v -> v <| BitSeqFt rrt)) ViewL (FingerTree Measure) Elem FT.EmptyL -> (BitSeqFt -> BitSeq BitSeq BitSeqFt lt, BitSeqFt -> BitSeq BitSeq BitSeqFt forall v a. Measured v a => FingerTree v a FT.empty)