{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
#endif
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif

{-# OPTIONS_HADDOCK not-home #-}

#include "containers.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.IntSet.Internal
-- Copyright   :  (c) Daan Leijen 2002
--                (c) Joachim Breitner 2011
-- License     :  BSD-style
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.
--
-- = 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)
import Data.Semigroup (Semigroup(stimes))
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup((<>)))
#endif
import Data.Semigroup (stimesIdempotentMonoid)
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 !(WORD_SIZE_IN_BITS==64)
import qualified GHC.Int
#  endif
import Language.Haskell.TH.Syntax (Lift)
#endif

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

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 :: Int -> Nat
natFromInt Int
i = Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
{-# INLINE natFromInt #-}

intFromNat :: Nat -> Int
intFromNat :: Nat -> Int
intFromNat Nat
w = Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
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

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

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

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

#if __GLASGOW_HASKELL__

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

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

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

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

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

#endif

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

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

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

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

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

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



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

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

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

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

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

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

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

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

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

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

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

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

{--------------------------------------------------------------------
  Union
--------------------------------------------------------------------}
-- | The union of a list of sets.
unions :: Foldable f => f IntSet -> IntSet
unions :: 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 Int
p1 Int
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2)
  | Int -> Int -> Bool
shorter Int
m1 Int
m2  = IntSet
union1
  | Int -> Int -> Bool
shorter Int
m2 Int
m1  = IntSet
union2
  | Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2       = Int -> Int -> IntSet -> IntSet -> IntSet
Bin Int
p1 Int
m1 (IntSet -> IntSet -> IntSet
union IntSet
l1 IntSet
l2) (IntSet -> IntSet -> IntSet
union IntSet
r1 IntSet
r2)
  | Bool
otherwise      = Int -> IntSet -> Int -> IntSet -> IntSet
link Int
p1 IntSet
t1 Int
p2 IntSet
t2
  where
    union1 :: IntSet
union1  | Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1  = Int -> IntSet -> Int -> IntSet -> IntSet
link Int
p1 IntSet
t1 Int
p2 IntSet
t2
            | Int -> Int -> Bool
zero Int
p2 Int
m1        = Int -> Int -> IntSet -> IntSet -> IntSet
Bin Int
p1 Int
m1 (IntSet -> IntSet -> IntSet
union IntSet
l1 IntSet
t2) IntSet
r1
            | Bool
otherwise         = Int -> Int -> IntSet -> IntSet -> IntSet
Bin Int
p1 Int
m1 IntSet
l1 (IntSet -> IntSet -> IntSet
union IntSet
r1 IntSet
t2)

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

union t :: IntSet
t@(Bin Int
_ Int
_ IntSet
_ IntSet
_) (Tip Int
kx Nat
bm) = Int -> Nat -> IntSet -> IntSet
insertBM Int
kx Nat
bm IntSet
t
union t :: IntSet
t@(Bin Int
_ Int
_ IntSet
_ IntSet
_) IntSet
Nil = IntSet
t
union (Tip Int
kx Nat
bm) IntSet
t = Int -> Nat -> IntSet -> IntSet
insertBM Int
kx Nat
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 Int
p1 Int
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2)
  | Int -> Int -> Bool
shorter Int
m1 Int
m2  = IntSet
difference1
  | Int -> Int -> Bool
shorter Int
m2 Int
m1  = IntSet
difference2
  | Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2       = Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p1 Int
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 | Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1  = IntSet
t1
                | Int -> Int -> Bool
zero Int
p2 Int
m1        = Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p1 Int
m1 (IntSet -> IntSet -> IntSet
difference IntSet
l1 IntSet
t2) IntSet
r1
                | Bool
otherwise         = Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p1 Int
m1 IntSet
l1 (IntSet -> IntSet -> IntSet
difference IntSet
r1 IntSet
t2)

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

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

difference t1 :: IntSet
t1@(Tip Int
kx Nat
bm) IntSet
t2 = IntSet -> IntSet
differenceTip IntSet
t2
  where differenceTip :: IntSet -> IntSet
