{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE MagicHash, DeriveDataTypeable, StandaloneDeriving #-}
#endif
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE TypeFamilies #-}
#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.
--
-- = Description
--
-- An efficient implementation of integer sets.
--
-- These modules are intended to be imported qualified, to avoid name
-- clashes with Prelude functions, e.g.
--
-- >  import Data.IntSet (IntSet)
-- >  import qualified Data.IntSet as IntSet
--
-- The implementation is based on /big-endian patricia trees/.  This data
-- structure performs especially well on binary operations like 'union'
-- and 'intersection'.  However, my benchmarks show that it is also
-- (much) faster on insertions and deletions when compared to a generic
-- size-balanced set implementation (see "Data.Set").
--
--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",
--      Workshop on ML, September 1998, pages 77-86,
--      <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452>
--
--    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information Coded In Alphanumeric/\",
--      Journal of the ACM, 15(4), October 1968, pages 514-534.
--
-- Additionally, this implementation places bitmaps in the leaves of the tree.
-- Their size is the natural size of a machine word (32 or 64 bits) and greatly
-- reduce memory footprint and execution times for dense sets, e.g. sets where
-- it is likely that many values lie close to each other. The asymptotics are
-- not affected by this optimization.
--
-- Many operations have a worst-case complexity of /O(min(n,W))/.
-- This means that the operation can become linear in the number of
-- elements with a maximum of /W/ -- the number of bits in an 'Int'
-- (32 or 64).
--
-- @since 0.5.9
-----------------------------------------------------------------------------

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


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


-- [Note: Order of constructors]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The order of constructors of 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(..), Key -- instance Eq,Show
    , Prefix, Mask, BitMap

    -- * Operators
    , (\\)

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

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

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

    -- * Filter
    , filter
    , partition
    , split
    , splitMember
    , splitRoot

    -- * Map
    , map
    , mapMonotonic

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

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

    -- * Conversion

    -- ** List
    , elems
    , toList
    , fromList

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

    -- * Debugging
    , showTree
    , showTreeWith

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

import Control.Applicative (Const(..))
import Control.DeepSeq (NFData(rnf))
import Data.Bits
import qualified Data.List as List
import Data.Maybe (fromMaybe)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..))
import Data.Word (Word)
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(stimes))
#endif
#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup((<>)))
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (stimesIdempotentMonoid)
#endif
import Data.Typeable
import Prelude hiding (filter, foldr, foldl, null, map)

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

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

#if __GLASGOW_HASKELL__
import qualified GHC.Exts
#if !(MIN_VERSION_base(4,8,0) && (WORD_SIZE_IN_BITS==64))
import qualified GHC.Int
#endif
#endif

import qualified Data.Foldable as Foldable
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity (Identity(..))
#else
import Data.Foldable (Foldable())
#endif

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

-- A "Nat" is a natural machine word (an unsigned Int)
type Nat = Word

