{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
#endif

{-# OPTIONS_HADDOCK not-home #-}

#include "containers.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.IntSet.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.
--
--
-- = Finite Int Sets (internals)
--
-- The @'IntSet'@ type represents a set of elements of type @Int@. An @IntSet@
-- is strict in its elements.
--
--
-- == Implementation
--
-- The implementation is based on /big-endian patricia trees/.  This data
-- structure performs especially well on binary operations like 'union'
-- and 'intersection'. Additionally, 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,
--      <https://web.archive.org/web/20150417234429/https://ittc.ku.edu/~andygill/papers/IntMap98.pdf>.
--
--    * D.R. Morrison,
--      \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",
--      Journal of the ACM, 15(4), October 1968, pages 514-534,
--      <https://doi.org/10.1145/321479.321481>.
--
-- 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
-- reduces the 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.
--
-- @since 0.5.9
-----------------------------------------------------------------------------

-- [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 IntSet 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 Data.IntSet.Internal (
    -- * Set type
      IntSet(..) -- instance Eq,Show
    , Key
    , BitMap

    -- * Operators
    , (\\)

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

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

    -- * Combine
    , union
    , unions
    , difference
    , intersection
    , intersections
    , symmetricDifference
    , Intersection(..)

    -- * Filter
    , filter
    , partition

    , takeWhileAntitone
    , dropWhileAntitone
    , spanAntitone

    , split
    , splitMember
    , splitRoot

    -- * Map
    , map
    , mapMonotonic

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

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

    -- * Conversion

    -- ** List
    , elems
    , toList
    , fromList

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

    -- * Debugging
    , showTree
    , showTreeWith

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

import Control.Applicative (Const(..))
import Control.DeepSeq (NFData(rnf))
import Data.Bits
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (fromMaybe)
import Data.Semigroup (Semigroup(..), stimesIdempotent, stimesIdempotentMonoid)
import Utils.Containers.Internal.Prelude hiding
  (filter, foldr, foldl, foldl', foldMap, null, map)
import Prelude ()

import Utils.Containers.Internal.BitUtil (iShiftRL, shiftLL, shiftRL)
import Utils.Containers.Internal.StrictPair
import Data.IntSet.Internal.IntTreeCommons
  ( Key
  , Prefix(..)
  , nomatch
  , left
  , signBranch
  , mask
  , branchMask
  , TreeTreeBranch(..)
  , treeTreeBranch
  , i2w
  , Order(..)
  )

#if __GLASGOW_HASKELL__
import Data.Data (Data(..), Constr, mkConstr, constrIndex, DataType, mkDataType)
import qualified Data.Data
import Text.Read
import Data.Coerce (coerce)
#endif

#if __GLASGOW_HASKELL__
import qualified GHC.Exts
#  if !(WORD_SIZE_IN_BITS==64)
import qualified GHC.Int
#  endif
import Language.Haskell.TH.Syntax (Lift)
-- See Note [ Template Haskell Dependencies ]
import Language.Haskell.TH ()
#endif

import qualified Data.Foldable as Foldable
import Data.Functor.Identity (Identity(..))

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

{--------------------------------------------------------------------
  Operators
--------------------------------------------------------------------}
-- | \(O(\min(n, m \log \frac{2^W}{m})), m \leq n\).
-- See 'difference'.
(\\) :: IntSet -> IntSet -> IntSet
IntSet
m1 \\ :: IntSet -> IntSet -> IntSet
\\ IntSet
m2 = IntSet -> IntSet -> IntSet
difference IntSet
m1 IntSet
m2

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

-- | A set of integers.

-- See Note: Order of constructors
data IntSet = Bin {-# UNPACK #-} !Prefix
                  !IntSet
                  !IntSet
            | Tip {-# UNPACK #-} !Int
                  {-# UNPACK #-} !BitMap
            | Nil

type BitMap = Word

--
-- Note [IntSet structure and invariants]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- * Nil is never found as a child of Bin.
--
-- * The Prefix of a Bin indicates the common high-order bits that all keys in
--   the Bin share.
--
-- * The least significant set bit of the Int value of a Prefix is called the
--   mask bit.
--
-- * All the bits to the left of the mask bit are called the shared prefix. All
--   keys stored in the Bin begin with the shared prefix.
--
-- * All keys in the left child of the Bin have the mask bit unset, and all keys
--   in the right child have the mask bit set. It follows that
--
--   1. The Int value of the Prefix of a Bin is the smallest key that can be
--      present in the right child of the Bin.
--
--   2. All keys in the right child of a Bin are greater than keys in the
--      left child, with one exceptional situation. If the Bin separates
--      negative and non-negative keys, the mask bit is the sign bit and the
--      left child stores the non-negative keys while the right child stores the
--      negative keys.
--
-- * All bits to the right of the mask bit are set to 0 in a Prefix.
--
-- * The shared prefix of a Bin is never longer than
--   (WORD_SIZE - lg(WORD_SIZE) - 1) bits.
--
-- * In the context of a Tip, the highest (WORD_SIZE - lg(WORD_SIZE)) bits of
--   a key are called "prefix" and the lowest lg(WORD_SIZE) bits are called
--   "suffix". In Tip kx bm, kx is the shared prefix and bm is a bitmask of the
--   suffixes of the keys. In other words, the keys of Tip kx bm are (kx .|. i)
--   for every set bit i in bm.
--
-- * In Tip kx _, the lowest lg(WORD_SIZE) bits of kx are set to 0.
--
-- * In Tip _ bm, bm is never 0.
--

#ifdef __GLASGOW_HASKELL__
-- | @since 0.6.6
deriving instance Lift IntSet
#endif

-- | @mempty@ = 'empty'
instance Monoid IntSet where
    mempty :: IntSet
mempty  = IntSet
empty
    mconcat :: [IntSet] -> IntSet
mconcat = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
unions
    mappend :: IntSet -> IntSet -> IntSet
mappend = IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
(<>)

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

#if __GLASGOW_HASKELL__

{--------------------------------------------------------------------
  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 IntSet where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntSet -> c IntSet
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z IntSet
is = ([Int] -> IntSet) -> c ([Int] -> IntSet)
forall g. g -> c g
z [Int] -> IntSet
fromList c ([Int] -> IntSet) -> [Int] -> c IntSet
forall d b. Data d => c (d -> b) -> d -> c b
`f` (IntSet -> [Int]
toList IntSet
is)
  toConstr :: IntSet -> Constr
toConstr IntSet
_     = Constr
fromListConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntSet
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 ([Int] -> IntSet) -> c IntSet
forall b r. Data b => c (b -> r) -> c r
k (([Int] -> IntSet) -> c ([Int] -> IntSet)
forall r. r -> c r
z [Int] -> IntSet
fromList)
    Int
_ -> [Char] -> c IntSet
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
  dataTypeOf :: IntSet -> DataType
dataTypeOf IntSet
_   = 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.IntSet.Internal.IntSet" [Constr
fromListConstr]

#endif

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

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

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

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

-- | \(O(\min(n,W))\). Is the element not in the set?
notMember :: Key -> IntSet -> Bool
notMember :: Int -> IntSet -> Bool
notMember Int
k = Bool -> Bool
not (Bool -> Bool) -> (IntSet -> Bool) -> IntSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntSet -> Bool
member Int
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 -> IntSet -> Maybe Key
lookupLT :: Int -> IntSet -> Maybe Int
lookupLT !Int
x IntSet
t = case IntSet
t of
    Bin Prefix
p IntSet
l IntSet
r | Prefix -> Bool
signBranch Prefix
p -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then IntSet -> IntSet -> Maybe Int
go IntSet
r IntSet
l else IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
r
    IntSet
_ -> IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Int
go IntSet
def (Bin Prefix
p IntSet
l IntSet
r) | Int -> Prefix -> Bool
nomatch Int
x Prefix
p = if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Prefix -> Int
unPrefix Prefix
p then IntSet -> Maybe Int
unsafeFindMax IntSet
def else IntSet -> Maybe Int
unsafeFindMax IntSet
r
                       | Int -> Prefix -> Bool
left Int
x Prefix
p  = IntSet -> IntSet -> Maybe Int
go IntSet
def IntSet
l
                       | Bool
otherwise = IntSet -> IntSet -> Maybe Int
go IntSet
l IntSet
r
    go IntSet
def (Tip Int
kx Word
bm) | Int -> Int
prefixOf Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
kx = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
highestBitSet Word
bm
                       | Int -> Int
prefixOf Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx Bool -> Bool -> Bool
&& Word
maskLT Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
highestBitSet Word
maskLT
                       | Bool
otherwise = IntSet -> Maybe Int
unsafeFindMax IntSet
def
                       where maskLT :: Word
maskLT = (Int -> Word
bitmapOf Int
x Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm
    go IntSet
def IntSet
Nil = IntSet -> Maybe Int
unsafeFindMax IntSet
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 -> IntSet -> Maybe Key
lookupGT :: Int -> IntSet -> Maybe Int
lookupGT !Int
x IntSet
t = case IntSet
t of
    Bin Prefix
p IntSet
l IntSet
r | Prefix -> Bool
signBranch Prefix
p -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
l else IntSet -> IntSet -> Maybe Int
go IntSet
l IntSet
r
    IntSet
_ -> IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Int
go IntSet
def (Bin Prefix
p IntSet
l IntSet
r) | Int -> Prefix -> Bool
nomatch Int
x Prefix
p = if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Prefix -> Int
unPrefix Prefix
p then IntSet -> Maybe Int
unsafeFindMin IntSet
l else IntSet -> Maybe Int
unsafeFindMin IntSet
def
                       | Int -> Prefix -> Bool
left Int
x Prefix
p  = IntSet -> IntSet -> Maybe Int
go IntSet
r IntSet
l
                       | Bool
otherwise = IntSet -> IntSet -> Maybe Int
go IntSet
def IntSet
r
    go IntSet
def (Tip Int
kx Word
bm) | Int -> Int
prefixOf Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
kx = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
lowestBitSet Word
bm
                       | Int -> Int
prefixOf Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx Bool -> Bool -> Bool
&& Word
maskGT Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
lowestBitSet Word
maskGT
                       | Bool
otherwise = IntSet -> Maybe Int
unsafeFindMin IntSet
def
                       where maskGT :: Word
maskGT = (- ((Int -> Word
bitmapOf Int
x) Word -> Int -> Word
`shiftLL` Int
1)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm
    go IntSet
def IntSet
Nil = IntSet -> Maybe Int
unsafeFindMin IntSet
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 -> IntSet -> Maybe Key
lookupLE :: Int -> IntSet -> Maybe Int
lookupLE !Int
x IntSet
t = case IntSet
t of
    Bin Prefix
p IntSet
l IntSet
r | Prefix -> Bool
signBranch Prefix
p -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then IntSet -> IntSet -> Maybe Int
go IntSet
r IntSet
l else IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
r
    IntSet
_ -> IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Int
go IntSet
def (Bin Prefix
p IntSet
l IntSet
r) | Int -> Prefix -> Bool
nomatch Int
x Prefix
p = if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Prefix -> Int
unPrefix Prefix
p then IntSet -> Maybe Int
unsafeFindMax IntSet
def else IntSet -> Maybe Int
unsafeFindMax IntSet
r
                       | Int -> Prefix -> Bool
left Int
x Prefix
p  = IntSet -> IntSet -> Maybe Int
go IntSet
def IntSet
l
                       | Bool
otherwise = IntSet -> IntSet -> Maybe Int
go IntSet
l IntSet
r
    go IntSet
def (Tip Int
kx Word
bm) | Int -> Int
prefixOf Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
kx = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
highestBitSet Word
bm
                       | Int -> Int
prefixOf Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx Bool -> Bool -> Bool
&& Word
maskLE Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
highestBitSet Word
maskLE
                       | Bool
otherwise = IntSet -> Maybe Int
unsafeFindMax IntSet
def
                       where maskLE :: Word
maskLE = (((Int -> Word
bitmapOf Int
x) Word -> Int -> Word
`shiftLL` Int
1) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm
    go IntSet
def IntSet
Nil = IntSet -> Maybe Int
unsafeFindMax IntSet
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 -> IntSet -> Maybe Key
lookupGE :: Int -> IntSet -> Maybe Int
lookupGE !Int
x IntSet
t = case IntSet
t of
    Bin Prefix
p IntSet
l IntSet
r | Prefix -> Bool
signBranch Prefix
p -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
l else IntSet -> IntSet -> Maybe Int
go IntSet
l IntSet
r
    IntSet
_ -> IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Int
go IntSet
def (Bin Prefix
p IntSet
l IntSet
r) | Int -> Prefix -> Bool
nomatch Int
x Prefix
p = if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Prefix -> Int
unPrefix Prefix
p then IntSet -> Maybe Int
unsafeFindMin IntSet
l else IntSet -> Maybe Int
unsafeFindMin IntSet
def
                       | Int -> Prefix -> Bool
left Int
x Prefix
p  = IntSet -> IntSet -> Maybe Int
go IntSet
r IntSet
l
                       | Bool
otherwise = IntSet -> IntSet -> Maybe Int
go IntSet
def IntSet
r
    go IntSet
def (Tip Int
kx Word
bm) | Int -> Int
prefixOf Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
kx = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
lowestBitSet Word
bm
                       | Int -> Int
prefixOf Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx Bool -> Bool -> Bool
&& Word
maskGE Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
lowestBitSet Word
maskGE
                       | Bool
otherwise = IntSet -> Maybe Int
unsafeFindMin IntSet
def
                       where maskGE :: Word
maskGE = (- (Int -> Word
bitmapOf Int
x)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm
    go IntSet
def IntSet
Nil = IntSet -> Maybe Int
unsafeFindMin IntSet
def



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

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

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

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

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

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

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

-- Deletes all values mentioned in the BitMap from the set.
-- Helper function for delete and difference.
deleteBM :: Int -> BitMap -> IntSet -> IntSet
deleteBM :: Int -> Word -> IntSet -> IntSet
deleteBM !Int
kx !Word
bm t :: IntSet
t@(Bin Prefix
p IntSet
l IntSet
r)
  | Int -> Prefix -> Bool
nomatch Int
kx Prefix
p = IntSet
t
  | Int -> Prefix -> Bool
left Int
kx Prefix
p    = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p (Int -> Word -> IntSet -> IntSet
deleteBM Int
kx Word
bm IntSet
l) IntSet
r
  | Bool
otherwise    = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l (Int -> Word -> IntSet -> IntSet
deleteBM Int
kx Word
bm IntSet
r)
deleteBM Int
kx Word
bm t :: IntSet
t@(Tip Int
kx' Word
bm')
  | Int
kx' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx = Int -> Word -> IntSet
tip Int
kx (Word
bm' Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
bm)
  | Bool
otherwise = IntSet
t
deleteBM Int
_ Word
_ IntSet
Nil = IntSet
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 -> IntSet -> f IntSet
alterF :: forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Int -> IntSet -> f IntSet
alterF Bool -> f Bool
f Int
k IntSet
s = (Bool -> IntSet) -> f Bool -> f IntSet
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> IntSet
choose (Bool -> f Bool
f Bool
member_)
  where
    member_ :: Bool
member_ = Int -> IntSet -> Bool
member Int
k IntSet
s

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

    choose :: Bool -> IntSet
choose Bool
True  = IntSet
inserted
    choose Bool
False = IntSet
deleted
#ifndef __GLASGOW_HASKELL__
{-# INLINE alterF #-}
#else
{-# INLINABLE [2] alterF #-}

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

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

{--------------------------------------------------------------------
  Union
--------------------------------------------------------------------}
-- | The union of a list of sets.
unions :: Foldable f => f IntSet -> IntSet
unions :: forall (f :: * -> *). Foldable f => f IntSet -> IntSet
unions f IntSet
xs
  = (IntSet -> IntSet -> IntSet) -> IntSet -> f IntSet -> IntSet
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' IntSet -> IntSet -> IntSet
union IntSet
empty f IntSet
xs


-- | \(O(\min(n, m \log \frac{2^W}{m})), m \leq n\).
-- The union of two sets.
union :: IntSet -> IntSet -> IntSet
union :: IntSet -> IntSet -> IntSet
union t1 :: IntSet
t1@(Bin Prefix
p1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Prefix
p2 IntSet
l2 IntSet
r2) = case Prefix -> Prefix -> TreeTreeBranch
treeTreeBranch Prefix
p1 Prefix
p2 of
  TreeTreeBranch
ABL -> Prefix -> IntSet -> IntSet -> IntSet
Bin Prefix
p1 (IntSet -> IntSet -> IntSet
union IntSet
l1 IntSet
t2) IntSet
r1
  TreeTreeBranch
ABR -> Prefix -> IntSet -> IntSet -> IntSet
Bin Prefix
p1 IntSet
l1 (IntSet -> IntSet -> IntSet
union IntSet
r1 IntSet
t2)
  TreeTreeBranch
BAL -> Prefix -> IntSet -> IntSet -> IntSet
Bin Prefix
p2 (IntSet -> IntSet -> IntSet
union IntSet
t1 IntSet
l2) IntSet
r2
  TreeTreeBranch
BAR -> Prefix -> IntSet -> IntSet -> IntSet
Bin Prefix
p2 IntSet
l2 (IntSet -> IntSet -> IntSet
union IntSet
t1 IntSet
r2)
  TreeTreeBranch
EQL -> Prefix -> IntSet -> IntSet -> IntSet
Bin Prefix
p1 (IntSet -> IntSet -> IntSet
union IntSet
l1 IntSet
l2) (IntSet -> IntSet -> IntSet
union IntSet
r1 IntSet
r2)
  TreeTreeBranch
NOM -> Int -> IntSet -> Int -> IntSet -> IntSet
link (Prefix -> Int
unPrefix Prefix
p1) IntSet
t1 (Prefix -> Int
unPrefix Prefix
p2) IntSet
t2
union t :: IntSet
t@(Bin Prefix
_ IntSet
_ IntSet
_) (Tip Int
kx Word
bm) = Int -> Word -> IntSet -> IntSet
insertBM Int
kx Word
bm IntSet
t
union t :: IntSet
t@(Bin Prefix
_ IntSet
_ IntSet
_) IntSet
Nil = IntSet
t
union (Tip Int
kx Word
bm) IntSet
t = Int -> Word -> IntSet -> IntSet
insertBM Int
kx Word
bm IntSet
t
union IntSet
Nil IntSet
t = IntSet
t


{--------------------------------------------------------------------
  Difference
--------------------------------------------------------------------}
-- | \(O(\min(n, m \log \frac{2^W}{m})), m \leq n\).
-- Difference between two sets.
difference :: IntSet -> IntSet -> IntSet
difference :: IntSet -> IntSet -> IntSet
difference t1 :: IntSet
t1@(Bin Prefix
p1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Prefix
p2 IntSet
l2 IntSet
r2) = case Prefix -> Prefix -> TreeTreeBranch
treeTreeBranch Prefix
p1 Prefix
p2 of
  TreeTreeBranch
ABL -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p1 (IntSet -> IntSet -> IntSet
difference IntSet
l1 IntSet
t2) IntSet
r1
  TreeTreeBranch
ABR -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p1 IntSet
l1 (IntSet -> IntSet -> IntSet
difference IntSet
r1 IntSet
t2)
  TreeTreeBranch
BAL -> IntSet -> IntSet -> IntSet
difference IntSet
t1 IntSet
l2
  TreeTreeBranch
BAR -> IntSet -> IntSet -> IntSet
difference IntSet
t1 IntSet
r2
  TreeTreeBranch
EQL -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p1 (IntSet -> IntSet -> IntSet
difference IntSet
l1 IntSet
l2) (IntSet -> IntSet -> IntSet
difference IntSet
r1 IntSet
r2)
  TreeTreeBranch
NOM -> IntSet
t1

difference t :: IntSet
t@(Bin Prefix
_ IntSet
_ IntSet
_) (Tip Int
kx Word
bm) = Int -> Word -> IntSet -> IntSet
deleteBM Int
kx Word
bm IntSet
t
difference t :: IntSet
t@(Bin Prefix
_ IntSet
_ IntSet
_) IntSet
Nil = IntSet
t

difference t1 :: IntSet
t1@(Tip Int
kx Word
bm) IntSet
t2 = IntSet -> IntSet
differenceTip IntSet
t2
  where differenceTip :: IntSet -> IntSet
differenceTip (Bin Prefix
p2 IntSet
l2 IntSet
r2) | Int -> Prefix -> Bool
nomatch Int
kx Prefix
p2 = IntSet
t1
                                     | Int -> Prefix -> Bool
left Int
kx Prefix
p2 = IntSet -> IntSet
differenceTip IntSet
l2
                                     | Bool
otherwise = IntSet -> IntSet
differenceTip IntSet
r2
        differenceTip (Tip Int
kx2 Word
bm2) | Int
kx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 = Int -> Word -> IntSet
tip Int
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
bm2)
                                    | Bool
otherwise = IntSet
t1
        differenceTip IntSet
Nil = IntSet
t1

difference IntSet
Nil IntSet
_     = IntSet
Nil



{--------------------------------------------------------------------
  Intersection
--------------------------------------------------------------------}
-- | \(O(\min(n, m \log \frac{2^W}{m})), m \leq n\).
-- The intersection of two sets.
intersection :: IntSet -> IntSet -> IntSet
intersection :: IntSet -> IntSet -> IntSet
intersection t1 :: IntSet
t1@(Bin Prefix
p1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Prefix
p2 IntSet
l2 IntSet
r2) = case Prefix -> Prefix -> TreeTreeBranch
treeTreeBranch Prefix
p1 Prefix
p2 of
  TreeTreeBranch
ABL -> IntSet -> IntSet -> IntSet
intersection IntSet
l1 IntSet
t2
  TreeTreeBranch
ABR -> IntSet -> IntSet -> IntSet
intersection IntSet
r1 IntSet
t2
  TreeTreeBranch
BAL -> IntSet -> IntSet -> IntSet
intersection IntSet
t1 IntSet
l2
  TreeTreeBranch
BAR -> IntSet -> IntSet -> IntSet
intersection IntSet
t1 IntSet
r2
  TreeTreeBranch
EQL -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p1 (IntSet -> IntSet -> IntSet
intersection IntSet
l1 IntSet
l2) (IntSet -> IntSet -> IntSet
intersection IntSet
r1 IntSet
r2)
  TreeTreeBranch
NOM -> IntSet
Nil

intersection t1 :: IntSet
t1@(Bin Prefix
_ IntSet
_ IntSet
_) (Tip Int
kx2 Word
bm2) = IntSet -> IntSet
intersectBM IntSet
t1
  where intersectBM :: IntSet -> IntSet
intersectBM (Bin Prefix
p1 IntSet
l1 IntSet
r1) | Int -> Prefix -> Bool
nomatch Int
kx2 Prefix
p1 = IntSet
Nil
                                   | Int -> Prefix -> Bool
left Int
kx2 Prefix
p1    = IntSet -> IntSet
intersectBM IntSet
l1
                                   | Bool
otherwise      = IntSet -> IntSet
intersectBM IntSet
r1
        intersectBM (Tip Int
kx1 Word
bm1) | Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 = Int -> Word -> IntSet
tip Int
kx1 (Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm2)
                                  | Bool
otherwise = IntSet
Nil
        intersectBM IntSet
Nil = IntSet
Nil

intersection (Bin Prefix
_ IntSet
_ IntSet
_) IntSet
Nil = IntSet
Nil

intersection (Tip Int
kx1 Word
bm1) IntSet
t2 = IntSet -> IntSet
intersectBM IntSet
t2
  where intersectBM :: IntSet -> IntSet
intersectBM (Bin Prefix
p2 IntSet
l2 IntSet
r2) | Int -> Prefix -> Bool
nomatch Int
kx1 Prefix
p2 = IntSet
Nil
                                   | Int -> Prefix -> Bool
left Int
kx1 Prefix
p2    = IntSet -> IntSet
intersectBM IntSet
l2
                                   | Bool
otherwise      = IntSet -> IntSet
intersectBM IntSet
r2
        intersectBM (Tip Int
kx2 Word
bm2) | Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 = Int -> Word -> IntSet
tip Int
kx1 (Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm2)
                                  | Bool
otherwise = IntSet
Nil
        intersectBM IntSet
Nil = IntSet
Nil

intersection IntSet
Nil IntSet
_ = IntSet
Nil

-- | The intersection of a series of sets. Intersections are performed
-- left-to-right.
--
-- @since 0.8
intersections :: NonEmpty IntSet -> IntSet
intersections :: NonEmpty IntSet -> IntSet
intersections (IntSet
s0 :| [IntSet]
ss)
  | IntSet -> Bool
null IntSet
s0 = IntSet
empty
  | Bool
otherwise = (IntSet -> (IntSet -> IntSet) -> IntSet -> IntSet)
-> (IntSet -> IntSet) -> [IntSet] -> IntSet -> IntSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr IntSet -> (IntSet -> IntSet) -> IntSet -> IntSet
go IntSet -> IntSet
forall a. a -> a
id [IntSet]
ss IntSet
s0
  where
    go :: IntSet -> (IntSet -> IntSet) -> IntSet -> IntSet
go IntSet
s IntSet -> IntSet
r IntSet
acc
      | IntSet -> Bool
null IntSet
acc' = IntSet
empty
      | Bool
otherwise = IntSet -> IntSet
r IntSet
acc'
      where
        acc' :: IntSet
acc' = IntSet -> IntSet -> IntSet
intersection IntSet
acc IntSet
s
{-# INLINABLE intersections #-}

-- | @IntSet@s form a 'Semigroup' under 'intersection'.
--
-- A @Monoid@ instance is not defined because it would be impractical to
-- construct @mempty@, the @IntSet@ containing all @Int@s.
--
-- @since 0.8
newtype Intersection = Intersection { Intersection -> IntSet
getIntersection :: IntSet }
  deriving (Int -> Intersection -> ShowS
[Intersection] -> ShowS
Intersection -> [Char]
(Int -> Intersection -> ShowS)
-> (Intersection -> [Char])
-> ([Intersection] -> ShowS)
-> Show Intersection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Intersection -> ShowS
showsPrec :: Int -> Intersection -> ShowS
$cshow :: Intersection -> [Char]
show :: Intersection -> [Char]
$cshowList :: [Intersection] -> ShowS
showList :: [Intersection] -> ShowS
Show, Intersection -> Intersection -> Bool
(Intersection -> Intersection -> Bool)
-> (Intersection -> Intersection -> Bool) -> Eq Intersection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Intersection -> Intersection -> Bool
== :: Intersection -> Intersection -> Bool
$c/= :: Intersection -> Intersection -> Bool
/= :: Intersection -> Intersection -> Bool
Eq, Eq Intersection
Eq Intersection =>
(Intersection -> Intersection -> Ordering)
-> (Intersection -> Intersection -> Bool)
-> (Intersection -> Intersection -> Bool)
-> (Intersection -> Intersection -> Bool)
-> (Intersection -> Intersection -> Bool)
-> (Intersection -> Intersection -> Intersection)
-> (Intersection -> Intersection -> Intersection)
-> Ord Intersection
Intersection -> Intersection -> Bool
Intersection -> Intersection -> Ordering
Intersection -> Intersection -> Intersection
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Intersection -> Intersection -> Ordering
compare :: Intersection -> Intersection -> Ordering
$c< :: Intersection -> Intersection -> Bool
< :: Intersection -> Intersection -> Bool
$c<= :: Intersection -> Intersection -> Bool
<= :: Intersection -> Intersection -> Bool
$c> :: Intersection -> Intersection -> Bool
> :: Intersection -> Intersection -> Bool
$c>= :: Intersection -> Intersection -> Bool
>= :: Intersection -> Intersection -> Bool
$cmax :: Intersection -> Intersection -> Intersection
max :: Intersection -> Intersection -> Intersection
$cmin :: Intersection -> Intersection -> Intersection
min :: Intersection -> Intersection -> Intersection
Ord)

instance Semigroup Intersection where
  Intersection IntSet
s1 <> :: Intersection -> Intersection -> Intersection
<> Intersection IntSet
s2 = IntSet -> Intersection
Intersection (IntSet -> IntSet -> IntSet
intersection IntSet
s1 IntSet
s2)

  stimes :: forall b. Integral b => b -> Intersection -> Intersection
stimes = b -> Intersection -> Intersection
forall b a. Integral b => b -> a -> a
stimesIdempotent
  {-# INLINABLE stimes #-}

  sconcat :: NonEmpty Intersection -> Intersection
sconcat =
#ifdef __GLASGOW_HASKELL__
    (NonEmpty IntSet -> IntSet)
-> NonEmpty Intersection -> Intersection
forall a b. Coercible a b => a -> b
coerce NonEmpty IntSet -> IntSet
intersections
#else
    Intersection . intersections . fmap getIntersection
#endif

{--------------------------------------------------------------------
  Symmetric difference
--------------------------------------------------------------------}

-- | \(O(\min(n, m \log \frac{2^W}{m})), m \leq n\).
-- The symmetric difference of two sets.
--
-- The result contains elements that appear in exactly one of the two sets.
--
-- @
-- symmetricDifference (fromList [0,2,4,6]) (fromList [0,3,6,9]) == fromList [2,3,4,9]
-- @
--
-- @since 0.8
symmetricDifference :: IntSet -> IntSet -> IntSet
symmetricDifference :: IntSet -> IntSet -> IntSet
symmetricDifference t1 :: IntSet
t1@(Bin Prefix
p1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Prefix
p2 IntSet
l2 IntSet
r2) =
  case Prefix -> Prefix -> TreeTreeBranch
treeTreeBranch Prefix
p1 Prefix
p2 of
    TreeTreeBranch
ABL -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p1 (IntSet -> IntSet -> IntSet
symmetricDifference IntSet
l1 IntSet
t2) IntSet
r1
    TreeTreeBranch
ABR -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p1 IntSet
l1 (IntSet -> IntSet -> IntSet
symmetricDifference IntSet
r1 IntSet
t2)
    TreeTreeBranch
BAL -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p2 (IntSet -> IntSet -> IntSet
symmetricDifference IntSet
t1 IntSet
l2) IntSet
r2
    TreeTreeBranch
BAR -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p2 IntSet
l2 (IntSet -> IntSet -> IntSet
symmetricDifference IntSet
t1 IntSet
r2)
    TreeTreeBranch
EQL -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p1 (IntSet -> IntSet -> IntSet
symmetricDifference IntSet
l1 IntSet
l2) (IntSet -> IntSet -> IntSet
symmetricDifference IntSet
r1 IntSet
r2)
    TreeTreeBranch
NOM -> Int -> IntSet -> Int -> IntSet -> IntSet
link (Prefix -> Int
unPrefix Prefix
p1) IntSet
t1 (Prefix -> Int
unPrefix Prefix
p2) IntSet
t2
symmetricDifference t1 :: IntSet
t1@(Bin Prefix
_ IntSet
_ IntSet
_) t2 :: IntSet
t2@(Tip Int
kx2 Word
bm2) = IntSet -> Int -> Word -> IntSet -> IntSet
symDiffTip IntSet
t2 Int
kx2 Word
bm2 IntSet
t1
symmetricDifference t1 :: IntSet
t1@(Bin Prefix
_ IntSet
_ IntSet
_) IntSet
Nil = IntSet
t1
symmetricDifference t1 :: IntSet
t1@(Tip Int
kx1 Word
bm1) IntSet
t2 = IntSet -> Int -> Word -> IntSet -> IntSet
symDiffTip IntSet
t1 Int
kx1 Word
bm1 IntSet
t2
symmetricDifference IntSet
Nil IntSet
t2 = IntSet
t2

symDiffTip :: IntSet -> Int -> BitMap -> IntSet -> IntSet
symDiffTip :: IntSet -> Int -> Word -> IntSet -> IntSet
symDiffTip !IntSet
t1 !Int
kx1 !Word
bm1 = IntSet -> IntSet
go
  where
    go :: IntSet -> IntSet
go t2 :: IntSet
t2@(Bin Prefix
p2 IntSet
l2 IntSet
r2)
      | Int -> Prefix -> Bool
nomatch Int
kx1 Prefix
p2 = Int -> IntSet -> Prefix -> IntSet -> IntSet
linkKey Int
kx1 IntSet
t1 Prefix
p2 IntSet
t2
      | Int -> Prefix -> Bool
left Int
kx1 Prefix
p2 = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p2 (IntSet -> IntSet
go IntSet
l2) IntSet
r2
      | Bool
otherwise = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p2 IntSet
l2 (IntSet -> IntSet
go IntSet
r2)
    go t2 :: IntSet
t2@(Tip Int
kx2 Word
bm2)
      | Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 = Int -> Word -> IntSet
tip Int
kx1 (Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
bm2)
      | Bool
otherwise = Int -> IntSet -> Int -> IntSet -> IntSet
link Int
kx1 IntSet
t1 Int
kx2 IntSet
t2
    go IntSet
Nil = IntSet
t1

{--------------------------------------------------------------------
  Subset
--------------------------------------------------------------------}
-- | \(O(\min(n, m \log \frac{2^W}{m})), m \leq n\).
-- Is this a proper subset? (ie. a subset but not equal).
isProperSubsetOf :: IntSet -> IntSet -> Bool
isProperSubsetOf :: IntSet -> IntSet -> Bool
isProperSubsetOf IntSet
t1 IntSet
t2
  = case IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
t2 of
      Ordering
LT -> Bool
True
      Ordering
_  -> Bool
False

subsetCmp :: IntSet -> IntSet -> Ordering
subsetCmp :: IntSet -> IntSet -> Ordering
subsetCmp t1 :: IntSet
t1@(Bin Prefix
p1 IntSet
l1 IntSet
r1) (Bin Prefix
p2 IntSet
l2 IntSet
r2) = case Prefix -> Prefix -> TreeTreeBranch
treeTreeBranch Prefix
p1 Prefix
p2 of
  TreeTreeBranch
ABL -> Ordering
GT
  TreeTreeBranch
ABR -> Ordering
GT
  TreeTreeBranch
BAL -> case IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
l2 of Ordering
GT -> Ordering
GT ; Ordering
_ -> Ordering
LT
  TreeTreeBranch
BAR -> case IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
r2 of Ordering
GT -> Ordering
GT ; Ordering
_ -> Ordering
LT
  TreeTreeBranch
EQL -> Ordering
subsetCmpEq
  TreeTreeBranch
NOM -> Ordering
GT  -- disjoint
  where
    subsetCmpEq :: Ordering
subsetCmpEq = case (IntSet -> IntSet -> Ordering
subsetCmp IntSet
l1 IntSet
l2, IntSet -> IntSet -> Ordering
subsetCmp IntSet
r1 IntSet
r2) of
                    (Ordering
GT,Ordering
_ ) -> Ordering
GT
                    (Ordering
_ ,Ordering
GT) -> Ordering
GT
                    (Ordering
EQ,Ordering
EQ) -> Ordering
EQ
                    (Ordering, Ordering)
_       -> Ordering
LT

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

-- | \(O(\min(n, m \log \frac{2^W}{m})), m \leq n\).
-- Is this a subset?
-- @(s1 \`isSubsetOf\` s2)@ tells whether @s1@ is a subset of @s2@.

isSubsetOf :: IntSet -> IntSet -> Bool
isSubsetOf :: IntSet -> IntSet -> Bool
isSubsetOf t1 :: IntSet
t1@(Bin Prefix
p1 IntSet
l1 IntSet
r1) (Bin Prefix
p2 IntSet
l2 IntSet
r2) = case Prefix -> Prefix -> TreeTreeBranch
treeTreeBranch Prefix
p1 Prefix
p2 of
  TreeTreeBranch
ABL -> Bool
False
  TreeTreeBranch
ABR -> Bool
False
  TreeTreeBranch
BAL -> IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
l2
  TreeTreeBranch
BAR -> IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
r2
  TreeTreeBranch
EQL -> IntSet -> IntSet -> Bool
isSubsetOf IntSet
l1 IntSet
l2 Bool -> Bool -> Bool
&& IntSet -> IntSet -> Bool
isSubsetOf IntSet
r1 IntSet
r2
  TreeTreeBranch
NOM -> Bool
False
isSubsetOf (Bin Prefix
_ IntSet
_ IntSet
_) IntSet
_ = Bool
False
isSubsetOf (Tip Int
kx1 Word
bm1) (Tip Int
kx2 Word
bm2) = Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 Bool -> Bool -> Bool
&& Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
bm2 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
isSubsetOf t1 :: IntSet
t1@(Tip Int
kx Word
_) (Bin Prefix
p IntSet
l IntSet
r)
  | Int -> Prefix -> Bool
nomatch Int
kx Prefix
p = Bool
False
  | Int -> Prefix -> Bool
left Int
kx Prefix
p    = IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
l
  | Bool
otherwise    = IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
r
isSubsetOf (Tip Int
_ Word
_) IntSet
Nil = Bool
False
isSubsetOf IntSet
Nil IntSet
_         = Bool
True


{--------------------------------------------------------------------
  Disjoint
--------------------------------------------------------------------}
-- | \(O(\min(n, m \log \frac{2^W}{m})), m \leq n\).
-- 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 :: IntSet -> IntSet -> Bool
disjoint :: IntSet -> IntSet -> Bool
disjoint t1 :: IntSet
t1@(Bin Prefix
p1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Prefix
p2 IntSet
l2 IntSet
r2) = case Prefix -> Prefix -> TreeTreeBranch
treeTreeBranch Prefix
p1 Prefix
p2 of
  TreeTreeBranch
ABL -> IntSet -> IntSet -> Bool
disjoint IntSet
l1 IntSet
t2
  TreeTreeBranch
ABR -> IntSet -> IntSet -> Bool
disjoint IntSet
r1 IntSet
t2
  TreeTreeBranch
BAL -> IntSet -> IntSet -> Bool
disjoint IntSet
t1 IntSet
l2
  TreeTreeBranch
BAR -> IntSet -> IntSet -> Bool
disjoint IntSet
t1 IntSet
r2
  TreeTreeBranch
EQL -> IntSet -> IntSet -> Bool
disjoint IntSet
l1 IntSet
l2 Bool -> Bool -> Bool
&& IntSet -> IntSet -> Bool
disjoint IntSet
r1 IntSet
r2
  TreeTreeBranch
NOM -> Bool
True

disjoint t1 :: IntSet
t1@(Bin Prefix
_ IntSet
_ IntSet
_) (Tip Int
kx2 Word
bm2) = IntSet -> Bool
disjointBM IntSet
t1
  where disjointBM :: IntSet -> Bool
disjointBM (Bin Prefix
p1 IntSet
l1 IntSet
r1) | Int -> Prefix -> Bool
nomatch Int
kx2 Prefix
p1 = Bool
True
                                  | Int -> Prefix -> Bool
left Int
kx2 Prefix
p1    = IntSet -> Bool
disjointBM IntSet
l1
                                  | Bool
otherwise      = IntSet -> Bool
disjointBM IntSet
r1
        disjointBM (Tip Int
kx1 Word
bm1) | Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 = (Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm2) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
                                 | Bool
otherwise = Bool
True
        disjointBM IntSet
Nil = Bool
True

disjoint (Bin Prefix
_ IntSet
_ IntSet
_) IntSet
Nil = Bool
True

disjoint (Tip Int
kx1 Word
bm1) IntSet
t2 = IntSet -> Bool
disjointBM IntSet
t2
  where disjointBM :: IntSet -> Bool
disjointBM (Bin Prefix
p2 IntSet
l2 IntSet
r2) | Int -> Prefix -> Bool
nomatch Int
kx1 Prefix
p2 = Bool
True
                                  | Int -> Prefix -> Bool
left Int
kx1 Prefix
p2    = IntSet -> Bool
disjointBM IntSet
l2
                                  | Bool
otherwise      = IntSet -> Bool
disjointBM IntSet
r2
        disjointBM (Tip Int
kx2 Word
bm2) | Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 = (Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm2) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
                                 | Bool
otherwise = Bool
True
        disjointBM IntSet
Nil = Bool
True

disjoint IntSet
Nil IntSet
_ = Bool
True


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

-- | \(O(n)\). partition the set according to some predicate.
partition :: (Key -> Bool) -> IntSet -> (IntSet,IntSet)
partition :: (Int -> Bool) -> IntSet -> (IntSet, IntSet)
partition Int -> Bool
predicate0 IntSet
t0 = StrictPair IntSet IntSet -> (IntSet, IntSet)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair IntSet IntSet -> (IntSet, IntSet))
-> StrictPair IntSet IntSet -> (IntSet, IntSet)
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate0 IntSet
t0
  where
    go :: (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate IntSet
t
      = case IntSet
t of
          Bin Prefix
p IntSet
l IntSet
r
            -> let (IntSet
l1 :*: IntSet
l2) = (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate IntSet
l
                   (IntSet
r1 :*: IntSet
r2) = (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate IntSet
r
               in Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l1 IntSet
r1 IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l2 IntSet
r2
          Tip Int
kx Word
bm
            -> let bm1 :: Word
bm1 = Int -> (Word -> Int -> Word) -> Word -> Word -> Word
forall a. Int -> (a -> Int -> a) -> a -> Word -> a
foldl'Bits Int
0 (Int -> Word -> Int -> Word
bitPred Int
kx) Word
0 Word
bm
               in  Int -> Word -> IntSet
tip Int
kx Word
bm1 IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Int -> Word -> IntSet
tip Int
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
bm1)
          IntSet
Nil -> (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
Nil)
      where bitPred :: Int -> Word -> Int -> Word
bitPred Int
kx Word
bm Int
bi | Int -> Bool
predicate (Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bi) = Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Int -> Word
bitmapOfSuffix Int
bi
                             | Bool
otherwise           = Word
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) -> IntSet -> IntSet
takeWhileAntitone :: (Int -> Bool) -> IntSet -> IntSet
takeWhileAntitone Int -> Bool
predicate IntSet
t =
  case IntSet
t of
    Bin Prefix
p IntSet
l IntSet
r
      | Prefix -> Bool
signBranch Prefix
p ->
        if Int -> Bool
predicate Int
0 -- handle negative numbers.
        then Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p ((Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate IntSet
l) IntSet
r
        else (Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate IntSet
r
    IntSet
_ -> (Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate IntSet
t
  where
    go :: (Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate' (Bin Prefix
p IntSet
l IntSet
r)
      | Int -> Bool
predicate' (Prefix -> Int
unPrefix Prefix
p) = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l ((Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate' IntSet
r)
      | Bool
otherwise               = (Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate' IntSet
l
    go Int -> Bool
predicate' (Tip Int
kx Word
bm) = Int -> Word -> IntSet
tip Int
kx (Int -> (Int -> Bool) -> Word -> Word
takeWhileAntitoneBits Int
kx Int -> Bool
predicate' Word
bm)
    go Int -> Bool
_ IntSet
Nil = IntSet
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) -> IntSet -> IntSet
dropWhileAntitone :: (Int -> Bool) -> IntSet -> IntSet
dropWhileAntitone Int -> Bool
predicate IntSet
t =
  case IntSet
t of
    Bin Prefix
p IntSet
l IntSet
r
      | Prefix -> Bool
signBranch Prefix
p ->
        if Int -> Bool
predicate Int
0 -- handle negative numbers.
        then (Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate IntSet
l
        else Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l ((Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate IntSet
r)
    IntSet
_ -> (Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate IntSet
t
  where
    go :: (Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate' (Bin Prefix
p IntSet
l IntSet
r)
      | Int -> Bool
predicate' (Prefix -> Int
unPrefix Prefix
p) = (Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate' IntSet
r
      | Bool
otherwise               = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p ((Int -> Bool) -> IntSet -> IntSet
go Int -> Bool
predicate' IntSet
l) IntSet
r
    go Int -> Bool
predicate' (Tip Int
kx Word
bm) = Int -> Word -> IntSet
tip Int
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Int -> (Int -> Bool) -> Word -> Word
takeWhileAntitoneBits Int
kx Int -> Bool
predicate' Word
bm)
    go Int -> Bool
_ IntSet
Nil = IntSet
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) -> IntSet -> (IntSet, IntSet)
spanAntitone :: (Int -> Bool) -> IntSet -> (IntSet, IntSet)
spanAntitone Int -> Bool
predicate IntSet
t =
  case IntSet
t of
    Bin Prefix
p IntSet
l IntSet
r
      | Prefix -> Bool
signBranch Prefix
p ->
        if Int -> Bool
predicate Int
0 -- handle negative numbers.
        then
          case (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate IntSet
l of
            (IntSet
lt :*: IntSet
gt) ->
              let !lt' :: IntSet
lt' = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
lt IntSet
r
              in (IntSet
lt', IntSet
gt)
        else
          case (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate IntSet
r of
            (IntSet
lt :*: IntSet
gt) ->
              let !gt' :: IntSet
gt' = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l IntSet
gt
              in (IntSet
lt, IntSet
gt')
    IntSet
_ -> case (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate IntSet
t of
          (IntSet
lt :*: IntSet
gt) -> (IntSet
lt, IntSet
gt)
  where
    go :: (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate' (Bin Prefix
p IntSet
l IntSet
r)
      | Int -> Bool
predicate' (Prefix -> Int
unPrefix Prefix
p) = case (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate' IntSet
r of (IntSet
lt :*: IntSet
gt) -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l IntSet
lt IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
gt
      | Bool
otherwise               = case (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate' IntSet
l of (IntSet
lt :*: IntSet
gt) -> IntSet
lt IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
gt IntSet
r
    go Int -> Bool
predicate' (Tip Int
kx Word
bm) = let bm' :: Word
bm' = Int -> (Int -> Bool) -> Word -> Word
takeWhileAntitoneBits Int
kx Int -> Bool
predicate' Word
bm
                                in (Int -> Word -> IntSet
tip Int
kx Word
bm' IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Int -> Word -> IntSet
tip Int
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
bm'))
    go Int -> Bool
_ IntSet
Nil = (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
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 -> IntSet -> (IntSet,IntSet)
split :: Int -> IntSet -> (IntSet, IntSet)
split Int
x IntSet
t =
  case IntSet
t of
    Bin Prefix
p IntSet
l IntSet
r
      | Prefix -> Bool
signBranch Prefix
p ->
        if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0  -- handle negative numbers.
        then
          case Int -> IntSet -> StrictPair IntSet IntSet
go Int
x IntSet
l of
            (IntSet
lt :*: IntSet
gt) ->
              let !lt' :: IntSet
lt' = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
lt IntSet
r
              in (IntSet
lt', IntSet
gt)
        else
          case Int -> IntSet -> StrictPair IntSet IntSet
go Int
x IntSet
r of
            (IntSet
lt :*: IntSet
gt) ->
              let !gt' :: IntSet
gt' = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l IntSet
gt
              in (IntSet
lt, IntSet
gt')
    IntSet
_ -> case Int -> IntSet -> StrictPair IntSet IntSet
go Int
x IntSet
t of
          (IntSet
lt :*: IntSet
gt) -> (IntSet
lt, IntSet
gt)
  where
    go :: Int -> IntSet -> StrictPair IntSet IntSet
go !Int
x' t' :: IntSet
t'@(Bin Prefix
p IntSet
l IntSet
r)
        | Int -> Prefix -> Bool
nomatch Int
x' Prefix
p = if Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Prefix -> Int
unPrefix Prefix
p then (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
t') else (IntSet
t' IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
Nil)
        | Int -> Prefix -> Bool
left Int
x' Prefix
p    = case Int -> IntSet -> StrictPair IntSet IntSet
go Int
x' IntSet
l of (IntSet
lt :*: IntSet
gt) -> IntSet
lt IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
gt IntSet
r
        | Bool
otherwise    = case Int -> IntSet -> StrictPair IntSet IntSet
go Int
x' IntSet
r of (IntSet
lt :*: IntSet
gt) -> Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l IntSet
lt IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
gt
    go Int
x' t' :: IntSet
t'@(Tip Int
kx' Word
bm)
        | Int
kx' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
x'          = (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
t')
          -- equivalent to kx' > prefixOf x'
        | Int
kx' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int
prefixOf Int
x' = (IntSet
t' IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
Nil)
        | Bool
otherwise = Int -> Word -> IntSet
tip Int
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
lowerBitmap) IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: Int -> Word -> IntSet
tip Int
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
higherBitmap)
            where lowerBitmap :: Word
lowerBitmap = Int -> Word
bitmapOf Int
x' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
                  higherBitmap :: Word
higherBitmap = Word -> Word
forall a. Bits a => a -> a
complement (Word
lowerBitmap Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Int -> Word
bitmapOf Int
x')
    go Int
_ IntSet
Nil = (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
Nil)

-- | \(O(\min(n,W))\). Performs a 'split' but also returns whether the pivot
-- element was found in the original set.
splitMember :: Key -> IntSet -> (IntSet,Bool,IntSet)
splitMember :: Int -> IntSet -> (IntSet, Bool, IntSet)
splitMember Int
x IntSet
t =
  case IntSet
t of
    Bin Prefix
p IntSet
l IntSet
r
      | Prefix -> Bool
signBranch Prefix
p ->
        if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -- handle negative numbers.
        then
          case Int -> IntSet -> (IntSet, Bool, IntSet)
go Int
x IntSet
l of
            (IntSet
lt, Bool
fnd, IntSet
gt) ->
              let !lt' :: IntSet
lt' = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
lt IntSet
r
              in (IntSet
lt', Bool
fnd, IntSet
gt)
        else
          case Int -> IntSet -> (IntSet, Bool, IntSet)
go Int
x IntSet
r of
            (IntSet
lt, Bool
fnd, IntSet
gt) ->
              let !gt' :: IntSet
gt' = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l IntSet
gt
              in (IntSet
lt, Bool
fnd, IntSet
gt')
    IntSet
_ -> Int -> IntSet -> (IntSet, Bool, IntSet)
go Int
x IntSet
t
  where
    go :: Int -> IntSet -> (IntSet, Bool, IntSet)
go !Int
x' t' :: IntSet
t'@(Bin Prefix
p IntSet
l IntSet
r)
        | Int -> Prefix -> Bool
nomatch Int
x' Prefix
p = if Int
x' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Prefix -> Int
unPrefix Prefix
p then (IntSet
Nil, Bool
False, IntSet
t') else (IntSet
t', Bool
False, IntSet
Nil)
        | Int -> Prefix -> Bool
left Int
x' Prefix
p =
          case Int -> IntSet -> (IntSet, Bool, IntSet)
go Int
x' IntSet
l of
            (IntSet
lt, Bool
fnd, IntSet
gt) ->
              let !gt' :: IntSet
gt' = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
gt IntSet
r
              in (IntSet
lt, Bool
fnd, IntSet
gt')
        | Bool
otherwise =
          case Int -> IntSet -> (IntSet, Bool, IntSet)
go Int
x' IntSet
r of
            (IntSet
lt, Bool
fnd, IntSet
gt) ->
              let !lt' :: IntSet
lt' = Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l IntSet
lt
              in (IntSet
lt', Bool
fnd, IntSet
gt)
    go Int
x' t' :: IntSet
t'@(Tip Int
kx' Word
bm)
        | Int
kx' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
x'          = (IntSet
Nil, Bool
False, IntSet
t')
          -- equivalent to kx' > prefixOf x'
        | Int
kx' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int
prefixOf Int
x' = (IntSet
t', Bool
False, IntSet
Nil)
        | Bool
otherwise = let !lt :: IntSet
lt = Int -> Word -> IntSet
tip Int
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
lowerBitmap)
                          !found :: Bool
found = (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bitmapOfx') Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0
                          !gt :: IntSet
gt = Int -> Word -> IntSet
tip Int
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
higherBitmap)
                      in (IntSet
lt, Bool
found, IntSet
gt)
            where bitmapOfx' :: Word
bitmapOfx' = Int -> Word
bitmapOf Int
x'
                  lowerBitmap :: Word
lowerBitmap = Word
bitmapOfx' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
                  higherBitmap :: Word
higherBitmap = Word -> Word
forall a. Bits a => a -> a
complement (Word
lowerBitmap Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
bitmapOfx')
    go Int
_ IntSet
Nil = (IntSet
Nil, Bool
False, IntSet
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 :: IntSet -> Maybe (Key, IntSet)
maxView :: IntSet -> Maybe (Int, IntSet)
maxView IntSet
t =
  case IntSet
t of IntSet
Nil -> Maybe (Int, IntSet)
forall a. Maybe a
Nothing
            Bin Prefix
p IntSet
l IntSet
r | Prefix -> Bool
signBranch Prefix
p -> case IntSet -> (Int, IntSet)
go IntSet
l of (Int
result, IntSet
l') -> (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (Int
result, Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l' IntSet
r)
            IntSet
_ -> (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (IntSet -> (Int, IntSet)
go IntSet
t)
  where
    go :: IntSet -> (Int, IntSet)
go (Bin Prefix
p IntSet
l IntSet
r) = case IntSet -> (Int, IntSet)
go IntSet
r of (Int
result, IntSet
r') -> (Int
result, Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l IntSet
r')
    go (Tip Int
kx Word
bm) = case Word -> Int
highestBitSet Word
bm of Int
bi -> (Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bi, Int -> Word -> IntSet
tip Int
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Int -> Word
bitmapOfSuffix Int
bi)))
    go IntSet
Nil = [Char] -> (Int, IntSet)
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 :: IntSet -> Maybe (Key, IntSet)
minView :: IntSet -> Maybe (Int, IntSet)
minView IntSet
t =
  case IntSet
t of IntSet
Nil -> Maybe (Int, IntSet)
forall a. Maybe a
Nothing
            Bin Prefix
p IntSet
l IntSet
r | Prefix -> Bool
signBranch Prefix
p -> case IntSet -> (Int, IntSet)
go IntSet
r of (Int
result, IntSet
r') -> (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (Int
result, Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l IntSet
r')
            IntSet
_ -> (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (IntSet -> (Int, IntSet)
go IntSet
t)
  where
    go :: IntSet -> (Int, IntSet)
go (Bin Prefix
p IntSet
l IntSet
r) = case IntSet -> (Int, IntSet)
go IntSet
l of (Int
result, IntSet
l') -> (Int
result, Prefix -> IntSet -> IntSet -> IntSet
bin Prefix
p IntSet
l' IntSet
r)
    go (Tip Int
kx Word
bm) = case Word -> Int
lowestBitSet Word
bm of Int
bi -> (Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bi, Int -> Word -> IntSet
tip Int
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Int -> Word
bitmapOfSuffix Int
bi)))
    go IntSet
Nil = [Char] -> (Int, IntSet)
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 :: IntSet -> (Key, IntSet)
deleteFindMin :: IntSet -> (Int, IntSet)
deleteFindMin = (Int, IntSet) -> Maybe (Int, IntSet) -> (Int, IntSet)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Int, IntSet)
forall a. HasCallStack => [Char] -> a
error [Char]
"deleteFindMin: empty set has no minimal element") (Maybe (Int, IntSet) -> (Int, IntSet))
-> (IntSet -> Maybe (Int, IntSet)) -> IntSet -> (Int, IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Int, IntSet)
minView

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

lookupMinSure :: IntSet -> Key
lookupMinSure :: IntSet -> Int
lookupMinSure (Tip Int
kx Word
bm) = Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
lowestBitSet Word
bm
lookupMinSure (Bin Prefix
_ IntSet
l IntSet
_) = IntSet -> Int
lookupMinSure IntSet
l
lookupMinSure IntSet
Nil         = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"lookupMin Nil"

-- | \(O(\min(n,W))\). The minimal element of the set. Returns 'Nothing' if the
-- set is empty.
--
-- @since 0.8
lookupMin :: IntSet -> Maybe Key
lookupMin :: IntSet -> Maybe Int
lookupMin IntSet
Nil         = Maybe Int
forall a. Maybe a
Nothing
lookupMin (Tip Int
kx Word
bm) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
lowestBitSet Word
bm
lookupMin (Bin Prefix
p IntSet
l IntSet
r) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! IntSet -> Int
lookupMinSure (if Prefix -> Bool
signBranch Prefix
p then IntSet
r else IntSet
l)
{-# INLINE lookupMin #-} -- See Note [Inline lookupMin] in Data.Set.Internal

-- | \(O(\min(n,W))\). The minimal element of the set. Calls 'error' if the set
-- is empty.
findMin :: IntSet -> Key
findMin :: IntSet -> Int
findMin IntSet
t
  | Just Int
r <- IntSet -> Maybe Int
lookupMin IntSet
t = Int
r
  | Bool
otherwise = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"findMin: empty set has no minimal element"

lookupMaxSure :: IntSet -> Key
lookupMaxSure :: IntSet -> Int
lookupMaxSure (Tip Int
kx Word
bm) = Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
highestBitSet Word
bm
lookupMaxSure (Bin Prefix
_ IntSet
_ IntSet
r) = IntSet -> Int
lookupMaxSure IntSet
r
lookupMaxSure IntSet
Nil         = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"lookupMax Nil"

-- | \(O(\min(n,W))\). The maximal element of the set. Returns 'Nothing' if the
-- set is empty.
--
-- @since 0.8
lookupMax :: IntSet -> Maybe Key
lookupMax :: IntSet -> Maybe Int
lookupMax IntSet
Nil         = Maybe Int
forall a. Maybe a
Nothing
lookupMax (Tip Int
kx Word
bm) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
highestBitSet Word
bm
lookupMax (Bin Prefix
p IntSet
l IntSet
r) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! IntSet -> Int
lookupMaxSure (if Prefix -> Bool
signBranch Prefix
p then IntSet
l else IntSet
r)
{-# INLINE lookupMax #-} -- See Note [Inline lookupMin] in Data.Set.Internal

-- | \(O(\min(n,W))\). The maximal element of the set. Calls 'error' if the set
-- is empty.
findMax :: IntSet -> Key
findMax :: IntSet -> Int
findMax IntSet
t
  | Just Int
r <- IntSet -> Maybe Int
lookupMax IntSet
t = Int
r
  | Bool
otherwise = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"findMax: empty set has no maximal element"

-- | \(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 'IntSet' was already empty.
deleteMin :: IntSet -> IntSet
deleteMin :: IntSet -> IntSet
deleteMin = IntSet
-> ((Int, IntSet) -> IntSet) -> Maybe (Int, IntSet) -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntSet
Nil (Int, IntSet) -> IntSet
forall a b. (a, b) -> b
snd (Maybe (Int, IntSet) -> IntSet)
-> (IntSet -> Maybe (Int, IntSet)) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Int, IntSet)
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 'IntSet' was already empty.
deleteMax :: IntSet -> IntSet
deleteMax :: IntSet -> IntSet
deleteMax = IntSet
-> ((Int, IntSet) -> IntSet) -> Maybe (Int, IntSet) -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntSet
Nil (Int, IntSet) -> IntSet
forall a b. (a, b) -> b
snd (Maybe (Int, IntSet) -> IntSet)
-> (IntSet -> Maybe (Int, IntSet)) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Int, IntSet)
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) -> IntSet -> IntSet
map :: (Int -> Int) -> IntSet -> IntSet
map Int -> Int
f = [Int] -> IntSet
fromList ([Int] -> IntSet) -> (IntSet -> [Int]) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
List.map Int -> Int
f ([Int] -> [Int]) -> (IntSet -> [Int]) -> IntSet -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
toList

-- | \(O(n)\). The
--
-- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is strictly increasing.
-- 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
--
-- __Warning__: This function should be used only if @f@ is monotonically
-- strictly increasing. This precondition is not checked. Use 'map' if the
-- precondition may not hold.
--
-- @since 0.6.3.1

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


{--------------------------------------------------------------------
  Fold
--------------------------------------------------------------------}
-- | \(O(n)\). Fold the elements in the set using the given right-associative
-- binary operator.
--
{-# DEPRECATED fold "Use Data.IntSet.foldr instead" #-}
fold :: (Key -> b -> b) -> b -> IntSet -> b
fold :: forall b. (Int -> b -> b) -> b -> IntSet -> b
fold = (Int -> b -> b) -> b -> IntSet -> b
forall b. (Int -> b -> b) -> b -> IntSet -> 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 -> IntSet -> b
foldr :: forall b. (Int -> b -> b) -> b -> IntSet -> b
foldr Int -> b -> b
f b
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Prefix
p IntSet
l IntSet
r | Prefix -> Bool
signBranch Prefix
p -> b -> IntSet -> b
go (b -> IntSet -> b
go b
z IntSet
l) IntSet
r -- put negative numbers before
                      | Bool
otherwise -> b -> IntSet -> b
go (b -> IntSet -> b
go b
z IntSet
r) IntSet
l
            IntSet
_ -> b -> IntSet -> b
go b
z IntSet
t
  where
    go :: b -> IntSet -> b
go b
z' IntSet
Nil         = b
z'
    go b
z' (Tip Int
kx Word
bm) = Int -> (Int -> b -> b) -> b -> Word -> b
forall a. Int -> (Int -> a -> a) -> a -> Word -> a
foldrBits Int
kx Int -> b -> b
f b
z' Word
bm
    go b
z' (Bin Prefix
_ IntSet
l IntSet
r) = b -> IntSet -> b
go (b -> IntSet -> b
go b
z' IntSet
r) IntSet
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 -> IntSet -> b
foldr' :: forall b. (Int -> b -> b) -> b -> IntSet -> b
foldr' Int -> b -> b
f b
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Prefix
p IntSet
l IntSet
r | Prefix -> Bool
signBranch Prefix
p -> b -> IntSet -> b
go (b -> IntSet -> b
go b
z IntSet
l) IntSet
r -- put negative numbers before
                      | Bool
otherwise -> b -> IntSet -> b
go (b -> IntSet -> b
go b
z IntSet
r) IntSet
l
            IntSet
_ -> b -> IntSet -> b
go b
z IntSet
t
  where
    go :: b -> IntSet -> b
go !b
z' IntSet
Nil        = b
z'
    go b
z' (Tip Int
kx Word
bm) = Int -> (Int -> b -> b) -> b -> Word -> b
forall a. Int -> (Int -> a -> a) -> a -> Word -> a
foldr'Bits Int
kx Int -> b -> b
f b
z' Word
bm
    go b
z' (Bin Prefix
_ IntSet
l IntSet
r) = b -> IntSet -> b
go (b -> IntSet -> b
go b
z' IntSet
r) IntSet
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 -> IntSet -> a
foldl :: forall a. (a -> Int -> a) -> a -> IntSet -> a
foldl a -> Int -> a
f a
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Prefix
p IntSet
l IntSet
r | Prefix -> Bool
signBranch Prefix
p -> a -> IntSet -> a
go (a -> IntSet -> a
go a
z IntSet
r) IntSet
l -- put negative numbers before
                      | Bool
otherwise -> a -> IntSet -> a
go (a -> IntSet -> a
go a
z IntSet
l) IntSet
r
            IntSet
_ -> a -> IntSet -> a
go a
z IntSet
t
  where
    go :: a -> IntSet -> a
go a
z' IntSet
Nil         = a
z'
    go a
z' (Tip Int
kx Word
bm) = Int -> (a -> Int -> a) -> a -> Word -> a
forall a. Int -> (a -> Int -> a) -> a -> Word -> a
foldlBits Int
kx a -> Int -> a
f a
z' Word
bm
    go a
z' (Bin Prefix
_ IntSet
l IntSet
r) = a -> IntSet -> a
go (a -> IntSet -> a
go a
z' IntSet
l) IntSet
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 -> IntSet -> a
foldl' :: forall a. (a -> Int -> a) -> a -> IntSet -> a
foldl' a -> Int -> a
f a
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Prefix
p IntSet
l IntSet
r | Prefix -> Bool
signBranch Prefix
p -> a -> IntSet -> a
go (a -> IntSet -> a
go a
z IntSet
r) IntSet
l -- put negative numbers before
                      | Bool
otherwise -> a -> IntSet -> a
go (a -> IntSet -> a
go a
z IntSet
l) IntSet
r
            IntSet
_ -> a -> IntSet -> a
go a
z IntSet
t
  where
    go :: a -> IntSet -> a
go !a
z' IntSet
Nil        = a
z'
    go a
z' (Tip Int
kx Word
bm) = Int -> (a -> Int -> a) -> a -> Word -> a
forall a. Int -> (a -> Int -> a) -> a -> Word -> a
foldl'Bits Int
kx a -> Int -> a
f a
z' Word
bm
    go a
z' (Bin Prefix
_ IntSet
l IntSet
r) = a -> IntSet -> a
go (a -> IntSet -> a
go a
z' IntSet
l) IntSet
r
{-# INLINE foldl' #-}

-- | \(O(n)\). Map the elements in the set to a monoid and combine with @(<>)@.
--
-- @since 0.8
foldMap :: Monoid a => (Key -> a) -> IntSet -> a
foldMap :: forall a. Monoid a => (Int -> a) -> IntSet -> a
foldMap Int -> a
f = \IntSet
t ->  -- Use lambda t to be inlinable with one argument only.
  case IntSet
t of
    Bin Prefix
p IntSet
l IntSet
r
#if MIN_VERSION_base(4,11,0)
      | Prefix -> Bool
signBranch Prefix
p -> IntSet -> a
go IntSet
r a -> a -> a
forall a. Semigroup a => a -> a -> a
<> IntSet -> a
go IntSet
l  -- handle negative numbers
      | Bool
otherwise -> IntSet -> a
go IntSet
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> IntSet -> a
go IntSet
r
#else
      | signBranch p -> go r `mappend` go l  -- handle negative numbers
      | otherwise -> go l `mappend` go r
#endif
    IntSet
_ -> IntSet -> a
go IntSet
t
  where
#if MIN_VERSION_base(4,11,0)
    go :: IntSet -> a
go (Bin Prefix
_ IntSet
l IntSet
r) = IntSet -> a
go IntSet
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> IntSet -> a
go IntSet
r
#else
    go (Bin _ l r) = go l `mappend` go r
#endif
    go (Tip Int
kx Word
bm) = Int -> (Int -> a) -> Word -> a
forall a. Semigroup a => Int -> (Int -> a) -> Word -> a
foldMapBits Int
kx Int -> a
f Word
bm
    go IntSet
Nil = a
forall a. Monoid a => a
mempty
{-# INLINE foldMap #-}

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

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

#ifdef __GLASGOW_HASKELL__
-- | @since 0.5.6.2
instance GHC.Exts.IsList IntSet where
  type Item IntSet = Key
  fromList :: [Item IntSet] -> IntSet
fromList = [Int] -> IntSet
[Item IntSet] -> IntSet
fromList
  toList :: IntSet -> [Item IntSet]
toList   = IntSet -> [Int]
IntSet -> [Item IntSet]
toList
#endif

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

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

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

-- List fusion for the list generating functions.
#if __GLASGOW_HASKELL__
-- 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 -> IntSet -> b
foldrFB :: forall b. (Int -> b -> b) -> b -> IntSet -> b
foldrFB = (Int -> b -> b) -> b -> IntSet -> b
forall b. (Int -> b -> b) -> b -> IntSet -> b
foldr
{-# INLINE[0] foldrFB #-}
foldlFB :: (a -> Key -> a) -> a -> IntSet -> a
foldlFB :: forall a. (a -> Int -> a) -> a -> IntSet -> a
foldlFB = (a -> Int -> a) -> a -> IntSet -> a
forall a. (a -> Int -> a) -> a -> IntSet -> 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 "IntSet.toAscList" [~1] forall s . toAscList s = GHC.Exts.build (\c n -> foldrFB c n s) #-}
{-# RULES "IntSet.toAscListBack" [1] foldrFB (:) [] = toAscList #-}
{-# RULES "IntSet.toDescList" [~1] forall s . toDescList s = GHC.Exts.build (\c n -> foldlFB (\xs x -> c x xs) n s) #-}
{-# RULES "IntSet.toDescListBack" [1] foldlFB (\xs x -> x : xs) [] = toDescList #-}
#endif


-- | \(O(n \min(n,W))\). Create a set from a list of integers.
fromList :: [Key] -> IntSet
fromList :: [Int] -> IntSet
fromList [Int]
xs
  = (IntSet -> Int -> IntSet) -> IntSet -> [Int] -> IntSet
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' IntSet -> Int -> IntSet
ins IntSet
empty [Int]
xs
  where
    ins :: IntSet -> Int -> IntSet
ins IntSet
t Int
x  = Int -> IntSet -> IntSet
insert Int
x IntSet
t

-- | \(O(n / W)\). Create a set from a range of integers.
--
-- > fromRange (low, high) == fromList [low..high]
--
-- @since 0.7
fromRange :: (Key, Key) -> IntSet
fromRange :: (Int, Int) -> IntSet
fromRange (Int
lx,Int
rx)
  | Int
lx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
rx  = IntSet
empty
  | Int
lp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rp = Int -> Word -> IntSet
Tip Int
lp (Int -> Word
bitmapOf Int
rx Word -> Int -> Word
`shiftLL` Int
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Int -> Word
bitmapOf Int
lx)
  | Bool
otherwise =
      let m :: Int
m = Int -> Int -> Int
branchMask Int
lx Int
rx
          p :: Prefix
p = Int -> Prefix
Prefix (Int -> Int -> Int
mask Int
lx Int
m Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
m)
      in if Prefix -> Bool
signBranch Prefix
p  -- handle negative numbers
         then Prefix -> IntSet -> IntSet -> IntSet
Bin Prefix
p (Int -> IntSet
goR Int
0) (Int -> IntSet
goL Int
0)
         else Prefix -> IntSet -> IntSet -> IntSet
Bin Prefix
p (Int -> IntSet
goL (Prefix -> Int
unPrefix Prefix
p)) (Int -> IntSet
goR (Prefix -> Int
unPrefix Prefix
p))
  where
    lp :: Int
lp = Int -> Int
prefixOf Int
lx
    rp :: Int
rp = Int -> Int
prefixOf Int
rx
    -- goL p0 = fromList [lx .. p0-1]
    -- Expected: p0 is lx where one 0-bit is flipped to 1 and all bits lower than that are 0.
    --           p0 can be 0 (pretend that bit WORD_SIZE is flipped to 1).
    goL :: Int -> IntSet
    goL :: Int -> IntSet
goL !Int
p0 = IntSet -> Int -> IntSet
go (Int -> Word -> IntSet
Tip Int
lp (- Int -> Word
bitmapOf Int
lx)) (Int
lp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
lbm Int
prefixBitMask)
      where
        go :: IntSet -> Int -> IntSet
go !IntSet
l Int
p | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p0 = IntSet
l
        go IntSet
l Int
p =
          let m :: Int
m = Int -> Int
lbm Int
p
              l' :: IntSet
l' = Prefix -> IntSet -> IntSet -> IntSet
Bin (Int -> Prefix
Prefix Int
p) IntSet
l (Int -> Int -> IntSet
goFull Int
p (Int -> Int
shr1 Int
m))
          in IntSet -> Int -> IntSet
go IntSet
l' (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m)
    -- goR p0 = fromList [p0 .. rx]
    -- Expected: p0 is a prefix of rx
    goR :: Int -> IntSet
    goR :: Int -> IntSet
goR !Int
p0 = IntSet -> Int -> IntSet
go (Int -> Word -> IntSet
Tip Int
rp (Int -> Word
bitmapOf Int
rx Word -> Int -> Word
`shiftLL` Int
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)) Int
rp
      where
        go :: IntSet -> Int -> IntSet
go !IntSet
r Int
p | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p0 = IntSet
r
        go IntSet
r Int
p =
          let m :: Int
m = Int -> Int
lbm Int
p
              p' :: Int
p' = Int
p Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
m
              r' :: IntSet
r' = Prefix -> IntSet -> IntSet -> IntSet
Bin (Int -> Prefix
Prefix Int
p) (Int -> Int -> IntSet
goFull Int
p' (Int -> Int
shr1 Int
m)) IntSet
r
          in IntSet -> Int -> IntSet
go IntSet
r' Int
p'
    -- goFull p m = fromList [p .. p+2*m-1]
    -- Expected: popCount m == 1, p == mask p m
    goFull :: Int -> Int -> IntSet
    goFull :: Int -> Int -> IntSet
goFull Int
p Int
m
      | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
suffixBitMask = Int -> Word -> IntSet
Tip Int
p (Word -> Word
forall a. Bits a => a -> a
complement Word
0)
      | Bool
otherwise         = Prefix -> IntSet -> IntSet -> IntSet
Bin (Int -> Prefix
Prefix (Int
p Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
m)) (Int -> Int -> IntSet
goFull Int
p (Int -> Int
shr1 Int
m)) (Int -> Int -> IntSet
goFull (Int
p Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
m) (Int -> Int
shr1 Int
m))
    lbm :: Int -> Int
    lbm :: Int -> Int
lbm Int
p = Int
p Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Num a => a -> a
negate Int
p -- lowest bit mask
    {-# INLINE lbm #-}
    shr1 :: Int -> Int
    shr1 :: Int -> Int
shr1 Int
m = Int
m Int -> Int -> Int
`iShiftRL` Int
1
    {-# INLINE shr1 #-}

-- | \(O(n)\). Build a set from an ascending list of elements.
--
-- __Warning__: This function should be used only if the elements are in
-- non-decreasing order. This precondition is not checked. Use 'fromList' if the
-- precondition may not hold.
fromAscList :: [Key] -> IntSet
fromAscList :: [Int] -> IntSet
fromAscList = [Int] -> IntSet
fromMonoList
{-# NOINLINE fromAscList #-}

-- | \(O(n)\). Build a set from an ascending list of distinct elements.
--
-- __Warning__: This function should be used only if the elements are in
-- strictly increasing order. This precondition is not checked. Use 'fromList'
-- if the precondition may not hold.
fromDistinctAscList :: [Key] -> IntSet
fromDistinctAscList :: [Int] -> IntSet
fromDistinctAscList = [Int] -> IntSet
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] -> IntSet
fromMonoList :: [Int] -> IntSet
fromMonoList []         = IntSet
Nil
fromMonoList (Int
kx : [Int]
zs1) = Int -> Word -> [Int] -> IntSet
addAll' (Int -> Int
prefixOf Int
kx) (Int -> Word
bitmapOf Int
kx) [Int]
zs1
  where
    -- `addAll'` collects all keys with the prefix `px` into a single
    -- bitmap, and then proceeds with `addAll`.
    addAll' :: Int -> Word -> [Int] -> IntSet
addAll' !Int
px !Word
bm []
        = Int -> Word -> IntSet
Tip Int
px Word
bm
    addAll' !Int
px !Word
bm (Int
ky : [Int]
zs)
        | Int
px Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
prefixOf Int
ky
        = Int -> Word -> [Int] -> IntSet
addAll' Int
px (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Int -> Word
bitmapOf Int
ky) [Int]
zs
        -- inlined: | otherwise = addAll px (Tip px bm) (ky : zs)
        | Int
py <- Int -> Int
prefixOf Int
ky
        , Int
m <- Int -> Int -> Int
branchMask Int
px Int
py
        , Inserted IntSet
ty [Int]
zs' <- Int -> Int -> Word -> [Int] -> Inserted
addMany' Int
m Int
py (Int -> Word
bitmapOf Int
ky) [Int]
zs
        = Int -> IntSet -> [Int] -> IntSet
addAll Int
px (Int -> Int -> IntSet -> Int -> IntSet -> IntSet
linkWithMask Int
m Int
py IntSet
ty Int
px (Int -> Word -> IntSet
Tip Int
px Word
bm)) [Int]
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 :: Int -> IntSet -> [Int] -> IntSet
addAll !Int
_px !IntSet
tx []
        = IntSet
tx
    addAll !Int
px !IntSet
tx (Int
ky : [Int]
zs)
        | Int
py <- Int -> Int
prefixOf Int
ky
        , Int
m <- Int -> Int -> Int
branchMask Int
px Int
py
        , Inserted IntSet
ty [Int]
zs' <- Int -> Int -> Word -> [Int] -> Inserted
addMany' Int
m Int
py (Int -> Word
bitmapOf Int
ky) [Int]
zs
        = Int -> IntSet -> [Int] -> IntSet
addAll Int
px (Int -> Int -> IntSet -> Int -> IntSet -> IntSet
linkWithMask Int
m Int
py IntSet
ty Int
px IntSet
tx) [Int]
zs'

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

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

data Inserted = Inserted !IntSet ![Key]

{--------------------------------------------------------------------
  Eq
--------------------------------------------------------------------}
instance Eq IntSet where
  == :: IntSet -> IntSet -> Bool
(==) = IntSet -> IntSet -> Bool
equal

equal :: IntSet -> IntSet -> Bool
equal :: IntSet -> IntSet -> Bool
equal (Bin Prefix
p1 IntSet
l1 IntSet
r1) (Bin Prefix
p2 IntSet
l2 IntSet
r2)
  = (Prefix
p1 Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
== Prefix
p2) Bool -> Bool -> Bool
&& (IntSet -> IntSet -> Bool
equal IntSet
l1 IntSet
l2) Bool -> Bool -> Bool
&& (IntSet -> IntSet -> Bool
equal IntSet
r1 IntSet
r2)
equal (Tip Int
kx1 Word
bm1) (Tip Int
kx2 Word
bm2)
  = Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 Bool -> Bool -> Bool
&& Word
bm1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
bm2
equal IntSet
Nil IntSet
Nil = Bool
True
equal IntSet
_   IntSet
_   = Bool
False

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

instance Ord IntSet where
  compare :: IntSet -> IntSet -> Ordering
compare = IntSet -> IntSet -> Ordering
compareIntSets

compareIntSets :: IntSet -> IntSet -> Ordering
compareIntSets :: IntSet -> IntSet -> Ordering
compareIntSets IntSet
s1 IntSet
s2 = case (IntSet -> (IntSet, IntSet)
splitSign IntSet
s1, IntSet -> (IntSet, IntSet)
splitSign IntSet
s2) of
  ((IntSet
l1, IntSet
r1), (IntSet
l2, IntSet
r2)) -> case IntSet -> IntSet -> Order
go IntSet
l1 IntSet
l2 of
    Order
A_LT_B -> Ordering
LT
    Order
A_Prefix_B -> if IntSet -> Bool
null IntSet
r1 then Ordering
LT else Ordering
GT
    Order
A_EQ_B -> case IntSet -> IntSet -> Order
go IntSet
r1 IntSet
r2 of
      Order
A_LT_B -> Ordering
LT
      Order
A_Prefix_B -> Ordering
LT
      Order
A_EQ_B -> Ordering
EQ
      Order
B_Prefix_A -> Ordering
GT
      Order
A_GT_B -> Ordering
GT
    Order
B_Prefix_A -> if IntSet -> Bool
null IntSet
r2 then Ordering
GT else Ordering
LT
    Order
A_GT_B -> Ordering
GT
  where
    go :: IntSet -> IntSet -> Order
go t1 :: IntSet
t1@(Bin Prefix
p1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Prefix
p2 IntSet
l2 IntSet
r2) = case Prefix -> Prefix -> TreeTreeBranch
treeTreeBranch Prefix
p1 Prefix
p2 of
      TreeTreeBranch
ABL -> case IntSet -> IntSet -> Order
go IntSet
l1 IntSet
t2 of
        Order
A_Prefix_B -> Order
A_GT_B
        Order
A_EQ_B -> Order
B_Prefix_A
        Order
o -> Order
o
      TreeTreeBranch
ABR -> Order
A_LT_B
      TreeTreeBranch
BAL -> case IntSet -> IntSet -> Order
go IntSet
t1 IntSet
l2 of
        Order
A_EQ_B -> Order
A_Prefix_B
        Order
B_Prefix_A -> Order
A_LT_B
        Order
o -> Order
o
      TreeTreeBranch
BAR -> Order
A_GT_B
      TreeTreeBranch
EQL -> case IntSet -> IntSet -> Order
go IntSet
l1 IntSet
l2 of
        Order
A_Prefix_B -> Order
A_GT_B
        Order
A_EQ_B -> IntSet -> IntSet -> Order
go IntSet
r1 IntSet
r2
        Order
B_Prefix_A -> Order
A_LT_B
        Order
o -> Order
o
      TreeTreeBranch
NOM -> if Prefix -> Int
unPrefix Prefix
p1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Prefix -> Int
unPrefix Prefix
p2 then Order
A_LT_B else Order
A_GT_B
    go (Bin Prefix
_ IntSet
l1 IntSet
_) (Tip Int
k2 Word
bm2) = case IntSet -> Tip'
leftmostTipSure IntSet
l1 of
      Tip' Int
k1 Word
bm1 -> case Int -> Word -> Int -> Word -> Order
orderTips Int
k1 Word
bm1 Int
k2 Word
bm2 of
        Order
A_Prefix_B -> Order
A_GT_B
        Order
A_EQ_B -> Order
B_Prefix_A
        Order
o -> Order
o
    go (Tip Int
k1 Word
bm1) (Bin Prefix
_ IntSet
l2 IntSet
_) = case IntSet -> Tip'
leftmostTipSure IntSet
l2 of
      Tip' Int
k2 Word
bm2 -> case Int -> Word -> Int -> Word -> Order
orderTips Int
k1 Word
bm1 Int
k2 Word
bm2 of
        Order
A_EQ_B -> Order
A_Prefix_B
        Order
B_Prefix_A -> Order
A_LT_B
        Order
o -> Order
o
    go (Tip Int
k1 Word
bm1) (Tip Int
k2 Word
bm2) = Int -> Word -> Int -> Word -> Order
orderTips Int
k1 Word
bm1 Int
k2 Word
bm2
    go IntSet
Nil IntSet
Nil = Order
A_EQ_B
    go IntSet
Nil IntSet
_ = Order
A_Prefix_B
    go IntSet
_ IntSet
Nil = Order
B_Prefix_A

-- This type allows GHC to return unboxed ints from leftmostTipSure, as
-- $wleftmostTipSure :: IntSet -> (# Int#, Word# #)
-- On a modern enough GHC (>=9.4) this is unnecessary, we could use StrictPair
-- instead and get the same Core.
data Tip' = Tip' {-# UNPACK #-} !Int {-# UNPACK #-} !BitMap

leftmostTipSure :: IntSet -> Tip'
leftmostTipSure :: IntSet -> Tip'
leftmostTipSure (Bin Prefix
_ IntSet
l IntSet
_) = IntSet -> Tip'
leftmostTipSure IntSet
l
leftmostTipSure (Tip Int
k Word
bm) = Int -> Word -> Tip'
Tip' Int
k Word
bm
leftmostTipSure IntSet
Nil = [Char] -> Tip'
forall a. HasCallStack => [Char] -> a
error [Char]
"leftmostTipSure: Nil"

orderTips :: Int -> BitMap -> Int -> BitMap -> Order
orderTips :: Int -> Word -> Int -> Word -> Order
orderTips Int
k1 Word
bm1 Int
k2 Word
bm2 = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k1 Int
k2 of
  Ordering
LT -> Order
A_LT_B
  Ordering
EQ | Word
bm1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
bm2 -> Order
A_EQ_B
     | Bool
otherwise ->
         -- To lexicographically compare the elements of two BitMaps,
         -- - Find the lowest bit where they differ.
         -- - For the BitMap with this bit 0, check if all higher bits are also
         --   0. If yes it is a prefix, otherwise it is greater.
         let diff :: Word
diff = Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
bm2
             lowestDiff :: Word
lowestDiff = Word
diff Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Num a => a -> a
negate Word
diff
             highMask :: Word
highMask = Word -> Word
forall a. Num a => a -> a
negate Word
lowestDiff
         in if Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
lowestDiff Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
            then (if Word
bm1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
highMask Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Order
A_Prefix_B else Order
A_GT_B)
            else (if Word
bm2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
highMask Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Order
B_Prefix_A else Order
A_LT_B)
  Ordering
GT -> Order
A_GT_B
{-# INLINE orderTips #-}

-- Split into negative and non-negative
splitSign :: IntSet -> (IntSet, IntSet)
splitSign :: IntSet -> (IntSet, IntSet)
splitSign t :: IntSet
t@(Bin Prefix
p IntSet
l IntSet
r)
  | Prefix -> Bool
signBranch Prefix
p = (IntSet
r, IntSet
l)
  | Prefix -> Int
unPrefix Prefix
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (IntSet
t, IntSet
Nil)
  | Bool
otherwise = (IntSet
Nil, IntSet
t)
splitSign t :: IntSet
t@(Tip Int
k Word
_)
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (IntSet
t, IntSet
Nil)
  | Bool
otherwise = (IntSet
Nil, IntSet
t)
splitSign IntSet
Nil = (IntSet
Nil, IntSet
Nil)
{-# INLINE splitSign #-}

{--------------------------------------------------------------------
  Show
--------------------------------------------------------------------}
instance Show IntSet where
  showsPrec :: Int -> IntSet -> ShowS
showsPrec Int
p IntSet
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
. [Int] -> ShowS
forall a. Show a => a -> ShowS
shows (IntSet -> [Int]
toList IntSet
xs)

{--------------------------------------------------------------------
  Read
--------------------------------------------------------------------}
instance Read IntSet where
#ifdef __GLASGOW_HASKELL__
  readPrec :: ReadPrec IntSet
readPrec = ReadPrec IntSet -> ReadPrec IntSet
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec IntSet -> ReadPrec IntSet)
-> ReadPrec IntSet -> ReadPrec IntSet
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec IntSet -> ReadPrec IntSet
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec IntSet -> ReadPrec IntSet)
-> ReadPrec IntSet -> ReadPrec IntSet
forall a b. (a -> b) -> a -> b
$ do
    Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
    [Int]
xs <- ReadPrec [Int]
forall a. Read a => ReadPrec a
readPrec
    IntSet -> ReadPrec IntSet
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> IntSet
fromList [Int]
xs)

  readListPrec :: ReadPrec [IntSet]
readListPrec = ReadPrec [IntSet]
forall a. Read a => ReadPrec [a]
readListPrecDefault
#else
  readsPrec p = readParen (p > 10) $ \ r -> do
    ("fromList",s) <- lex r
    (xs,t) <- reads s
    return (fromList xs,t)
#endif

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

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

{--------------------------------------------------------------------
  Debugging
--------------------------------------------------------------------}
-- | \(O(n \min(n,W))\). Show the tree that implements the set. The tree is shown
-- in a compressed, hanging format.
showTree :: IntSet -> String
showTree :: IntSet -> [Char]
showTree IntSet
s
  = Bool -> Bool -> IntSet -> [Char]
showTreeWith Bool
True Bool
False IntSet
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 -> IntSet -> String
showTreeWith :: Bool -> Bool -> IntSet -> [Char]
showTreeWith Bool
hang Bool
wide IntSet
t
  | Bool
hang      = (Bool -> [[Char]] -> IntSet -> ShowS
showsTreeHang Bool
wide [] IntSet
t) [Char]
""
  | Bool
otherwise = (Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree Bool
wide [] [] IntSet
t) [Char]
""

showsTree :: Bool -> [String] -> [String] -> IntSet -> ShowS
showsTree :: Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree Bool
wide [[Char]]
lbars [[Char]]
rbars IntSet
t
  = case IntSet
t of
      Bin Prefix
p IntSet
l IntSet
r
          -> Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
rbars) ([[Char]] -> [[Char]]
withEmpty [[Char]]
rbars) IntSet
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 (Prefix -> [Char]
showBin Prefix
p) 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]] -> IntSet -> ShowS
showsTree Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
lbars) ([[Char]] -> [[Char]]
withBar [[Char]]
lbars) IntSet
l
      Tip Int
kx Word
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
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
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
.
                                                Word -> ShowS
showsBitMap Word
bm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
      IntSet
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] -> IntSet -> ShowS
showsTreeHang :: Bool -> [[Char]] -> IntSet -> ShowS
showsTreeHang Bool
wide [[Char]]
bars IntSet
t
  = case IntSet
t of
      Bin Prefix
p IntSet
l IntSet
r
          -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString (Prefix -> [Char]
showBin Prefix
p) 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]] -> IntSet -> ShowS
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
bars) IntSet
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]] -> IntSet -> ShowS
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
bars) IntSet
r
      Tip Int
kx Word
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
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
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
.
                                               Word -> ShowS
showsBitMap Word
bm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
      IntSet
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 -> String
showBin :: Prefix -> [Char]
showBin Prefix
_
  = [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 :: Word -> ShowS
showsBitMap :: Word -> ShowS
showsBitMap = [Char] -> ShowS
showString ([Char] -> ShowS) -> (Word -> [Char]) -> Word -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> [Char]
showBitMap

showBitMap :: Word -> String
showBitMap :: Word -> [Char]
showBitMap Word
w = [Int] -> [Char]
forall a. Show a => a -> [Char]
show ([Int] -> [Char]) -> [Int] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> [Int] -> [Int]) -> [Int] -> Word -> [Int]
forall a. Int -> (Int -> a -> a) -> a -> Word -> a
foldrBits Int
0 (:) [] Word
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 two @IntSet@s. The sets must not be empty. The @Prefix@es of the two
-- sets must be different. @k1@ must share the prefix of @t1@. @p2@ must be the
-- prefix of @t2@.
linkKey :: Key -> IntSet -> Prefix -> IntSet -> IntSet
linkKey :: Int -> IntSet -> Prefix -> IntSet -> IntSet
linkKey Int
k1 IntSet
t1 Prefix
p2 IntSet
t2 = Int -> IntSet -> Int -> IntSet -> IntSet
link Int
k1 IntSet
t1 (Prefix -> Int
unPrefix Prefix
p2) IntSet
t2
{-# INLINE linkKey #-}

-- | Link two @IntSets. The sets must not be empty. The @Prefix@es of the two
-- sets must be different. @k1@ must share the prefix of @t1@ and @k2@ must
-- share the prefix of @t2@.
link :: Int -> IntSet -> Int -> IntSet -> IntSet
link :: Int -> IntSet -> Int -> IntSet -> IntSet
link Int
k1 IntSet
t1 Int
k2 IntSet
t2 = Int -> Int -> IntSet -> Int -> IntSet -> IntSet
linkWithMask (Int -> Int -> Int
branchMask Int
k1 Int
k2) Int
k1 IntSet
t1 Int
k2 IntSet
t2
{-# INLINE link #-}

-- `linkWithMask` is useful when the `branchMask` has already been computed
linkWithMask :: Int -> Key -> IntSet -> Key -> IntSet -> IntSet
linkWithMask :: Int -> Int -> IntSet -> Int -> IntSet -> IntSet
linkWithMask Int
m Int
k1 IntSet
t1 Int
k2 IntSet
t2
  | Int -> Word
i2w Int
k1 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Word
i2w Int
k2 = Prefix -> IntSet -> IntSet -> IntSet
Bin Prefix
p IntSet
t1 IntSet
t2
  | Bool
otherwise = Prefix -> IntSet -> IntSet -> IntSet
Bin Prefix
p IntSet
t2 IntSet
t1
  where
    p :: Prefix
p = Int -> Prefix
Prefix (Int -> Int -> Int
mask Int
k1 Int
m Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
m)
{-# INLINE linkWithMask #-}

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

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


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

suffixBitMask :: Int
suffixBitMask :: Int
suffixBitMask = Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
forall a. HasCallStack => a
undefined::Word) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
{-# INLINE suffixBitMask #-}

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

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

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

bitmapOfSuffix :: Int -> BitMap
bitmapOfSuffix :: Int -> Word
bitmapOfSuffix Int
s = Word
1 Word -> Int -> Word
`shiftLL` Int
s
{-# INLINE bitmapOfSuffix #-}

bitmapOf :: Int -> BitMap
bitmapOf :: Int -> Word
bitmapOf Int
x = Int -> Word
bitmapOfSuffix (Int -> Int
suffixOf Int
x)
{-# INLINE bitmapOf #-}


{----------------------------------------------------------------------
  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 :: Word -> Int
highestBitSet :: Word -> Int
foldlBits :: Int -> (a -> Int -> a) -> a -> Word -> a
foldl'Bits :: Int -> (a -> Int -> a) -> a -> Word -> a
foldrBits :: Int -> (Int -> a -> a) -> a -> Word -> a
foldr'Bits :: Int -> (Int -> a -> a) -> a -> Word -> a
#if MIN_VERSION_base(4,11,0)
foldMapBits :: Semigroup a => Int -> (Int -> a) -> Word -> a
#else
foldMapBits :: Monoid a => Int -> (Int -> a) -> Word -> a
#endif
takeWhileAntitoneBits :: Int -> (Int -> Bool) -> Word -> Word

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

#if defined(__GLASGOW_HASKELL__)

lowestBitSet :: Word -> Int
lowestBitSet Word
x = Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word
x

highestBitSet :: Word -> Int
highestBitSet Word
x = WORD_SIZE_IN_BITS - 1 - countLeadingZeros x

-- Reverse the order of bits in the Word.
revWord :: Word -> Word
#if WORD_SIZE_IN_BITS==32
revWord x1 = case ((x1 `shiftRL` 1) .&. 0x55555555) .|. ((x1 .&. 0x55555555) `shiftLL` 1) of
              x2 -> case ((x2 `shiftRL` 2) .&. 0x33333333) .|. ((x2 .&. 0x33333333) `shiftLL` 2) of
                 x3 -> case ((x3 `shiftRL` 4) .&. 0x0F0F0F0F) .|. ((x3 .&. 0x0F0F0F0F) `shiftLL` 4) of
                   x4 -> case ((x4 `shiftRL` 8) .&. 0x00FF00FF) .|. ((x4 .&. 0x00FF00FF) `shiftLL` 8) of
                     x5 -> ( x5 `shiftRL` 16             ) .|. ( x5               `shiftLL` 16);
#else
revWord :: Word -> Word
revWord Word
x1 = case ((Word
x1 Word -> Int -> Word
`shiftRL` Int
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x5555555555555555) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x5555555555555555) Word -> Int -> Word
`shiftLL` Int
1) of
              Word
x2 -> case ((Word
x2 Word -> Int -> Word
`shiftRL` Int
2) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3333333333333333) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x3333333333333333) Word -> Int -> Word
`shiftLL` Int
2) of
                 Word
x3 -> case ((Word
x3 Word -> Int -> Word
`shiftRL` Int
4) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x0F0F0F0F0F0F0F0F) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x3 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x0F0F0F0F0F0F0F0F) Word -> Int -> Word
`shiftLL` Int
4) of
                   Word
x4 -> case ((Word
x4 Word -> Int -> Word
`shiftRL` Int
8) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x00FF00FF00FF00FF) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x4 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x00FF00FF00FF00FF) Word -> Int -> Word
`shiftLL` Int
8) of
                     Word
x5 -> case ((Word
x5 Word -> Int -> Word
`shiftRL` Int
16) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x0000FFFF0000FFFF) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ((Word
x5 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x0000FFFF0000FFFF) Word -> Int -> Word
`shiftLL` Int
16) of
                       Word
x6 -> ( Word
x6 Word -> Int -> Word
`shiftRL` Int
32             ) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ( Word
x6               Word -> Int -> Word
`shiftLL` Int
32);
#endif

foldlBits :: forall a. Int -> (a -> Int -> a) -> a -> Word -> a
foldlBits Int
prefix a -> Int -> a
f a
z0 Word
bitmap = a -> Word -> a
go a
z0 (Word -> a) -> Word -> a
forall a b. (a -> b) -> a -> b
$! Word -> Word
revWord Word
bitmap
  where
    -- Note: We pass the z as a static argument because it helps GHC with demand
    -- analysis. See GHC #25578 for details.
    go :: a -> Word -> a
go a
z !Word
bm = a -> Int -> a
f (if Word
bm' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then a
z else a -> Word -> a
go a
z Word
bm') Int
x
      where
        bi :: Int
bi = WORD_SIZE_IN_BITS - 1 - countTrailingZeros bm
        !x :: Int
x = Int
prefix Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
bi
        bm' :: Word
bm' = Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
bmWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)

foldl'Bits :: forall a. Int -> (a -> Int -> a) -> a -> Word -> a
foldl'Bits Int
prefix a -> Int -> a
f a
z0 Word
bitmap = a -> Word -> a
go a
z0 Word
bitmap
  where
    go :: a -> Word -> a
go !a
z !Word
bm = if Word
bm' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then a
z' else a -> Word -> a
go a
z' Word
bm'
      where
        bi :: Int
bi = Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word
bm
        !x :: Int
x = Int
prefix Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
bi
        !z' :: a
z' = a -> Int -> a
f a
z Int
x
        bm' :: Word
bm' = Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
bmWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)

foldrBits :: forall a. Int -> (Int -> a -> a) -> a -> Word -> a
foldrBits Int
prefix Int -> a -> a
f a
z0 Word
bitmap = Word -> a -> a
go Word
bitmap a
z0
  where
    -- Note: We pass the z as a static argument because it helps GHC with demand
    -- analysis. See GHC #25578 for details.
    go :: Word -> a -> a
go !Word
bm a
z = Int -> a -> a
f Int
x (if Word
bm' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then a
z else Word -> a -> a
go Word
bm' a
z)
      where
        bi :: Int
bi = Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word
bm
        !x :: Int
x = Int
prefix Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
bi
        bm' :: Word
bm' = Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
bmWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)

foldr'Bits :: forall a. Int -> (Int -> a -> a) -> a -> Word -> a
foldr'Bits Int
prefix Int -> a -> a
f a
z0 Word
bitmap = (Word -> a -> a
go (Word -> a -> a) -> Word -> a -> a
forall a b. (a -> b) -> a -> b
$! Word -> Word
revWord Word
bitmap) a
z0
  where
    go :: Word -> a -> a
go !Word
bm !a
z = if Word
bm' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then a
z' else Word -> a -> a
go Word
bm' a
z'
      where
        bi :: Int
bi = WORD_SIZE_IN_BITS - 1 - countTrailingZeros bm
        !x :: Int
x = Int
prefix Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
bi
        !z' :: a
z' = Int -> a -> a
f Int
x a
z
        bm' :: Word
bm' = Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
bmWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)

foldMapBits :: forall a. Semigroup a => Int -> (Int -> a) -> Word -> a
foldMapBits Int
prefix Int -> a
f Word
bitmap = Word -> a
go Word
bitmap
  where
    go :: Word -> a
go !Word
bm = if Word
bm' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
             then Int -> a
f Int
x
#if MIN_VERSION_base(4,11,0)
             else Int -> a
f Int
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Word -> a
go Word
bm'
#else
             else f x `mappend` go bm'
#endif
      where
        bi :: Int
bi = Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word
bm
        !x :: Int
x = Int
prefix Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
bi
        bm' :: Word
bm' = Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
bmWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)

takeWhileAntitoneBits :: Int -> (Int -> Bool) -> Word -> Word
takeWhileAntitoneBits Int
prefix Int -> Bool
predicate Word
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 WORD_SIZE_IN_BITS + 1) (popcount bitmap) predicate calls.
  let next :: Int -> Word -> (Word, Int) -> (Word, Int)
next Int
d Word
h (Word
n',Int
b') =
        if Word
n' Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
h Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 Bool -> Bool -> Bool
&& (Int -> Bool
predicate (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$! Int
prefixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) then (Word
n' Word -> Int -> Word
`shiftRL` Int
d, Int
b'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) else (Word
n',Int
b')
      {-# INLINE next #-}
      (Word
_,Int
b) = Int -> Word -> (Word, Int) -> (Word, Int)
next Int
1  Word
0x2 ((Word, Int) -> (Word, Int)) -> (Word, Int) -> (Word, Int)
forall a b. (a -> b) -> a -> b
$
              Int -> Word -> (Word, Int) -> (Word, Int)
next Int
2  Word
0xC ((Word, Int) -> (Word, Int)) -> (Word, Int) -> (Word, Int)
forall a b. (a -> b) -> a -> b
$
              Int -> Word -> (Word, Int) -> (Word, Int)
next Int
4  Word
0xF0 ((Word, Int) -> (Word, Int)) -> (Word, Int) -> (Word, Int)
forall a b. (a -> b) -> a -> b
$
              Int -> Word -> (Word, Int) -> (Word, Int)
next Int
8  Word
0xFF00 ((Word, Int) -> (Word, Int)) -> (Word, Int) -> (Word, Int)
forall a b. (a -> b) -> a -> b
$
              Int -> Word -> (Word, Int) -> (Word, Int)
next Int
16 Word
0xFFFF0000 ((Word, Int) -> (Word, Int)) -> (Word, Int) -> (Word, Int)
forall a b. (a -> b) -> a -> b
$
#if WORD_SIZE_IN_BITS==64
              Int -> Word -> (Word, Int) -> (Word, Int)
next Int
32 Word
0xFFFFFFFF00000000 ((Word, Int) -> (Word, Int)) -> (Word, Int) -> (Word, Int)
forall a b. (a -> b) -> a -> b
$
#endif
              (Word
bitmap,Int
0)
      m :: Word
m = if Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
|| (Word
bitmap Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0x1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 Bool -> Bool -> Bool
&& Int -> Bool
predicate Int
prefix)
          then ((Word
2 Word -> Int -> Word
`shiftLL` Int
b) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
          else ((Word
1 Word -> Int -> Word
`shiftLL` Int
b) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
  in Word
bitmap Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
m

#else
{----------------------------------------------------------------------
  In general case we use logarithmic implementation of
  lowestBitSet and highestBitSet, which works up to bit sizes of 64.

  Folds are linear scans.
----------------------------------------------------------------------}

lowestBitSet n0 =
    let (n1,b1) = if n0 .&. 0xFFFFFFFF /= 0 then (n0,0)  else (n0 `shiftRL` 32, 32)
        (n2,b2) = if n1 .&. 0xFFFF /= 0     then (n1,b1) else (n1 `shiftRL` 16, 16+b1)
        (n3,b3) = if n2 .&. 0xFF /= 0       then (n2,b2) else (n2 `shiftRL` 8,  8+b2)
        (n4,b4) = if n3 .&. 0xF /= 0        then (n3,b3) else (n3 `shiftRL` 4,  4+b3)
        (n5,b5) = if n4 .&. 0x3 /= 0        then (n4,b4) else (n4 `shiftRL` 2,  2+b4)
        b6      = if n5 .&. 0x1 /= 0        then     b5  else                   1+b5
    in b6

highestBitSet n0 =
    let (n1,b1) = if n0 .&. 0xFFFFFFFF00000000 /= 0 then (n0 `shiftRL` 32, 32)    else (n0,0)
        (n2,b2) = if n1 .&. 0xFFFF0000 /= 0         then (n1 `shiftRL` 16, 16+b1) else (n1,b1)
        (n3,b3) = if n2 .&. 0xFF00 /= 0             then (n2 `shiftRL` 8,  8+b2)  else (n2,b2)
        (n4,b4) = if n3 .&. 0xF0 /= 0               then (n3 `shiftRL` 4,  4+b3)  else (n3,b3)
        (n5,b5) = if n4 .&. 0xC /= 0                then (n4 `shiftRL` 2,  2+b4)  else (n4,b4)
        b6      = if n5 .&. 0x2 /= 0                then                   1+b5   else     b5
    in b6

foldlBits prefix f z bm = let lb = lowestBitSet bm
                          in  go (prefix+lb) z (bm `shiftRL` lb)
  where go !_ acc 0 = acc
        go bi acc n | n `testBit` 0 = go (bi + 1) (f acc bi) (n `shiftRL` 1)
                    | otherwise     = go (bi + 1)    acc     (n `shiftRL` 1)

foldl'Bits prefix f z bm = let lb = lowestBitSet bm
                           in  go (prefix+lb) z (bm `shiftRL` lb)
  where go !_ !acc 0 = acc
        go bi acc n | n `testBit` 0 = go (bi + 1) (f acc bi) (n `shiftRL` 1)
                    | otherwise     = go (bi + 1)    acc     (n `shiftRL` 1)

foldrBits prefix f z bm = let lb = lowestBitSet bm
                          in  go (prefix+lb) (bm `shiftRL` lb)
  where go !_ 0 = z
        go bi n | n `testBit` 0 = f bi (go (bi + 1) (n `shiftRL` 1))
                | otherwise     =       go (bi + 1) (n `shiftRL` 1)

foldr'Bits prefix f z bm = let lb = lowestBitSet bm
                           in  go (prefix+lb) (bm `shiftRL` lb)
  where
        go !_ 0 = z
        go bi n | n `testBit` 0 = f bi $! go (bi + 1) (n `shiftRL` 1)
                | otherwise     =         go (bi + 1) (n `shiftRL` 1)

foldMapBits prefix f bm = go x0 (x0 + 1) ((bm `shiftRL` lb) `shiftRL` 1)
  where
    lb = lowestBitSet bm
    x0 = prefix + lb
    go !x !_ 0 = f x
    go !x !bi n
#if MIN_VERSION_base(4,11,0)
      | n `testBit` 0 = f x <> go bi (bi + 1) (n `shiftRL` 1)
#else
      | n `testBit` 0 = f x `mappend` go bi (bi + 1) (n `shiftRL` 1)
#endif
      | otherwise = go x (bi + 1) (n `shiftRL` 1)

takeWhileAntitoneBits prefix predicate = foldl'Bits prefix f 0 -- Does not use antitone property
  where
    f acc bi | predicate bi = acc .|. bitmapOf bi
             | otherwise    = acc

#endif


{--------------------------------------------------------------------
  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 :: IntSet -> [IntSet]
splitRoot :: IntSet -> [IntSet]
splitRoot IntSet
Nil = []
-- NOTE: we don't currently split below Tip, but we could.
splitRoot x :: IntSet
x@(Tip Int
_ Word
_) = [IntSet
x]
splitRoot (Bin Prefix
p IntSet
l IntSet
r) | Prefix -> Bool
signBranch Prefix
p = [IntSet
r, IntSet
l]
                      | Bool
otherwise = [IntSet
l, IntSet
r]
{-# INLINE splitRoot #-}