differenceTip (Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2) | Int -> Int -> Int -> Bool
nomatch Int
kx Int
p2 Int
m2 = IntSet
t1
                                        | Int -> Int -> Bool
zero Int
kx Int
m2 = IntSet -> IntSet
differenceTip IntSet
l2
                                        | Bool
otherwise = IntSet -> IntSet
differenceTip IntSet
r2
        differenceTip (Tip Int
kx2 Nat
bm2) | Int
kx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 = Int -> Nat -> IntSet
tip Int
kx (Nat
bm Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat -> Nat
forall a. Bits a => a -> a
complement Nat
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 Int
p1 Int
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2)
  | Int -> Int -> Bool
shorter Int
m1 Int
m2  = IntSet
intersection1
  | Int -> Int -> Bool
shorter Int
m2 Int
m1  = IntSet
intersection2
  | Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2       = Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p1 Int
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 | Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1  = IntSet
Nil
                  | Int -> Int -> Bool
zero Int
p2 Int
m1        = IntSet -> IntSet -> IntSet
intersection IntSet
l1 IntSet
t2
                  | Bool
otherwise         = IntSet -> IntSet -> IntSet
intersection IntSet
r1 IntSet
t2

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

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

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

intersection (Tip Int
kx1 Nat
bm1) IntSet
t2 = IntSet -> IntSet
intersectBM IntSet
t2
  where intersectBM :: IntSet -> IntSet
intersectBM (Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2) | Int -> Int -> Int -> Bool
nomatch Int
kx1 Int
p2 Int
m2 = IntSet
Nil
                                      | Int -> Int -> Bool
zero Int
kx1 Int
m2       = IntSet -> IntSet
intersectBM IntSet
l2
                                      | Bool
otherwise         = IntSet -> IntSet
intersectBM IntSet
r2
        intersectBM (Tip Int
kx2 Nat
bm2) | Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 = Int -> Nat -> IntSet
tip Int
kx1 (Nat
bm1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
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 Int
p1 Int
m1 IntSet
l1 IntSet
r1) (Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2)
  | Int -> Int -> Bool
shorter Int
m1 Int
m2  = Ordering
GT
  | Int -> Int -> Bool
shorter Int
m2 Int
m1  = case Ordering
subsetCmpLt of
                       Ordering
GT -> Ordering
GT
                       Ordering
_  -> Ordering
LT
  | Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2       = Ordering
subsetCmpEq
  | Bool
otherwise      = Ordering
GT  -- disjoint
  where
    subsetCmpLt :: Ordering
subsetCmpLt | Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2  = Ordering
GT
                | Int -> Int -> Bool
zero Int
p1 Int
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 Int
_ Int
_ IntSet
_ IntSet
_) IntSet
_  = Ordering
GT
subsetCmp (Tip Int
kx1 Nat
bm1) (Tip Int
kx2 Nat
bm2)
  | Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
kx2                  = Ordering
GT -- disjoint
  | Nat
bm1 Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
bm2                  = Ordering
EQ
  | Nat
bm1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat -> Nat
forall a. Bits a => a -> a
complement Nat
bm2 Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0 = Ordering
LT
  | Bool
otherwise                   = Ordering
GT
subsetCmp t1 :: IntSet
t1@(Tip Int
kx Nat
_) (Bin Int
p Int
m IntSet
l IntSet
r)
  | Int -> Int -> Int -> Bool
nomatch Int
kx Int
p Int
m = Ordering
GT
  | Int -> Int -> Bool
zero Int
kx Int
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 Int
_ Nat
_) 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 Int
p1 Int
m1 IntSet
l1 IntSet
r1) (Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2)
  | Int -> Int -> Bool
shorter Int
m1 Int
m2  = Bool
False
  | Int -> Int -> Bool
shorter Int
m2 Int
m1  = Int -> Int -> Int -> Bool
match Int
p1 Int
p2 Int
m2 Bool -> Bool -> Bool
&& (if Int -> Int -> Bool
zero Int
p1 Int
m2 then IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
l2
                                                      else IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
r2)
  | Bool
