{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Word64Set.Internal
-- Copyright   :  (c) Daan Leijen 2002
--                (c) Joachim Breitner 2011
-- License     :  BSD-style
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.
--
-- = Description
--
-- An efficient implementation of integer sets.
--
-- These modules are intended to be imported qualified, to avoid name
-- clashes with Prelude functions, e.g.
--
-- >  import Data.Word64Set (Word64Set)
-- >  import qualified Data.Word64Set as Word64Set
--
-- The implementation is based on /big-endian patricia trees/.  This data
-- structure performs especially well on binary operations like 'union'
-- and 'intersection'.  However, my benchmarks show that it is also
-- (much) faster on insertions and deletions when compared to a generic
-- size-balanced set implementation (see "Data.Set").
--
--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",
--      Workshop on ML, September 1998, pages 77-86,
--      <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452>
--
--    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",
--      Journal of the ACM, 15(4), October 1968, pages 514-534.
--
-- Additionally, this implementation places bitmaps in the leaves of the tree.
-- Their size is the natural size of a machine word (32 or 64 bits) and greatly
-- reduce memory footprint and execution times for dense sets, e.g. sets where
-- it is likely that many values lie close to each other. The asymptotics are
-- not affected by this optimization.
--
-- Many operations have a worst-case complexity of \(O(\min(n,W))\).
-- This means that the operation can become linear in the number of
-- elements with a maximum of \(W\) -- the number of bits in an 'Int'
-- (32 or 64).
--
-- @since 0.5.9
-----------------------------------------------------------------------------

-- [Note: INLINE bit fiddling]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- It is essential that the bit fiddling functions like mask, zero, branchMask
-- etc are inlined. If they do not, the memory allocation skyrockets. The GHC
-- usually gets it right, but it is disastrous if it does not. Therefore we
-- explicitly mark these functions INLINE.


-- [Note: Local 'go' functions and capturing]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Care must be taken when using 'go' function which captures an argument.
-- Sometimes (for example when the argument is passed to a data constructor,
-- as in insert), GHC heap-allocates more than necessary. Therefore C-- code
-- must be checked for increased allocation when creating and modifying such
-- functions.


-- [Note: Order of constructors]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The order of constructors of Word64Set matters when considering performance.
-- Currently in GHC 7.0, when type has 3 constructors, they are matched from
-- the first to the last -- the best performance is achieved when the
-- constructors are ordered by frequency.
-- On GHC 7.0, reordering constructors from Nil | Tip | Bin to Bin | Tip | Nil
-- improves the benchmark by circa 10%.

module GHC.Data.Word64Set.Internal (
    -- * Set type
      Word64Set(..), Key -- instance Eq,Show
    , Prefix, Mask, BitMap

    -- * Operators
    , (\\)

    -- * Query
    , null
    , size
    , member
    , notMember
    , lookupLT
    , lookupGT
    , lookupLE
    , lookupGE
    , isSubsetOf
    , isProperSubsetOf
    , disjoint

    -- * Construction
    , empty
    , singleton
    , insert
    , delete
    , alterF

    -- * Combine
    , union
    , unions
    , difference
    , intersection

    -- * Filter
    , filter
    , partition

    , takeWhileAntitone
    , dropWhileAntitone
    , spanAntitone

    , split
    , splitMember
    , splitRoot

    -- * Map
    , map
    , mapMonotonic

    -- * Folds
    , foldr
    , foldl
    -- ** Strict folds
    , foldr'
    , foldl'
    -- ** Legacy folds
    , fold

    -- * Min\/Max
    , findMin
    , findMax
    , deleteMin
    , deleteMax
    , deleteFindMin
    , deleteFindMax
    , maxView
    , minView

    -- * Conversion

    -- ** List
    , elems
    , toList
    , fromList

    -- ** Ordered list
    , toAscList
    , toDescList
    , fromAscList
    , fromDistinctAscList

    -- * Debugging
    , showTree
    , showTreeWith

    -- * Internals
    , match
    , suffixBitMask
    , prefixBitMask
    , bitmapOf
    , zero
    ) where

import Control.Applicative (Const(..))
import Control.DeepSeq (NFData(rnf))
import Data.Bits
import qualified Data.List as List
import Data.Maybe (fromMaybe)
import Data.Semigroup (Semigroup(stimes, (<>)), stimesIdempotentMonoid)
import GHC.Prelude.Basic hiding
  (filter, foldr, foldl, foldl', null, map)
import Data.Word ( Word64 )

import GHC.Utils.Containers.Internal.BitUtil
import GHC.Utils.Containers.Internal.StrictPair

import Data.Data (Data(..), Constr, mkConstr, constrIndex, DataType, mkDataType)
import qualified Data.Data
import Text.Read

import qualified GHC.Exts

import Data.Functor.Identity (Identity(..))

infixl 9 \\{-This comment teaches CPP correct behaviour -}

-- A "Nat" is a 64 bit machine word
type Nat = Word64

natFromInt :: Word64 -> Nat
natFromInt :: Mask -> Mask
natFromInt = Mask -> Mask
forall a. a -> a
id
{-# INLINE natFromInt #-}

intFromNat :: Nat -> Word64
intFromNat :: Mask -> Mask
intFromNat = Mask -> Mask
forall a. a -> a
id
{-# INLINE intFromNat #-}

{--------------------------------------------------------------------
  Operators
--------------------------------------------------------------------}
-- | \(O(n+m)\). See 'difference'.
(\\) :: Word64Set -> Word64Set -> Word64Set
Word64Set
m1 \\ :: Word64Set -> Word64Set -> Word64Set
\\ Word64Set
m2 = Word64Set -> Word64Set -> Word64Set
difference Word64Set
m1 Word64Set
m2

{--------------------------------------------------------------------
  Types
--------------------------------------------------------------------}

-- | A set of integers.

-- See Note: Order of constructors
data Word64Set = Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !Word64Set !Word64Set
-- Invariant: Nil is never found as a child of Bin.
-- Invariant: The Mask is a power of 2.  It is the largest bit position at which
--            two elements of the set differ.
-- Invariant: Prefix is the common high-order bits that all elements share to
--            the left of the Mask bit.
-- Invariant: In Bin prefix mask left right, left consists of the elements that
--            don't have the mask bit set; right is all the elements that do.
            | Tip {-# UNPACK #-} !Prefix {-# UNPACK #-} !BitMap
-- Invariant: The Prefix is zero for the last 6 bits. The values of the set
--            represented by a tip are the prefix plus the indices of the set
--            bits in the bit map.
            | Nil

-- A number stored in a set is stored as
-- * Prefix (all but last 6 bits) and
-- * BitMap (last 6 bits stored as a bitmask)
--   Last 6 bits are called a Suffix.

type Prefix = Word64
type Mask   = Word64
type BitMap = Word64
type Key    = Word64

instance Monoid Word64Set where
    mempty :: Word64Set
mempty  = Word64Set
empty
    mconcat :: [Word64Set] -> Word64Set
mconcat = [Word64Set] -> Word64Set
unions
    mappend :: Word64Set -> Word64Set -> Word64Set
mappend = Word64Set -> Word64Set -> Word64Set
forall a. Semigroup a => a -> a -> a
(<>)

-- | @since 0.5.7
instance Semigroup Word64Set where
    <> :: Word64Set -> Word64Set -> Word64Set
(<>)    = Word64Set -> Word64Set -> Word64Set
union
    stimes :: forall b. Integral b => b -> Word64Set -> Word64Set
stimes  = b -> Word64Set -> Word64Set
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid


{--------------------------------------------------------------------
  A Data instance
--------------------------------------------------------------------}

-- This instance preserves data abstraction at the cost of inefficiency.
-- We provide limited reflection services for the sake of data abstraction.

instance Data Word64Set where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Word64Set -> c Word64Set
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Word64Set
is = ([Mask] -> Word64Set) -> c ([Mask] -> Word64Set)
forall g. g -> c g
z [Mask] -> Word64Set
fromList c ([Mask] -> Word64Set) -> [Mask] -> c Word64Set
forall d b. Data d => c (d -> b) -> d -> c b
`f` (Word64Set -> [Mask]
toList Word64Set
is)
  toConstr :: Word64Set -> Constr
toConstr Word64Set
_     = Constr
fromListConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Word64Set
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> c ([Mask] -> Word64Set) -> c Word64Set
forall b r. Data b => c (b -> r) -> c r
k (([Mask] -> Word64Set) -> c ([Mask] -> Word64Set)
forall r. r -> c r
z [Mask] -> Word64Set
fromList)
    Int
_ -> [Char] -> c Word64Set
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
  dataTypeOf :: Word64Set -> DataType
dataTypeOf Word64Set
_   = DataType
intSetDataType

fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
intSetDataType [Char]
"fromList" [] Fixity
Data.Data.Prefix

intSetDataType :: DataType
intSetDataType :: DataType
intSetDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.Word64Set.Internal.Word64Set" [Constr
fromListConstr]


{--------------------------------------------------------------------
  Query
--------------------------------------------------------------------}
-- | \(O(1)\). Is the set empty?
null :: Word64Set -> Bool
null :: Word64Set -> Bool
null Word64Set
Nil = Bool
True
null Word64Set
_   = Bool
False
{-# INLINE null #-}

-- | \(O(n)\). Cardinality of the set.
size :: Word64Set -> Int
size :: Word64Set -> Int
size = Int -> Word64Set -> Int
go Int
0
  where
    go :: Int -> Word64Set -> Int
go !Int
acc (Bin Mask
_ Mask
_ Word64Set
l Word64Set
r) = Int -> Word64Set -> Int
go (Int -> Word64Set -> Int
go Int
acc Word64Set
l) Word64Set
r
    go Int
acc (Tip Mask
_ Mask
bm) = Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Mask -> Int
bitcount Int
0 Mask
bm
    go Int
acc Word64Set
Nil = Int
acc

-- | \(O(\min(n,W))\). Is the value a member of the set?

-- See Note: Local 'go' functions and capturing.
member :: Key -> Word64Set -> Bool
member :: Mask -> Word64Set -> Bool
member !Mask
x = Word64Set -> Bool
go
  where
    go :: Word64Set -> Bool
go (Bin Mask
p Mask
m Word64Set
l Word64Set
r)
      | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = Bool
False
      | Mask -> Mask -> Bool
zero Mask
x Mask
m      = Word64Set -> Bool
go Word64Set
l
      | Bool
otherwise     = Word64Set -> Bool
go Word64Set
r
    go (Tip Mask
y Mask
bm) = Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
y Bool -> Bool -> Bool
&& Mask -> Mask
bitmapOf Mask
x Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
bm Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0
    go Word64Set
Nil = Bool
False

-- | \(O(\min(n,W))\). Is the element not in the set?
notMember :: Key -> Word64Set -> Bool
notMember :: Mask -> Word64Set -> Bool
notMember Mask
k = Bool -> Bool
not (Bool -> Bool) -> (Word64Set -> Bool) -> Word64Set -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mask -> Word64Set -> Bool
member Mask
k

-- | \(O(\min(n,W))\). Find largest element smaller than the given one.
--
-- > lookupLT 3 (fromList [3, 5]) == Nothing
-- > lookupLT 5 (fromList [3, 5]) == Just 3

-- See Note: Local 'go' functions and capturing.
lookupLT :: Key -> Word64Set -> Maybe Key
lookupLT :: Mask -> Word64Set -> Maybe Mask
lookupLT !Mask
x Word64Set
t = case Word64Set
t of
    Bin Mask
_ Mask
m Word64Set
l Word64Set
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then Word64Set -> Word64Set -> Maybe Mask
go Word64Set
r Word64Set
l else Word64Set -> Word64Set -> Maybe Mask
go Word64Set
Nil Word64Set
r
    Word64Set
_ -> Word64Set -> Word64Set -> Maybe Mask
go Word64Set
Nil Word64Set
t
  where
    go :: Word64Set -> Word64Set -> Maybe Mask
go Word64Set
def (Bin Mask
p Mask
m Word64Set
l Word64Set
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then Word64Set -> Maybe Mask
unsafeFindMax Word64Set
def else Word64Set -> Maybe Mask
unsafeFindMax Word64Set
r
                         | Mask -> Mask -> Bool
zero Mask
x Mask
m  = Word64Set -> Word64Set -> Maybe Mask
go Word64Set
def Word64Set
l
                         | Bool
otherwise = Word64Set -> Word64Set -> Maybe Mask
go Word64Set
l Word64Set
r
    go Word64Set
def (Tip Mask
kx Mask
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
highestBitSet Mask
bm
                       | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Mask
maskLT Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
highestBitSet Mask
maskLT
                       | Bool
otherwise = Word64Set -> Maybe Mask
unsafeFindMax Word64Set
def
                       where maskLT :: Mask
maskLT = (Mask -> Mask
bitmapOf Mask
x Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
bm
    go Word64Set
def Word64Set
Nil = Word64Set -> Maybe Mask
unsafeFindMax Word64Set
def


-- | \(O(\min(n,W))\). Find smallest element greater than the given one.
--
-- > lookupGT 4 (fromList [3, 5]) == Just 5
-- > lookupGT 5 (fromList [3, 5]) == Nothing

-- See Note: Local 'go' functions and capturing.
lookupGT :: Key -> Word64Set -> Maybe Key
lookupGT :: Mask -> Word64Set -> Maybe Mask
lookupGT !Mask
x Word64Set
t = case Word64Set
t of
    Bin Mask
_ Mask
m Word64Set
l Word64Set
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then Word64Set -> Word64Set -> Maybe Mask
go Word64Set
Nil Word64Set
l else Word64Set -> Word64Set -> Maybe Mask
go Word64Set
l Word64Set
r
    Word64Set
_ -> Word64Set -> Word64Set -> Maybe Mask
go Word64Set
Nil Word64Set
t
  where
    go :: Word64Set -> Word64Set -> Maybe Mask
go Word64Set
def (Bin Mask
p Mask
m Word64Set
l Word64Set
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then Word64Set -> Maybe Mask
unsafeFindMin Word64Set
l else Word64Set -> Maybe Mask
unsafeFindMin Word64Set
def
                         | Mask -> Mask -> Bool
zero Mask
x Mask
m  = Word64Set -> Word64Set -> Maybe Mask
go Word64Set
r Word64Set
l
                         | Bool
otherwise = Word64Set -> Word64Set -> Maybe Mask
go Word64Set
def Word64Set
r
    go Word64Set
def (Tip Mask
kx Mask
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
lowestBitSet Mask
bm
                       | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Mask
maskGT Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
lowestBitSet Mask
maskGT
                       | Bool
otherwise = Word64Set -> Maybe Mask
unsafeFindMin Word64Set
def
                       where maskGT :: Mask
maskGT = (- ((Mask -> Mask
bitmapOf Mask
x) Mask -> Int -> Mask
`shiftLL` Int
1)) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
bm
    go Word64Set
def Word64Set
Nil = Word64Set -> Maybe Mask
unsafeFindMin Word64Set
def


-- | \(O(\min(n,W))\). Find largest element smaller or equal to the given one.
--
-- > lookupLE 2 (fromList [3, 5]) == Nothing
-- > lookupLE 4 (fromList [3, 5]) == Just 3
-- > lookupLE 5 (fromList [3, 5]) == Just 5

-- See Note: Local 'go' functions and capturing.
lookupLE :: Key -> Word64Set -> Maybe Key
lookupLE :: Mask -> Word64Set -> Maybe Mask
lookupLE !Mask
x Word64Set
t = case Word64Set
t of
    Bin Mask
_ Mask
m Word64Set
l Word64Set
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then Word64Set -> Word64Set -> Maybe Mask
go Word64Set
r Word64Set
l else Word64Set -> Word64Set -> Maybe Mask
go Word64Set
Nil Word64Set
r
    Word64Set
_ -> Word64Set -> Word64Set -> Maybe Mask
go Word64Set
Nil Word64Set
t
  where
    go :: Word64Set -> Word64Set -> Maybe Mask
go Word64Set
def (Bin Mask
p Mask
m Word64Set
l Word64Set
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then Word64Set -> Maybe Mask
unsafeFindMax Word64Set
def else Word64Set -> Maybe Mask
unsafeFindMax Word64Set
r
                         | Mask -> Mask -> Bool
zero Mask
x Mask
m  = Word64Set -> Word64Set -> Maybe Mask
go Word64Set
def Word64Set
l
                         | Bool
otherwise = Word64Set -> Word64Set -> Maybe Mask
go Word64Set
l Word64Set
r
    go Word64Set
def (Tip Mask
kx Mask
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
highestBitSet Mask
bm
                       | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Mask
maskLE Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
highestBitSet Mask
maskLE
                       | Bool
otherwise = Word64Set -> Maybe Mask
unsafeFindMax Word64Set
def
                       where maskLE :: Mask
maskLE = (((Mask -> Mask
bitmapOf Mask
x) Mask -> Int -> Mask
`shiftLL` Int
1) Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
bm
    go Word64Set
def Word64Set
Nil = Word64Set -> Maybe Mask
unsafeFindMax Word64Set
def


-- | \(O(\min(n,W))\). Find smallest element greater or equal to the given one.
--
-- > lookupGE 3 (fromList [3, 5]) == Just 3
-- > lookupGE 4 (fromList [3, 5]) == Just 5
-- > lookupGE 6 (fromList [3, 5]) == Nothing

-- See Note: Local 'go' functions and capturing.
lookupGE :: Key -> Word64Set -> Maybe Key
lookupGE :: Mask -> Word64Set -> Maybe Mask
lookupGE !Mask
x Word64Set
t = case Word64Set
t of
    Bin Mask
_ Mask
m Word64Set
l Word64Set
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then Word64Set -> Word64Set -> Maybe Mask
go Word64Set
Nil Word64Set
l else Word64Set -> Word64Set -> Maybe Mask
go Word64Set
l Word64Set
r
    Word64Set
_ -> Word64Set -> Word64Set -> Maybe Mask
go Word64Set
Nil Word64Set
t
  where
    go :: Word64Set -> Word64Set -> Maybe Mask
go Word64Set
def (Bin Mask
p Mask
m Word64Set
l Word64Set
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then Word64Set -> Maybe Mask
unsafeFindMin Word64Set
l else Word64Set -> Maybe Mask
unsafeFindMin Word64Set
def
                         | Mask -> Mask -> Bool
zero Mask
x Mask
m  = Word64Set -> Word64Set -> Maybe Mask
go Word64Set
r Word64Set
l
                         | Bool
otherwise = Word64Set -> Word64Set -> Maybe Mask
go Word64Set
def Word64Set
r
    go Word64Set
def (Tip Mask
kx Mask
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
lowestBitSet Mask
bm
                       | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Mask
maskGE Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
lowestBitSet Mask
maskGE
                       | Bool
otherwise = Word64Set -> Maybe Mask
unsafeFindMin Word64Set
def
                       where maskGE :: Mask
maskGE = (- (Mask -> Mask
bitmapOf Mask
x)) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
bm
    go Word64Set
def Word64Set
Nil = Word64Set -> Maybe Mask
unsafeFindMin Word64Set
def



-- Helper function for lookupGE and lookupGT. It assumes that if a Bin node is
-- given, it has m > 0.
unsafeFindMin :: Word64Set -> Maybe Key
unsafeFindMin :: Word64Set -> Maybe Mask
unsafeFindMin Word64Set
Nil = Maybe Mask
forall a. Maybe a
Nothing
unsafeFindMin (Tip Mask
kx Mask
bm) = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
lowestBitSet Mask
bm
unsafeFindMin (Bin Mask
_ Mask
_ Word64Set
l Word64Set
_) = Word64Set -> Maybe Mask
unsafeFindMin Word64Set
l

-- Helper function for lookupLE and lookupLT. It assumes that if a Bin node is
-- given, it has m > 0.
unsafeFindMax :: Word64Set -> Maybe Key
unsafeFindMax :: Word64Set -> Maybe Mask
unsafeFindMax Word64Set
Nil = Maybe Mask
forall a. Maybe a
Nothing
unsafeFindMax (Tip Mask
kx Mask
bm) = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
highestBitSet Mask
bm
unsafeFindMax (Bin Mask
_ Mask
_ Word64Set
_ Word64Set
r) = Word64Set -> Maybe Mask
unsafeFindMax Word64Set
r

{--------------------------------------------------------------------
  Construction
--------------------------------------------------------------------}
-- | \(O(1)\). The empty set.
empty :: Word64Set
empty :: Word64Set
empty
  = Word64Set
Nil
{-# INLINE empty #-}

-- | \(O(1)\). A set of one element.
singleton :: Key -> Word64Set
singleton :: Mask -> Word64Set
singleton Mask
x
  = Mask -> Mask -> Word64Set
Tip (Mask -> Mask
prefixOf Mask
x) (Mask -> Mask
bitmapOf Mask
x)
{-# INLINE singleton #-}

{--------------------------------------------------------------------
  Insert
--------------------------------------------------------------------}
-- | \(O(\min(n,W))\). Add a value to the set. There is no left- or right bias for
-- Word64Sets.
insert :: Key -> Word64Set -> Word64Set
insert :: Mask -> Word64Set -> Word64Set
insert !Mask
x = Mask -> Mask -> Word64Set -> Word64Set
insertBM (Mask -> Mask
prefixOf Mask
x) (Mask -> Mask
bitmapOf Mask
x)

-- Helper function for insert and union.
insertBM :: Prefix -> BitMap -> Word64Set -> Word64Set
insertBM :: Mask -> Mask -> Word64Set -> Word64Set
insertBM !Mask
kx !Mask
bm t :: Word64Set
t@(Bin Mask
p Mask
m Word64Set
l Word64Set
r)
  | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = Mask -> Word64Set -> Mask -> Word64Set -> Word64Set
link Mask
kx (Mask -> Mask -> Word64Set
Tip Mask
kx Mask
bm) Mask
p Word64Set
t
  | Mask -> Mask -> Bool
zero Mask
kx Mask
m      = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
Bin Mask
p Mask
m (Mask -> Mask -> Word64Set -> Word64Set
insertBM Mask
kx Mask
bm Word64Set
l) Word64Set
r
  | Bool
otherwise      = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
Bin Mask
p Mask
m Word64Set
l (Mask -> Mask -> Word64Set -> Word64Set
insertBM Mask
kx Mask
bm Word64Set
r)
insertBM Mask
kx Mask
bm t :: Word64Set
t@(Tip Mask
kx' Mask
bm')
  | Mask
kx' Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx = Mask -> Mask -> Word64Set
Tip Mask
kx' (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. Mask
bm')
  | Bool
otherwise = Mask -> Word64Set -> Mask -> Word64Set -> Word64Set
link Mask
kx (Mask -> Mask -> Word64Set
Tip Mask
kx Mask
bm) Mask
kx' Word64Set
t
insertBM Mask
kx Mask
bm Word64Set
Nil = Mask -> Mask -> Word64Set
Tip Mask
kx Mask
bm

-- | \(O(\min(n,W))\). Delete a value in the set. Returns the
-- original set when the value was not present.
delete :: Key -> Word64Set -> Word64Set
delete :: Mask -> Word64Set -> Word64Set
delete !Mask
x = Mask -> Mask -> Word64Set -> Word64Set
deleteBM (Mask -> Mask
prefixOf Mask
x) (Mask -> Mask
bitmapOf Mask
x)

-- Deletes all values mentioned in the BitMap from the set.
-- Helper function for delete and difference.
deleteBM :: Prefix -> BitMap -> Word64Set -> Word64Set
deleteBM :: Mask -> Mask -> Word64Set -> Word64Set
deleteBM !Mask
kx !Mask
bm t :: Word64Set
t@(Bin Mask
p Mask
m Word64Set
l Word64Set
r)
  | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = Word64Set
t
  | Mask -> Mask -> Bool
zero Mask
kx Mask
m      = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m (Mask -> Mask -> Word64Set -> Word64Set
deleteBM Mask
kx Mask
bm Word64Set
l) Word64Set
r
  | Bool
otherwise      = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l (Mask -> Mask -> Word64Set -> Word64Set
deleteBM Mask
kx Mask
bm Word64Set
r)
deleteBM Mask
kx Mask
bm t :: Word64Set
t@(Tip Mask
kx' Mask
bm')
  | Mask
kx' Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx = Mask -> Mask -> Word64Set
tip Mask
kx (Mask
bm' Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask -> Mask
forall a. Bits a => a -> a
complement Mask
bm)
  | Bool
otherwise = Word64Set
t
deleteBM Mask
_ Mask
_ Word64Set
Nil = Word64Set
Nil

-- | \(O(\min(n,W))\). @('alterF' f x s)@ can delete or insert @x@ in @s@ depending
-- on whether it is already present in @s@.
--
-- In short:
--
-- @
-- 'member' x \<$\> 'alterF' f x s = f ('member' x s)
-- @
--
-- Note: 'alterF' is a variant of the @at@ combinator from "Control.Lens.At".
--
-- @since 0.6.3.1
alterF :: Functor f => (Bool -> f Bool) -> Key -> Word64Set -> f Word64Set
alterF :: forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Mask -> Word64Set -> f Word64Set
alterF Bool -> f Bool
f Mask
k Word64Set
s = (Bool -> Word64Set) -> f Bool -> f Word64Set
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Word64Set
choose (Bool -> f Bool
f Bool
member_)
  where
    member_ :: Bool
member_ = Mask -> Word64Set -> Bool
member Mask
k Word64Set
s

    (Word64Set
inserted, Word64Set
deleted)
      | Bool
member_   = (Word64Set
s         , Mask -> Word64Set -> Word64Set
delete Mask
k Word64Set
s)
      | Bool
otherwise = (Mask -> Word64Set -> Word64Set
insert Mask
k Word64Set
s, Word64Set
s         )

    choose :: Bool -> Word64Set
choose Bool
True  = Word64Set
inserted
    choose Bool
False = Word64Set
deleted
{-# INLINABLE [2] alterF #-}

{-# RULES
"alterF/Const" forall k (f :: Bool -> Const a Bool) . alterF f k = \s -> Const . getConst . f $ member k s
 #-}

{-# SPECIALIZE alterF :: (Bool -> Identity Bool) -> Key -> Word64Set -> Identity Word64Set #-}

{--------------------------------------------------------------------
  Union
--------------------------------------------------------------------}
-- | The union of a list of sets.

{-# INLINABLE unions #-}
unions :: [Word64Set] -> Word64Set
unions :: [Word64Set] -> Word64Set
unions = (Word64Set -> Word64Set -> Word64Set)
-> Word64Set -> [Word64Set] -> Word64Set
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Word64Set -> Word64Set -> Word64Set
union Word64Set
empty

-- | \(O(n+m)\). The union of two sets.
union :: Word64Set -> Word64Set -> Word64Set
union :: Word64Set -> Word64Set -> Word64Set
union t1 :: Word64Set
t1@(Bin Mask
p1 Mask
m1 Word64Set
l1 Word64Set
r1) t2 :: Word64Set
t2@(Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2)
  | Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2  = Word64Set
union1
  | Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1  = Word64Set
union2
  | Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2       = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
Bin Mask
p1 Mask
m1 (Word64Set -> Word64Set -> Word64Set
union Word64Set
l1 Word64Set
l2) (Word64Set -> Word64Set -> Word64Set
union Word64Set
r1 Word64Set
r2)
  | Bool
otherwise      = Mask -> Word64Set -> Mask -> Word64Set -> Word64Set
link Mask
p1 Word64Set
t1 Mask
p2 Word64Set
t2
  where
    union1 :: Word64Set
union1  | Mask -> Mask -> Mask -> Bool
nomatch Mask
p2 Mask
p1 Mask
m1  = Mask -> Word64Set -> Mask -> Word64Set -> Word64Set
link Mask
p1 Word64Set
t1 Mask
p2 Word64Set
t2
            | Mask -> Mask -> Bool
zero Mask
p2 Mask
m1        = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
Bin Mask
p1 Mask
m1 (Word64Set -> Word64Set -> Word64Set
union Word64Set
l1 Word64Set
t2) Word64Set
r1
            | Bool
otherwise         = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
Bin Mask
p1 Mask
m1 Word64Set
l1 (Word64Set -> Word64Set -> Word64Set
union Word64Set
r1 Word64Set
t2)

    union2 :: Word64Set
union2  | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2  = Mask -> Word64Set -> Mask -> Word64Set -> Word64Set
link Mask
p1 Word64Set
t1 Mask
p2 Word64Set
t2
            | Mask -> Mask -> Bool
zero Mask
p1 Mask
m2        = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
Bin Mask
p2 Mask
m2 (Word64Set -> Word64Set -> Word64Set
union Word64Set
t1 Word64Set
l2) Word64Set
r2
            | Bool
otherwise         = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
Bin Mask
p2 Mask
m2 Word64Set
l2 (Word64Set -> Word64Set -> Word64Set
union Word64Set
t1 Word64Set
r2)

union t :: Word64Set
t@(Bin Mask
_ Mask
_ Word64Set
_ Word64Set
_) (Tip Mask
kx Mask
bm) = Mask -> Mask -> Word64Set -> Word64Set
insertBM Mask
kx Mask
bm Word64Set
t
union t :: Word64Set
t@(Bin Mask
_ Mask
_ Word64Set
_ Word64Set
_) Word64Set
Nil = Word64Set
t
union (Tip Mask
kx Mask
bm) Word64Set
t = Mask -> Mask -> Word64Set -> Word64Set
insertBM Mask
kx Mask
bm Word64Set
t
union Word64Set
Nil Word64Set
t = Word64Set
t


{--------------------------------------------------------------------
  Difference
--------------------------------------------------------------------}
-- | \(O(n+m)\). Difference between two sets.
difference :: Word64Set -> Word64Set -> Word64Set
difference :: Word64Set -> Word64Set -> Word64Set
difference t1 :: Word64Set
t1@(Bin Mask
p1 Mask
m1 Word64Set
l1 Word64Set
r1) t2 :: Word64Set
t2@(Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2)
  | Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2  = Word64Set
difference1
  | Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1  = Word64Set
difference2
  | Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2       = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p1 Mask
m1 (Word64Set -> Word64Set -> Word64Set
difference Word64Set
l1 Word64Set
l2) (Word64Set -> Word64Set -> Word64Set
difference Word64Set
r1 Word64Set
r2)
  | Bool
otherwise      = Word64Set
t1
  where
    difference1 :: Word64Set
difference1 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p2 Mask
p1 Mask
m1  = Word64Set
t1
                | Mask -> Mask -> Bool
zero Mask
p2 Mask
m1        = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p1 Mask
m1 (Word64Set -> Word64Set -> Word64Set
difference Word64Set
l1 Word64Set
t2) Word64Set
r1
                | Bool
otherwise         = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p1 Mask
m1 Word64Set
l1 (Word64Set -> Word64Set -> Word64Set
difference Word64Set
r1 Word64Set
t2)

    difference2 :: Word64Set
difference2 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2  = Word64Set
t1
                | Mask -> Mask -> Bool
zero Mask
p1 Mask
m2        = Word64Set -> Word64Set -> Word64Set
difference Word64Set
t1 Word64Set
l2
                | Bool
otherwise         = Word64Set -> Word64Set -> Word64Set
difference Word64Set
t1 Word64Set
r2

difference t :: Word64Set
t@(Bin Mask
_ Mask
_ Word64Set
_ Word64Set
_) (Tip Mask
kx Mask
bm) = Mask -> Mask -> Word64Set -> Word64Set
deleteBM Mask
kx Mask
bm Word64Set
t
difference t :: Word64Set
t@(Bin Mask
_ Mask
_ Word64Set
_ Word64Set
_) Word64Set
Nil = Word64Set
t

difference t1 :: Word64Set
t1@(Tip Mask
kx Mask
bm) Word64Set
t2 = Word64Set -> Word64Set
differenceTip Word64Set
t2
  where differenceTip :: Word64Set -> Word64Set
differenceTip (Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p2 Mask
m2 = Word64Set
t1
                                        | Mask -> Mask -> Bool
zero Mask
kx Mask
m2 = Word64Set -> Word64Set
differenceTip Word64Set
l2
                                        | Bool
otherwise = Word64Set -> Word64Set
differenceTip Word64Set
r2
        differenceTip (Tip Mask
kx2 Mask
bm2) | Mask
kx Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = Mask -> Mask -> Word64Set
tip Mask
kx (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask -> Mask
forall a. Bits a => a -> a
complement Mask
bm2)
                                    | Bool
otherwise = Word64Set
t1
        differenceTip Word64Set
Nil = Word64Set
t1

difference Word64Set
Nil Word64Set
_     = Word64Set
Nil



{--------------------------------------------------------------------
  Intersection
--------------------------------------------------------------------}
-- | \(O(n+m)\). The intersection of two sets.
intersection :: Word64Set -> Word64Set -> Word64Set
intersection :: Word64Set -> Word64Set -> Word64Set
intersection t1 :: Word64Set
t1@(Bin Mask
p1 Mask
m1 Word64Set
l1 Word64Set
r1) t2 :: Word64Set
t2@(Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2)
  | Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2  = Word64Set
intersection1
  | Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1  = Word64Set
intersection2
  | Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2       = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p1 Mask
m1 (Word64Set -> Word64Set -> Word64Set
intersection Word64Set
l1 Word64Set
l2) (Word64Set -> Word64Set -> Word64Set
intersection Word64Set
r1 Word64Set
r2)
  | Bool
otherwise      = Word64Set
Nil
  where
    intersection1 :: Word64Set
intersection1 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p2 Mask
p1 Mask
m1  = Word64Set
Nil
                  | Mask -> Mask -> Bool
zero Mask
p2 Mask
m1        = Word64Set -> Word64Set -> Word64Set
intersection Word64Set
l1 Word64Set
t2
                  | Bool
otherwise         = Word64Set -> Word64Set -> Word64Set
intersection Word64Set
r1 Word64Set
t2

    intersection2 :: Word64Set
intersection2 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2  = Word64Set
Nil
                  | Mask -> Mask -> Bool
zero Mask
p1 Mask
m2        = Word64Set -> Word64Set -> Word64Set
intersection Word64Set
t1 Word64Set
l2
                  | Bool
otherwise         = Word64Set -> Word64Set -> Word64Set
intersection Word64Set
t1 Word64Set
r2

intersection t1 :: Word64Set
t1@(Bin Mask
_ Mask
_ Word64Set
_ Word64Set
_) (Tip Mask
kx2 Mask
bm2) = Word64Set -> Word64Set
intersectBM Word64Set
t1
  where intersectBM :: Word64Set -> Word64Set
intersectBM (Bin Mask
p1 Mask
m1 Word64Set
l1 Word64Set
r1) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx2 Mask
p1 Mask
m1 = Word64Set
Nil
                                      | Mask -> Mask -> Bool
zero Mask
kx2 Mask
m1       = Word64Set -> Word64Set
intersectBM Word64Set
l1
                                      | Bool
otherwise         = Word64Set -> Word64Set
intersectBM Word64Set
r1
        intersectBM (Tip Mask
kx1 Mask
bm1) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = Mask -> Mask -> Word64Set
tip Mask
kx1 (Mask
bm1 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
bm2)
                                  | Bool
otherwise = Word64Set
Nil
        intersectBM Word64Set
Nil = Word64Set
Nil

intersection (Bin Mask
_ Mask
_ Word64Set
_ Word64Set
_) Word64Set
Nil = Word64Set
Nil

intersection (Tip Mask
kx1 Mask
bm1) Word64Set
t2 = Word64Set -> Word64Set
intersectBM Word64Set
t2
  where intersectBM :: Word64Set -> Word64Set
intersectBM (Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx1 Mask
p2 Mask
m2 = Word64Set
Nil
                                      | Mask -> Mask -> Bool
zero Mask
kx1 Mask
m2       = Word64Set -> Word64Set
intersectBM Word64Set
l2
                                      | Bool
otherwise         = Word64Set -> Word64Set
intersectBM Word64Set
r2
        intersectBM (Tip Mask
kx2 Mask
bm2) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = Mask -> Mask -> Word64Set
tip Mask
kx1 (Mask
bm1 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
bm2)
                                  | Bool
otherwise = Word64Set
Nil
        intersectBM Word64Set
Nil = Word64Set
Nil

intersection Word64Set
Nil Word64Set
_ = Word64Set
Nil

{--------------------------------------------------------------------
  Subset
--------------------------------------------------------------------}
-- | \(O(n+m)\). Is this a proper subset? (ie. a subset but not equal).
isProperSubsetOf :: Word64Set -> Word64Set -> Bool
isProperSubsetOf :: Word64Set -> Word64Set -> Bool
isProperSubsetOf Word64Set
t1 Word64Set
t2
  = case Word64Set -> Word64Set -> Ordering
subsetCmp Word64Set
t1 Word64Set
t2 of
      Ordering
LT -> Bool
True
      Ordering
_  -> Bool
False

subsetCmp :: Word64Set -> Word64Set -> Ordering
subsetCmp :: Word64Set -> Word64Set -> Ordering
subsetCmp t1 :: Word64Set
t1@(Bin Mask
p1 Mask
m1 Word64Set
l1 Word64Set
r1) (Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2)
  | Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2  = Ordering
GT
  | Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1  = case Ordering
subsetCmpLt of
                       Ordering
GT -> Ordering
GT
                       Ordering
_  -> Ordering
LT
  | Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2       = Ordering
subsetCmpEq
  | Bool
otherwise      = Ordering
GT  -- disjoint
  where
    subsetCmpLt :: Ordering
subsetCmpLt | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2  = Ordering
GT
                | Mask -> Mask -> Bool
zero Mask
p1 Mask
m2        = Word64Set -> Word64Set -> Ordering
subsetCmp Word64Set
t1 Word64Set
l2
                | Bool
otherwise         = Word64Set -> Word64Set -> Ordering
subsetCmp Word64Set
t1 Word64Set
r2
    subsetCmpEq :: Ordering
subsetCmpEq = case (Word64Set -> Word64Set -> Ordering
subsetCmp Word64Set
l1 Word64Set
l2, Word64Set -> Word64Set -> Ordering
subsetCmp Word64Set
r1 Word64Set
r2) of
                    (Ordering
GT,Ordering
_ ) -> Ordering
GT
                    (Ordering
_ ,Ordering
GT) -> Ordering
GT
                    (Ordering
EQ,Ordering
EQ) -> Ordering
EQ
                    (Ordering, Ordering)
_       -> Ordering
LT

subsetCmp (Bin Mask
_ Mask
_ Word64Set
_ Word64Set
_) Word64Set
_  = Ordering
GT
subsetCmp (Tip Mask
kx1 Mask
bm1) (Tip Mask
kx2 Mask
bm2)
  | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
kx2                  = Ordering
GT -- disjoint
  | Mask
bm1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
bm2                  = Ordering
EQ
  | Mask
bm1 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask -> Mask
forall a. Bits a => a -> a
complement Mask
bm2 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
0 = Ordering
LT
  | Bool
otherwise                   = Ordering
GT
subsetCmp t1 :: Word64Set
t1@(Tip Mask
kx Mask
_) (Bin Mask
p Mask
m Word64Set
l Word64Set
r)
  | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = Ordering
GT
  | Mask -> Mask -> Bool
zero Mask
kx Mask
m      = case Word64Set -> Word64Set -> Ordering
subsetCmp Word64Set
t1 Word64Set
l of Ordering
GT -> Ordering
GT ; Ordering
_ -> Ordering
LT
  | Bool
otherwise      = case Word64Set -> Word64Set -> Ordering
subsetCmp Word64Set
t1 Word64Set
r of Ordering
GT -> Ordering
GT ; Ordering
_ -> Ordering
LT
subsetCmp (Tip Mask
_ Mask
_) Word64Set
Nil = Ordering
GT -- disjoint
subsetCmp Word64Set
Nil Word64Set
Nil = Ordering
EQ
subsetCmp Word64Set
Nil Word64Set
_   = Ordering
LT

-- | \(O(n+m)\). Is this a subset?
-- @(s1 \`isSubsetOf\` s2)@ tells whether @s1@ is a subset of @s2@.

isSubsetOf :: Word64Set -> Word64Set -> Bool
isSubsetOf :: Word64Set -> Word64Set -> Bool
isSubsetOf t1 :: Word64Set
t1@(Bin Mask
p1 Mask
m1 Word64Set
l1 Word64Set
r1) (Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2)
  | Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2  = Bool
False
  | Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1  = Mask -> Mask -> Mask -> Bool
match Mask
p1 Mask
p2 Mask
m2 Bool -> Bool -> Bool
&& (if Mask -> Mask -> Bool
zero Mask
p1 Mask
m2 then Word64Set -> Word64Set -> Bool
isSubsetOf Word64Set
t1 Word64Set
l2
                                                      else Word64Set -> Word64Set -> Bool
isSubsetOf Word64Set
t1 Word64Set
r2)
  | Bool
otherwise      = (Mask
p1Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
==Mask
p2) Bool -> Bool -> Bool
&& Word64Set -> Word64Set -> Bool
isSubsetOf Word64Set
l1 Word64Set
l2 Bool -> Bool -> Bool
&& Word64Set -> Word64Set -> Bool
isSubsetOf Word64Set
r1 Word64Set
r2
isSubsetOf (Bin Mask
_ Mask
_ Word64Set
_ Word64Set
_) Word64Set
_  = Bool
False
isSubsetOf (Tip Mask
kx1 Mask
bm1) (Tip Mask
kx2 Mask
bm2) = Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 Bool -> Bool -> Bool
&& Mask
bm1 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask -> Mask
forall a. Bits a => a -> a
complement Mask
bm2 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
0
isSubsetOf t1 :: Word64Set
t1@(Tip Mask
kx Mask
_) (Bin Mask
p Mask
m Word64Set
l Word64Set
r)
  | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = Bool
False
  | Mask -> Mask -> Bool
zero Mask
kx Mask
m      = Word64Set -> Word64Set -> Bool
isSubsetOf Word64Set
t1 Word64Set
l
  | Bool
otherwise      = Word64Set -> Word64Set -> Bool
isSubsetOf Word64Set
t1 Word64Set
r
isSubsetOf (Tip Mask
_ Mask
_) Word64Set
Nil = Bool
False
isSubsetOf Word64Set
Nil Word64Set
_         = Bool
True


{--------------------------------------------------------------------
  Disjoint
--------------------------------------------------------------------}
-- | \(O(n+m)\). Check whether two sets are disjoint (i.e. their intersection
--   is empty).
--
-- > disjoint (fromList [2,4,6])   (fromList [1,3])     == True
-- > disjoint (fromList [2,4,6,8]) (fromList [2,3,5,7]) == False
-- > disjoint (fromList [1,2])     (fromList [1,2,3,4]) == False
-- > disjoint (fromList [])        (fromList [])        == True
--
-- @since 0.5.11
disjoint :: Word64Set -> Word64Set -> Bool
disjoint :: Word64Set -> Word64Set -> Bool
disjoint t1 :: Word64Set
t1@(Bin Mask
p1 Mask
m1 Word64Set
l1 Word64Set
r1) t2 :: Word64Set
t2@(Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2)
  | Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2  = Bool
disjoint1
  | Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1  = Bool
disjoint2
  | Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2       = Word64Set -> Word64Set -> Bool
disjoint Word64Set
l1 Word64Set
l2 Bool -> Bool -> Bool
&& Word64Set -> Word64Set -> Bool
disjoint Word64Set
r1 Word64Set
r2
  | Bool
otherwise      = Bool
True
  where
    disjoint1 :: Bool
disjoint1 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p2 Mask
p1 Mask
m1  = Bool
True
              | Mask -> Mask -> Bool
zero Mask
p2 Mask
m1        = Word64Set -> Word64Set -> Bool
disjoint Word64Set
l1 Word64Set
t2
              | Bool
otherwise         = Word64Set -> Word64Set -> Bool
disjoint Word64Set
r1 Word64Set
t2

    disjoint2 :: Bool
disjoint2 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2  = Bool
True
              | Mask -> Mask -> Bool
zero Mask
p1 Mask
m2        = Word64Set -> Word64Set -> Bool
disjoint Word64Set
t1 Word64Set
l2
              | Bool
otherwise         = Word64Set -> Word64Set -> Bool
disjoint Word64Set
t1 Word64Set
r2

disjoint t1 :: Word64Set
t1@(Bin Mask
_ Mask
_ Word64Set
_ Word64Set
_) (Tip Mask
kx2 Mask
bm2) = Word64Set -> Bool
disjointBM Word64Set
t1
  where disjointBM :: Word64Set -> Bool
disjointBM (Bin Mask
p1 Mask
m1 Word64Set
l1 Word64Set
r1) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx2 Mask
p1 Mask
m1 = Bool
True
                                     | Mask -> Mask -> Bool
zero Mask
kx2 Mask
m1       = Word64Set -> Bool
disjointBM Word64Set
l1
                                     | Bool
otherwise         = Word64Set -> Bool
disjointBM Word64Set
r1
        disjointBM (Tip Mask
kx1 Mask
bm1) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = (Mask
bm1 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
bm2) Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
0
                                 | Bool
otherwise = Bool
True
        disjointBM Word64Set
Nil = Bool
True

disjoint (Bin Mask
_ Mask
_ Word64Set
_ Word64Set
_) Word64Set
Nil = Bool
True

disjoint (Tip Mask
kx1 Mask
bm1) Word64Set
t2 = Word64Set -> Bool
disjointBM Word64Set
t2
  where disjointBM :: Word64Set -> Bool
disjointBM (Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx1 Mask
p2 Mask
m2 = Bool
True
                                     | Mask -> Mask -> Bool
zero Mask
kx1 Mask
m2       = Word64Set -> Bool
disjointBM Word64Set
l2
                                     | Bool
otherwise         = Word64Set -> Bool
disjointBM Word64Set
r2
        disjointBM (Tip Mask
kx2 Mask
bm2) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = (Mask
bm1 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
bm2) Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
0
                                 | Bool
otherwise = Bool
True
        disjointBM Word64Set
Nil = Bool
True

disjoint Word64Set
Nil Word64Set
_ = Bool
True


{--------------------------------------------------------------------
  Filter
--------------------------------------------------------------------}
-- | \(O(n)\). Filter all elements that satisfy some predicate.
filter :: (Key -> Bool) -> Word64Set -> Word64Set
filter :: (Mask -> Bool) -> Word64Set -> Word64Set
filter Mask -> Bool
predicate Word64Set
t
  = case Word64Set
t of
      Bin Mask
p Mask
m Word64Set
l Word64Set
r
        -> Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m ((Mask -> Bool) -> Word64Set -> Word64Set
filter Mask -> Bool
predicate Word64Set
l) ((Mask -> Bool) -> Word64Set -> Word64Set
filter Mask -> Bool
predicate Word64Set
r)
      Tip Mask
kx Mask
bm
        -> Mask -> Mask -> Word64Set
tip Mask
kx (Mask -> (Mask -> Mask -> Mask) -> Mask -> Mask -> Mask
forall a. Mask -> (a -> Mask -> a) -> a -> Mask -> a
foldl'Bits Mask
0 (Mask -> Mask -> Mask -> Mask
bitPred Mask
kx) Mask
0 Mask
bm)
      Word64Set
Nil -> Word64Set
Nil
  where bitPred :: Mask -> Mask -> Mask -> Mask
bitPred Mask
kx Mask
bm Mask
bi | Mask -> Bool
predicate (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi) = Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. Mask -> Mask
bitmapOfSuffix Mask
bi
                         | Bool
otherwise           = Mask
bm
        {-# INLINE bitPred #-}

-- | \(O(n)\). partition the set according to some predicate.
partition :: (Key -> Bool) -> Word64Set -> (Word64Set,Word64Set)
partition :: (Mask -> Bool) -> Word64Set -> (Word64Set, Word64Set)
partition Mask -> Bool
predicate0 Word64Set
t0 = StrictPair Word64Set Word64Set -> (Word64Set, Word64Set)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair Word64Set Word64Set -> (Word64Set, Word64Set))
-> StrictPair Word64Set Word64Set -> (Word64Set, Word64Set)
forall a b. (a -> b) -> a -> b
$ (Mask -> Bool) -> Word64Set -> StrictPair Word64Set Word64Set
go Mask -> Bool
predicate0 Word64Set
t0
  where
    go :: (Mask -> Bool) -> Word64Set -> StrictPair Word64Set Word64Set
go Mask -> Bool
predicate Word64Set
t
      = case Word64Set
t of
          Bin Mask
p Mask
m Word64Set
l Word64Set
r
            -> let (Word64Set
l1 :*: Word64Set
l2) = (Mask -> Bool) -> Word64Set -> StrictPair Word64Set Word64Set
go Mask -> Bool
predicate Word64Set
l
                   (Word64Set
r1 :*: Word64Set
r2) = (Mask -> Bool) -> Word64Set -> StrictPair Word64Set Word64Set
go Mask -> Bool
predicate Word64Set
r
               in Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l1 Word64Set
r1 Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l2 Word64Set
r2
          Tip Mask
kx Mask
bm
            -> let bm1 :: Mask
bm1 = Mask -> (Mask -> Mask -> Mask) -> Mask -> Mask -> Mask
forall a. Mask -> (a -> Mask -> a) -> a -> Mask -> a
foldl'Bits Mask
0 (Mask -> Mask -> Mask -> Mask
bitPred Mask
kx) Mask
0 Mask
bm
               in  Mask -> Mask -> Word64Set
tip Mask
kx Mask
bm1 Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Mask -> Mask -> Word64Set
tip Mask
kx (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask
bm1)
          Word64Set
Nil -> (Word64Set
Nil Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Word64Set
Nil)
      where bitPred :: Mask -> Mask -> Mask -> Mask
bitPred Mask
kx Mask
bm Mask
bi | Mask -> Bool
predicate (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi) = Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. Mask -> Mask
bitmapOfSuffix Mask
bi
                             | Bool
otherwise           = Mask
bm
            {-# INLINE bitPred #-}

-- | \(O(\min(n,W))\). Take while a predicate on the elements holds.
-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.
-- See note at 'spanAntitone'.
--
-- @
-- takeWhileAntitone p = 'fromDistinctAscList' . 'Data.List.takeWhile' p . 'toList'
-- takeWhileAntitone p = 'filter' p
-- @
--
-- @since 0.6.7
takeWhileAntitone :: (Key -> Bool) -> Word64Set -> Word64Set
takeWhileAntitone :: (Mask -> Bool) -> Word64Set -> Word64Set
takeWhileAntitone Mask -> Bool
predicate Word64Set
t =
  case Word64Set
t of
    Bin Mask
p Mask
m Word64Set
l Word64Set
r
      | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 ->
        if Mask -> Bool
predicate Mask
0 -- handle negative numbers.
        then Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m ((Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate Word64Set
l) Word64Set
r
        else (Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate Word64Set
r
    Word64Set
_ -> (Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate Word64Set
t
  where
    go :: (Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate' (Bin Mask
p Mask
m Word64Set
l Word64Set
r)
      | Mask -> Bool
predicate' (Mask -> Bool) -> Mask -> Bool
forall a b. (a -> b) -> a -> b
$! Mask
pMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
m = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l ((Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate' Word64Set
r)
      | Bool
otherwise         = (Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate' Word64Set
l
    go Mask -> Bool
predicate' (Tip Mask
kx Mask
bm) = Mask -> Mask -> Word64Set
tip Mask
kx (Mask -> (Mask -> Bool) -> Mask -> Mask
takeWhileAntitoneBits Mask
kx Mask -> Bool
predicate' Mask
bm)
    go Mask -> Bool
_ Word64Set
Nil = Word64Set
Nil

-- | \(O(\min(n,W))\). Drop while a predicate on the elements holds.
-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.
-- See note at 'spanAntitone'.
--
-- @
-- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' p . 'toList'
-- dropWhileAntitone p = 'filter' (not . p)
-- @
--
-- @since 0.6.7
dropWhileAntitone :: (Key -> Bool) -> Word64Set -> Word64Set
dropWhileAntitone :: (Mask -> Bool) -> Word64Set -> Word64Set
dropWhileAntitone Mask -> Bool
predicate Word64Set
t =
  case Word64Set
t of
    Bin Mask
p Mask
m Word64Set
l Word64Set
r
      | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 ->
        if Mask -> Bool
predicate Mask
0 -- handle negative numbers.
        then (Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate Word64Set
l
        else Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l ((Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate Word64Set
r)
    Word64Set
_ -> (Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate Word64Set
t
  where
    go :: (Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate' (Bin Mask
p Mask
m Word64Set
l Word64Set
r)
      | Mask -> Bool
predicate' (Mask -> Bool) -> Mask -> Bool
forall a b. (a -> b) -> a -> b
$! Mask
pMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
m = (Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate' Word64Set
r
      | Bool
otherwise         = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m ((Mask -> Bool) -> Word64Set -> Word64Set
go Mask -> Bool
predicate' Word64Set
l) Word64Set
r
    go Mask -> Bool
predicate' (Tip Mask
kx Mask
bm) = Mask -> Mask -> Word64Set
tip Mask
kx (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask -> (Mask -> Bool) -> Mask -> Mask
takeWhileAntitoneBits Mask
kx Mask -> Bool
predicate' Mask
bm)
    go Mask -> Bool
_ Word64Set
Nil = Word64Set
Nil

-- | \(O(\min(n,W))\). Divide a set at the point where a predicate on the elements stops holding.
-- The user is responsible for ensuring that for all @Int@s, @j \< k ==\> p j \>= p k@.
--
-- @
-- spanAntitone p xs = ('takeWhileAntitone' p xs, 'dropWhileAntitone' p xs)
-- spanAntitone p xs = 'partition' p xs
-- @
--
-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the set
-- at some /unspecified/ point.
--
-- @since 0.6.7
spanAntitone :: (Key -> Bool) -> Word64Set -> (Word64Set, Word64Set)
spanAntitone :: (Mask -> Bool) -> Word64Set -> (Word64Set, Word64Set)
spanAntitone Mask -> Bool
predicate Word64Set
t =
  case Word64Set
t of
    Bin Mask
p Mask
m Word64Set
l Word64Set
r
      | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 ->
        if Mask -> Bool
predicate Mask
0 -- handle negative numbers.
        then
          case (Mask -> Bool) -> Word64Set -> StrictPair Word64Set Word64Set
go Mask -> Bool
predicate Word64Set
l of
            (Word64Set
lt :*: Word64Set
gt) ->
              let !lt' :: Word64Set
lt' = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
lt Word64Set
r
              in (Word64Set
lt', Word64Set
gt)
        else
          case (Mask -> Bool) -> Word64Set -> StrictPair Word64Set Word64Set
go Mask -> Bool
predicate Word64Set
r of
            (Word64Set
lt :*: Word64Set
gt) ->
              let !gt' :: Word64Set
gt' = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l Word64Set
gt
              in (Word64Set
lt, Word64Set
gt')
    Word64Set
_ -> case (Mask -> Bool) -> Word64Set -> StrictPair Word64Set Word64Set
go Mask -> Bool
predicate Word64Set
t of
          (Word64Set
lt :*: Word64Set
gt) -> (Word64Set
lt, Word64Set
gt)
  where
    go :: (Mask -> Bool) -> Word64Set -> StrictPair Word64Set Word64Set
go Mask -> Bool
predicate' (Bin Mask
p Mask
m Word64Set
l Word64Set
r)
      | Mask -> Bool
predicate' (Mask -> Bool) -> Mask -> Bool
forall a b. (a -> b) -> a -> b
$! Mask
pMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
m = case (Mask -> Bool) -> Word64Set -> StrictPair Word64Set Word64Set
go Mask -> Bool
predicate' Word64Set
r of (Word64Set
lt :*: Word64Set
gt) -> Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l Word64Set
lt Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Word64Set
gt
      | Bool
otherwise         = case (Mask -> Bool) -> Word64Set -> StrictPair Word64Set Word64Set
go Mask -> Bool
predicate' Word64Set
l of (Word64Set
lt :*: Word64Set
gt) -> Word64Set
lt Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
gt Word64Set
r
    go Mask -> Bool
predicate' (Tip Mask
kx Mask
bm) = let bm' :: Mask
bm' = Mask -> (Mask -> Bool) -> Mask -> Mask
takeWhileAntitoneBits Mask
kx Mask -> Bool
predicate' Mask
bm
                                in (Mask -> Mask -> Word64Set
tip Mask
kx Mask
bm' Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Mask -> Mask -> Word64Set
tip Mask
kx (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask
bm'))
    go Mask -> Bool
_ Word64Set
Nil = (Word64Set
Nil Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Word64Set
Nil)

-- | \(O(\min(n,W))\). The expression (@'split' x set@) is a pair @(set1,set2)@
-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@
-- comprises the elements of @set@ greater than @x@.
--
-- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [4,5])
split :: Key -> Word64Set -> (Word64Set,Word64Set)
split :: Mask -> Word64Set -> (Word64Set, Word64Set)
split Mask
x Word64Set
t =
  case Word64Set
t of
    Bin Mask
p Mask
m Word64Set
l Word64Set
r
      | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 ->
        if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0  -- handle negative numbers.
        then
          case Mask -> Word64Set -> StrictPair Word64Set Word64Set
go Mask
x Word64Set
l of
            (Word64Set
lt :*: Word64Set
gt) ->
              let !lt' :: Word64Set
lt' = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
lt Word64Set
r
              in (Word64Set
lt', Word64Set
gt)
        else
          case Mask -> Word64Set -> StrictPair Word64Set Word64Set
go Mask
x Word64Set
r of
            (Word64Set
lt :*: Word64Set
gt) ->
              let !gt' :: Word64Set
gt' = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l Word64Set
gt
              in (Word64Set
lt, Word64Set
gt')
    Word64Set
_ -> case Mask -> Word64Set -> StrictPair Word64Set Word64Set
go Mask
x Word64Set
t of
          (Word64Set
lt :*: Word64Set
gt) -> (Word64Set
lt, Word64Set
gt)
  where
    go :: Mask -> Word64Set -> StrictPair Word64Set Word64Set
go !Mask
x' t' :: Word64Set
t'@(Bin Mask
p Mask
m Word64Set
l Word64Set
r)
        | Mask -> Mask -> Mask -> Bool
nomatch Mask
x' Mask
p Mask
m = if Mask
x' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then (Word64Set
Nil Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Word64Set
t') else (Word64Set
t' Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Word64Set
Nil)
        | Mask -> Mask -> Bool
zero Mask
x' Mask
m      = case Mask -> Word64Set -> StrictPair Word64Set Word64Set
go Mask
x' Word64Set
l of (Word64Set
lt :*: Word64Set
gt) -> Word64Set
lt Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
gt Word64Set
r
        | Bool
otherwise      = case Mask -> Word64Set -> StrictPair Word64Set Word64Set
go Mask
x' Word64Set
r of (Word64Set
lt :*: Word64Set
gt) -> Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l Word64Set
lt Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Word64Set
gt
    go Mask
x' t' :: Word64Set
t'@(Tip Mask
kx' Mask
bm)
        | Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
x'          = (Word64Set
Nil Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Word64Set
t')
          -- equivalent to kx' > prefixOf x'
        | Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask -> Mask
prefixOf Mask
x' = (Word64Set
t' Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Word64Set
Nil)
        | Bool
otherwise = Mask -> Mask -> Word64Set
tip Mask
kx' (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
lowerBitmap) Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Mask -> Mask -> Word64Set
tip Mask
kx' (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
higherBitmap)
            where lowerBitmap :: Mask
lowerBitmap = Mask -> Mask
bitmapOf Mask
x' Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1
                  higherBitmap :: Mask
higherBitmap = Mask -> Mask
forall a. Bits a => a -> a
complement (Mask
lowerBitmap Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
bitmapOf Mask
x')
    go Mask
_ Word64Set
Nil = (Word64Set
Nil Word64Set -> Word64Set -> StrictPair Word64Set Word64Set
forall a b. a -> b -> StrictPair a b
:*: Word64Set
Nil)

-- | \(O(\min(n,W))\). Performs a 'split' but also returns whether the pivot
-- element was found in the original set.
splitMember :: Key -> Word64Set -> (Word64Set,Bool,Word64Set)
splitMember :: Mask -> Word64Set -> (Word64Set, Bool, Word64Set)
splitMember Mask
x Word64Set
t =
  case Word64Set
t of
    Bin Mask
p Mask
m Word64Set
l Word64Set
r
      | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 ->
        if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 -- handle negative numbers.
        then
          case Mask -> Word64Set -> (Word64Set, Bool, Word64Set)
go Mask
x Word64Set
l of
            (Word64Set
lt, Bool
fnd, Word64Set
gt) ->
              let !lt' :: Word64Set
lt' = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
lt Word64Set
r
              in (Word64Set
lt', Bool
fnd, Word64Set
gt)
        else
          case Mask -> Word64Set -> (Word64Set, Bool, Word64Set)
go Mask
x Word64Set
r of
            (Word64Set
lt, Bool
fnd, Word64Set
gt) ->
              let !gt' :: Word64Set
gt' = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l Word64Set
gt
              in (Word64Set
lt, Bool
fnd, Word64Set
gt')
    Word64Set
_ -> Mask -> Word64Set -> (Word64Set, Bool, Word64Set)
go Mask
x Word64Set
t
  where
    go :: Mask -> Word64Set -> (Word64Set, Bool, Word64Set)
go Mask
x' t' :: Word64Set
t'@(Bin Mask
p Mask
m Word64Set
l Word64Set
r)
        | Mask -> Mask -> Mask -> Bool
nomatch Mask
x' Mask
p Mask
m = if Mask
x' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then (Word64Set
Nil, Bool
False, Word64Set
t') else (Word64Set
t', Bool
False, Word64Set
Nil)
        | Mask -> Mask -> Bool
zero Mask
x' Mask
m =
          case Mask -> Word64Set -> (Word64Set, Bool, Word64Set)
go Mask
x' Word64Set
l of
            (Word64Set
lt, Bool
fnd, Word64Set
gt) ->
              let !gt' :: Word64Set
gt' = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
gt Word64Set
r
              in (Word64Set
lt, Bool
fnd, Word64Set
gt')
        | Bool
otherwise =
          case Mask -> Word64Set -> (Word64Set, Bool, Word64Set)
go Mask
x' Word64Set
r of
            (Word64Set
lt, Bool
fnd, Word64Set
gt) ->
              let !lt' :: Word64Set
lt' = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l Word64Set
lt
              in (Word64Set
lt', Bool
fnd, Word64Set
gt)
    go Mask
x' t' :: Word64Set
t'@(Tip Mask
kx' Mask
bm)
        | Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
x'          = (Word64Set
Nil, Bool
False, Word64Set
t')
          -- equivalent to kx' > prefixOf x'
        | Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask -> Mask
prefixOf Mask
x' = (Word64Set
t', Bool
False, Word64Set
Nil)
        | Bool
otherwise = let !lt :: Word64Set
lt = Mask -> Mask -> Word64Set
tip Mask
kx' (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
lowerBitmap)
                          !found :: Bool
found = (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
bitmapOfx') Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0
                          !gt :: Word64Set
gt = Mask -> Mask -> Word64Set
tip Mask
kx' (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
higherBitmap)
                      in (Word64Set
lt, Bool
found, Word64Set
gt)
            where bitmapOfx' :: Mask
bitmapOfx' = Mask -> Mask
bitmapOf Mask
x'
                  lowerBitmap :: Mask
lowerBitmap = Mask
bitmapOfx' Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1
                  higherBitmap :: Mask
higherBitmap = Mask -> Mask
forall a. Bits a => a -> a
complement (Mask
lowerBitmap Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bitmapOfx')
    go Mask
_ Word64Set
Nil = (Word64Set
Nil, Bool
False, Word64Set
Nil)

{----------------------------------------------------------------------
  Min/Max
----------------------------------------------------------------------}

-- | \(O(\min(n,W))\). Retrieves the maximal key of the set, and the set
-- stripped of that element, or 'Nothing' if passed an empty set.
maxView :: Word64Set -> Maybe (Key, Word64Set)
maxView :: Word64Set -> Maybe (Mask, Word64Set)
maxView Word64Set
t =
  case Word64Set
t of Word64Set
Nil -> Maybe (Mask, Word64Set)
forall a. Maybe a
Nothing
            Bin Mask
p Mask
m Word64Set
l Word64Set
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> case Word64Set -> (Mask, Word64Set)
go Word64Set
l of (Mask
result, Word64Set
l') -> (Mask, Word64Set) -> Maybe (Mask, Word64Set)
forall a. a -> Maybe a
Just (Mask
result, Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l' Word64Set
r)
            Word64Set
_ -> (Mask, Word64Set) -> Maybe (Mask, Word64Set)
forall a. a -> Maybe a
Just (Word64Set -> (Mask, Word64Set)
go Word64Set
t)
  where
    go :: Word64Set -> (Mask, Word64Set)
go (Bin Mask
p Mask
m Word64Set
l Word64Set
r) = case Word64Set -> (Mask, Word64Set)
go Word64Set
r of (Mask
result, Word64Set
r') -> (Mask
result, Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l Word64Set
r')
    go (Tip Mask
kx Mask
bm) = case Mask -> Mask
highestBitSet Mask
bm of Mask
bi -> (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi, Mask -> Mask -> Word64Set
tip Mask
kx (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask -> Mask
forall a. Bits a => a -> a
complement (Mask -> Mask
bitmapOfSuffix Mask
bi)))
    go Word64Set
Nil = [Char] -> (Mask, Word64Set)
forall a. HasCallStack => [Char] -> a
error [Char]
"maxView Nil"

-- | \(O(\min(n,W))\). Retrieves the minimal key of the set, and the set
-- stripped of that element, or 'Nothing' if passed an empty set.
minView :: Word64Set -> Maybe (Key, Word64Set)
minView :: Word64Set -> Maybe (Mask, Word64Set)
minView Word64Set
t =
  case Word64Set
t of Word64Set
Nil -> Maybe (Mask, Word64Set)
forall a. Maybe a
Nothing
            Bin Mask
p Mask
m Word64Set
l Word64Set
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> case Word64Set -> (Mask, Word64Set)
go Word64Set
r of (Mask
result, Word64Set
r') -> (Mask, Word64Set) -> Maybe (Mask, Word64Set)
forall a. a -> Maybe a
Just (Mask
result, Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l Word64Set
r')
            Word64Set
_ -> (Mask, Word64Set) -> Maybe (Mask, Word64Set)
forall a. a -> Maybe a
Just (Word64Set -> (Mask, Word64Set)
go Word64Set
t)
  where
    go :: Word64Set -> (Mask, Word64Set)
go (Bin Mask
p Mask
m Word64Set
l Word64Set
r) = case Word64Set -> (Mask, Word64Set)
go Word64Set
l of (Mask
result, Word64Set
l') -> (Mask
result, Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
p Mask
m Word64Set
l' Word64Set
r)
    go (Tip Mask
kx Mask
bm) = case Mask -> Mask
lowestBitSet Mask
bm of Mask
bi -> (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi, Mask -> Mask -> Word64Set
tip Mask
kx (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask -> Mask
forall a. Bits a => a -> a
complement (Mask -> Mask
bitmapOfSuffix Mask
bi)))
    go Word64Set
Nil = [Char] -> (Mask, Word64Set)
forall a. HasCallStack => [Char] -> a
error [Char]
"minView Nil"

-- | \(O(\min(n,W))\). Delete and find the minimal element.
--
-- > deleteFindMin set = (findMin set, deleteMin set)
deleteFindMin :: Word64Set -> (Key, Word64Set)
deleteFindMin :: Word64Set -> (Mask, Word64Set)
deleteFindMin = (Mask, Word64Set) -> Maybe (Mask, Word64Set) -> (Mask, Word64Set)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Mask, Word64Set)
forall a. HasCallStack => [Char] -> a
error [Char]
"deleteFindMin: empty set has no minimal element") (Maybe (Mask, Word64Set) -> (Mask, Word64Set))
-> (Word64Set -> Maybe (Mask, Word64Set))
-> Word64Set
-> (Mask, Word64Set)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64Set -> Maybe (Mask, Word64Set)
minView

-- | \(O(\min(n,W))\). Delete and find the maximal element.
--
-- > deleteFindMax set = (findMax set, deleteMax set)
deleteFindMax :: Word64Set -> (Key, Word64Set)
deleteFindMax :: Word64Set -> (Mask, Word64Set)
deleteFindMax = (Mask, Word64Set) -> Maybe (Mask, Word64Set) -> (Mask, Word64Set)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Mask, Word64Set)
forall a. HasCallStack => [Char] -> a
error [Char]
"deleteFindMax: empty set has no maximal element") (Maybe (Mask, Word64Set) -> (Mask, Word64Set))
-> (Word64Set -> Maybe (Mask, Word64Set))
-> Word64Set
-> (Mask, Word64Set)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64Set -> Maybe (Mask, Word64Set)
maxView


-- | \(O(\min(n,W))\). The minimal element of the set.
findMin :: Word64Set -> Key
findMin :: Word64Set -> Mask
findMin Word64Set
Nil = [Char] -> Mask
forall a. HasCallStack => [Char] -> a
error [Char]
"findMin: empty set has no minimal element"
findMin (Tip Mask
kx Mask
bm) = Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
lowestBitSet Mask
bm
findMin (Bin Mask
_ Mask
m Word64Set
l Word64Set
r)
  |   Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0   = Word64Set -> Mask
find Word64Set
r
  | Bool
otherwise = Word64Set -> Mask
find Word64Set
l
    where find :: Word64Set -> Mask
find (Tip Mask
kx Mask
bm) = Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
lowestBitSet Mask
bm
          find (Bin Mask
_ Mask
_ Word64Set
l' Word64Set
_) = Word64Set -> Mask
find Word64Set
l'
          find Word64Set
Nil            = [Char] -> Mask
forall a. HasCallStack => [Char] -> a
error [Char]
"findMin Nil"

-- | \(O(\min(n,W))\). The maximal element of a set.
findMax :: Word64Set -> Key
findMax :: Word64Set -> Mask
findMax Word64Set
Nil = [Char] -> Mask
forall a. HasCallStack => [Char] -> a
error [Char]
"findMax: empty set has no maximal element"
findMax (Tip Mask
kx Mask
bm) = Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
highestBitSet Mask
bm
findMax (Bin Mask
_ Mask
m Word64Set
l Word64Set
r)
  |   Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0   = Word64Set -> Mask
find Word64Set
l
  | Bool
otherwise = Word64Set -> Mask
find Word64Set
r
    where find :: Word64Set -> Mask
find (Tip Mask
kx Mask
bm) = Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Mask
highestBitSet Mask
bm
          find (Bin Mask
_ Mask
_ Word64Set
_ Word64Set
r') = Word64Set -> Mask
find Word64Set
r'
          find Word64Set
Nil            = [Char] -> Mask
forall a. HasCallStack => [Char] -> a
error [Char]
"findMax Nil"


-- | \(O(\min(n,W))\). Delete the minimal element. Returns an empty set if the set is empty.
--
-- Note that this is a change of behaviour for consistency with 'Data.Set.Set' &#8211;
-- versions prior to 0.5 threw an error if the 'Word64Set' was already empty.
deleteMin :: Word64Set -> Word64Set
deleteMin :: Word64Set -> Word64Set
deleteMin = Word64Set
-> ((Mask, Word64Set) -> Word64Set)
-> Maybe (Mask, Word64Set)
-> Word64Set
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64Set
Nil (Mask, Word64Set) -> Word64Set
forall a b. (a, b) -> b
snd (Maybe (Mask, Word64Set) -> Word64Set)
-> (Word64Set -> Maybe (Mask, Word64Set)) -> Word64Set -> Word64Set
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64Set -> Maybe (Mask, Word64Set)
minView

-- | \(O(\min(n,W))\). Delete the maximal element. Returns an empty set if the set is empty.
--
-- Note that this is a change of behaviour for consistency with 'Data.Set.Set' &#8211;
-- versions prior to 0.5 threw an error if the 'Word64Set' was already empty.
deleteMax :: Word64Set -> Word64Set
deleteMax :: Word64Set -> Word64Set
deleteMax = Word64Set
-> ((Mask, Word64Set) -> Word64Set)
-> Maybe (Mask, Word64Set)
-> Word64Set
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64Set
Nil (Mask, Word64Set) -> Word64Set
forall a b. (a, b) -> b
snd (Maybe (Mask, Word64Set) -> Word64Set)
-> (Word64Set -> Maybe (Mask, Word64Set)) -> Word64Set -> Word64Set
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64Set -> Maybe (Mask, Word64Set)
maxView

{----------------------------------------------------------------------
  Map
----------------------------------------------------------------------}

-- | \(O(n \min(n,W))\).
-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
--
-- It's worth noting that the size of the result may be smaller if,
-- for some @(x,y)@, @x \/= y && f x == f y@

map :: (Key -> Key) -> Word64Set -> Word64Set
map :: (Mask -> Mask) -> Word64Set -> Word64Set
map Mask -> Mask
f = [Mask] -> Word64Set
fromList ([Mask] -> Word64Set)
-> (Word64Set -> [Mask]) -> Word64Set -> Word64Set
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mask -> Mask) -> [Mask] -> [Mask]
forall a b. (a -> b) -> [a] -> [b]
List.map Mask -> Mask
f ([Mask] -> [Mask]) -> (Word64Set -> [Mask]) -> Word64Set -> [Mask]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64Set -> [Mask]
toList

-- | \(O(n)\). The
--
-- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is strictly increasing.
-- /The precondition is not checked./
-- Semi-formally, we have:
--
-- > and [x < y ==> f x < f y | x <- ls, y <- ls]
-- >                     ==> mapMonotonic f s == map f s
-- >     where ls = toList s
--
-- @since 0.6.3.1

-- Note that for now the test is insufficient to support any fancier implementation.
mapMonotonic :: (Key -> Key) -> Word64Set -> Word64Set
mapMonotonic :: (Mask -> Mask) -> Word64Set -> Word64Set
mapMonotonic Mask -> Mask
f = [Mask] -> Word64Set
fromDistinctAscList ([Mask] -> Word64Set)
-> (Word64Set -> [Mask]) -> Word64Set -> Word64Set
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mask -> Mask) -> [Mask] -> [Mask]
forall a b. (a -> b) -> [a] -> [b]
List.map Mask -> Mask
f ([Mask] -> [Mask]) -> (Word64Set -> [Mask]) -> Word64Set -> [Mask]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64Set -> [Mask]
toAscList


{--------------------------------------------------------------------
  Fold
--------------------------------------------------------------------}
-- | \(O(n)\). Fold the elements in the set using the given right-associative
-- binary operator. This function is an equivalent of 'foldr' and is present
-- for compatibility only.
--
-- /Please note that fold will be deprecated in the future and removed./
fold :: (Key -> b -> b) -> b -> Word64Set -> b
fold :: forall b. (Mask -> b -> b) -> b -> Word64Set -> b
fold = (Mask -> b -> b) -> b -> Word64Set -> b
forall b. (Mask -> b -> b) -> b -> Word64Set -> b
foldr
{-# INLINE fold #-}

-- | \(O(n)\). Fold the elements in the set using the given right-associative
-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'toAscList'@.
--
-- For example,
--
-- > toAscList set = foldr (:) [] set
foldr :: (Key -> b -> b) -> b -> Word64Set -> b
foldr :: forall b. (Mask -> b -> b) -> b -> Word64Set -> b
foldr Mask -> b -> b
f b
z = \Word64Set
t ->      -- Use lambda t to be inlinable with two arguments only.
  case Word64Set
t of Bin Mask
_ Mask
m Word64Set
l Word64Set
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> b -> Word64Set -> b
go (b -> Word64Set -> b
go b
z Word64Set
l) Word64Set
r -- put negative numbers before
                        | Bool
otherwise -> b -> Word64Set -> b
go (b -> Word64Set -> b
go b
z Word64Set
r) Word64Set
l
            Word64Set
_ -> b -> Word64Set -> b
go b
z Word64Set
t
  where
    go :: b -> Word64Set -> b
go b
z' Word64Set
Nil           = b
z'
    go b
z' (Tip Mask
kx Mask
bm)   = Mask -> (Mask -> b -> b) -> b -> Mask -> b
forall a. Mask -> (Mask -> a -> a) -> a -> Mask -> a
foldrBits Mask
kx Mask -> b -> b
f b
z' Mask
bm
    go b
z' (Bin Mask
_ Mask
_ Word64Set
l Word64Set
r) = b -> Word64Set -> b
go (b -> Word64Set -> b
go b
z' Word64Set
r) Word64Set
l
{-# INLINE foldr #-}

-- | \(O(n)\). A strict version of 'foldr'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldr' :: (Key -> b -> b) -> b -> Word64Set -> b
foldr' :: forall b. (Mask -> b -> b) -> b -> Word64Set -> b
foldr' Mask -> b -> b
f b
z = \Word64Set
t ->      -- Use lambda t to be inlinable with two arguments only.
  case Word64Set
t of Bin Mask
_ Mask
m Word64Set
l Word64Set
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> b -> Word64Set -> b
go (b -> Word64Set -> b
go b
z Word64Set
l) Word64Set
r -- put negative numbers before
                        | Bool
otherwise -> b -> Word64Set -> b
go (b -> Word64Set -> b
go b
z Word64Set
r) Word64Set
l
            Word64Set
_ -> b -> Word64Set -> b
go b
z Word64Set
t
  where
    go :: b -> Word64Set -> b
go !b
z' Word64Set
Nil           = b
z'
    go b
z' (Tip Mask
kx Mask
bm)   = Mask -> (Mask -> b -> b) -> b -> Mask -> b
forall a. Mask -> (Mask -> a -> a) -> a -> Mask -> a
foldr'Bits Mask
kx Mask -> b -> b
f b
z' Mask
bm
    go b
z' (Bin Mask
_ Mask
_ Word64Set
l Word64Set
r) = b -> Word64Set -> b
go (b -> Word64Set -> b
go b
z' Word64Set
r) Word64Set
l
{-# INLINE foldr' #-}

-- | \(O(n)\). Fold the elements in the set using the given left-associative
-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'toAscList'@.
--
-- For example,
--
-- > toDescList set = foldl (flip (:)) [] set
foldl :: (a -> Key -> a) -> a -> Word64Set -> a
foldl :: forall a. (a -> Mask -> a) -> a -> Word64Set -> a
foldl a -> Mask -> a
f a
z = \Word64Set
t ->      -- Use lambda t to be inlinable with two arguments only.
  case Word64Set
t of Bin Mask
_ Mask
m Word64Set
l Word64Set
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> a -> Word64Set -> a
go (a -> Word64Set -> a
go a
z Word64Set
r) Word64Set
l -- put negative numbers before
                        | Bool
otherwise -> a -> Word64Set -> a
go (a -> Word64Set -> a
go a
z Word64Set
l) Word64Set
r
            Word64Set
_ -> a -> Word64Set -> a
go a
z Word64Set
t
  where
    go :: a -> Word64Set -> a
go a
z' Word64Set
Nil           = a
z'
    go a
z' (Tip Mask
kx Mask
bm)   = Mask -> (a -> Mask -> a) -> a -> Mask -> a
forall a. Mask -> (a -> Mask -> a) -> a -> Mask -> a
foldlBits Mask
kx a -> Mask -> a
f a
z' Mask
bm
    go a
z' (Bin Mask
_ Mask
_ Word64Set
l Word64Set
r) = a -> Word64Set -> a
go (a -> Word64Set -> a
go a
z' Word64Set
l) Word64Set
r
{-# INLINE foldl #-}

-- | \(O(n)\). A strict version of 'foldl'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldl' :: (a -> Key -> a) -> a -> Word64Set -> a
foldl' :: forall a. (a -> Mask -> a) -> a -> Word64Set -> a
foldl' a -> Mask -> a
f a
z = \Word64Set
t ->      -- Use lambda t to be inlinable with two arguments only.
  case Word64Set
t of Bin Mask
_ Mask
m Word64Set
l Word64Set
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> a -> Word64Set -> a
go (a -> Word64Set -> a
go a
z Word64Set
r) Word64Set
l -- put negative numbers before
                        | Bool
otherwise -> a -> Word64Set -> a
go (a -> Word64Set -> a
go a
z Word64Set
l) Word64Set
r
            Word64Set
_ -> a -> Word64Set -> a
go a
z Word64Set
t
  where
    go :: a -> Word64Set -> a
go !a
z' Word64Set
Nil           = a
z'
    go a
z' (Tip Mask
kx Mask
bm)   = Mask -> (a -> Mask -> a) -> a -> Mask -> a
forall a. Mask -> (a -> Mask -> a) -> a -> Mask -> a
foldl'Bits Mask
kx a -> Mask -> a
f a
z' Mask
bm
    go a
z' (Bin Mask
_ Mask
_ Word64Set
l Word64Set
r) = a -> Word64Set -> a
go (a -> Word64Set -> a
go a
z' Word64Set
l) Word64Set
r
{-# INLINE foldl' #-}

{--------------------------------------------------------------------
  List variations
--------------------------------------------------------------------}
-- | \(O(n)\). An alias of 'toAscList'. The elements of a set in ascending order.
-- Subject to list fusion.
elems :: Word64Set -> [Key]
elems :: Word64Set -> [Mask]
elems
  = Word64Set -> [Mask]
toAscList

{--------------------------------------------------------------------
  Lists
--------------------------------------------------------------------}

-- | @since 0.5.6.2
instance GHC.Exts.IsList Word64Set where
  type Item Word64Set = Key
  fromList :: [Item Word64Set] -> Word64Set
fromList = [Mask] -> Word64Set
[Item Word64Set] -> Word64Set
fromList
  toList :: Word64Set -> [Item Word64Set]
toList   = Word64Set -> [Mask]
Word64Set -> [Item Word64Set]
toList

-- | \(O(n)\). Convert the set to a list of elements. Subject to list fusion.
toList :: Word64Set -> [Key]
toList :: Word64Set -> [Mask]
toList
  = Word64Set -> [Mask]
toAscList

-- | \(O(n)\). Convert the set to an ascending list of elements. Subject to list
-- fusion.
toAscList :: Word64Set -> [Key]
toAscList :: Word64Set -> [Mask]
toAscList = (Mask -> [Mask] -> [Mask]) -> [Mask] -> Word64Set -> [Mask]
forall b. (Mask -> b -> b) -> b -> Word64Set -> b
foldr (:) []

-- | \(O(n)\). Convert the set to a descending list of elements. Subject to list
-- fusion.
toDescList :: Word64Set -> [Key]
toDescList :: Word64Set -> [Mask]
toDescList = ([Mask] -> Mask -> [Mask]) -> [Mask] -> Word64Set -> [Mask]
forall a. (a -> Mask -> a) -> a -> Word64Set -> a
foldl ((Mask -> [Mask] -> [Mask]) -> [Mask] -> Mask -> [Mask]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

-- List fusion for the list generating functions.
-- The foldrFB and foldlFB are foldr and foldl equivalents, used for list fusion.
-- They are important to convert unfused to{Asc,Desc}List back, see mapFB in prelude.
foldrFB :: (Key -> b -> b) -> b -> Word64Set -> b
foldrFB :: forall b. (Mask -> b -> b) -> b -> Word64Set -> b
foldrFB = (Mask -> b -> b) -> b -> Word64Set -> b
forall b. (Mask -> b -> b) -> b -> Word64Set -> b
foldr
{-# INLINE[0] foldrFB #-}
foldlFB :: (a -> Key -> a) -> a -> Word64Set -> a
foldlFB :: forall a. (a -> Mask -> a) -> a -> Word64Set -> a
foldlFB = (a -> Mask -> a) -> a -> Word64Set -> a
forall a. (a -> Mask -> a) -> a -> Word64Set -> a
foldl
{-# INLINE[0] foldlFB #-}

-- Inline elems and toList, so that we need to fuse only toAscList.
{-# INLINE elems #-}
{-# INLINE toList #-}

-- The fusion is enabled up to phase 2 included. If it does not succeed,
-- convert in phase 1 the expanded to{Asc,Desc}List calls back to
-- to{Asc,Desc}List.  In phase 0, we inline fold{lr}FB (which were used in
-- a list fusion, otherwise it would go away in phase 1), and let compiler do
-- whatever it wants with to{Asc,Desc}List -- it was forbidden to inline it
-- before phase 0, otherwise the fusion rules would not fire at all.
{-# NOINLINE[0] toAscList #-}
{-# NOINLINE[0] toDescList #-}
{-# RULES "Word64Set.toAscList" [~1] forall s . toAscList s = GHC.Exts.build (\c n -> foldrFB c n s) #-}
{-# RULES "Word64Set.toAscListBack" [1] foldrFB (:) [] = toAscList #-}
{-# RULES "Word64Set.toDescList" [~1] forall s . toDescList s = GHC.Exts.build (\c n -> foldlFB (\xs x -> c x xs) n s) #-}
{-# RULES "Word64Set.toDescListBack" [1] foldlFB (\xs x -> x : xs) [] = toDescList #-}


-- | \(O(n \min(n,W))\). Create a set from a list of integers.
{-# INLINABLE fromList #-}
fromList :: [Key] -> Word64Set
fromList :: [Mask] -> Word64Set
fromList = (Word64Set -> Mask -> Word64Set)
-> Word64Set -> [Mask] -> Word64Set
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Word64Set -> Mask -> Word64Set
ins Word64Set
empty
  where
    ins :: Word64Set -> Mask -> Word64Set
ins Word64Set
t Mask
x  = Mask -> Word64Set -> Word64Set
insert Mask
x Word64Set
t

-- | \(O(n)\). Build a set from an ascending list of elements.
-- /The precondition (input list is ascending) is not checked./
fromAscList :: [Key] -> Word64Set
fromAscList :: [Mask] -> Word64Set
fromAscList = [Mask] -> Word64Set
fromMonoList
{-# NOINLINE fromAscList #-}

-- | \(O(n)\). Build a set from an ascending list of distinct elements.
-- /The precondition (input list is strictly ascending) is not checked./
fromDistinctAscList :: [Key] -> Word64Set
fromDistinctAscList :: [Mask] -> Word64Set
fromDistinctAscList = [Mask] -> Word64Set
fromAscList
{-# INLINE fromDistinctAscList #-}

-- | \(O(n)\). Build a set from a monotonic list of elements.
--
-- The precise conditions under which this function works are subtle:
-- For any branch mask, keys with the same prefix w.r.t. the branch
-- mask must occur consecutively in the list.
fromMonoList :: [Key] -> Word64Set
fromMonoList :: [Mask] -> Word64Set
fromMonoList []         = Word64Set
Nil
fromMonoList (Mask
kx : [Mask]
zs1) = Mask -> Mask -> [Mask] -> Word64Set
addAll' (Mask -> Mask
prefixOf Mask
kx) (Mask -> Mask
bitmapOf Mask
kx) [Mask]
zs1
  where
    -- `addAll'` collects all keys with the prefix `px` into a single
    -- bitmap, and then proceeds with `addAll`.
    addAll' :: Mask -> Mask -> [Mask] -> Word64Set
addAll' !Mask
px !Mask
bm []
        = Mask -> Mask -> Word64Set
Tip Mask
px Mask
bm
    addAll' !Mask
px !Mask
bm (Mask
ky : [Mask]
zs)
        | Mask
px Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask -> Mask
prefixOf Mask
ky
        = Mask -> Mask -> [Mask] -> Word64Set
addAll' Mask
px (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. Mask -> Mask
bitmapOf Mask
ky) [Mask]
zs
        -- inlined: | otherwise = addAll px (Tip px bm) (ky : zs)
        | Mask
py <- Mask -> Mask
prefixOf Mask
ky
        , Mask
m <- Mask -> Mask -> Mask
branchMask Mask
px Mask
py
        , Inserted Word64Set
ty [Mask]
zs' <- Mask -> Mask -> Mask -> [Mask] -> Inserted
addMany' Mask
m Mask
py (Mask -> Mask
bitmapOf Mask
ky) [Mask]
zs
        = Mask -> Word64Set -> [Mask] -> Word64Set
addAll Mask
px (Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
linkWithMask Mask
m Mask
py Word64Set
ty {-px-} (Mask -> Mask -> Word64Set
Tip Mask
px Mask
bm)) [Mask]
zs'

    -- for `addAll` and `addMany`, px is /a/ prefix inside the tree `tx`
    -- `addAll` consumes the rest of the list, adding to the tree `tx`
    addAll :: Mask -> Word64Set -> [Mask] -> Word64Set
addAll !Mask
_px !Word64Set
tx []
        = Word64Set
tx
    addAll !Mask
px !Word64Set
tx (Mask
ky : [Mask]
zs)
        | Mask
py <- Mask -> Mask
prefixOf Mask
ky
        , Mask
m <- Mask -> Mask -> Mask
branchMask Mask
px Mask
py
        , Inserted Word64Set
ty [Mask]
zs' <- Mask -> Mask -> Mask -> [Mask] -> Inserted
addMany' Mask
m Mask
py (Mask -> Mask
bitmapOf Mask
ky) [Mask]
zs
        = Mask -> Word64Set -> [Mask] -> Word64Set
addAll Mask
px (Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
linkWithMask Mask
m Mask
py Word64Set
ty {-px-} Word64Set
tx) [Mask]
zs'

    -- `addMany'` is similar to `addAll'`, but proceeds with `addMany'`.
    addMany' :: Mask -> Mask -> Mask -> [Mask] -> Inserted
addMany' !Mask
_m !Mask
px !Mask
bm []
        = Word64Set -> [Mask] -> Inserted
Inserted (Mask -> Mask -> Word64Set
Tip Mask
px Mask
bm) []
    addMany' !Mask
m !Mask
px !Mask
bm zs0 :: [Mask]
zs0@(Mask
ky : [Mask]
zs)
        | Mask
px Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask -> Mask
prefixOf Mask
ky
        = Mask -> Mask -> Mask -> [Mask] -> Inserted
addMany' Mask
m Mask
px (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. Mask -> Mask
bitmapOf Mask
ky) [Mask]
zs
        -- inlined: | otherwise = addMany m px (Tip px bm) (ky : zs)
        | Mask -> Mask -> Mask
mask Mask
px Mask
m Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask -> Mask -> Mask
mask Mask
ky Mask
m
        = Word64Set -> [Mask] -> Inserted
Inserted (Mask -> Mask -> Word64Set
Tip (Mask -> Mask
prefixOf Mask
px) Mask
bm) [Mask]
zs0
        | Mask
py <- Mask -> Mask
prefixOf Mask
ky
        , Mask
mxy <- Mask -> Mask -> Mask
branchMask Mask
px Mask
py
        , Inserted Word64Set
ty [Mask]
zs' <- Mask -> Mask -> Mask -> [Mask] -> Inserted
addMany' Mask
mxy Mask
py (Mask -> Mask
bitmapOf Mask
ky) [Mask]
zs
        = Mask -> Mask -> Word64Set -> [Mask] -> Inserted
addMany Mask
m Mask
px (Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
linkWithMask Mask
mxy Mask
py Word64Set
ty {-px-} (Mask -> Mask -> Word64Set
Tip Mask
px Mask
bm)) [Mask]
zs'

    -- `addAll` adds to `tx` all keys whose prefix w.r.t. `m` agrees with `px`.
    addMany :: Mask -> Mask -> Word64Set -> [Mask] -> Inserted
addMany !Mask
_m !Mask
_px Word64Set
tx []
        = Word64Set -> [Mask] -> Inserted
Inserted Word64Set
tx []
    addMany !Mask
m !Mask
px Word64Set
tx zs0 :: [Mask]
zs0@(Mask
ky : [Mask]
zs)
        | Mask -> Mask -> Mask
mask Mask
px Mask
m Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask -> Mask -> Mask
mask Mask
ky Mask
m
        = Word64Set -> [Mask] -> Inserted
Inserted Word64Set
tx [Mask]
zs0
        | Mask
py <- Mask -> Mask
prefixOf Mask
ky
        , Mask
mxy <- Mask -> Mask -> Mask
branchMask Mask
px Mask
py
        , Inserted Word64Set
ty [Mask]
zs' <- Mask -> Mask -> Mask -> [Mask] -> Inserted
addMany' Mask
mxy Mask
py (Mask -> Mask
bitmapOf Mask
ky) [Mask]
zs
        = Mask -> Mask -> Word64Set -> [Mask] -> Inserted
addMany Mask
m Mask
px (Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
linkWithMask Mask
mxy Mask
py Word64Set
ty {-px-} Word64Set
tx) [Mask]
zs'
{-# INLINE fromMonoList #-}

data Inserted = Inserted !Word64Set ![Key]

{--------------------------------------------------------------------
  Eq
--------------------------------------------------------------------}
instance Eq Word64Set where
  Word64Set
t1 == :: Word64Set -> Word64Set -> Bool
== Word64Set
t2  = Word64Set -> Word64Set -> Bool
equal Word64Set
t1 Word64Set
t2
  Word64Set
t1 /= :: Word64Set -> Word64Set -> Bool
/= Word64Set
t2  = Word64Set -> Word64Set -> Bool
nequal Word64Set
t1 Word64Set
t2

equal :: Word64Set -> Word64Set -> Bool
equal :: Word64Set -> Word64Set -> Bool
equal (Bin Mask
p1 Mask
m1 Word64Set
l1 Word64Set
r1) (Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2)
  = (Mask
m1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
m2) Bool -> Bool -> Bool
&& (Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2) Bool -> Bool -> Bool
&& (Word64Set -> Word64Set -> Bool
equal Word64Set
l1 Word64Set
l2) Bool -> Bool -> Bool
&& (Word64Set -> Word64Set -> Bool
equal Word64Set
r1 Word64Set
r2)
equal (Tip Mask
kx1 Mask
bm1) (Tip Mask
kx2 Mask
bm2)
  = Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 Bool -> Bool -> Bool
&& Mask
bm1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
bm2
equal Word64Set
Nil Word64Set
Nil = Bool
True
equal Word64Set
_   Word64Set
_   = Bool
False

nequal :: Word64Set -> Word64Set -> Bool
nequal :: Word64Set -> Word64Set -> Bool
nequal (Bin Mask
p1 Mask
m1 Word64Set
l1 Word64Set
r1) (Bin Mask
p2 Mask
m2 Word64Set
l2 Word64Set
r2)
  = (Mask
m1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
m2) Bool -> Bool -> Bool
|| (Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
p2) Bool -> Bool -> Bool
|| (Word64Set -> Word64Set -> Bool
nequal Word64Set
l1 Word64Set
l2) Bool -> Bool -> Bool
|| (Word64Set -> Word64Set -> Bool
nequal Word64Set
r1 Word64Set
r2)
nequal (Tip Mask
kx1 Mask
bm1) (Tip Mask
kx2 Mask
bm2)
  = Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
kx2 Bool -> Bool -> Bool
|| Mask
bm1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
bm2
nequal Word64Set
Nil Word64Set
Nil = Bool
False
nequal Word64Set
_   Word64Set
_   = Bool
True

{--------------------------------------------------------------------
  Ord
--------------------------------------------------------------------}

instance Ord Word64Set where
    compare :: Word64Set -> Word64Set -> Ordering
compare Word64Set
s1 Word64Set
s2 = [Mask] -> [Mask] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word64Set -> [Mask]
toAscList Word64Set
s1) (Word64Set -> [Mask]
toAscList Word64Set
s2)
    -- tentative implementation. See if more efficient exists.

{--------------------------------------------------------------------
  Show
--------------------------------------------------------------------}
instance Show Word64Set where
  showsPrec :: Int -> Word64Set -> ShowS
showsPrec Int
p Word64Set
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    [Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mask] -> ShowS
forall a. Show a => a -> ShowS
shows (Word64Set -> [Mask]
toList Word64Set
xs)

{--------------------------------------------------------------------
  Read
--------------------------------------------------------------------}
instance Read Word64Set where
  readPrec :: ReadPrec Word64Set
readPrec = ReadPrec Word64Set -> ReadPrec Word64Set
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec Word64Set -> ReadPrec Word64Set)
-> ReadPrec Word64Set -> ReadPrec Word64Set
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec Word64Set -> ReadPrec Word64Set
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec Word64Set -> ReadPrec Word64Set)
-> ReadPrec Word64Set -> ReadPrec Word64Set
forall a b. (a -> b) -> a -> b
$ do
    Ident "fromList" <- ReadPrec Lexeme
lexP
    xs <- readPrec
    return (fromList xs)

  readListPrec :: ReadPrec [Word64Set]
readListPrec = ReadPrec [Word64Set]
forall a. Read a => ReadPrec [a]
readListPrecDefault

{--------------------------------------------------------------------
  NFData
--------------------------------------------------------------------}

-- The Word64Set constructors consist only of strict fields of Ints and
-- Word64Sets, thus the default NFData instance which evaluates to whnf
-- should suffice
instance NFData Word64Set where rnf :: Word64Set -> ()
rnf Word64Set
x = Word64Set -> () -> ()
forall a b. a -> b -> b
seq Word64Set
x ()

{--------------------------------------------------------------------
  Debugging
--------------------------------------------------------------------}
-- | \(O(n \min(n,W))\). Show the tree that implements the set. The tree is shown
-- in a compressed, hanging format.
showTree :: Word64Set -> String
showTree :: Word64Set -> [Char]
showTree Word64Set
s
  = Bool -> Bool -> Word64Set -> [Char]
showTreeWith Bool
True Bool
False Word64Set
s


{- | \(O(n \min(n,W))\). The expression (@'showTreeWith' hang wide map@) shows
 the tree that implements the set. If @hang@ is
 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
 @wide@ is 'True', an extra wide version is shown.
-}
showTreeWith :: Bool -> Bool -> Word64Set -> String
showTreeWith :: Bool -> Bool -> Word64Set -> [Char]
showTreeWith Bool
hang Bool
wide Word64Set
t
  | Bool
hang      = (Bool -> [[Char]] -> Word64Set -> ShowS
showsTreeHang Bool
wide [] Word64Set
t) [Char]
""
  | Bool
otherwise = (Bool -> [[Char]] -> [[Char]] -> Word64Set -> ShowS
showsTree Bool
wide [] [] Word64Set
t) [Char]
""

showsTree :: Bool -> [String] -> [String] -> Word64Set -> ShowS
showsTree :: Bool -> [[Char]] -> [[Char]] -> Word64Set -> ShowS
showsTree Bool
wide [[Char]]
lbars [[Char]]
rbars Word64Set
t
  = case Word64Set
t of
      Bin Mask
p Mask
m Word64Set
l Word64Set
r
          -> Bool -> [[Char]] -> [[Char]] -> Word64Set -> ShowS
showsTree Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
rbars) ([[Char]] -> [[Char]]
withEmpty [[Char]]
rbars) Word64Set
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
rbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString (Mask -> Mask -> [Char]
showBin Mask
p Mask
m) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> [[Char]] -> Word64Set -> ShowS
showsTree Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
lbars) ([[Char]] -> [[Char]]
withBar [[Char]]
lbars) Word64Set
l
      Tip Mask
kx Mask
bm
          -> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mask -> ShowS
forall a. Show a => a -> ShowS
shows Mask
kx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" + " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                Mask -> ShowS
showsBitMap Mask
bm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
      Word64Set
Nil -> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"

showsTreeHang :: Bool -> [String] -> Word64Set -> ShowS
showsTreeHang :: Bool -> [[Char]] -> Word64Set -> ShowS
showsTreeHang Bool
wide [[Char]]
bars Word64Set
t
  = case Word64Set
t of
      Bin Mask
p Mask
m Word64Set
l Word64Set
r
          -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString (Mask -> Mask -> [Char]
showBin Mask
p Mask
m) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> Word64Set -> ShowS
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
bars) Word64Set
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> Word64Set -> ShowS
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
bars) Word64Set
r
      Tip Mask
kx Mask
bm
          -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mask -> ShowS
forall a. Show a => a -> ShowS
shows Mask
kx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" + " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                               Mask -> ShowS
showsBitMap Mask
bm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
      Word64Set
Nil -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"

showBin :: Prefix -> Mask -> String
showBin :: Mask -> Mask -> [Char]
showBin Mask
_ Mask
_
  = [Char]
"*" -- ++ show (p,m)

showWide :: Bool -> [String] -> String -> String
showWide :: Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
bars
  | Bool
wide      = [Char] -> ShowS
showString ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
bars)) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"
  | Bool
otherwise = ShowS
forall a. a -> a
id

showsBars :: [String] -> ShowS
showsBars :: [[Char]] -> ShowS
showsBars [] = ShowS
forall a. a -> a
id
showsBars ([Char]
_ : [[Char]]
tl) = [Char] -> ShowS
showString ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
tl)) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
node

showsBitMap :: Word64 -> ShowS
showsBitMap :: Mask -> ShowS
showsBitMap = [Char] -> ShowS
showString ([Char] -> ShowS) -> (Mask -> [Char]) -> Mask -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mask -> [Char]
showBitMap

showBitMap :: Word64 -> String
showBitMap :: Mask -> [Char]
showBitMap Mask
w = [Mask] -> [Char]
forall a. Show a => a -> [Char]
show ([Mask] -> [Char]) -> [Mask] -> [Char]
forall a b. (a -> b) -> a -> b
$ Mask -> (Mask -> [Mask] -> [Mask]) -> [Mask] -> Mask -> [Mask]
forall a. Mask -> (Mask -> a -> a) -> a -> Mask -> a
foldrBits Mask
0 (:) [] Mask
w

node :: String
node :: [Char]
node           = [Char]
"+--"

withBar, withEmpty :: [String] -> [String]
withBar :: [[Char]] -> [[Char]]
withBar [[Char]]
bars   = [Char]
"|  "[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
bars
withEmpty :: [[Char]] -> [[Char]]
withEmpty [[Char]]
bars = [Char]
"   "[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
bars


{--------------------------------------------------------------------
  Helpers
--------------------------------------------------------------------}
{--------------------------------------------------------------------
  Link
--------------------------------------------------------------------}
link :: Prefix -> Word64Set -> Prefix -> Word64Set -> Word64Set
link :: Mask -> Word64Set -> Mask -> Word64Set -> Word64Set
link Mask
p1 Word64Set
t1 Mask
p2 Word64Set
t2 = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
linkWithMask (Mask -> Mask -> Mask
branchMask Mask
p1 Mask
p2) Mask
p1 Word64Set
t1 {-p2-} Word64Set
t2
{-# INLINE link #-}

-- `linkWithMask` is useful when the `branchMask` has already been computed
linkWithMask :: Mask -> Prefix -> Word64Set -> Word64Set -> Word64Set
linkWithMask :: Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
linkWithMask Mask
m Mask
p1 Word64Set
t1 {-p2-} Word64Set
t2
  | Mask -> Mask -> Bool
zero Mask
p1 Mask
m = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
Bin Mask
p Mask
m Word64Set
t1 Word64Set
t2
  | Bool
otherwise = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
Bin Mask
p Mask
m Word64Set
t2 Word64Set
t1
  where
    p :: Mask
p = Mask -> Mask -> Mask
mask Mask
p1 Mask
m
{-# INLINE linkWithMask #-}

{--------------------------------------------------------------------
  @bin@ assures that we never have empty trees within a tree.
--------------------------------------------------------------------}
bin :: Prefix -> Mask -> Word64Set -> Word64Set -> Word64Set
bin :: Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
bin Mask
_ Mask
_ Word64Set
l Word64Set
Nil = Word64Set
l
bin Mask
_ Mask
_ Word64Set
Nil Word64Set
r = Word64Set
r
bin Mask
p Mask
m Word64Set
l Word64Set
r   = Mask -> Mask -> Word64Set -> Word64Set -> Word64Set
Bin Mask
p Mask
m Word64Set
l Word64Set
r
{-# INLINE bin #-}

{--------------------------------------------------------------------
  @tip@ assures that we never have empty bitmaps within a tree.
--------------------------------------------------------------------}
tip :: Prefix -> BitMap -> Word64Set
tip :: Mask -> Mask -> Word64Set
tip Mask
_ Mask
0 = Word64Set
Nil
tip Mask
kx Mask
bm = Mask -> Mask -> Word64Set
Tip Mask
kx Mask
bm
{-# INLINE tip #-}


{----------------------------------------------------------------------
  Functions that generate Prefix and BitMap of a Key or a Suffix.
----------------------------------------------------------------------}

suffixBitMask :: Word64
suffixBitMask :: Mask
suffixBitMask = Int -> Mask
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Mask -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Mask
forall a. HasCallStack => a
undefined::Word64)) Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1
{-# INLINE suffixBitMask #-}

prefixBitMask :: Word64
prefixBitMask :: Mask
prefixBitMask = Mask -> Mask
forall a. Bits a => a -> a
complement Mask
suffixBitMask
{-# INLINE prefixBitMask #-}

prefixOf :: Word64 -> Prefix
prefixOf :: Mask -> Mask
prefixOf Mask
x = Mask
x Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
prefixBitMask
{-# INLINE prefixOf #-}

suffixOf :: Word64 -> Word64
suffixOf :: Mask -> Mask
suffixOf Mask
x = Mask
x Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
suffixBitMask
{-# INLINE suffixOf #-}

bitmapOfSuffix :: Word64 -> BitMap
bitmapOfSuffix :: Mask -> Mask
bitmapOfSuffix Mask
s = Mask
1 Mask -> Int -> Mask
`shiftLL` Mask -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Mask
s
{-# INLINE bitmapOfSuffix #-}

bitmapOf :: Word64 -> BitMap
bitmapOf :: Mask -> Mask
bitmapOf Mask
x = Mask -> Mask
bitmapOfSuffix (Mask -> Mask
suffixOf Mask
x)
{-# INLINE bitmapOf #-}


{--------------------------------------------------------------------
  Endian independent bit twiddling
--------------------------------------------------------------------}
-- Returns True iff the bits set in i and the Mask m are disjoint.
zero :: Word64 -> Mask -> Bool
zero :: Mask -> Mask -> Bool
zero Mask
i Mask
m
  = (Mask -> Mask
natFromInt Mask
i) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. (Mask -> Mask
natFromInt Mask
m) Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
0
{-# INLINE zero #-}

nomatch,match :: Word64 -> Prefix -> Mask -> Bool
nomatch :: Mask -> Mask -> Mask -> Bool
nomatch Mask
i Mask
p Mask
m
  = (Mask -> Mask -> Mask
mask Mask
i Mask
m) Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
p
{-# INLINE nomatch #-}

match :: Mask -> Mask -> Mask -> Bool
match Mask
i Mask
p Mask
m
  = (Mask -> Mask -> Mask
mask Mask
i Mask
m) Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p
{-# INLINE match #-}

-- Suppose a is largest such that 2^a divides 2*m.
-- Then mask i m is i with the low a bits zeroed out.
mask :: Word64 -> Mask -> Prefix
mask :: Mask -> Mask -> Mask
mask Mask
i Mask
m
  = Mask -> Mask -> Mask
maskW (Mask -> Mask
natFromInt Mask
i) (Mask -> Mask
natFromInt Mask
m)
{-# INLINE mask #-}

{--------------------------------------------------------------------
  Big endian operations
--------------------------------------------------------------------}
maskW :: Nat -> Nat -> Prefix
maskW :: Mask -> Mask -> Mask
maskW Mask
i Mask
m
  = Mask -> Mask
intFromNat (Mask
i Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. (Mask -> Mask
forall a. Bits a => a -> a
complement (Mask
mMask -> Mask -> Mask
forall a. Num a => a -> a -> a
-Mask
1) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask
m))
{-# INLINE maskW #-}

shorter :: Mask -> Mask -> Bool
shorter :: Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2
  = (Mask -> Mask
natFromInt Mask
m1) Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> (Mask -> Mask
natFromInt Mask
m2)
{-# INLINE shorter #-}

branchMask :: Prefix -> Prefix -> Mask
branchMask :: Mask -> Mask -> Mask
branchMask Mask
p1 Mask
p2
  = Mask -> Mask
intFromNat (Mask -> Mask
highestBitMask (Mask -> Mask
natFromInt Mask
p1 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask -> Mask
natFromInt Mask
p2))
{-# INLINE branchMask #-}

{----------------------------------------------------------------------
  To get best performance, we provide fast implementations of
  lowestBitSet, highestBitSet and fold[lr][l]Bits for GHC.
  If the intel bsf and bsr instructions ever become GHC primops,
  this code should be reimplemented using these.

  Performance of this code is crucial for folds, toList, filter, partition.

  The signatures of methods in question are placed after this comment.
----------------------------------------------------------------------}

lowestBitSet :: Nat -> Word64
highestBitSet :: Nat -> Word64
foldlBits :: Word64 -> (a -> Word64 -> a) -> a -> Nat -> a
foldl'Bits :: Word64 -> (a -> Word64 -> a) -> a -> Nat -> a
foldrBits :: Word64 -> (Word64 -> a -> a) -> a -> Nat -> a
foldr'Bits :: Word64 -> (Word64 -> a -> a) -> a -> Nat -> a
takeWhileAntitoneBits :: Word64 -> (Word64 -> Bool) -> Nat -> Nat

{-# INLINE lowestBitSet #-}
{-# INLINE highestBitSet #-}
{-# INLINE foldlBits #-}
{-# INLINE foldl'Bits #-}
{-# INLINE foldrBits #-}
{-# INLINE foldr'Bits #-}
{-# INLINE takeWhileAntitoneBits #-}

indexOfTheOnlyBit :: Nat -> Word64
{-# INLINE indexOfTheOnlyBit #-}
indexOfTheOnlyBit :: Mask -> Mask
indexOfTheOnlyBit Mask
bitmask = Int -> Mask
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Mask) -> Int -> Mask
forall a b. (a -> b) -> a -> b
$ Mask -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Mask
bitmask

lowestBitSet :: Mask -> Mask
lowestBitSet Mask
x = Int -> Mask
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Mask) -> Int -> Mask
forall a b. (a -> b) -> a -> b
$ Mask -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Mask
x

highestBitSet :: Mask -> Mask
highestBitSet Mask
x = Int -> Mask
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Mask) -> Int -> Mask
forall a b. (a -> b) -> a -> b
$ Int
63 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Mask -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Mask
x

lowestBitMask :: Nat -> Nat
lowestBitMask :: Mask -> Mask
lowestBitMask Mask
x = Mask
x Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask -> Mask
forall a. Num a => a -> a
negate Mask
x
{-# INLINE lowestBitMask #-}

-- Reverse the order of bits in the Nat.
revNat :: Nat -> Nat
revNat :: Mask -> Mask
revNat Mask
x1 = case ((Mask
x1 Mask -> Int -> Mask
`shiftRL` Int
1) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x5555555555555555) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. ((Mask
x1 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x5555555555555555) Mask -> Int -> Mask
`shiftLL` Int
1) of
              Mask
x2 -> case ((Mask
x2 Mask -> Int -> Mask
`shiftRL` Int
2) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x3333333333333333) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. ((Mask
x2 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x3333333333333333) Mask -> Int -> Mask
`shiftLL` Int
2) of
                 Mask
x3 -> case ((Mask
x3 Mask -> Int -> Mask
`shiftRL` Int
4) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x0F0F0F0F0F0F0F0F) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. ((Mask
x3 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x0F0F0F0F0F0F0F0F) Mask -> Int -> Mask
`shiftLL` Int
4) of
                   Mask
x4 -> case ((Mask
x4 Mask -> Int -> Mask
`shiftRL` Int
8) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x00FF00FF00FF00FF) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. ((Mask
x4 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x00FF00FF00FF00FF) Mask -> Int -> Mask
`shiftLL` Int
8) of
                     Mask
x5 -> case ((Mask
x5 Mask -> Int -> Mask
`shiftRL` Int
16) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x0000FFFF0000FFFF) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. ((Mask
x5 Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x0000FFFF0000FFFF) Mask -> Int -> Mask
`shiftLL` Int
16) of
                       Mask
x6 -> ( Mask
x6 Mask -> Int -> Mask
`shiftRL` Int
32             ) Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.|. ( Mask
x6               Mask -> Int -> Mask
`shiftLL` Int
32);

foldlBits :: forall a. Mask -> (a -> Mask -> a) -> a -> Mask -> a
foldlBits Mask
prefix a -> Mask -> a
f a
z Mask
bitmap = Mask -> a -> a
go Mask
bitmap a
z
  where go :: Mask -> a -> a
go Mask
0 a
acc = a
acc
        go Mask
bm a
acc = Mask -> a -> a
go (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask
bitmask) ((a -> Mask -> a
f a
acc) (Mask -> a) -> Mask -> a
forall a b. (a -> b) -> a -> b
$! (Mask
prefixMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
bi))
          where
            !bitmask :: Mask
bitmask = Mask -> Mask
lowestBitMask Mask
bm
            !bi :: Mask
bi = Mask -> Mask
indexOfTheOnlyBit Mask
bitmask

foldl'Bits :: forall a. Mask -> (a -> Mask -> a) -> a -> Mask -> a
foldl'Bits Mask
prefix a -> Mask -> a
f a
z Mask
bitmap = Mask -> a -> a
go Mask
bitmap a
z
  where go :: Mask -> a -> a
go Mask
0 a
acc = a
acc
        go Mask
bm !a
acc = Mask -> a -> a
go (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask
bitmask) ((a -> Mask -> a
f a
acc) (Mask -> a) -> Mask -> a
forall a b. (a -> b) -> a -> b
$! (Mask
prefixMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
bi))
          where !bitmask :: Mask
bitmask = Mask -> Mask
lowestBitMask Mask
bm
                !bi :: Mask
bi = Mask -> Mask
indexOfTheOnlyBit Mask
bitmask

foldrBits :: forall a. Mask -> (Mask -> a -> a) -> a -> Mask -> a
foldrBits Mask
prefix Mask -> a -> a
f a
z Mask
bitmap = Mask -> a -> a
go (Mask -> Mask
revNat Mask
bitmap) a
z
  where go :: Mask -> a -> a
go Mask
0 a
acc = a
acc
        go Mask
bm a
acc = Mask -> a -> a
go (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask
bitmask) ((Mask -> a -> a
f (Mask -> a -> a) -> Mask -> a -> a
forall a b. (a -> b) -> a -> b
$! (Mask
prefixMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
63Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
-Mask
bi)) a
acc)
          where !bitmask :: Mask
bitmask = Mask -> Mask
lowestBitMask Mask
bm
                !bi :: Mask
bi = Mask -> Mask
indexOfTheOnlyBit Mask
bitmask


foldr'Bits :: forall a. Mask -> (Mask -> a -> a) -> a -> Mask -> a
foldr'Bits Mask
prefix Mask -> a -> a
f a
z Mask
bitmap = Mask -> a -> a
go (Mask -> Mask
revNat Mask
bitmap) a
z
  where go :: Mask -> a -> a
go Mask
0 a
acc = a
acc
        go Mask
bm !a
acc = Mask -> a -> a
go (Mask
bm Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
`xor` Mask
bitmask) ((Mask -> a -> a
f (Mask -> a -> a) -> Mask -> a -> a
forall a b. (a -> b) -> a -> b
$! (Mask
prefixMask -> Mask -> Mask
forall a. Num a => a -> a -> a
+Mask
63Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
-Mask
bi)) a
acc)
          where !bitmask :: Mask
bitmask = Mask -> Mask
lowestBitMask Mask
bm
                !bi :: Mask
bi = Mask -> Mask
indexOfTheOnlyBit Mask
bitmask

takeWhileAntitoneBits :: Mask -> (Mask -> Bool) -> Mask -> Mask
takeWhileAntitoneBits Mask
prefix Mask -> Bool
predicate Mask
bitmap =
  -- Binary search for the first index where the predicate returns false, but skip a predicate
  -- call if the high half of the current range is empty. This ensures
  -- min (log2 64 + 1 = 7) (popcount bitmap) predicate calls.
  let next :: Int -> Mask -> (Mask, Int) -> (Mask, Int)
next Int
d Mask
h (Mask
n',Int
b') =
        if Mask
n' Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
h Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0 Bool -> Bool -> Bool
&& (Mask -> Bool
predicate (Mask -> Bool) -> Mask -> Bool
forall a b. (a -> b) -> a -> b
$! Mask
prefix Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Int -> Mask
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
b'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)) then (Mask
n' Mask -> Int -> Mask
`shiftRL` Int
d, Int
b'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) else (Mask
n',Int
b')
      {-# INLINE next #-}
      (Mask
_,Int
b) = Int -> Mask -> (Mask, Int) -> (Mask, Int)
next Int
1  Mask
0x2 ((Mask, Int) -> (Mask, Int)) -> (Mask, Int) -> (Mask, Int)
forall a b. (a -> b) -> a -> b
$
              Int -> Mask -> (Mask, Int) -> (Mask, Int)
next Int
2  Mask
0xC ((Mask, Int) -> (Mask, Int)) -> (Mask, Int) -> (Mask, Int)
forall a b. (a -> b) -> a -> b
$
              Int -> Mask -> (Mask, Int) -> (Mask, Int)
next Int
4  Mask
0xF0 ((Mask, Int) -> (Mask, Int)) -> (Mask, Int) -> (Mask, Int)
forall a b. (a -> b) -> a -> b
$
              Int -> Mask -> (Mask, Int) -> (Mask, Int)
next Int
8  Mask
0xFF00 ((Mask, Int) -> (Mask, Int)) -> (Mask, Int) -> (Mask, Int)
forall a b. (a -> b) -> a -> b
$
              Int -> Mask -> (Mask, Int) -> (Mask, Int)
next Int
16 Mask
0xFFFF0000 ((Mask, Int) -> (Mask, Int)) -> (Mask, Int) -> (Mask, Int)
forall a b. (a -> b) -> a -> b
$
              Int -> Mask -> (Mask, Int) -> (Mask, Int)
next Int
32 Mask
0xFFFFFFFF00000000 ((Mask, Int) -> (Mask, Int)) -> (Mask, Int) -> (Mask, Int)
forall a b. (a -> b) -> a -> b
$
              (Mask
bitmap,Int
0)
      m :: Mask
m = if Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
|| (Mask
bitmap Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
0x1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
0 Bool -> Bool -> Bool
&& Mask -> Bool
predicate Mask
prefix)
          then ((Mask
2 Mask -> Int -> Mask
`shiftLL` Int
b) Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1)
          else ((Mask
1 Mask -> Int -> Mask
`shiftLL` Int
b) Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1)
  in Mask
bitmap Mask -> Mask -> Mask
forall a. Bits a => a -> a -> a
.&. Mask
m



{--------------------------------------------------------------------
  Utilities
--------------------------------------------------------------------}

-- | \(O(1)\).  Decompose a set into pieces based on the structure of the underlying
-- tree.  This function is useful for consuming a set in parallel.
--
-- No guarantee is made as to the sizes of the pieces; an internal, but
-- deterministic process determines this.  However, it is guaranteed that the
-- pieces returned will be in ascending order (all elements in the first submap
-- less than all elements in the second, and so on).
--
-- Examples:
--
-- > splitRoot (fromList [1..120]) == [fromList [1..63],fromList [64..120]]
-- > splitRoot empty == []
--
--  Note that the current implementation does not return more than two subsets,
--  but you should not depend on this behaviour because it can change in the
--  future without notice. Also, the current version does not continue
--  splitting all the way to individual singleton sets -- it stops at some
--  point.
splitRoot :: Word64Set -> [Word64Set]
splitRoot :: Word64Set -> [Word64Set]
splitRoot Word64Set
Nil = []
-- NOTE: we don't currently split below Tip, but we could.
splitRoot x :: Word64Set
x@(Tip Mask
_ Mask
_) = [Word64Set
x]
splitRoot (Bin Mask
_ Mask
m Word64Set
l Word64Set
r) | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 = [Word64Set
r, Word64Set
l]
                        | Bool
otherwise = [Word64Set
l, Word64Set
r]
{-# INLINE splitRoot #-}