{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE MagicHash, DeriveDataTypeable, StandaloneDeriving #-}
#endif
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE TypeFamilies #-}
#endif

{-# OPTIONS_HADDOCK not-home #-}

#include "containers.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.IntSet.Internal
-- Copyright   :  (c) Daan Leijen 2002
--                (c) Joachim Breitner 2011
-- License     :  BSD-style
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.
--
-- = Description
--
-- An efficient implementation of integer sets.
--
-- These modules are intended to be imported qualified, to avoid name
-- clashes with Prelude functions, e.g.
--
-- >  import Data.IntSet (IntSet)
-- >  import qualified Data.IntSet as IntSet
--
-- The implementation is based on /big-endian patricia trees/.  This data
-- structure performs especially well on binary operations like 'union'
-- and 'intersection'.  However, my benchmarks show that it is also
-- (much) faster on insertions and deletions when compared to a generic
-- size-balanced set implementation (see "Data.Set").
--
--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",
--      Workshop on ML, September 1998, pages 77-86,
--      <http://citeseer.ist.psu.edu/okasaki98fast.html>
--
--    * 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

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

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

    -- * Map
    , map

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

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

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

#if __GLASGOW_HASKELL__
import GHC.Exts (Int(..), build)
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as GHCExts
#endif
import GHC.Exts (indexInt8OffAddr#)
#endif

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

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

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

natFromInt :: Int -> Nat
natFromInt :: Int -> Nat
natFromInt i :: 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 w :: 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
m1 :: IntSet
m1 \\ :: IntSet -> IntSet -> IntSet
\\ m2 :: IntSet
m2 = IntSet -> IntSet -> IntSet
difference IntSet
m1 IntSet
m2

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

-- | A set of integers.

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

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

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

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

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

#if __GLASGOW_HASKELL__

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

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

instance Data IntSet where
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntSet -> c IntSet
gfoldl f :: forall d b. Data d => c (d -> b) -> d -> c b
f z :: forall g. g -> c g
z is :: 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 _     = Constr
fromListConstr
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntSet
gunfold k :: forall b r. Data b => c (b -> r) -> c r
k z :: forall r. r -> c r
z c :: Constr
c  = case Constr -> Int
constrIndex Constr
c of
    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)
    _ -> [Char] -> c IntSet
forall a. HasCallStack => [Char] -> a
error "gunfold"
  dataTypeOf :: IntSet -> DataType
dataTypeOf _   = DataType
intSetDataType

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

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

#endif

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

-- | /O(n)/. Cardinality of the set.
size :: IntSet -> Int
size :: IntSet -> Int
size = Int -> IntSet -> Int
go 0
  where
    go :: Int -> IntSet -> Int
go !Int
acc (Bin _ _ l :: IntSet
l r :: IntSet
r) = Int -> IntSet -> Int
go (Int -> IntSet -> Int
go Int
acc IntSet
l) IntSet
r
    go acc :: Int
acc (Tip _ bm :: Nat
bm) = Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Nat -> Int
bitcount 0 Nat
bm
    go acc :: Int
acc 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 p :: Int
p m :: Int
m l :: IntSet
l r :: 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 y :: Int
y bm :: 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
/= 0
    go Nil = Bool
False

-- | /O(min(n,W))/. Is the element not in the set?
notMember :: Key -> IntSet -> Bool
notMember :: Int -> IntSet -> Bool
notMember k :: 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 t :: IntSet
t = case IntSet
t of
    Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then IntSet -> IntSet -> Maybe Int
go IntSet
r IntSet
l else IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
r
    _ -> IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Int
go def :: IntSet
def (Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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 def :: IntSet
def (Tip kx :: Int
kx bm :: 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
/= 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
- 1) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
bm
    go def :: IntSet
def 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 t :: IntSet
t = case IntSet
t of
    Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
l else IntSet -> IntSet -> Maybe Int
go IntSet
l IntSet
r
    _ -> IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Int
go def :: IntSet
def (Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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 def :: IntSet
def (Tip kx :: Int
kx bm :: 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
/= 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` 1)) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
bm
    go def :: IntSet
def 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 t :: IntSet
t = case IntSet
t of
    Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then IntSet -> IntSet -> Maybe Int
go IntSet
r IntSet
l else IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
r
    _ -> IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Int
go def :: IntSet
def (Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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 def :: IntSet
def (Tip kx :: Int
kx bm :: 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
/= 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` 1) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- 1) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
bm
    go def :: IntSet
def 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 t :: IntSet
t = case IntSet
t of
    Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
l else IntSet -> IntSet -> Maybe Int
go IntSet
l IntSet
r
    _ -> IntSet -> IntSet -> Maybe Int
go IntSet
Nil IntSet
t
  where
    go :: IntSet -> IntSet -> Maybe Int
go def :: IntSet
def (Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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 def :: IntSet
def (Tip kx :: Int
kx bm :: 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
/= 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 def :: IntSet
def 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 Nil = Maybe Int
forall a. Maybe a
Nothing
unsafeFindMin (Tip kx :: Int
kx bm :: 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 _ _ l :: IntSet
l _) = 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 Nil = Maybe Int
forall a. Maybe a
Nothing
unsafeFindMax (Tip kx :: Int
kx bm :: 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 _ _ _ r :: 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 x :: 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 p :: Int
p m :: Int
m l :: IntSet
l r :: 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 kx :: Int
kx bm :: Nat
bm t :: IntSet
t@(Tip kx' :: Int
kx' bm' :: 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 kx :: Int
kx bm :: Nat
bm 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 p :: Int
p m :: Int
m l :: IntSet
l r :: 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 kx :: Int
kx bm :: Nat
bm t :: IntSet
t@(Tip kx' :: Int
kx' bm' :: 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 _ _ Nil = IntSet
Nil


{--------------------------------------------------------------------
  Union
--------------------------------------------------------------------}
-- | The union of a list of sets.
unions :: Foldable f => f IntSet -> IntSet
unions :: f IntSet -> IntSet
unions xs :: 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 p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) t2 :: IntSet
t2@(Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: 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 _ _ _ _) (Tip kx :: Int
kx bm :: Nat
bm) = Int -> Nat -> IntSet -> IntSet
insertBM Int
kx Nat
bm IntSet
t
union t :: IntSet
t@(Bin _ _ _ _) Nil = IntSet
t
union (Tip kx :: Int
kx bm :: Nat
bm) t :: IntSet
t = Int -> Nat -> IntSet -> IntSet
insertBM Int
kx Nat
bm IntSet
t
union Nil t :: 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 p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) t2 :: IntSet
t2@(Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: 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 _ _ _ _) (Tip kx :: Int
kx bm :: Nat
bm) = Int -> Nat -> IntSet -> IntSet
deleteBM Int
kx Nat
bm IntSet
t
difference t :: IntSet
t@(Bin _ _ _ _) Nil = IntSet
t

difference t1 :: IntSet
t1@(Tip kx :: Int
kx bm :: Nat
bm) t2 :: IntSet
t2 = IntSet -> IntSet
differenceTip IntSet
t2
  where differenceTip :: IntSet -> IntSet
differenceTip (Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: 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 kx2 :: Int
kx2 bm2 :: 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 Nil = IntSet
t1

difference Nil _     = IntSet
Nil



{--------------------------------------------------------------------
  Intersection
--------------------------------------------------------------------}
-- | /O(n+m)/. The intersection of two sets.
intersection :: IntSet -> IntSet -> IntSet
intersection :: IntSet -> IntSet -> IntSet
intersection t1 :: IntSet
t1@(Bin p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) t2 :: IntSet
t2@(Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: 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 _ _ _ _) (Tip kx2 :: Int
kx2 bm2 :: Nat
bm2) = IntSet -> IntSet
intersectBM IntSet
t1
  where intersectBM :: IntSet -> IntSet
intersectBM (Bin p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: 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 kx1 :: Int
kx1 bm1 :: 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 Nil = IntSet
Nil

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

intersection (Tip kx1 :: Int
kx1 bm1 :: Nat
bm1) t2 :: IntSet
t2 = IntSet -> IntSet
intersectBM IntSet
t2
  where intersectBM :: IntSet -> IntSet
intersectBM (Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: 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 kx2 :: Int
kx2 bm2 :: 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 Nil = IntSet
Nil

intersection Nil _ = 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 t1 :: IntSet
t1 t2 :: IntSet
t2
  = case IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
t2 of
      LT -> Bool
True
      _  -> Bool
False

subsetCmp :: IntSet -> IntSet -> Ordering
subsetCmp :: IntSet -> IntSet -> Ordering
subsetCmp t1 :: IntSet
t1@(Bin p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) (Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: IntSet
r2)
  | Int -> Int -> Bool
shorter Int
m1 Int
m2  = Ordering
GT
  | Int -> Int -> Bool
shorter Int
m2 Int
m1  = case Ordering
subsetCmpLt of
                       GT -> Ordering
GT
                       _  -> 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
                    (GT,_ ) -> Ordering
GT
                    (_ ,GT) -> Ordering
GT
                    (EQ,EQ) -> Ordering
EQ
                    _       -> Ordering
LT

subsetCmp (Bin _ _ _ _) _  = Ordering
GT
subsetCmp (Tip kx1 :: Int
kx1 bm1 :: Nat
bm1) (Tip kx2 :: Int
kx2 bm2 :: 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
== 0 = Ordering
LT
  | Bool
otherwise                   = Ordering
GT
subsetCmp t1 :: IntSet
t1@(Tip kx :: Int
kx _) (Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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 GT -> Ordering
GT ; _ -> Ordering
LT
  | Bool
otherwise      = case IntSet -> IntSet -> Ordering
subsetCmp IntSet
t1 IntSet
r of GT -> Ordering
GT ; _ -> Ordering
LT
subsetCmp (Tip _ _) Nil = Ordering
GT -- disjoint
subsetCmp Nil Nil = Ordering
EQ
subsetCmp Nil _   = 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 p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) (Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: 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 _ _ _ _) _  = Bool
False
isSubsetOf (Tip kx1 :: Int
kx1 bm1 :: Nat
bm1) (Tip kx2 :: Int
kx2 bm2 :: 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
== 0
isSubsetOf t1 :: IntSet
t1@(Tip kx :: Int
kx _) (Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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 _ _) Nil = Bool
False
isSubsetOf Nil _         = 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 p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) t2 :: IntSet
t2@(Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: 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 _ _ _ _) (Tip kx2 :: Int
kx2 bm2 :: Nat
bm2) = IntSet -> Bool
disjointBM IntSet
t1
  where disjointBM :: IntSet -> Bool
disjointBM (Bin p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: 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 kx1 :: Int
kx1 bm1 :: 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
== 0
                                 | Bool
otherwise = Bool
True
        disjointBM Nil = Bool
True

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

disjoint (Tip kx1 :: Int
kx1 bm1 :: Nat
bm1) t2 :: IntSet
t2 = IntSet -> Bool
disjointBM IntSet
t2
  where disjointBM :: IntSet -> Bool
disjointBM (Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: 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 kx2 :: Int
kx2 bm2 :: 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
== 0
                                 | Bool
otherwise = Bool
True
        disjointBM Nil = Bool
True

disjoint Nil _ = Bool
True


{--------------------------------------------------------------------
  Filter
--------------------------------------------------------------------}
-- | /O(n)/. Filter all elements that satisfy some predicate.
filter :: (Key -> Bool) -> IntSet -> IntSet
filter :: (Int -> Bool) -> IntSet -> IntSet
filter predicate :: Int -> Bool
predicate t :: IntSet
t
  = case IntSet
t of
      Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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 kx :: Int
kx bm :: 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 0 (Int -> Nat -> Int -> Nat
bitPred Int
kx) 0 Nat
bm)
      Nil -> IntSet
Nil
  where bitPred :: Int -> Nat -> Int -> Nat
bitPred kx :: Int
kx bm :: Nat
bm bi :: 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 predicate0 :: Int -> Bool
predicate0 t0 :: 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 predicate :: Int -> Bool
predicate t :: IntSet
t
      = case IntSet
t of
          Bin p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r
            -> let (l1 :: IntSet
l1 :*: l2 :: IntSet
l2) = (Int -> Bool) -> IntSet -> StrictPair IntSet IntSet
go Int -> Bool
predicate IntSet
l
                   (r1 :: IntSet
r1 :*: r2 :: 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 kx :: Int
kx bm :: Nat
bm
            -> let bm1 :: Nat
bm1 = Int -> (Nat -> Int -> Nat) -> Nat -> Nat -> Nat
forall a. Int -> (a -> Int -> a) -> a -> Nat -> a
foldl'Bits 0 (Int -> Nat -> Int -> Nat
bitPred Int
kx) 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)
          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 kx :: Int
kx bm :: Nat
bm bi :: 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 x :: Int
x t :: IntSet
t =
  case IntSet
t of
      Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r
          | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0  -- handle negative numbers.
                     then case Int -> IntSet -> StrictPair IntSet IntSet
go Int
x IntSet
l of (lt :: IntSet
lt :*: gt :: 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 (lt :: IntSet
lt :*: gt :: IntSet
gt) -> let !gt' :: IntSet
gt' = IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
l
                                                        in (IntSet
lt, IntSet
gt')
      _ -> case Int -> IntSet -> StrictPair IntSet IntSet
go Int
x IntSet
t of
          (lt :: IntSet
lt :*: gt :: IntSet
gt) -> (IntSet
lt, IntSet
gt)
  where
    go :: Int -> IntSet -> StrictPair IntSet IntSet
go !Int
x' t' :: IntSet
t'@(Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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
                             (lt :: IntSet
lt :*: gt :: 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
                             (lt :: IntSet
lt :*: gt :: 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 x' :: Int
x' t' :: IntSet
t'@(Tip kx' :: Int
kx' bm :: 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
- 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 _ 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 x :: Int
x t :: IntSet
t =
  case IntSet
t of
      Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
                             then case Int -> IntSet -> (IntSet, Bool, IntSet)
go Int
x IntSet
l of
                                 (lt :: IntSet
lt, fnd :: Bool
fnd, gt :: 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
                                 (lt :: IntSet
lt, fnd :: Bool
fnd, gt :: IntSet
gt) -> let !gt' :: IntSet
gt' = IntSet -> IntSet -> IntSet
union IntSet
gt IntSet
l
                                                  in (IntSet
lt, Bool
fnd, IntSet
gt')
      _ -> Int -> IntSet -> (IntSet, Bool, IntSet)
go Int
x IntSet
t
  where
    go :: Int -> IntSet -> (IntSet, Bool, IntSet)
go x' :: Int
x' t' :: IntSet
t'@(Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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
                             (lt :: IntSet
lt, fnd :: Bool
fnd, gt :: 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
                             (lt :: IntSet
lt, fnd :: Bool
fnd, gt :: 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 x' :: Int
x' t' :: IntSet
t'@(Tip kx' :: Int
kx' bm :: 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
/= 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
- 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 _ 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 t :: IntSet
t =
  case IntSet
t of Nil -> Maybe (Int, IntSet)
forall a. Maybe a
Nothing
            Bin p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> case IntSet -> (Int, IntSet)
go IntSet
l of (result :: Int
result, l' :: 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)
            _ -> (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (IntSet -> (Int, IntSet)
go IntSet
t)
  where
    go :: IntSet -> (Int, IntSet)
go (Bin p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r) = case IntSet -> (Int, IntSet)
go IntSet
r of (result :: Int
result, r' :: IntSet
r') -> (Int
result, Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
l IntSet
r')
    go (Tip kx :: Int
kx bm :: Nat
bm) = case Nat -> Int
highestBitSet Nat
bm of bi :: 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 Nil = [Char] -> (Int, IntSet)
forall a. HasCallStack => [Char] -> a
error "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 t :: IntSet
t =
  case IntSet
t of Nil -> Maybe (Int, IntSet)
forall a. Maybe a
Nothing
            Bin p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> case IntSet -> (Int, IntSet)
go IntSet
r of (result :: Int
result, r' :: 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')
            _ -> (Int, IntSet) -> Maybe (Int, IntSet)
forall a. a -> Maybe a
Just (IntSet -> (Int, IntSet)
go IntSet
t)
  where
    go :: IntSet -> (Int, IntSet)
go (Bin p :: Int
p m :: Int
m l :: IntSet
l r :: IntSet
r) = case IntSet -> (Int, IntSet)
go IntSet
l of (result :: Int
result, l' :: IntSet
l') -> (Int
result, Int -> Int -> IntSet -> IntSet -> IntSet
bin Int
p Int
m IntSet
l' IntSet
r)
    go (Tip kx :: Int
kx bm :: Nat
bm) = case Nat -> Int
lowestBitSet Nat
bm of bi :: 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 Nil = [Char] -> (Int, IntSet)
forall a. HasCallStack => [Char] -> a
error "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 "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 "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 Nil = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error "findMin: empty set has no minimal element"
findMin (Tip kx :: Int
kx bm :: Nat
bm) = Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Nat -> Int
lowestBitSet Nat
bm
findMin (Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r)
  |   Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0   = IntSet -> Int
find IntSet
r
  | Bool
otherwise = IntSet -> Int
find IntSet
l
    where find :: IntSet -> Int
find (Tip kx :: Int
kx bm :: Nat
bm) = Int
kx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Nat -> Int
lowestBitSet Nat
bm
          find (Bin _ _ l' :: IntSet
l' _) = IntSet -> Int
find IntSet
l'
          find Nil            = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error "findMin Nil"

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

{--------------------------------------------------------------------
  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 f :: Int -> b -> b
f z :: b
z = \t :: IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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
            _ -> b -> IntSet -> b
go b
z IntSet
t
  where
    go :: b -> IntSet -> b
go z' :: b
z' Nil           = b
z'
    go z' :: b
z' (Tip kx :: Int
kx bm :: 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 z' :: b
z' (Bin _ _ l :: IntSet
l r :: 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' f :: Int -> b -> b
f z :: b
z = \t :: IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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
            _ -> b -> IntSet -> b
go b
z IntSet
t
  where
    go :: b -> IntSet -> b
go !b
z' Nil           = b
z'
    go z' :: b
z' (Tip kx :: Int
kx bm :: 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 z' :: b
z' (Bin _ _ l :: IntSet
l r :: 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 f :: a -> Int -> a
f z :: a
z = \t :: IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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
            _ -> a -> IntSet -> a
go a
z IntSet
t
  where
    go :: a -> IntSet -> a
go z' :: a
z' Nil           = a
z'
    go z' :: a
z' (Tip kx :: Int
kx bm :: 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 z' :: a
z' (Bin _ _ l :: IntSet
l r :: 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' f :: a -> Int -> a
f z :: a
z = \t :: IntSet
t ->      -- Use lambda t to be inlinable with two arguments only.
  case IntSet
t of Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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
            _ -> a -> IntSet -> a
go a
z IntSet
t
  where
    go :: a -> IntSet -> a
go !a
z' Nil           = a
z'
    go z' :: a
z' (Tip kx :: Int
kx bm :: 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 z' :: a
z' (Bin _ _ l :: IntSet
l r :: 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
--------------------------------------------------------------------}
#if __GLASGOW_HASKELL__ >= 708
-- | @since 0.5.6.2
instance GHCExts.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 = build (\c n -> foldrFB c n s) #-}
{-# RULES "IntSet.toAscListBack" [1] foldrFB (:) [] = toAscList #-}
{-# RULES "IntSet.toDescList" [~1] forall s . toDescList s = 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 xs :: [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 t :: IntSet
t x :: 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 [] = IntSet
Nil
fromAscList (x0 :: Int
x0 : xs0 :: [Int]
xs0) = [Int] -> IntSet
fromDistinctAscList (Int -> [Int] -> [Int]
forall a. Eq a => a -> [a] -> [a]
combineEq Int
x0 [Int]
xs0)
  where
    combineEq :: a -> [a] -> [a]
combineEq x' :: a
x' [] = [a
x']
    combineEq x' :: a
x' (x :: a
x:xs :: [a]
xs)
      | a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x'     = a -> [a] -> [a]
combineEq a
x' [a]
xs
      | Bool
otherwise = a
x' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
combineEq a
x [a]
xs

-- | /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 []         = IntSet
Nil
fromDistinctAscList (z0 :: Int
z0 : zs0 :: [Int]
zs0) = Int -> Nat -> [Int] -> Stack -> IntSet
work (Int -> Int
prefixOf Int
z0) (Int -> Nat
bitmapOf Int
z0) [Int]
zs0 Stack
Nada
  where
    -- 'work' accumulates all values that go into one tip, before passing this Tip
    -- to 'reduce'
    work :: Int -> Nat -> [Int] -> Stack -> IntSet
work kx :: Int
kx bm :: Nat
bm []     stk :: Stack
stk = Int -> IntSet -> Stack -> IntSet
finish Int
kx (Int -> Nat -> IntSet
Tip Int
kx Nat
bm) Stack
stk
    work kx :: Int
kx bm :: Nat
bm (z :: Int
z:zs :: [Int]
zs) stk :: Stack
stk | Int
kx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
prefixOf Int
z = Int -> Nat -> [Int] -> Stack -> IntSet
work Int
kx (Nat
bm Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Int -> Nat
bitmapOf Int
z) [Int]
zs Stack
stk
    work kx :: Int
kx bm :: Nat
bm (z :: Int
z:zs :: [Int]
zs) stk :: Stack
stk = Int -> [Int] -> Int -> Int -> IntSet -> Stack -> IntSet
reduce Int
z [Int]
zs (Int -> Int -> Int
branchMask Int
z Int
kx) Int
kx (Int -> Nat -> IntSet
Tip Int
kx Nat
bm) Stack
stk

    reduce :: Int -> [Int] -> Int -> Int -> IntSet -> Stack -> IntSet
reduce z :: Int
z zs :: [Int]
zs _ px :: Int
px tx :: IntSet
tx Nada = Int -> Nat -> [Int] -> Stack -> IntSet
work (Int -> Int
prefixOf Int
z) (Int -> Nat
bitmapOf Int
z) [Int]
zs (Int -> IntSet -> Stack -> Stack
Push Int
px IntSet
tx Stack
Nada)
    reduce z :: Int
z zs :: [Int]
zs m :: Int
m px :: Int
px tx :: IntSet
tx stk :: Stack
stk@(Push py :: Int
py ty :: IntSet
ty stk' :: Stack
stk') =
        let mxy :: Int
mxy = Int -> Int -> Int
branchMask Int
px Int
py
            pxy :: Int
pxy = Int -> Int -> Int
mask Int
px Int
mxy
        in  if Int -> Int -> Bool
shorter Int
m Int
mxy
                 then Int -> [Int] -> Int -> Int -> IntSet -> Stack -> IntSet
reduce Int
z [Int]
zs Int
m Int
pxy (Int -> Int -> IntSet -> IntSet -> IntSet
Bin Int
pxy Int
mxy IntSet
ty IntSet
tx) Stack
stk'
                 else Int -> Nat -> [Int] -> Stack -> IntSet
work (Int -> Int
prefixOf Int
z) (Int -> Nat
bitmapOf Int
z) [Int]
zs (Int -> IntSet -> Stack -> Stack
Push Int
px IntSet
tx Stack
stk)

    finish :: Int -> IntSet -> Stack -> IntSet
finish _  t :: IntSet
t  Nada = IntSet
t
    finish px :: Int
px tx :: IntSet
tx (Push py :: Int
py ty :: IntSet
ty stk :: Stack
stk) = Int -> IntSet -> Stack -> IntSet
finish Int
p (Int -> IntSet -> Int -> IntSet -> IntSet
link Int
py IntSet
ty Int
px IntSet
tx) Stack
stk
        where m :: Int
m = Int -> Int -> Int
branchMask Int
px Int
py
              p :: Int
p = Int -> Int -> Int
mask Int
px Int
m

data Stack = Push {-# UNPACK #-} !Prefix !IntSet !Stack | Nada


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

equal :: IntSet -> IntSet -> Bool
equal :: IntSet -> IntSet -> Bool
equal (Bin p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) (Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: 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 kx1 :: Int
kx1 bm1 :: Nat
bm1) (Tip kx2 :: Int
kx2 bm2 :: 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 Nil Nil = Bool
True
equal _   _   = Bool
False

nequal :: IntSet -> IntSet -> Bool
nequal :: IntSet -> IntSet -> Bool
nequal (Bin p1 :: Int
p1 m1 :: Int
m1 l1 :: IntSet
l1 r1 :: IntSet
r1) (Bin p2 :: Int
p2 m2 :: Int
m2 l2 :: IntSet
l2 r2 :: 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 kx1 :: Int
kx1 bm1 :: Nat
bm1) (Tip kx2 :: Int
kx2 bm2 :: 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 Nil Nil = Bool
False
nequal _   _   = Bool
True

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

instance Ord IntSet where
    compare :: IntSet -> IntSet -> Ordering
compare s1 :: IntSet
s1 s2 :: 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 p :: Int
p xs :: IntSet
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    [Char] -> ShowS
showString "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 10 (ReadPrec IntSet -> ReadPrec IntSet)
-> ReadPrec IntSet -> ReadPrec IntSet
forall a b. (a -> b) -> a -> b
$ do
    Ident "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

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

INSTANCE_TYPEABLE0(IntSet)

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

-- The IntSet constructors consist only of strict fields of Ints and
-- IntSets, thus the default NFData instance which evaluates to whnf
-- should suffice
instance NFData IntSet where rnf :: IntSet -> ()
rnf x :: IntSet
x = IntSet -> () -> ()
forall a b. a -> b -> b
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 s :: 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 hang :: Bool
hang wide :: Bool
wide t :: IntSet
t
  | Bool
hang      = (Bool -> [[Char]] -> IntSet -> ShowS
showsTreeHang Bool
wide [] IntSet
t) ""
  | Bool
otherwise = (Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree Bool
wide [] [] IntSet
t) ""

showsTree :: Bool -> [String] -> [String] -> IntSet -> ShowS
showsTree :: Bool -> [[Char]] -> [[Char]] -> IntSet -> ShowS
showsTree wide :: Bool
wide lbars :: [[Char]]
lbars rbars :: [[Char]]
rbars t :: IntSet
t
  = case IntSet
t of
      Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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 "\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 kx :: Int
kx bm :: Nat
bm
          -> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString " " 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 " + " 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 "\n"
      Nil -> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString "|\n"

showsTreeHang :: Bool -> [String] -> IntSet -> ShowS
showsTreeHang :: Bool -> [[Char]] -> IntSet -> ShowS
showsTreeHang wide :: Bool
wide bars :: [[Char]]
bars t :: IntSet
t
  = case IntSet
t of
      Bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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 "\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 kx :: Int
kx bm :: Nat
bm
          -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString " " 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 " + " 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 "\n"
      Nil -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString "|\n"

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

showWide :: Bool -> [String] -> String -> String
showWide :: Bool -> [[Char]] -> ShowS
showWide wide :: Bool
wide bars :: [[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 "|\n"
  | Bool
otherwise = ShowS
forall a. a -> a
id

showsBars :: [String] -> ShowS
showsBars :: [[Char]] -> ShowS
showsBars [] = ShowS
forall a. a -> a
id
showsBars bars :: [[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 w :: 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 0 (:) [] Nat
w

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

withBar, withEmpty :: [String] -> [String]
withBar :: [[Char]] -> [[Char]]
withBar bars :: [[Char]]
bars   = "|  "[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
bars
withEmpty :: [[Char]] -> [[Char]]
withEmpty bars :: [[Char]]
bars = "   "[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 p1 :: Int
p1 t1 :: IntSet
t1 p2 :: Int
p2 t2 :: 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
    m :: Int
m = Int -> Int -> Int
branchMask Int
p1 Int
p2
    p :: Int
p = Int -> Int -> Int
mask Int
p1 Int
m
{-# INLINE link #-}

{--------------------------------------------------------------------
  @bin@ assures that we never have empty trees within a tree.
--------------------------------------------------------------------}
bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet
bin :: Int -> Int -> IntSet -> IntSet -> IntSet
bin _ _ l :: IntSet
l Nil = IntSet
l
bin _ _ Nil r :: IntSet
r = IntSet
r
bin p :: Int
p m :: Int
m l :: IntSet
l r :: 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 _ 0 = IntSet
Nil
tip kx :: Int
kx bm :: 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
#if MIN_VERSION_base(4,7,0)
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
- 1
#else
suffixBitMask = bitSize (undefined::Word) - 1
#endif
{-# 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 x :: 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 x :: 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 s :: Int
s = 1 Nat -> Int -> Nat
`shiftLL` Int
s
{-# INLINE bitmapOfSuffix #-}

bitmapOf :: Int -> BitMap
bitmapOf :: Int -> Nat
bitmapOf x :: 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 i :: Int
i m :: 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
== 0
{-# INLINE zero #-}

nomatch,match :: Int -> Prefix -> Mask -> Bool
nomatch :: Int -> Int -> Int -> Bool
nomatch i :: Int
i p :: Int
p m :: 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 i :: Int
i p :: Int
p m :: 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 i :: Int
i m :: 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 i :: Nat
i m :: 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
-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 m1 :: Int
m1 m2 :: 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 p1 :: Int
p1 p2 :: 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)
{----------------------------------------------------------------------
  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 :: Nat -> Int
{-# INLINE indexOfTheOnlyBit #-}
indexOfTheOnlyBit :: Nat -> Int
indexOfTheOnlyBit bitmask :: Nat
bitmask =
  Int# -> Int
I# (Addr#
lsbArray Addr# -> Int# -> Int#
`indexInt8OffAddr#` Int -> Int#
unboxInt (Nat -> Int
intFromNat ((Nat
bitmask Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
* Nat
magic) Nat -> Int -> Nat
`shiftRL` Int
offset)))
  where unboxInt :: Int -> Int#
unboxInt (I# i :: Int#
i) = Int#
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 :: Nat
magic = 0x07EDD5E59A4E28C2
        offset :: Int
offset = 58
        !lsbArray :: Addr#
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.

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

lowestBitSet :: Nat -> Int
lowestBitSet x :: Nat
x = Nat -> Int
indexOfTheOnlyBit (Nat -> Nat
lowestBitMask Nat
x)

highestBitSet :: Nat -> Int
highestBitSet x :: Nat
x = Nat -> Int
indexOfTheOnlyBit (Nat -> Nat
highestBitMask Nat
x)

foldlBits :: Int -> (a -> Int -> a) -> a -> Nat -> a
foldlBits prefix :: Int
prefix f :: a -> Int -> a
f z :: a
z bitmap :: Nat
bitmap = Nat -> a -> a
go Nat
bitmap a
z
  where go :: Nat -> a -> a
go 0 acc :: a
acc = a
acc
        go bm :: Nat
bm acc :: 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 prefix :: Int
prefix f :: a -> Int -> a
f z :: a
z bitmap :: Nat
bitmap = Nat -> a -> a
go Nat
bitmap a
z
  where go :: Nat -> a -> a
go 0 acc :: a
acc = a
acc
        go bm :: 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 prefix :: Int
prefix f :: Int -> a -> a
f z :: a
z bitmap :: Nat
bitmap = Nat -> a -> a
go (Nat -> Nat
revNat Nat
bitmap) a
z
  where go :: Nat -> a -> a
go 0 acc :: a
acc = a
acc
        go bm :: Nat
bm acc :: 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 prefix :: Int
prefix f :: Int -> a -> a
f z :: a
z bitmap :: Nat
bitmap = Nat -> a -> a
go (Nat -> Nat
revNat Nat
bitmap) a
z
  where go :: Nat -> a -> a
go 0 acc :: a
acc = a
acc
        go bm :: 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 Nil = []
-- NOTE: we don't currently split below Tip, but we could.
splitRoot x :: IntSet
x@(Tip _ _) = [IntSet
x]
splitRoot (Bin _ m :: Int
m l :: IntSet
l r :: IntSet
r) | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = [IntSet
r, IntSet
l]
                        | Bool
otherwise = [IntSet
l, IntSet
r]
{-# INLINE splitRoot #-}