otherwise      = (Int
p1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
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 Int
_ Int
_ IntSet
_ IntSet
_) IntSet
_  = Bool
False
isSubsetOf (Tip Int
kx1 Nat
bm1) (Tip Int
kx2 Nat
bm2) = Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 Bool -> Bool -> Bool
&& Nat
bm1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat -> Nat
forall a. Bits a => a -> a
complement Nat
bm2 Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0
isSubsetOf t1 :: IntSet
t1@(Tip Int
kx Nat
_) (Bin Int
p Int
m IntSet
l IntSet
r)
  | Int -> Int -> Int -> Bool
nomatch Int
kx Int
p Int
m = Bool
False
  | Int -> Int -> Bool
zero Int
kx Int
m      = IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
l
  | Bool
otherwise      = IntSet -> IntSet -> Bool
isSubsetOf IntSet
t1 IntSet
r
isSubsetOf (Tip Int
_ Nat
_) 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 Int
p1 Int
m1 IntSet
l1 IntSet
r1) t2 :: IntSet
t2@(Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2)
  | Int -> Int -> Bool
shorter Int
m1 Int
m2  = Bool
disjoint1
  | Int -> Int -> Bool
shorter Int
m2 Int
m1  = Bool
disjoint2
  | Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 | Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1  = Bool
True
              | Int -> Int -> Bool
zero Int
p2 Int
m1        = IntSet -> IntSet -> Bool
disjoint IntSet
l1 IntSet
t2
              | Bool
otherwise         = IntSet -> IntSet -> Bool
disjoint IntSet
r1 IntSet
t2

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

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

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

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

disjoint IntSet
Nil IntSet
_ = Bool
True


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

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

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

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

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

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

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

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


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

-- | \(O(\min(n,W))\). The maximal element of a set.
findMax :: IntSet -> Key
findMax :: IntSet -> Int
findMax IntSet
Nil = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"findMax: empty set has no maximal element"
findMax (Tip Int
kx Nat
bm) = Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Nat -> Int
highestBitSet Nat
bm
findMax (Bin Int
_ Int
m IntSet
l IntSet
r)
  |   Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0   = IntSet -> Int
find IntSet
l
  | Bool
otherwise = IntSet -> Int
find IntSet
r
    where find :: IntSet -> Int
find (Tip Int
kx Nat
bm) = Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Nat -> Int
highestBitSet Nat
bm
          find (Bin Int
_ Int
_ IntSet
_ IntSet
r') = IntSet -> Int
find IntSet
r'
          find IntSet
Nil            = [Char] -> Int
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
-> ((Int, IntSet) -> IntSet) -> Maybe (Int, IntSet) -> IntSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntSet
Nil (Int, IntSet) -> IntSet
forall a b. (a, b) -> b
snd (Maybe (Int, IntSet) -> IntSet)
-> (IntSet -> Maybe (Int, IntSet)) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Int, IntSet)
minView

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

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

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

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

-- | \(O(n)\). The
--
-- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is strictly increasing.
-- /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 :: (Int -> Int) -> IntSet -> IntSet
mapMonotonic Int -> Int
f = [Int] -> IntSet
fromDistinctAscList ([Int] -> IntSet) -> (IntSet -> [Int]) -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
List.map Int -> Int
f ([Int] -> [Int]) -> (IntSet -> [Int]) -> IntSet -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
toAscList


{--------------------------------------------------------------------
  Fold
--------------------------------------------------------------------}
-- | \(O(n)\). Fold the elements in the set using the given right-associative
-- binary operator. 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 :: (Int -> b -> b) -> b -> IntSet -> b
fold = (Int -> b -> b) -> b -> IntSet -> b
forall b. (Int -> b -> b) -> b -> IntSet -> b
foldr
{-# INLINE fold #-}

-- | \(O(n)\). Fold the elements in the set using the given right-associative
-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'toAscList'@.
--
-- For example,
--
-- > toAscList set = foldr (:) [] set
foldr :: (Key -> b -> b) -> b -> IntSet -> b
foldr :: (Int -> b -> b) -> b -> IntSet -> b
foldr Int -> b -> b
f b
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Int
_ Int
m IntSet
l IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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 Int
kx Nat
bm)   = Int -> (Int -> b -> b) -> b -> Nat -> b
forall a. Int -> (Int -> a -> a) -> a -> Nat -> a
foldrBits Int
kx Int -> b -> b
f b
z' Nat
bm
    go b