natFromInt :: Int -> Nat
natFromInt :: Mask -> Word
natFromInt Mask
i = Mask -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Mask
i
{-# INLINE natFromInt #-}

intFromNat :: Nat -> Int
intFromNat :: Word -> Mask
intFromNat Word
w = Word -> Mask
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w
{-# INLINE intFromNat #-}

{--------------------------------------------------------------------
  Operators
--------------------------------------------------------------------}
-- | /O(n+m)/. 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 {-# UNPACK #-} !Mask !IntSet !IntSet
-- Invariant: Nil is never found as a child of Bin.
-- Invariant: The Mask is a power of 2.  It is the largest bit position at which
--            two elements of the set differ.
-- Invariant: Prefix is the common high-order bits that all elements share to
--            the left of the Mask bit.
-- Invariant: In Bin prefix mask left right, left consists of the elements that
--            don't have the mask bit set; right is all the elements that do.
            | Tip {-# UNPACK #-} !Prefix {-# UNPACK #-} !BitMap
-- Invariant: The Prefix is zero for the last 5 (on 32 bit arches) or 6 bits
--            (on 64 bit arches). The values of the set represented by a tip
--            are the prefix plus the indices of the set bits in the bit map.
            | Nil

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

type Prefix = Int
type Mask   = Int
type BitMap = Word
type Key    = Int

instance Monoid IntSet where
    mempty :: IntSet
mempty  = IntSet
empty
    mconcat :: [IntSet] -> IntSet
mconcat = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
unions
#if !(MIN_VERSION_base(4,9,0))
    mappend = union
#else
    mappend :: IntSet -> IntSet -> IntSet
mappend = IntSet -> IntSet -> IntSet
forall a. Semigroup a => a -> a -> a
(<>)

-- | @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
#endif

#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 = ([Mask] -> IntSet) -> c ([Mask] -> IntSet)
forall g. g -> c g
z [Mask] -> IntSet
fromList c ([Mask] -> IntSet) -> [Mask] -> c IntSet
forall d b. Data d => c (d -> b) -> d -> c b
`f` (IntSet -> [Mask]
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 -> Mask
constrIndex Constr
c of
    Mask
1 -> c ([Mask] -> IntSet) -> c IntSet
forall b r. Data b => c (b -> r) -> c r
k (([Mask] -> IntSet) -> c ([Mask] -> IntSet)
forall r. r -> c r
z [Mask] -> IntSet
fromList)
    Mask
_ -> [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 -> Mask
size = Mask -> IntSet -> Mask
go Mask
0
  where
    go :: Mask -> IntSet -> Mask
go !Mask
acc (Bin Mask
_ Mask
_ IntSet
l IntSet
r) = Mask -> IntSet -> Mask
go (Mask -> IntSet -> Mask
go Mask
acc IntSet
l) IntSet
r
    go Mask
acc (Tip Mask
_ Word
bm) = Mask
acc Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask -> Word -> Mask
bitcount Mask
0 Word
bm
    go Mask
acc IntSet
Nil = Mask
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 :: Mask -> IntSet -> Bool
member !Mask
x = IntSet -> Bool
go
  where
    go :: IntSet -> Bool
go (Bin Mask
p Mask
m IntSet
l IntSet
r)
      | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = Bool
False
      | Mask -> Mask -> Bool
zero Mask
x Mask
m      = IntSet -> Bool
go IntSet
l
      | Bool
otherwise     = IntSet -> Bool
go IntSet
r
    go (Tip Mask
y Word
bm) = Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
y Bool -> Bool -> Bool
&& Mask -> Word
bitmapOf Mask
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 :: Mask -> IntSet -> Bool
notMember Mask
k = Bool -> Bool
not (Bool -> Bool) -> (IntSet -> Bool) -> IntSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mask -> IntSet -> Bool
member Mask
k

-- | /O(log n)/. 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 :: Mask -> IntSet -> Maybe Mask
lookupLT !Mask
x IntSet
t = case IntSet
t of
    Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then IntSet -> IntSet -> Maybe Mask
go IntSet
r IntSet
l else IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
r
    IntSet
_ -> IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Mask
go IntSet
def (Bin Mask
p Mask
m IntSet
l IntSet
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then IntSet -> Maybe Mask
unsafeFindMax IntSet
def else IntSet -> Maybe Mask
unsafeFindMax IntSet
r
                         | Mask -> Mask -> Bool
zero Mask
x Mask
m  = IntSet -> IntSet -> Maybe Mask
go IntSet
def IntSet
l
                         | Bool
otherwise = IntSet -> IntSet -> Maybe Mask
go IntSet
l IntSet
r
    go IntSet
def (Tip Mask
kx Word
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
bm
                       | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Word
maskLT Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
maskLT
                       | Bool
otherwise = IntSet -> Maybe Mask
unsafeFindMax IntSet
def
                       where maskLT :: Word
maskLT = (Mask -> Word
bitmapOf Mask
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 Mask
unsafeFindMax IntSet
def


-- | /O(log n)/. 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 :: Mask -> IntSet -> Maybe Mask
lookupGT !Mask
x IntSet
t = case IntSet
t of
    Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
l else IntSet -> IntSet -> Maybe Mask
go IntSet
l IntSet
r
    IntSet
_ -> IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Mask
go IntSet
def (Bin Mask
p Mask
m IntSet
l IntSet
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then IntSet -> Maybe Mask
unsafeFindMin IntSet
l else IntSet -> Maybe Mask
unsafeFindMin IntSet
def
                         | Mask -> Mask -> Bool
zero Mask
x Mask
m  = IntSet -> IntSet -> Maybe Mask
go IntSet
r IntSet
l
                         | Bool
otherwise = IntSet -> IntSet -> Maybe Mask
go IntSet
def IntSet
r
    go IntSet
def (Tip Mask
kx Word
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
bm
                       | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Word
maskGT Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
maskGT
                       | Bool
otherwise = IntSet -> Maybe Mask
unsafeFindMin IntSet
def
                       where maskGT :: Word
maskGT = (- ((Mask -> Word
bitmapOf Mask
x) Word -> Mask -> Word
`shiftLL` Mask
1)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm
    go IntSet
def IntSet
Nil = IntSet -> Maybe Mask
unsafeFindMin IntSet
def


-- | /O(log n)/. 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 :: Mask -> IntSet -> Maybe Mask
lookupLE !Mask
x IntSet
t = case IntSet
t of
    Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then IntSet -> IntSet -> Maybe Mask
go IntSet
r IntSet
l else IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
r
    IntSet
_ -> IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Mask
go IntSet
def (Bin Mask
p Mask
m IntSet
l IntSet
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then IntSet -> Maybe Mask
unsafeFindMax IntSet
def else IntSet -> Maybe Mask
unsafeFindMax IntSet
r
                         | Mask -> Mask -> Bool
zero Mask
x Mask
m  = IntSet -> IntSet -> Maybe Mask
go IntSet
def IntSet
l
                         | Bool
otherwise = IntSet -> IntSet -> Maybe Mask
go IntSet
l IntSet
r
    go IntSet
def (Tip Mask
kx Word
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
bm
                       | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Word
maskLE Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
maskLE
                       | Bool
otherwise = IntSet -> Maybe Mask
unsafeFindMax IntSet
def
                       where maskLE :: Word
maskLE = (((Mask -> Word
bitmapOf Mask
x) Word -> Mask -> Word
`shiftLL` Mask
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 Mask
unsafeFindMax IntSet
def


-- | /O(log n)/. 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 :: Mask -> IntSet -> Maybe Mask
lookupGE !Mask
x IntSet
t = case IntSet
t of
    Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0 then IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
l else IntSet -> IntSet -> Maybe Mask
go IntSet
l IntSet
r
    IntSet
_ -> IntSet -> IntSet -> Maybe Mask
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Mask
go IntSet
def (Bin Mask
p Mask
m IntSet
l IntSet
r) | Mask -> Mask -> Mask -> Bool
nomatch Mask
x Mask
p Mask
m = if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then IntSet -> Maybe Mask
unsafeFindMin IntSet
l else IntSet -> Maybe Mask
unsafeFindMin IntSet
def
                         | Mask -> Mask -> Bool
zero Mask
x Mask
m  = IntSet -> IntSet -> Maybe Mask
go IntSet
r IntSet
l
                         | Bool
otherwise = IntSet -> IntSet -> Maybe Mask
go IntSet
def IntSet
r
    go IntSet
def (Tip Mask
kx Word
bm) | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
kx = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
bm
                       | Mask -> Mask
prefixOf Mask
x Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx Bool -> Bool -> Bool
&& Word
maskGE Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
maskGE
                       | Bool
otherwise = IntSet -> Maybe Mask
unsafeFindMin IntSet
def
                       where maskGE :: Word
maskGE = (- (Mask -> Word
bitmapOf Mask
x)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
bm
    go IntSet
def IntSet
Nil = IntSet -> Maybe Mask
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 Mask
unsafeFindMin IntSet
Nil = Maybe Mask
forall a. Maybe a
Nothing
unsafeFindMin (Tip Mask
kx Word
bm) = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
lowestBitSet Word
bm
unsafeFindMin (Bin Mask
_ Mask
_ IntSet
l IntSet
_) = IntSet -> Maybe Mask
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 Mask
unsafeFindMax IntSet
Nil = Maybe Mask
forall a. Maybe a
Nothing
unsafeFindMax (Tip Mask
kx Word
bm) = Mask -> Maybe Mask
forall a. a -> Maybe a
Just (Mask -> Maybe Mask) -> Mask -> Maybe Mask
forall a b. (a -> b) -> a -> b
$ Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Word -> Mask
highestBitSet Word
bm
unsafeFindMax (Bin Mask
_ Mask
_ IntSet
_ IntSet
r) = IntSet -> Maybe Mask
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 :: Mask -> IntSet
singleton Mask
x
  = Mask -> Word -> IntSet
Tip (Mask -> Mask
prefixOf Mask
x) (Mask -> Word
bitmapOf Mask
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 :: Mask -> IntSet -> IntSet
insert !Mask
x = Mask -> Word -> IntSet -> IntSet
insertBM (Mask -> Mask
prefixOf Mask
x) (Mask -> Word
bitmapOf Mask
x)

-- Helper function for insert and union.
insertBM :: Prefix -> BitMap -> IntSet -> IntSet
insertBM :: Mask -> Word -> IntSet -> IntSet
insertBM !Mask
kx !Word
bm t :: IntSet
t@(Bin Mask
p Mask
m IntSet
l IntSet
r)
  | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = Mask -> IntSet -> Mask -> IntSet -> IntSet
link Mask
kx (Mask -> Word -> IntSet
Tip Mask
kx Word
bm) Mask
p IntSet
t
  | Mask -> Mask -> Bool
zero Mask
kx Mask
m      = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p Mask
m (Mask -> Word -> IntSet -> IntSet
insertBM Mask
kx Word
bm IntSet
l) IntSet
r
  | Bool
otherwise      = Mask -> Mask -> IntSet -> IntSet -> IntSet
Bin Mask
p Mask
m IntSet
l (Mask -> Word -> IntSet -> IntSet
insertBM Mask
kx Word
bm IntSet
r)
insertBM Mask
kx Word
bm t :: IntSet
t@(Tip Mask
kx' Word
bm')
  | Mask
kx' Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx = Mask -> Word -> IntSet
Tip Mask
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
bm')
  | Bool
otherwise = Mask -> IntSet -> Mask -> IntSet -> IntSet
link Mask
kx (Mask -> Word -> IntSet
Tip Mask
kx Word
bm) Mask
kx' IntSet
t
insertBM Mask
kx Word
bm IntSet
Nil = Mask -> Word -> IntSet
Tip Mask
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 :: Mask -> IntSet -> IntSet
delete !Mask
x = Mask -> Word -> IntSet -> IntSet
deleteBM (Mask -> Mask
prefixOf Mask
x) (Mask -> Word
bitmapOf Mask
x)

-- Deletes all values mentioned in the BitMap from the set.
-- Helper function for delete and difference.
deleteBM :: Prefix -> BitMap -> IntSet -> IntSet
deleteBM :: Mask -> Word -> IntSet -> IntSet
deleteBM !Mask
kx !Word
bm t :: IntSet
t@(Bin Mask
p Mask
m IntSet
l IntSet
r)
  | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = IntSet
t
  | Mask -> Mask -> Bool
zero Mask
kx Mask
m      = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m (Mask -> Word -> IntSet -> IntSet
deleteBM Mask
kx Word
bm IntSet
l) IntSet
r
  | Bool
otherwise      = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l (Mask -> Word -> IntSet -> IntSet
deleteBM Mask
kx Word
bm IntSet
r)
deleteBM Mask
kx Word
bm t :: IntSet
t@(Tip Mask
kx' Word
bm')
  | Mask
kx' Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx = Mask -> Word -> IntSet
tip Mask
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 Mask
_ 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) -> Mask -> IntSet -> f IntSet
alterF Bool -> f Bool
f Mask
k IntSet
s = (Bool -> IntSet) -> f Bool -> f IntSet
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_ = Mask -> IntSet -> Bool
member Mask
k IntSet
s

    (IntSet
inserted, IntSet
deleted)
      | Bool
member_   = (IntSet
s         , Mask -> IntSet -> IntSet
delete Mask
k IntSet
s)
      | Bool
otherwise = (Mask -> IntSet -> IntSet
insert Mask
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

#if MIN_VERSION_base(4,8,0)
{-# SPECIALIZE alterF :: (Bool -> Identity Bool) -> Key -> IntSet -> Identity IntSet #-}
#endif

{--------------------------------------------------------------------
  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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' IntSet -> IntSet -> IntSet
union IntSet
empty f IntSet
xs


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

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

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


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

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

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

difference t1 :: IntSet
t1@(Tip Mask
kx Word
bm) IntSet
t2 = IntSet -> IntSet
differenceTip IntSet
t2
  where differenceTip :: IntSet -> IntSet
differenceTip (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p2 Mask
m2 = IntSet
t1
                                        | Mask -> Mask -> Bool
zero Mask
kx Mask
m2 = IntSet -> IntSet
differenceTip IntSet
l2
                                        | Bool
otherwise = IntSet -> IntSet
differenceTip IntSet
r2
        differenceTip (Tip Mask
kx2 Word
bm2) | Mask
kx Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = Mask -> Word -> IntSet
tip Mask
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(n+m)/. The intersection of two sets.
intersection :: IntSet -> IntSet -> IntSet
intersection :: IntSet -> IntSet -> IntSet
intersection t1 :: IntSet
t1@(Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
  | Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2  = IntSet
intersection1
  | Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1  = IntSet
intersection2
  | Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2       = Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p1 Mask
m1 (IntSet -> IntSet -> IntSet
intersection IntSet
l1 IntSet
l2) (IntSet -> IntSet -> IntSet
intersection IntSet
r1 IntSet
r2)
  | Bool
otherwise      = IntSet
Nil
  where
    intersection1 :: IntSet
intersection1 | Mask -> Mask -> Mask -> Bool
nomatch Mask
p2 Mask
p1 Mask
m1  = IntSet
Nil
                  | Mask -> Mask -> Bool
zero Mask
p2 Mask
m1        = IntSet -> IntSet -> IntSet
intersection IntSet
l1 IntSet
t2
                  | Bool
otherwise         = IntSet -> IntSet -> IntSet
intersection IntSet
r1 IntSet
t2

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

intersection t1 :: IntSet
t1@(Bin Mask
_ Mask
_ IntSet
_ IntSet
_) (Tip Mask
kx2 Word
bm2) = IntSet -> IntSet
intersectBM IntSet
t1
  where intersectBM :: IntSet -> IntSet
intersectBM (Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx2 Mask
p1 Mask
m1 = IntSet
Nil
                                      | Mask -> Mask -> Bool
zero Mask
kx2 Mask
m1       = IntSet -> IntSet
intersectBM IntSet
l1
                                      | Bool
otherwise         = IntSet -> IntSet
intersectBM IntSet
r1
        intersectBM (Tip Mask
kx1 Word
bm1) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = Mask -> Word -> IntSet
tip Mask
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 Mask
_ Mask
_ IntSet
_ IntSet
_) IntSet
Nil = IntSet
Nil

intersection (Tip Mask
kx1 Word
bm1) IntSet
t2 = IntSet -> IntSet
intersectBM IntSet
t2
  where intersectBM :: IntSet -> IntSet
intersectBM (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx1 Mask
p2 Mask
m2 = IntSet
Nil
                                      | Mask -> Mask -> Bool
zero Mask
kx1 Mask
m2       = IntSet -> IntSet
intersectBM IntSet
l2
                                      | Bool
otherwise         = IntSet -> IntSet
intersectBM IntSet
r2
        intersectBM (Tip Mask
kx2 Word
bm2) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
kx2 = Mask -> Word -> IntSet
tip Mask
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

{--------------------------------------------------------------------
  Subset
--------------------------------------------------------------------}
-- | /O(n+m)/. 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 Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
  | Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2  = Ordering
GT
  | Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1  = case Ordering
subsetCmpLt of
                       Ordering
GT -> Ordering
GT
                       Ordering
_  -> Ordering
LT
  | Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2       = Ordering
subsetCmpEq
  | Bool
otherwise      = Ordering
GT  -- disjoint
  where
    subsetCmpLt :: Ordering
subsetCmpLt | Mask -> Mask -> Mask -> Bool
nomatch Mask
p1 Mask
p2 Mask
m2  = Ordering
GT
                | Mask -> Mask -> Bool
zero Mask
p1 Mask
m2        = IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
l2
                | Bool
otherwise         = IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
r2
    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 Mask
_ Mask
_ IntSet
_ IntSet
_) IntSet
_  = Ordering
GT
subsetCmp (Tip Mask
kx1 Word
bm1) (Tip Mask
kx2 Word
bm2)
  | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
/= Mask
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 Mask
kx Word
_) (Bin Mask
p Mask
m IntSet
l IntSet
r)
  | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = Ordering
GT
  | Mask -> Mask -> Bool
zero Mask
kx Mask
m      = 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 Mask
_ Word
_) IntSet
Nil = Ordering
GT -- disjoint
subsetCmp IntSet
Nil IntSet
Nil = Ordering
EQ
subsetCmp IntSet
Nil IntSet
_   = Ordering
LT

-- | /O(n+m)/. 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 Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
  | Mask -> Mask -> Bool
shorter Mask
m1 Mask
m2  = Bool
False
  | Mask -> Mask -> Bool
shorter Mask
m2 Mask
m1  = Mask -> Mask -> Mask -> Bool
match Mask
p1 Mask
p2 Mask
m2 Bool -> Bool -> Bool
&& (if Mask -> Mask -> Bool
zero Mask
p1 Mask
m2 then IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
l2
                                                      else IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
r2)
  | Bool
otherwise      = (Mask
p1Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
==Mask
p2) Bool -> Bool -> Bool
&& IntSet -> IntSet -> Bool
isSubsetOf IntSet
l1 IntSet
l2 Bool -> Bool -> Bool
&& IntSet -> IntSet -> Bool
isSubsetOf IntSet
r1 IntSet
r2
isSubsetOf (Bin Mask
_ Mask
_ IntSet
_ IntSet
_) IntSet
_  = Bool
False
isSubsetOf (Tip Mask
kx1 Word
bm1) (Tip Mask
kx2 Word
bm2) = Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
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 Mask
kx Word
_) (Bin Mask
p Mask
m IntSet
l IntSet
r)
  | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx Mask
p Mask
m = Bool
False
  | Mask -> Mask -> Bool
zero Mask
kx Mask
m      = IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
l
  | Bool
otherwise      = IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
r
isSubsetOf (Tip Mask
_ Word
_) IntSet
Nil = Bool
False
isSubsetOf IntSet
Nil IntSet
_         = Bool
True


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

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

disjoint t1 :: IntSet
t1@(Bin Mask
_ Mask
_ IntSet
_ IntSet
_) (Tip Mask
kx2 Word
bm2) = IntSet -> Bool
disjointBM IntSet
t1
  where disjointBM :: IntSet -> Bool
disjointBM (Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx2 Mask
p1 Mask
m1 = Bool
True
                                     | Mask -> Mask -> Bool
zero Mask
kx2 Mask
m1       = IntSet -> Bool
disjointBM IntSet
l1
                                     | Bool
otherwise         = IntSet -> Bool
disjointBM IntSet
r1
        disjointBM (Tip Mask
kx1 Word
bm1) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
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 Mask
_ Mask
_ IntSet
_ IntSet
_) IntSet
Nil = Bool
True

disjoint (Tip Mask
kx1 Word
bm1) IntSet
t2 = IntSet -> Bool
disjointBM IntSet
t2
  where disjointBM :: IntSet -> Bool
disjointBM (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2) | Mask -> Mask -> Mask -> Bool
nomatch Mask
kx1 Mask
p2 Mask
m2 = Bool
True
                                     | Mask -> Mask -> Bool
zero Mask
kx1 Mask
m2       = IntSet -> Bool
disjointBM IntSet
l2
                                     | Bool
otherwise         = IntSet -> Bool
disjointBM IntSet
r2
        disjointBM (Tip Mask
kx2 Word
bm2) | Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
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 :: (Mask -> Bool) -> IntSet -> IntSet
filter Mask -> Bool
predicate IntSet
t
  = case IntSet
t of
      Bin Mask
p Mask
m IntSet
l IntSet
r
        -> Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m ((Mask -> Bool) -> IntSet -> IntSet
filter Mask -> Bool
predicate IntSet
l) ((Mask -> Bool) -> IntSet -> IntSet
filter Mask -> Bool
predicate IntSet
r)
      Tip Mask
kx Word
bm
        -> Mask -> Word -> IntSet
tip Mask
kx (Mask -> (Word -> Mask -> Word) -> Word -> Word -> Word
forall a. Mask -> (a -> Mask -> a) -> a -> Word -> a
foldl'Bits Mask
0 (Mask -> Word -> Mask -> Word
bitPred Mask
kx) Word
0 Word
bm)
      IntSet
Nil -> IntSet
Nil
  where bitPred :: Mask -> Word -> Mask -> Word
bitPred Mask
kx Word
bm Mask
bi | Mask -> Bool
predicate (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi) = Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Mask -> Word
bitmapOfSuffix Mask
bi
                         | Bool
otherwise           = Word
bm
        {-# INLINE bitPred #-}

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


-- | /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 :: Mask -> IntSet -> (IntSet, IntSet)
split Mask
x IntSet
t =
  case IntSet
t of
      Bin Mask
_ Mask
m IntSet
l IntSet
r
          | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0  -- handle negative numbers.
                     then case Mask -> IntSet -> StrictPair IntSet IntSet
go Mask
x IntSet
l of (IntSet
lt :*: IntSet
gt) -> let !lt' :: IntSet
lt' = IntSet -> IntSet -> IntSet
union IntSet
lt IntSet
r
                                                        in (IntSet
lt', IntSet
gt)
                     else case Mask -> IntSet -> StrictPair IntSet IntSet
go Mask
x IntSet
r of (IntSet
lt :*: IntSet
gt) -> let !gt' :: IntSet
gt' = IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
l
                                                        in (IntSet
lt, IntSet
gt')
      IntSet
_ -> case Mask -> IntSet -> StrictPair IntSet IntSet
go Mask
x IntSet
t of
          (IntSet
lt :*: IntSet
gt) -> (IntSet
lt, IntSet
gt)
  where
    go :: Mask -> IntSet -> StrictPair IntSet IntSet
go !Mask
x' t' :: IntSet
t'@(Bin Mask
p Mask
m IntSet
l IntSet
r)
        | Mask -> Mask -> Mask -> Bool
match Mask
x' Mask
p Mask
m = if Mask -> Mask -> Bool
zero Mask
x' Mask
m
                         then case Mask -> IntSet -> StrictPair IntSet IntSet
go Mask
x' IntSet
l of
                             (IntSet
lt :*: IntSet
gt) -> IntSet
lt IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
r
                         else case Mask -> IntSet -> StrictPair IntSet IntSet
go Mask
x' IntSet
r of
                             (IntSet
lt :*: IntSet
gt) -> IntSet -> IntSet -> IntSet
union IntSet
lt IntSet
l IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
gt
        | Bool
otherwise   = if Mask
x' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
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)
    go Mask
x' t' :: IntSet
t'@(Tip Mask
kx' Word
bm)
        | Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
x'          = (IntSet
Nil IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
t')
          -- equivalent to kx' > prefixOf x'
        | Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask -> Mask
prefixOf Mask
x' = (IntSet
t' IntSet -> IntSet -> StrictPair IntSet IntSet
forall a b. a -> b -> StrictPair a b
:*: IntSet
Nil)
        | Bool
otherwise = Mask -> Word -> IntSet
tip Mask
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
:*: Mask -> Word -> IntSet
tip Mask
kx' (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
higherBitmap)
            where lowerBitmap :: Word
lowerBitmap = Mask -> Word
bitmapOf Mask
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
+ Mask -> Word
bitmapOf Mask
x')
    go Mask
_ 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 :: Mask -> IntSet -> (IntSet, Bool, IntSet)
splitMember Mask
x IntSet
t =
  case IntSet
t of
      Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> if Mask
x Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
>= Mask
0
                             then case Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x IntSet
l of
                                 (IntSet
lt, Bool
fnd, IntSet
gt) -> let !lt' :: IntSet
lt' = IntSet -> IntSet -> IntSet
union IntSet
lt IntSet
r
                                                  in (IntSet
lt', Bool
fnd, IntSet
gt)
                             else case Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x IntSet
r of
                                 (IntSet
lt, Bool
fnd, IntSet
gt) -> let !gt' :: IntSet
gt' = IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
l
                                                  in (IntSet
lt, Bool
fnd, IntSet
gt')
      IntSet
_ -> Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x IntSet
t
  where
    go :: Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x' t' :: IntSet
t'@(Bin Mask
p Mask
m IntSet
l IntSet
r)
        | Mask -> Mask -> Mask -> Bool
match Mask
x' Mask
p Mask
m = if Mask -> Mask -> Bool
zero Mask
x' Mask
m
                         then case Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x' IntSet
l of
                             (IntSet
lt, Bool
fnd, IntSet
gt) -> (IntSet
lt, Bool
fnd, IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
r)
                         else case Mask -> IntSet -> (IntSet, Bool, IntSet)
go Mask
x' IntSet
r of
                             (IntSet
lt, Bool
fnd, IntSet
gt) -> (IntSet -> IntSet -> IntSet
union IntSet
lt IntSet
l, Bool
fnd, IntSet
gt)
        | Bool
otherwise   = if Mask
x' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
p then (IntSet
Nil, Bool
False, IntSet
t') else (IntSet
t', Bool
False, IntSet
Nil)
    go Mask
x' t' :: IntSet
t'@(Tip Mask
kx' Word
bm)
        | Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
x'          = (IntSet
Nil, Bool
False, IntSet
t')
          -- equivalent to kx' > prefixOf x'
        | Mask
kx' Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask -> Mask
prefixOf Mask
x' = (IntSet
t', Bool
False, IntSet
Nil)
        | Bool
otherwise = let !lt :: IntSet
lt = Mask -> Word -> IntSet
tip Mask
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 = Mask -> Word -> IntSet
tip Mask
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' = Mask -> Word
bitmapOf Mask
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 Mask
_ 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 (Mask, IntSet)
maxView IntSet
t =
  case IntSet
t of IntSet
Nil -> Maybe (Mask, IntSet)
forall a. Maybe a
Nothing
            Bin Mask
p Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> case IntSet -> (Mask, IntSet)
go IntSet
l of (Mask
result, IntSet
l') -> (Mask, IntSet) -> Maybe (Mask, IntSet)
forall a. a -> Maybe a
Just (Mask
result, Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l' IntSet
r)
            IntSet
_ -> (Mask, IntSet) -> Maybe (Mask, IntSet)
forall a. a -> Maybe a
Just (IntSet -> (Mask, IntSet)
go IntSet
t)
  where
    go :: IntSet -> (Mask, IntSet)
go (Bin Mask
p Mask
m IntSet
l IntSet
r) = case IntSet -> (Mask, IntSet)
go IntSet
r of (Mask
result, IntSet
r') -> (Mask
result, Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l IntSet
r')
    go (Tip Mask
kx Word
bm) = case Word -> Mask
highestBitSet Word
bm of Mask
bi -> (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi, Mask -> Word -> IntSet
tip Mask
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Mask -> Word
bitmapOfSuffix Mask
bi)))
    go IntSet
Nil = [Char] -> (Mask, 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 (Mask, IntSet)
minView IntSet
t =
  case IntSet
t of IntSet
Nil -> Maybe (Mask, IntSet)
forall a. Maybe a
Nothing
            Bin Mask
p Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> case IntSet -> (Mask, IntSet)
go IntSet
r of (Mask
result, IntSet
r') -> (Mask, IntSet) -> Maybe (Mask, IntSet)
forall a. a -> Maybe a
Just (Mask
result, Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l IntSet
r')
            IntSet
_ -> (Mask, IntSet) -> Maybe (Mask, IntSet)
forall a. a -> Maybe a
Just (IntSet -> (Mask, IntSet)
go IntSet
t)
  where
    go :: IntSet -> (Mask, IntSet)
go (Bin Mask
p Mask
m IntSet
l IntSet
r) = case IntSet -> (Mask, IntSet)
go IntSet
l of (Mask
result, IntSet
l') -> (Mask
result, Mask -> Mask -> IntSet -> IntSet -> IntSet
bin Mask
p Mask
m IntSet
l' IntSet
r)
    go (Tip Mask
kx Word
bm) = case Word -> Mask
lowestBitSet Word
bm of Mask
bi -> (Mask
kx Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
+ Mask
bi, Mask -> Word -> IntSet
tip Mask
kx (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement (Mask -> Word
bitmapOfSuffix Mask
bi)))
    go IntSet
Nil = [Char] -> (Mask, 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 -> (Mask, IntSet)
deleteFindMin = (Mask, IntSet) -> Maybe (Mask, IntSet) -> (Mask, IntSet)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (Mask, IntSet)
forall a. HasCallStack => [Char] -> a
error [Char]
"deleteFindMin: empty set has no minimal element") (Maybe (Mask, IntSet) -> (Mask, IntSet))
-> (IntSet -> Maybe (Mask, IntSet)) -> IntSet -> (Mask, IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Mask, IntSet)
minView

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


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

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


-- | /O(min(n,W))/. Delete the minimal element. Returns an empty set if the set is empty.
--
-- Note that this is a change of behaviour for consistency with 'Data.Set.Set' &#8211;
-- versions prior to 0.5 threw an error if the 'IntSet' was already empty.
deleteMin :: IntSet -> IntSet
deleteMin :: IntSet -> IntSet
deleteMin = IntSet
-> ((Mask, IntSet) -> IntSet) -> Maybe (Mask, IntSet) -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntSet
Nil (Mask, IntSet) -> IntSet
forall a b. (a, b) -> b
snd (Maybe (Mask, IntSet) -> IntSet)
-> (IntSet -> Maybe (Mask, IntSet)) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Mask, 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
-> ((Mask, IntSet) -> IntSet) -> Maybe (Mask, IntSet) -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntSet
Nil (Mask, IntSet) -> IntSet
forall a b. (a, b) -> b
snd (Maybe (Mask, IntSet) -> IntSet)
-> (IntSet -> Maybe (Mask, IntSet)) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Mask, 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 :: (Mask -> Mask) -> IntSet -> IntSet
map Mask -> Mask
f = [Mask] -> IntSet
fromList ([Mask] -> IntSet) -> (IntSet -> [Mask]) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mask -> Mask) -> [Mask] -> [Mask]
forall a b. (a -> b) -> [a] -> [b]
List.map Mask -> Mask
f ([Mask] -> [Mask]) -> (IntSet -> [Mask]) -> IntSet -> [Mask]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Mask]
toList

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

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


{--------------------------------------------------------------------
  Fold
--------------------------------------------------------------------}
-- | /O(n)/. Fold the elements in the set using the given right-associative
-- binary operator. This function is an equivalent of 'foldr' and is present
-- for compatibility only.
--
-- /Please note that fold will be deprecated in the future and removed./
fold :: (Key -> b -> b) -> b -> IntSet -> b
fold :: forall b. (Mask -> b -> b) -> b -> IntSet -> b
fold = (Mask -> b -> b) -> b -> IntSet -> b
forall b. (Mask -> 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. (Mask -> b -> b) -> b -> IntSet -> b
foldr Mask -> b -> b
f b
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> 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 Mask
kx Word
bm)   = Mask -> (Mask -> b -> b) -> b -> Word -> b
forall a. Mask -> (Mask -> a -> a) -> a -> Word -> a
foldrBits Mask
kx Mask -> b -> b
f b
z' Word
bm
    go b
z' (Bin Mask
_ Mask
_ 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. (Mask -> b -> b) -> b -> IntSet -> b
foldr' Mask -> b -> b
f b
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> 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 Mask
kx Word
bm)   = Mask -> (Mask -> b -> b) -> b -> Word -> b
forall a. Mask -> (Mask -> a -> a) -> a -> Word -> a
foldr'Bits Mask
kx Mask -> b -> b
f b
z' Word
bm
    go b
z' (Bin Mask
_ Mask
_ 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 -> Mask -> a) -> a -> IntSet -> a
foldl a -> Mask -> a
f a
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> 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 Mask
kx Word
bm)   = Mask -> (a -> Mask -> a) -> a -> Word -> a
forall a. Mask -> (a -> Mask -> a) -> a -> Word -> a
foldlBits Mask
kx a -> Mask -> a
f a
z' Word
bm
    go a
z' (Bin Mask
_ Mask
_ 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 -> Mask -> a) -> a -> IntSet -> a
foldl' a -> Mask -> a
f a
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Mask
_ Mask
m IntSet
l IntSet
r | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 -> 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 Mask
kx Word
bm)   = Mask -> (a -> Mask -> a) -> a -> Word -> a
forall a. Mask -> (a -> Mask -> a) -> a -> Word -> a
foldl'Bits Mask
kx a -> Mask -> a
f a
z' Word
bm
    go a
z' (Bin Mask
_ Mask
_ IntSet
l IntSet
r) = a -> IntSet -> a
go (a -> IntSet -> a
go a
z' IntSet
l) IntSet
r
{-# INLINE foldl' #-}

{--------------------------------------------------------------------
  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 -> [Mask]
elems
  = IntSet -> [Mask]
toAscList

{--------------------------------------------------------------------
  Lists
--------------------------------------------------------------------}
#if __GLASGOW_HASKELL__ >= 708
-- | @since 0.5.6.2
instance GHC.Exts.IsList IntSet where
  type Item IntSet = Key
  fromList :: [Item IntSet] -> IntSet
fromList = [Mask] -> IntSet
[Item IntSet] -> IntSet
fromList
  toList :: IntSet -> [Item IntSet]
toList   = IntSet -> [Mask]
IntSet -> [Item IntSet]
toList
#endif

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

-- | /O(n)/. Convert the set to an ascending list of elements. Subject to list
-- fusion.
toAscList :: IntSet -> [Key]
toAscList :: IntSet -> [Mask]
toAscList = (Mask -> [Mask] -> [Mask]) -> [Mask] -> IntSet -> [Mask]
forall b. (Mask -> 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 -> [Mask]
toDescList = ([Mask] -> Mask -> [Mask]) -> [Mask] -> IntSet -> [Mask]
forall a. (a -> Mask -> a) -> a -> IntSet -> a
foldl ((Mask -> [Mask] -> [Mask]) -> [Mask] -> Mask -> [Mask]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

-- List fusion for the list generating functions.
#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. (Mask -> b -> b) -> b -> IntSet -> b
foldrFB = (Mask -> b -> b) -> b -> IntSet -> b
forall b. (Mask -> b -> b) -> b -> IntSet -> b
foldr
{-# INLINE[0] foldrFB #-}
foldlFB :: (a -> Key -> a) -> a -> IntSet -> a
foldlFB :: forall a. (a -> Mask -> a) -> a -> IntSet -> a
foldlFB = (a -> Mask -> a) -> a -> IntSet -> a
forall a. (a -> Mask -> 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 :: [Mask] -> IntSet
fromList [Mask]
xs
  = (IntSet -> Mask -> IntSet) -> IntSet -> [Mask] -> IntSet
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' IntSet -> Mask -> IntSet
ins IntSet
empty [Mask]
xs
  where
    ins :: IntSet -> Mask -> IntSet
ins IntSet
t Mask
x  = Mask -> IntSet -> IntSet
insert Mask
x IntSet
t

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

-- | /O(n)/. Build a set from an ascending list of distinct elements.
-- /The precondition (input list is strictly ascending) is not checked./
fromDistinctAscList :: [Key] -> IntSet
fromDistinctAscList :: [Mask] -> IntSet
fromDistinctAscList = [Mask] -> 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 :: [Mask] -> IntSet
fromMonoList []         = IntSet
Nil
fromMonoList (Mask
kx : [Mask]
zs1) = Mask -> Word -> [Mask] -> IntSet
addAll' (Mask -> Mask
prefixOf Mask
kx) (Mask -> Word
bitmapOf Mask
kx) [Mask]
zs1
  where
    -- `addAll'` collects all keys with the prefix `px` into a single
    -- bitmap, and then proceeds with `addAll`.
    addAll' :: Mask -> Word -> [Mask] -> IntSet
addAll' !Mask
px !Word
bm []
        = Mask -> Word -> IntSet
Tip Mask
px Word
bm
    addAll' !Mask
px !Word
bm (Mask
ky : [Mask]
zs)
        | Mask
px Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask -> Mask
prefixOf Mask
ky
        = Mask -> Word -> [Mask] -> IntSet
addAll' Mask
px (Word
bm Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Mask -> Word
bitmapOf Mask
ky) [Mask]
zs
        -- inlined: | otherwise = addAll px (Tip px bm) (ky : zs)
        | Mask
py <- Mask -> Mask
prefixOf Mask
ky
        , Mask
m <- Mask -> Mask -> Mask
branchMask Mask
px Mask
py
        , Inserted IntSet
ty [Mask]
zs' <- Mask -> Mask -> Word -> [Mask] -> Inserted
addMany' Mask
m Mask
py (Mask -> Word
bitmapOf Mask
ky) [Mask]
zs
        = Mask -> IntSet -> [Mask] -> IntSet
addAll Mask
px (Mask -> Mask -> IntSet -> IntSet -> IntSet
linkWithMask Mask
m Mask
py IntSet
ty {-px-} (Mask -> Word -> IntSet
Tip Mask
px Word
bm)) [Mask]
zs'

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

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

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

data Inserted = Inserted !IntSet ![Key]

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

equal :: IntSet -> IntSet -> Bool
equal :: IntSet -> IntSet -> Bool
equal (Bin Mask
p1 Mask
m1 IntSet
l1 IntSet
r1) (Bin Mask
p2 Mask
m2 IntSet
l2 IntSet
r2)
  = (Mask
m1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
m2) Bool -> Bool -> Bool
&& (Mask
p1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
p2) Bool -> Bool -> Bool
&& (IntSet -> IntSet -> Bool
equal IntSet
l1 IntSet
l2) Bool -> Bool -> Bool
&& (IntSet -> IntSet -> Bool
equal IntSet
r1 IntSet
r2)
equal (Tip Mask
kx1 Word
bm1) (Tip Mask
kx2 Word
bm2)
  = Mask
kx1 Mask -> Mask -> Bool
forall a. Eq a => a -> a -> Bool
== Mask
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

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

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

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

{--------------------------------------------------------------------
  Show
--------------------------------------------------------------------}
instance Show IntSet where
  showsPrec :: Mask -> IntSet -> ShowS
showsPrec Mask
p IntSet
xs = Bool -> ShowS -> ShowS
showParen (Mask
p Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
> Mask
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    [Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mask] -> ShowS
forall a. Show a => a -> ShowS
shows (IntSet -> [Mask]
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
$ Mask -> ReadPrec IntSet -> ReadPrec IntSet
forall a. Mask -> ReadPrec a -> ReadPrec a
prec Mask
10 (ReadPrec IntSet -> ReadPrec IntSet)
-> ReadPrec IntSet -> ReadPrec IntSet
forall a b. (a -> b) -> a -> b
$ do
    Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
    [Mask]
xs <- ReadPrec [Mask]
forall a. Read a => ReadPrec a
readPrec
    IntSet -> ReadPrec IntSet
forall (m :: * -> *) a. Monad m => a -> m a
return ([Mask] -> IntSet
fromList [Mask]
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

{--------------------------------------------------------------------
  Typeable
--------------------------------------------------------------------}

INSTANCE_TYPEABLE0(IntSet)

{--------------------------------------------------------------------
  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 -> () -> ()
seq IntSet
x ()

{--------------------------------------------------------------------
  Debugging
--------------------------------------------------------------------}
-- | /O(n)/. 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)/. 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 Mask
p Mask
m 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 (Mask -> Mask -> [Char]
showBin Mask
p Mask
m) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
lbars) ([[Char]] -> [[Char]]
withBar [[Char]]
lbars) IntSet
l
      Tip Mask
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
. Mask -> ShowS
forall a. Show a => a -> ShowS
shows Mask
kx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" + " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                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 Mask
p Mask
m 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 (Mask -> Mask -> [Char]
showBin Mask
p Mask
m) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> 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 Mask
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
. Mask -> ShowS
forall a. Show a => a -> ShowS
shows Mask
kx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" + " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                               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 -> Mask -> String
showBin :: Mask -> Mask -> [Char]
showBin Mask
_ Mask
_
  = [Char]
"*" -- ++ show (p,m)

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

showsBars :: [String] -> ShowS
showsBars :: [[Char]] -> ShowS
showsBars [] = ShowS
forall a. a -> a
id
showsBars [[Char]]
bars = [Char] -> ShowS
showString ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
bars))) 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 = [Mask] -> [Char]
forall a. Show a => a -> [Char]
show ([Mask] -> [Char]) -> [Mask] -> [Char]
forall a b. (a -> b) -> a -> b
$ Mask -> (Mask -> [Mask] -> [Mask]) -> [Mask] -> Word -> [Mask]
forall a. Mask -> (Mask -> a -> a) -> a -> Word -> a
foldrBits Mask
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 :: Prefix -> IntSet -> Prefix -> IntSet -> IntSet
link :: Mask -> IntSet -> Mask -> IntSet -> IntSet
link Mask
p1 IntSet
t1 Mask
p2 IntSet
t2 = Mask -> Mask -> IntSet -> IntSet -> IntSet
linkWithMask (Mask -> Mask -> Mask
branchMask Mask
p1 Mask
p2) Mask
p1 IntSet
t1 {-p2-} IntSet
t2
{-# INLINE link #-}

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

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

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


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

suffixBitMask :: Int
#if MIN_VERSION_base(4,7,0)
suffixBitMask :: Mask
suffixBitMask = Word -> Mask
forall b. FiniteBits b => b -> Mask
finiteBitSize (Word
forall a. HasCallStack => a
undefined::Word) Mask -> Mask -> Mask
forall a. Num a => a -> a -> a
- Mask
1
#else
suffixBitMask = bitSize (undefined::Word) - 1
#endif
{-# INLINE suffixBitMask #-}

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

lowestBitSet :: Nat -> Int
highestBitSet :: Nat -> Int
foldlBits :: Int -> (a -> Int -> a) -> a -> Nat -> a
foldl'Bits :: Int -> (a -> Int -> a) -> a -> Nat -> a
foldrBits :: Int -> (Int -> a -> a) -> a -> Nat -> a
foldr'Bits :: Int -> (Int -> a -> a) -> a -> Nat -> a

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

#if defined(__GLASGOW_HASKELL__) && (WORD_SIZE_IN_BITS==32 || WORD_SIZE_IN_BITS==64)
indexOfTheOnlyBit :: Nat -> Int
{-# INLINE indexOfTheOnlyBit #-}
#if MIN_VERSION_base(4,8,0) && (WORD_SIZE_IN_BITS==64)
indexOfTheOnlyBit :: Word -> Mask
indexOfTheOnlyBit Word
bitmask = Word -> Mask
forall b. FiniteBits b => b -> Mask
countTrailingZeros Word
bitmask

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

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

#else
{----------------------------------------------------------------------
  For lowestBitSet we use wordsize-dependant implementation based on
  multiplication and DeBrujn indeces, which was proposed by Edward Kmett
  <http://haskell.org/pipermail/libraries/2011-September/016749.html>

  The core of this implementation is fast indexOfTheOnlyBit,
  which is given a Nat with exactly one bit set, and returns
  its index.

  Lot of effort was put in these implementations, please benchmark carefully
  before changing this code.
----------------------------------------------------------------------}

indexOfTheOnlyBit bitmask =
  fromIntegral (GHC.Int.I8# (lsbArray `GHC.Exts.indexInt8OffAddr#` unboxInt (intFromNat ((bitmask * magic) `shiftRL` offset))))
  where unboxInt (GHC.Exts.I# i) = i
#if WORD_SIZE_IN_BITS==32
        magic = 0x077CB531
        offset = 27
        !lsbArray = "\0\1\28\2\29\14\24\3\30\22\20\15\25\17\4\8\31\27\13\23\21\19\16\7\26\12\18\6\11\5\10\9"#
#else
        magic = 0x07EDD5E59A4E28C2
        offset = 58
        !lsbArray = "\63\0\58\1\59\47\53\2\60\39\48\27\54\33\42\3\61\51\37\40\49\18\28\20\55\30\34\11\43\14\22\4\62\57\46\52\38\26\32\41\50\36\17\19\29\10\13\21\56\45\25\31\35\16\9\12\44\24\15\8\23\7\6\5"#
#endif
-- The lsbArray gets inlined to every call site of indexOfTheOnlyBit.
-- That cannot be easily avoided, as GHC forbids top-level Addr# literal.
-- One could go around that by supplying getLsbArray :: () -> Addr# marked
-- as NOINLINE. But the code size of calling it and processing the result
-- is 48B on 32-bit and 56B on 64-bit architectures -- so the 32B and 64B array
-- is actually improvement on 32-bit and only a 8B size increase on 64-bit.

lowestBitSet x = indexOfTheOnlyBit (lowestBitMask x)

highestBitSet x = indexOfTheOnlyBit (highestBitMask x)

#endif

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

-- Reverse the order of bits in the Nat.
revNat :: Nat -> Nat
#if WORD_SIZE_IN_BITS==32
revNat 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
revNat :: Word -> Word
revNat Word
x1 = case ((Word
x1 Word -> Mask -> Word
`shiftRL` Mask
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 -> Mask -> Word
`shiftLL` Mask
1) of
              Word
x2 -> case ((Word
x2 Word -> Mask -> Word
`shiftRL` Mask
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 -> Mask -> Word
`shiftLL` Mask
2) of
                 Word
x3 -> case ((Word
x3 Word -> Mask -> Word
`shiftRL` Mask
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 -> Mask -> Word
`shiftLL` Mask
4) of
                   Word
x4 -> case ((Word
x4 Word -> Mask -> Word
`shiftRL` Mask
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 -> Mask -> Word
`shiftLL` Mask
8) of
                     Word
x5 -> case ((Word
x5 Word -> Mask -> Word
`shiftRL` Mask
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 -> Mask -> Word
`shiftLL` Mask
16) of
                       Word
x6 -> ( Word
x6 Word -> Mask -> Word
`shiftRL` Mask
32             ) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. ( Word
x6               Word -> Mask -> Word
`shiftLL` Mask
32);
#endif

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

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

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


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

#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)

#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 Mask
_ Word
_) = [IntSet
x]
splitRoot (Bin Mask
_ Mask
m IntSet
l IntSet
r) | Mask
m Mask -> Mask -> Bool
forall a. Ord a => a -> a -> Bool
< Mask
0 = [IntSet
r, IntSet
l]
                        | Bool
otherwise = [IntSet
l, IntSet
r]
{-# INLINE splitRoot #-}