z' (Bin Int
_ Int
_ 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' :: (Int -> b -> b) -> b -> IntSet -> b
foldr' Int -> b -> b
f b
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Int
_ Int
m IntSet
l IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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 Int
kx Nat
bm)   = Int -> (Int -> b -> b) -> b -> Nat -> b
forall a. Int -> (Int -> a -> a) -> a -> Nat -> a
foldr'Bits Int
kx Int -> b -> b
f b
z' Nat
bm
    go b
z' (Bin Int
_ Int
_ 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 :: (a -> Int -> a) -> a -> IntSet -> a
foldl a -> Int -> a
f a
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Int
_ Int
m IntSet
l IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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 Int
kx Nat
bm)   = Int -> (a -> Int -> a) -> a -> Nat -> a
forall a. Int -> (a -> Int -> a) -> a -> Nat -> a
foldlBits Int
kx a -> Int -> a
f a
z' Nat
bm
    go a
z' (Bin Int
_ Int
_ 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' :: (a -> Int -> a) -> a -> IntSet -> a
foldl' a -> Int -> a
f a
z = \IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin Int
_ Int
m IntSet
l IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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 Int
kx Nat
bm)   = Int -> (a -> Int -> a) -> a -> Nat -> a
forall a. Int -> (a -> Int -> a) -> a -> Nat -> a
foldl'Bits Int
kx a -> Int -> a
f a
z' Nat
bm
    go a
z' (Bin Int
_ Int
_ 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 -> [Int]
elems
  = IntSet -> [Int]
toAscList

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

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

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

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

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

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

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

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


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

-- | \(O(n)\). Build a set from an ascending list of elements.
-- /The precondition (input list is ascending) is not checked./
fromAscList :: [Key] -> IntSet
fromAscList :: [Int] -> IntSet
fromAscList = [Int] -> 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 :: [Int] -> IntSet
fromDistinctAscList = [Int] -> IntSet
fromAscList
{-# INLINE fromDistinctAscList #-}

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

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

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

    -- `addAll` adds to `tx` all keys whose prefix w.r.t. `m` agrees with `px`.
    addMany :: Int -> Int -> IntSet -> [Int] -> Inserted
addMany !Int
_m !Int
_px IntSet
tx []
        = IntSet -> [Int] -> Inserted
Inserted IntSet
tx []
    addMany !Int
m !Int
px IntSet
tx zs0 :: [Int]
zs0@(Int
ky : [Int]
zs)
        | Int -> Int -> Int
mask Int
px Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Int -> Int
mask Int
ky Int
m
        = IntSet -> [Int] -> Inserted
Inserted IntSet
tx [Int]
zs0
        | Int
py <- Int -> Int
prefixOf Int
ky
        , Int
mxy <- Int -> Int -> Int
branchMask Int
px Int
py
        , Inserted IntSet
ty [Int]
zs' <- Int -> Int -> Nat -> [Int] -> Inserted
addMany' Int
mxy Int
py (Int -> Nat
bitmapOf Int
ky) [Int]
zs
        = Int -> Int -> IntSet -> [Int] -> Inserted
addMany Int
m Int
px (Int -> Int -> IntSet -> IntSet -> IntSet
linkWithMask Int
mxy Int
py IntSet
ty {-px-} IntSet
tx) [Int]
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 Int
p1 Int
m1 IntSet
l1 IntSet
r1) (Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2)
  = (Int
m1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m2) Bool -> Bool -> Bool
&& (Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2) Bool -> Bool -> Bool
&& (IntSet -> IntSet -> Bool
equal IntSet
l1 IntSet
l2) Bool -> Bool -> Bool
&& (IntSet -> IntSet -> Bool
equal IntSet
r1 IntSet
r2)
equal (Tip Int
kx1 Nat
bm1) (Tip Int
kx2 Nat
bm2)
  = Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx2 Bool -> Bool -> Bool
&& Nat
bm1 Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
bm2
equal IntSet
Nil IntSet
Nil = Bool
True
equal IntSet
_   IntSet
_   = Bool
False

nequal :: IntSet -> IntSet -> Bool
nequal :: IntSet -> IntSet -> Bool
nequal (Bin Int
p1 Int
m1 IntSet
l1 IntSet
r1) (Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2)
  = (Int
m1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
m2) Bool -> Bool -> Bool
|| (Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
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 Int
kx1 Nat
bm1) (Tip Int
kx2 Nat
bm2)
  = Int
kx1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
kx2 Bool -> Bool -> Bool
|| Nat
bm1 Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
/= Nat
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 = [Int] -> [Int] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IntSet -> [Int]
toAscList IntSet
s1) (IntSet -> [Int]
toAscList IntSet
s2)
    -- tentative implementation. See if more efficient exists.

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

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

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

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

-- The IntSet constructors consist only of strict fields of Ints and
-- IntSets, thus the default NFData instance which evaluates to whnf
-- should suffice
instance NFData IntSet where rnf :: IntSet -> ()
rnf IntSet
x = IntSet -> () -> ()
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 Int
p Int
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 (Int -> Int -> [Char]
showBin Int
p Int
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 Int
kx Nat
bm
          -> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
kx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" + " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                Nat -> ShowS
showsBitMap Nat
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 Int
p Int
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 (Int -> Int -> [Char]
showBin Int
p Int
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 Int
kx Nat
bm
          -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
kx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" + " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                               Nat -> ShowS
showsBitMap Nat
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 :: Int -> Int -> [Char]
showBin Int
_ Int
_
  = [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 :: Nat -> ShowS
showsBitMap = [Char] -> ShowS
showString ([Char] -> ShowS) -> (Nat -> [Char]) -> Nat -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nat -> [Char]
showBitMap

showBitMap :: Word -> String
showBitMap :: Nat -> [Char]
showBitMap Nat
w = [Int] -> [Char]
forall a. Show a => a -> [Char]
show ([Int] -> [Char]) -> [Int] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> [Int] -> [Int]) -> [Int] -> Nat -> [Int]
forall a. Int -> (Int -> a -> a) -> a -> Nat -> a
foldrBits Int
0 (:) [] Nat
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 :: Int -> IntSet -> Int -> IntSet -> IntSet
link Int
p1 IntSet
t1 Int
p2 IntSet
t2 = Int -> Int -> IntSet -> IntSet -> IntSet
linkWithMask (Int -> Int -> Int
branchMask Int
p1 Int
p2) Int
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 :: Int -> Int -> IntSet -> IntSet -> IntSet
linkWithMask Int
m Int
p1 IntSet
t1 {-p2-} IntSet
t2
  | Int -> Int -> Bool
zero Int
p1 Int
m = Int -> Int -> IntSet -> IntSet -> IntSet
Bin Int
p Int
m IntSet
t1 IntSet
t2
  | Bool
otherwise = Int -> Int -> IntSet -> IntSet -> IntSet
Bin Int
p Int
m IntSet
t2 IntSet
t1
  where
    p :: Int
p = Int -> Int -> Int
mask Int
p1 Int
m
{-# INLINE linkWithMask #-}

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

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


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

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

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

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

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

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

bitmapOf :: Int -> BitMap
bitmapOf :: Int -> Nat
bitmapOf Int
x = Int -> Nat
bitmapOfSuffix (Int -> Int
suffixOf Int
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 :: Int -> Int -> Bool
zero Int
i Int
m
  = (Int -> Nat
natFromInt Int
i) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. (Int -> Nat
natFromInt Int
m) Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0
{-# INLINE zero #-}

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

match :: Int -> Int -> Int -> Bool
match Int
i Int
p Int
m
  = (Int -> Int -> Int
mask Int
i Int
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 :: Int -> Int -> Int
mask Int
i Int
m
  = Nat -> Nat -> Int
maskW (Int -> Nat
natFromInt Int
i) (Int -> Nat
natFromInt Int
m)
{-# INLINE mask #-}

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

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

branchMask :: Prefix -> Prefix -> Mask
branchMask :: Int -> Int -> Int
branchMask Int
p1 Int
p2
  = Nat -> Int
intFromNat (Nat -> Nat
highestBitMask (Int -> Nat
natFromInt Int
p1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Int -> Nat
natFromInt Int
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 WORD_SIZE_IN_BITS==64
indexOfTheOnlyBit :: Nat -> Int
indexOfTheOnlyBit Nat
bitmask = Nat -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Nat
bitmask

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

highestBitSet :: Nat -> Int
highestBitSet Nat
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 :: Nat -> Nat
lowestBitMask Nat
x = Nat
x Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat -> Nat
forall a. Num a => a -> a
negate Nat
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 :: Nat -> Nat
revNat Nat
x1 = case ((Nat
x1 Nat -> Int -> Nat
`shiftRL` Int
1) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
0x5555555555555555) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. ((Nat
x1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
0x5555555555555555) Nat -> Int -> Nat
`shiftLL` Int
1) of
              Nat
x2 -> case ((Nat
x2 Nat -> Int -> Nat
`shiftRL` Int
2) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
0x3333333333333333) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. ((Nat
x2 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
0x3333333333333333) Nat -> Int -> Nat
`shiftLL` Int
2) of
                 Nat
x3 -> case ((Nat
x3 Nat -> Int -> Nat
`shiftRL` Int
4) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
0x0F0F0F0F0F0F0F0F) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. ((Nat
x3 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
0x0F0F0F0F0F0F0F0F) Nat -> Int -> Nat
`shiftLL` Int
4) of
                   Nat
x4 -> case ((Nat
x4 Nat -> Int -> Nat
`shiftRL` Int
8) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
0x00FF00FF00FF00FF) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. ((Nat
x4 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
0x00FF00FF00FF00FF) Nat -> Int -> Nat
`shiftLL` Int
8) of
                     Nat
x5 -> case ((Nat
x5 Nat -> Int -> Nat
`shiftRL` Int
16) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
0x0000FFFF0000FFFF) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. ((Nat
x5 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
0x0000FFFF0000FFFF) Nat -> Int -> Nat
`shiftLL` Int
16) of
                       Nat
x6 -> ( Nat
x6 Nat -> Int -> Nat
`shiftRL` Int
32             ) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. ( Nat
x6               Nat -> Int -> Nat
`shiftLL` Int
32);
#endif

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

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

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


foldr'Bits :: Int -> (Int -> a -> a) -> a -> Nat -> a
foldr'Bits Int
prefix Int -> a -> a
f a
z Nat
bitmap = Nat -> a -> a
go (Nat -> Nat
revNat Nat
bitmap) a
z
  where go :: Nat -> a -> a
go Nat
0 a
acc = a
acc
        go Nat
bm !a
acc = Nat -> a -> a
go (Nat
bm Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Nat
bitmask) ((Int -> a -> a
f (Int -> a -> a) -> Int -> a -> a
forall a b. (a -> b) -> a -> b
$! (Int
prefixInt -> Int -> Int
forall a. Num a => a -> a -> a
+(WORD_SIZE_IN_BITS-1)-bi)) acc)
          where !bitmask :: Nat
bitmask = Nat -> Nat
lowestBitMask Nat
bm
                !bi :: Int
bi = Nat -> Int
indexOfTheOnlyBit Nat
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 Int
_ Nat
_) = [IntSet
x]
splitRoot (Bin Int
_ Int
m IntSet
l IntSet
r) | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [IntSet
r, IntSet
l]
                        | Bool
otherwise = [IntSet
l, IntSet
r]
{-# INLINE splitRoot #-}