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

{-# OPTIONS_HADDOCK not-home #-}

#include "containers.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Set.Internal
-- Copyright   :  (c) Daan Leijen 2002
-- License     :  BSD-style
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.
--
--
-- = Finite Sets (internals)
--
-- The @'Set' e@ type represents a set of elements of type @e@. Most operations
-- require that @e@ be an instance of the 'Ord' class. A 'Set' is strict in its
-- elements.
--
--
-- == Implementation
--
-- The implementation of 'Set' is based on /size balanced/ binary trees (or
-- trees of /bounded balance/) as described by:
--
--    * Stephen Adams, \"/Efficient sets—a balancing act/\",
--      Journal of Functional Programming 3(4):553-562, October 1993,
--      <https://doi.org/10.1017/S0956796800000885>,
--      <https://groups.csail.mit.edu/mac/users/adams/BB/index.html>.
--    * J. Nievergelt and E.M. Reingold,
--      \"/Binary search trees of bounded balance/\",
--      SIAM journal of computing 2(1), March 1973.
--      <https://doi.org/10.1137/0202005>.
--    * Yoichi Hirai and Kazuhiko Yamamoto,
--      \"/Balancing weight-balanced trees/\",
--      Journal of Functional Programming 21(3):287-307, 2011,
--      <https://doi.org/10.1017/S0956796811000104>
--
--  Bounds for 'union', 'intersection', and 'difference' are as given
--  by
--
--    * Guy Blelloch, Daniel Ferizovic, and Yihan Sun,
--      \"/Parallel Ordered Sets Using Join/\",
--      <https://arxiv.org/abs/1602.02120v4>.
--
--
-- @since 0.5.9
-----------------------------------------------------------------------------

-- [Note: Using INLINABLE]
-- ~~~~~~~~~~~~~~~~~~~~~~~
-- It is crucial to the performance that the functions specialize on the Ord
-- type when possible. GHC 7.0 and higher does this by itself when it sees th
-- unfolding of a function -- that is why all public functions are marked
-- INLINABLE (that exposes the unfolding).


-- [Note: Using INLINE]
-- ~~~~~~~~~~~~~~~~~~~~
-- For other compilers and GHC pre 7.0, we mark some of the functions INLINE.
-- We mark the functions that just navigate down the tree (lookup, insert,
-- delete and similar). That navigation code gets inlined and thus specialized
-- when possible. There is a price to pay -- code growth. The code INLINED is
-- therefore only the tree navigation, all the real work (rebalancing) is not
-- INLINED by using a NOINLINE.
--
-- All methods marked INLINE have to be nonrecursive -- a 'go' function doing
-- the real work is provided.


-- [Note: Type of local 'go' function]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- If the local 'go' function uses an Ord class, it sometimes heap-allocates
-- the Ord dictionary when the 'go' function does not have explicit type.
-- In that case we give 'go' explicit type. But this slightly decrease
-- performance, as the resulting 'go' function can float out to top level.


-- [Note: Local 'go' functions and capturing]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- As opposed to IntSet, when 'go' function captures an argument, increased
-- heap-allocation can occur: sometimes in a polymorphic function, the 'go'
-- floats out of its enclosing function and then it heap-allocates the
-- dictionary and the argument. Maybe it floats out too late and strictness
-- analyzer cannot see that these could be passed on stack.

-- [Note: Order of constructors]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The order of constructors of Set matters when considering performance.
-- Currently in GHC 7.0, when type has 2 constructors, a forward conditional
-- jump is made when successfully matching second constructor. Successful match
-- of first constructor results in the forward jump not taken.
-- On GHC 7.0, reordering constructors from Tip | Bin to Bin | Tip
-- improves the benchmark by up to 10% on x86.

module Data.Set.Internal (
            -- * Set type
              Set(..)       -- instance Eq,Ord,Show,Read,Data
            , Size

            -- * Operators
            , (\\)

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

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

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


            -- * Filter
            , filter
            , takeWhileAntitone
            , dropWhileAntitone
            , spanAntitone
            , partition
            , split
            , splitMember
            , splitRoot

            -- * Indexed
            , lookupIndex
            , findIndex
            , elemAt
            , deleteAt
            , take
            , drop
            , splitAt

            -- * Map
            , map
            , mapMonotonic

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

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

            -- * Conversion

            -- ** List
            , elems
            , toList
            , fromList

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

            -- * Debugging
            , showTree
            , showTreeWith
            , valid

            -- Internals (for testing)
            , bin
            , balanced
            , link
            , merge
            ) where

import Utils.Containers.Internal.Prelude hiding
  (filter,foldl,foldl',foldr,null,map,take,drop,splitAt)
import Prelude ()
import Control.Applicative (Const(..))
import qualified Data.List as List
import Data.Semigroup (Semigroup(..), stimesIdempotentMonoid, stimesIdempotent)
import Data.Functor.Classes
import Data.Functor.Identity (Identity)
import qualified Data.Foldable as Foldable
import Control.DeepSeq (NFData(rnf),NFData1(liftRnf))
import Data.List.NonEmpty (NonEmpty(..))

import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.PtrEquality
import Utils.Containers.Internal.EqOrdUtil (EqM(..), OrdM(..))

#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
import Text.Read ( readPrec, Read (..), Lexeme (..), parens, prec
                 , lexP, readListPrecDefault )
#endif
#if __GLASGOW_HASKELL__
import GHC.Exts ( build, lazy )
import qualified GHC.Exts as GHCExts
import Data.Data
import Language.Haskell.TH.Syntax (Lift)
-- See Note [ Template Haskell Dependencies ]
import Language.Haskell.TH ()
import Data.Coerce (coerce)
#endif


{--------------------------------------------------------------------
  Operators
--------------------------------------------------------------------}
infixl 9 \\ --

-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). See 'difference'.
(\\) :: Ord a => Set a -> Set a -> Set a
Set a
m1 \\ :: forall a. Ord a => Set a -> Set a -> Set a
\\ Set a
m2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
difference Set a
m1 Set a
m2
#if __GLASGOW_HASKELL__
{-# INLINABLE (\\) #-}
#endif

{--------------------------------------------------------------------
  Sets are size balanced trees
--------------------------------------------------------------------}
-- | A set of values @a@.

-- See Note: Order of constructors
data Set a    = Bin {-# UNPACK #-} !Size !a !(Set a) !(Set a)
              | Tip

type Size     = Int

#ifdef __GLASGOW_HASKELL__
type role Set nominal

-- | @since 0.6.6
deriving instance Lift a => Lift (Set a)
#endif

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

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

-- | Folds in order of increasing key.
instance Foldable.Foldable Set where
    fold :: forall m. Monoid m => Set m -> m
fold = Set m -> m
forall m. Monoid m => Set m -> m
go
      where go :: Set t -> t
go Set t
Tip = t
forall a. Monoid a => a
mempty
            go (Bin Int
1 t
k Set t
_ Set t
_) = t
k
            go (Bin Int
_ t
k Set t
l Set t
r) = Set t -> t
go Set t
l t -> t -> t
forall a. Monoid a => a -> a -> a
`mappend` (t
k t -> t -> t
forall a. Monoid a => a -> a -> a
`mappend` Set t -> t
go Set t
r)
    {-# INLINABLE fold #-}
    foldr :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldr = (a -> b -> b) -> b -> Set a -> b
forall a b. (a -> b -> b) -> b -> Set a -> b
foldr
    {-# INLINE foldr #-}
    foldl :: forall b a. (b -> a -> b) -> b -> Set a -> b
foldl = (b -> a -> b) -> b -> Set a -> b
forall b a. (b -> a -> b) -> b -> Set a -> b
foldl
    {-# INLINE foldl #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> Set a -> m
foldMap a -> m
f Set a
t = Set a -> m
go Set a
t
      where go :: Set a -> m
go Set a
Tip = m
forall a. Monoid a => a
mempty
            go (Bin Int
1 a
k Set a
_ Set a
_) = a -> m
f a
k
            go (Bin Int
_ a
k Set a
l Set a
r) = Set a -> m
go Set a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m
f a
k m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Set a -> m
go Set a
r)
    {-# INLINE foldMap #-}
    foldl' :: forall b a. (b -> a -> b) -> b -> Set a -> b
foldl' = (b -> a -> b) -> b -> Set a -> b
forall b a. (b -> a -> b) -> b -> Set a -> b
foldl'
    {-# INLINE foldl' #-}
    foldr' :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldr' = (a -> b -> b) -> b -> Set a -> b
forall a b. (a -> b -> b) -> b -> Set a -> b
foldr'
    {-# INLINE foldr' #-}
    length :: forall a. Set a -> Int
length = Set a -> Int
forall a. Set a -> Int
size
    {-# INLINE length #-}
    null :: forall a. Set a -> Bool
null   = Set a -> Bool
forall a. Set a -> Bool
null
    {-# INLINE null #-}
    toList :: forall a. Set a -> [a]
toList = Set a -> [a]
forall a. Set a -> [a]
toList
    {-# INLINE toList #-}
    elem :: forall a. Eq a => a -> Set a -> Bool
elem = a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
go
      where go :: t -> Set t -> Bool
go !t
_ Set t
Tip = Bool
False
            go t
x (Bin Int
_ t
y Set t
l Set t
r) = t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
y Bool -> Bool -> Bool
|| t -> Set t -> Bool
go t
x Set t
l Bool -> Bool -> Bool
|| t -> Set t -> Bool
go t
x Set t
r
    {-# INLINABLE elem #-}
    minimum :: forall a. Ord a => Set a -> a
minimum = Set a -> a
forall a. Set a -> a
findMin
    {-# INLINE minimum #-}
    maximum :: forall a. Ord a => Set a -> a
maximum = Set a -> a
forall a. Set a -> a
findMax
    {-# INLINE maximum #-}
    sum :: forall a. Num a => Set a -> a
sum = (a -> a -> a) -> a -> Set a -> a
forall b a. (b -> a -> b) -> b -> Set a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0
    {-# INLINABLE sum #-}
    product :: forall a. Num a => Set a -> a
product = (a -> a -> a) -> a -> Set a -> a
forall b a. (b -> a -> b) -> b -> Set a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1
    {-# INLINABLE product #-}

#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 a, Ord a) => Data (Set a) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Set a -> c (Set a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Set a
set = ([a] -> Set a) -> c ([a] -> Set a)
forall g. g -> c g
z [a] -> Set a
forall a. Ord a => [a] -> Set a
fromList c ([a] -> Set a) -> [a] -> c (Set a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` (Set a -> [a]
forall a. Set a -> [a]
toList Set a
set)
  toConstr :: Set a -> Constr
toConstr Set a
_     = Constr
fromListConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Set a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> c ([a] -> Set a) -> c (Set a)
forall b r. Data b => c (b -> r) -> c r
k (([a] -> Set a) -> c ([a] -> Set a)
forall r. r -> c r
z [a] -> Set a
forall a. Ord a => [a] -> Set a
fromList)
    Int
_ -> [Char] -> c (Set a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
  dataTypeOf :: Set a -> DataType
dataTypeOf Set a
_   = DataType
setDataType
  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Set a))
dataCast1 forall d. Data d => c (t d)
f    = c (t a) -> Maybe (c (Set a))
forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
f

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

setDataType :: DataType
setDataType :: DataType
setDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.Set.Internal.Set" [Constr
fromListConstr]

#endif

{--------------------------------------------------------------------
  Query
--------------------------------------------------------------------}
-- | \(O(1)\). Is this the empty set?
null :: Set a -> Bool
null :: forall a. Set a -> Bool
null Set a
Tip      = Bool
True
null (Bin {}) = Bool
False
{-# INLINE null #-}

-- | \(O(1)\). The number of elements in the set.
size :: Set a -> Int
size :: forall a. Set a -> Int
size Set a
Tip = Int
0
size (Bin Int
sz a
_ Set a
_ Set a
_) = Int
sz
{-# INLINE size #-}

-- | \(O(\log n)\). Is the element in the set?
member :: Ord a => a -> Set a -> Bool
member :: forall a. Ord a => a -> Set a -> Bool
member = a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
go
  where
    go :: t -> Set t -> Bool
go !t
_ Set t
Tip = Bool
False
    go t
x (Bin Int
_ t
y Set t
l Set t
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
x t
y of
      Ordering
LT -> t -> Set t -> Bool
go t
x Set t
l
      Ordering
GT -> t -> Set t -> Bool
go t
x Set t
r
      Ordering
EQ -> Bool
True
#if __GLASGOW_HASKELL__
{-# INLINABLE member #-}
#else
{-# INLINE member #-}
#endif

-- | \(O(\log n)\). Is the element not in the set?
notMember :: Ord a => a -> Set a -> Bool
notMember :: forall a. Ord a => a -> Set a -> Bool
notMember a
a Set a
t = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
member a
a Set a
t
#if __GLASGOW_HASKELL__
{-# INLINABLE notMember #-}
#else
{-# INLINE notMember #-}
#endif

-- | \(O(\log n)\). Find largest element smaller than the given one.
--
-- > lookupLT 3 (fromList [3, 5]) == Nothing
-- > lookupLT 5 (fromList [3, 5]) == Just 3
lookupLT :: Ord a => a -> Set a -> Maybe a
lookupLT :: forall a. Ord a => a -> Set a -> Maybe a
lookupLT = a -> Set a -> Maybe a
forall a. Ord a => a -> Set a -> Maybe a
goNothing
  where
    goNothing :: a -> Set a -> Maybe a
goNothing !a
_ Set a
Tip = Maybe a
forall a. Maybe a
Nothing
    goNothing a
x (Bin Int
_ a
y Set a
l Set a
r) | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y = a -> Set a -> Maybe a
goNothing a
x Set a
l
                              | Bool
otherwise = a -> a -> Set a -> Maybe a
forall {t}. Ord t => t -> t -> Set t -> Maybe t
goJust a
x a
y Set a
r

    goJust :: t -> t -> Set t -> Maybe t
goJust !t
_ t
best Set t
Tip = t -> Maybe t
forall a. a -> Maybe a
Just t
best
    goJust t
x t
best (Bin Int
_ t
y Set t
l Set t
r) | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
y = t -> t -> Set t -> Maybe t
goJust t
x t
best Set t
l
                                | Bool
otherwise = t -> t -> Set t -> Maybe t
goJust t
x t
y Set t
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupLT #-}
#else
{-# INLINE lookupLT #-}
#endif

-- | \(O(\log n)\). Find smallest element greater than the given one.
--
-- > lookupGT 4 (fromList [3, 5]) == Just 5
-- > lookupGT 5 (fromList [3, 5]) == Nothing
lookupGT :: Ord a => a -> Set a -> Maybe a
lookupGT :: forall a. Ord a => a -> Set a -> Maybe a
lookupGT = a -> Set a -> Maybe a
forall a. Ord a => a -> Set a -> Maybe a
goNothing
  where
    goNothing :: t -> Set t -> Maybe t
goNothing !t
_ Set t
Tip = Maybe t
forall a. Maybe a
Nothing
    goNothing t
x (Bin Int
_ t
y Set t
l Set t
r) | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
y = t -> t -> Set t -> Maybe t
forall {t}. Ord t => t -> t -> Set t -> Maybe t
goJust t
x t
y Set t
l
                              | Bool
otherwise = t -> Set t -> Maybe t
goNothing t
x Set t
r

    goJust :: t -> t -> Set t -> Maybe t
goJust !t
_ t
best Set t
Tip = t -> Maybe t
forall a. a -> Maybe a
Just t
best
    goJust t
x t
best (Bin Int
_ t
y Set t
l Set t
r) | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
y = t -> t -> Set t -> Maybe t
goJust t
x t
y Set t
l
                                | Bool
otherwise = t -> t -> Set t -> Maybe t
goJust t
x t
best Set t
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupGT #-}
#else
{-# INLINE lookupGT #-}
#endif

-- | \(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
lookupLE :: Ord a => a -> Set a -> Maybe a
lookupLE :: forall a. Ord a => a -> Set a -> Maybe a
lookupLE = a -> Set a -> Maybe a
forall a. Ord a => a -> Set a -> Maybe a
goNothing
  where
    goNothing :: a -> Set a -> Maybe a
goNothing !a
_ Set a
Tip = Maybe a
forall a. Maybe a
Nothing
    goNothing a
x (Bin Int
_ a
y Set a
l Set a
r) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of Ordering
LT -> a -> Set a -> Maybe a
goNothing a
x Set a
l
                                                    Ordering
EQ -> a -> Maybe a
forall a. a -> Maybe a
Just a
y
                                                    Ordering
GT -> a -> a -> Set a -> Maybe a
forall {t}. Ord t => t -> t -> Set t -> Maybe t
goJust a
x a
y Set a
r

    goJust :: t -> t -> Set t -> Maybe t
goJust !t
_ t
best Set t
Tip = t -> Maybe t
forall a. a -> Maybe a
Just t
best
    goJust t
x t
best (Bin Int
_ t
y Set t
l Set t
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
x t
y of Ordering
LT -> t -> t -> Set t -> Maybe t
goJust t
x t
best Set t
l
                                                      Ordering
EQ -> t -> Maybe t
forall a. a -> Maybe a
Just t
y
                                                      Ordering
GT -> t -> t -> Set t -> Maybe t
goJust t
x t
y Set t
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupLE #-}
#else
{-# INLINE lookupLE #-}
#endif

-- | \(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
lookupGE :: Ord a => a -> Set a -> Maybe a
lookupGE :: forall a. Ord a => a -> Set a -> Maybe a
lookupGE = a -> Set a -> Maybe a
forall a. Ord a => a -> Set a -> Maybe a
goNothing
  where
    goNothing :: t -> Set t -> Maybe t
goNothing !t
_ Set t
Tip = Maybe t
forall a. Maybe a
Nothing
    goNothing t
x (Bin Int
_ t
y Set t
l Set t
r) = case t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
x t
y of Ordering
LT -> t -> t -> Set t -> Maybe t
forall {t}. Ord t => t -> t -> Set t -> Maybe t
goJust t
x t
y Set t
l
                                                    Ordering
EQ -> t -> Maybe t
forall a. a -> Maybe a
Just t
y
                                                    Ordering
GT -> t -> Set t -> Maybe t
goNothing t
x Set t
r

    goJust :: a -> a -> Set a -> Maybe a
goJust !a
_ a
best Set a
Tip = a -> Maybe a
forall a. a -> Maybe a
Just a
best
    goJust a
x a
best (Bin Int
_ a
y Set a
l Set a
r) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of Ordering
LT -> a -> a -> Set a -> Maybe a
goJust a
x a
y Set a
l
                                                      Ordering
EQ -> a -> Maybe a
forall a. a -> Maybe a
Just a
y
                                                      Ordering
GT -> a -> a -> Set a -> Maybe a
goJust a
x a
best Set a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupGE #-}
#else
{-# INLINE lookupGE #-}
#endif

{--------------------------------------------------------------------
  Construction
--------------------------------------------------------------------}
-- | \(O(1)\). The empty set.
empty  :: Set a
empty :: forall a. Set a
empty = Set a
forall a. Set a
Tip
{-# INLINE empty #-}

-- | \(O(1)\). Create a singleton set.
singleton :: a -> Set a
singleton :: forall a. a -> Set a
singleton a
x = Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
{-# INLINE singleton #-}

{--------------------------------------------------------------------
  Insertion, Deletion
--------------------------------------------------------------------}
-- | \(O(\log n)\). Insert an element in a set.
-- If the set already contains an element equal to the given value,
-- it is replaced with the new value.

-- See Note: Type of local 'go' function
-- See Note: Avoiding worker/wrapper (in Data.Map.Internal)
insert :: Ord a => a -> Set a -> Set a
insert :: forall a. Ord a => a -> Set a -> Set a
insert a
x0 = a -> a -> Set a -> Set a
forall a. Ord a => a -> a -> Set a -> Set a
go a
x0 a
x0
  where
    go :: Ord a => a -> a -> Set a -> Set a
    go :: forall a. Ord a => a -> a -> Set a -> Set a
go a
orig !a
_ Set a
Tip = a -> Set a
forall a. a -> Set a
singleton (a -> a
forall a. a -> a
lazy a
orig)
    go a
orig !a
x t :: Set a
t@(Bin Int
sz a
y Set a
l Set a
r) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
        Ordering
LT | Set a
l' Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
l -> Set a
t
           | Bool
otherwise -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
l' Set a
r
           where !l' :: Set a
l' = a -> a -> Set a -> Set a
forall a. Ord a => a -> a -> Set a -> Set a
go a
orig a
x Set a
l
        Ordering
GT | Set a
r' Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
r -> Set a
t
           | Bool
otherwise -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l Set a
r'
           where !r' :: Set a
r' = a -> a -> Set a -> Set a
forall a. Ord a => a -> a -> Set a -> Set a
go a
orig a
x Set a
r
        Ordering
EQ | a -> a
forall a. a -> a
lazy a
orig a -> Bool -> Bool
forall a b. a -> b -> b
`seq` (a
orig a -> a -> Bool
forall a. a -> a -> Bool
`ptrEq` a
y) -> Set a
t
           | Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
sz (a -> a
forall a. a -> a
lazy a
orig) Set a
l Set a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE insert #-}
#else
{-# INLINE insert #-}
#endif

#ifndef __GLASGOW_HASKELL__
lazy :: a -> a
lazy a = a
#endif

-- Insert an element to the set only if it is not in the set.
-- Used by `union`.

-- See Note: Type of local 'go' function
-- See Note: Avoiding worker/wrapper (in Data.Map.Internal)
insertR :: Ord a => a -> Set a -> Set a
insertR :: forall a. Ord a => a -> Set a -> Set a
insertR a
x0 = a -> a -> Set a -> Set a
forall a. Ord a => a -> a -> Set a -> Set a
go a
x0 a
x0
  where
    go :: Ord a => a -> a -> Set a -> Set a
    go :: forall a. Ord a => a -> a -> Set a -> Set a
go a
orig !a
_ Set a
Tip = a -> Set a
forall a. a -> Set a
singleton (a -> a
forall a. a -> a
lazy a
orig)
    go a
orig !a
x t :: Set a
t@(Bin Int
_ a
y Set a
l Set a
r) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
        Ordering
LT | Set a
l' Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
l -> Set a
t
           | Bool
otherwise -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
l' Set a
r
           where !l' :: Set a
l' = a -> a -> Set a -> Set a
forall a. Ord a => a -> a -> Set a -> Set a
go a
orig a
x Set a
l
        Ordering
GT | Set a
r' Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
r -> Set a
t
           | Bool
otherwise -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l Set a
r'
           where !r' :: Set a
r' = a -> a -> Set a -> Set a
forall a. Ord a => a -> a -> Set a -> Set a
go a
orig a
x Set a
r
        Ordering
EQ -> Set a
t
#if __GLASGOW_HASKELL__
{-# INLINABLE insertR #-}
#else
{-# INLINE insertR #-}
#endif

-- | \(O(\log n)\). Delete an element from a set.

-- See Note: Type of local 'go' function
delete :: Ord a => a -> Set a -> Set a
delete :: forall a. Ord a => a -> Set a -> Set a
delete = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
go
  where
    go :: Ord a => a -> Set a -> Set a
    go :: forall a. Ord a => a -> Set a -> Set a
go !a
_ Set a
Tip = Set a
forall a. Set a
Tip
    go a
x t :: Set a
t@(Bin Int
_ a
y Set a
l Set a
r) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
        Ordering
LT | Set a
l' Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
l -> Set a
t
           | Bool
otherwise -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l' Set a
r
           where !l' :: Set a
l' = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
go a
x Set a
l
        Ordering
GT | Set a
r' Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
r -> Set a
t
           | Bool
otherwise -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
l Set a
r'
           where !r' :: Set a
r' = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
go a
x Set a
r
        Ordering
EQ -> Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE delete #-}
#else
{-# INLINE delete #-}
#endif

-- | \(O(\log n)\) @('alterF' f x s)@ can delete or insert @x@ in @s@ depending on
-- whether an equal element is found in @s@.
--
-- In short:
--
-- @
-- 'member' x \<$\> 'alterF' f x s = f ('member' x s)
-- @
--
-- Note that unlike 'insert', 'alterF' will /not/ replace an element equal to
-- the given value.
--
-- Note: 'alterF' is a variant of the @at@ combinator from "Control.Lens.At".
--
-- @since 0.6.3.1
alterF :: (Ord a, Functor f) => (Bool -> f Bool) -> a -> Set a -> f (Set a)
alterF :: forall a (f :: * -> *).
(Ord a, Functor f) =>
(Bool -> f Bool) -> a -> Set a -> f (Set a)
alterF Bool -> f Bool
f a
k Set a
s = (Bool -> Set a) -> f Bool -> f (Set a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Set a
choose (Bool -> f Bool
f Bool
member_)
  where
    (Bool
member_, Set a
inserted, Set a
deleted) = case a -> Set a -> AlteredSet a
forall a. Ord a => a -> Set a -> AlteredSet a
alteredSet a
k Set a
s of
        Deleted Set a
d           -> (Bool
True , Set a
s, Set a
d)
        Inserted Set a
i          -> (Bool
False, Set a
i, Set a
s)

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

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

{-# SPECIALIZE alterF :: Ord a => (Bool -> Identity Bool) -> a -> Set a -> Identity (Set a) #-}

data AlteredSet a
      -- | The needle is present in the original set.
      -- We return the set where the needle is deleted.
    = Deleted !(Set a)

      -- | The needle is not present in the original set.
      -- We return the set with the needle inserted.
    | Inserted !(Set a)

alteredSet :: Ord a => a -> Set a -> AlteredSet a
alteredSet :: forall a. Ord a => a -> Set a -> AlteredSet a
alteredSet a
x0 Set a
s0 = a -> Set a -> AlteredSet a
forall a. Ord a => a -> Set a -> AlteredSet a
go a
x0 Set a
s0
  where
    go :: Ord a => a -> Set a -> AlteredSet a
    go :: forall a. Ord a => a -> Set a -> AlteredSet a
go a
x Set a
Tip           = Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Inserted (a -> Set a
forall a. a -> Set a
singleton a
x)
    go a
x (Bin Int
_ a
y Set a
l Set a
r) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
        Ordering
LT -> case a -> Set a -> AlteredSet a
forall a. Ord a => a -> Set a -> AlteredSet a
go a
x Set a
l of
            Deleted Set a
d           -> Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Deleted (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
d Set a
r)
            Inserted Set a
i          -> Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Inserted (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
i Set a
r)
        Ordering
GT -> case a -> Set a -> AlteredSet a
forall a. Ord a => a -> Set a -> AlteredSet a
go a
x Set a
r of
            Deleted Set a
d           -> Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Deleted (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
l Set a
d)
            Inserted Set a
i          -> Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Inserted (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l Set a
i)
        Ordering
EQ -> Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Deleted (Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r)
#if __GLASGOW_HASKELL__
{-# INLINABLE alteredSet #-}
#else
{-# INLINE alteredSet #-}
#endif

{--------------------------------------------------------------------
  Subset
--------------------------------------------------------------------}
-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\).
-- @(s1 \`isProperSubsetOf\` s2)@ indicates whether @s1@ is a
-- proper subset of @s2@.
--
-- @
-- s1 \`isProperSubsetOf\` s2 = s1 ``isSubsetOf`` s2 && s1 /= s2
-- @
isProperSubsetOf :: Ord a => Set a -> Set a -> Bool
isProperSubsetOf :: forall a. Ord a => Set a -> Set a -> Bool
isProperSubsetOf Set a
s1 Set a
s2
    = Set a -> Int
forall a. Set a -> Int
size Set a
s1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Set a -> Int
forall a. Set a -> Int
size Set a
s2 Bool -> Bool -> Bool
&& Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
isSubsetOfX Set a
s1 Set a
s2
#if __GLASGOW_HASKELL__
{-# INLINABLE isProperSubsetOf #-}
#endif


-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\).
-- @(s1 \`isSubsetOf\` s2)@ indicates whether @s1@ is a subset of @s2@.
--
-- @
-- s1 \`isSubsetOf\` s2 = all (``member`` s2) s1
-- s1 \`isSubsetOf\` s2 = null (s1 ``difference`` s2)
-- s1 \`isSubsetOf\` s2 = s1 ``union`` s2 == s2
-- s1 \`isSubsetOf\` s2 = s1 ``intersection`` s2 == s1
-- @
isSubsetOf :: Ord a => Set a -> Set a -> Bool
isSubsetOf :: forall a. Ord a => Set a -> Set a -> Bool
isSubsetOf Set a
t1 Set a
t2
  = Set a -> Int
forall a. Set a -> Int
size Set a
t1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Set a -> Int
forall a. Set a -> Int
size Set a
t2 Bool -> Bool -> Bool
&& Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
isSubsetOfX Set a
t1 Set a
t2
#if __GLASGOW_HASKELL__
{-# INLINABLE isSubsetOf #-}
#endif

-- Test whether a set is a subset of another without the *initial*
-- size test.
--
-- This function is structured very much like `difference`, `union`,
-- and `intersection`. Whereas the bounds proofs for those in Blelloch
-- et al needed to account for both "split work" and "merge work", we
-- only have to worry about split work here, which is the same as in
-- those functions.
isSubsetOfX :: Ord a => Set a -> Set a -> Bool
isSubsetOfX :: forall a. Ord a => Set a -> Set a -> Bool
isSubsetOfX Set a
Tip Set a
_ = Bool
True
isSubsetOfX Set a
_ Set a
Tip = Bool
False
-- Skip the final split when we hit a singleton.
isSubsetOfX (Bin Int
1 a
x Set a
_ Set a
_) Set a
t = a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
member a
x Set a
t
isSubsetOfX (Bin Int
_ a
x Set a
l Set a
r) Set a
t
  = Bool
found Bool -> Bool -> Bool
&&
    -- Cheap size checks can sometimes save expensive recursive calls when the
    -- result will be False. Suppose we check whether [1..10] (with root 4) is
    -- a subset of [0..9]. After the first split, we have to check if [1..3] is
    -- a subset of [0..3] and if [5..10] is a subset of [5..9]. But we can bail
    -- immediately because size [5..10] > size [5..9].
    --
    -- Why not just call `isSubsetOf` on each side to do the size checks?
    -- Because that could make a recursive call on the left even though the
    -- size check would fail on the right. In principle, we could take this to
    -- extremes by maintaining a queue of pairs of sets to be checked, working
    -- through the tree level-wise. But that would impose higher administrative
    -- costs without obvious benefits. It might be worth considering if we find
    -- a way to use it to tighten the bounds in some useful/comprehensible way.
    Set a -> Int
forall a. Set a -> Int
size Set a
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Set a -> Int
forall a. Set a -> Int
size Set a
lt Bool -> Bool -> Bool
&& Set a -> Int
forall a. Set a -> Int
size Set a
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Set a -> Int
forall a. Set a -> Int
size Set a
gt Bool -> Bool -> Bool
&&
    Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
isSubsetOfX Set a
l Set a
lt Bool -> Bool -> Bool
&& Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
isSubsetOfX Set a
r Set a
gt
  where
    (Set a
lt,Bool
found,Set a
gt) = a -> Set a -> (Set a, Bool, Set a)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
t
#if __GLASGOW_HASKELL__
{-# INLINABLE isSubsetOfX #-}
#endif

{--------------------------------------------------------------------
  Disjoint
--------------------------------------------------------------------}
-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Check whether two sets are disjoint
-- (i.e., their intersection is empty).
--
-- > disjoint (fromList [2,4,6])   (fromList [1,3])     == True
-- > disjoint (fromList [2,4,6,8]) (fromList [2,3,5,7]) == False
-- > disjoint (fromList [1,2])     (fromList [1,2,3,4]) == False
-- > disjoint (fromList [])        (fromList [])        == True
--
-- @
-- xs ``disjoint`` ys = null (xs ``intersection`` ys)
-- @
--
-- @since 0.5.11

disjoint :: Ord a => Set a -> Set a -> Bool
disjoint :: forall a. Ord a => Set a -> Set a -> Bool
disjoint Set a
Tip Set a
_ = Bool
True
disjoint Set a
_ Set a
Tip = Bool
True
-- Avoid a split for the singleton case.
disjoint (Bin Int
1 a
x Set a
_ Set a
_) Set a
t = a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`notMember` Set a
t
disjoint (Bin Int
_ a
x Set a
l Set a
r) Set a
t
  -- Analogous implementation to `subsetOfX`
  = Bool -> Bool
not Bool
found Bool -> Bool -> Bool
&& Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
disjoint Set a
l Set a
lt Bool -> Bool -> Bool
&& Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
disjoint Set a
r Set a
gt
  where
    (Set a
lt,Bool
found,Set a
gt) = a -> Set a -> (Set a, Bool, Set a)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
t

{--------------------------------------------------------------------
  Minimal, Maximal
--------------------------------------------------------------------}

-- Note [Inline lookupMin]
-- ~~~~~~~~~~~~~~~~~~~~~~~
-- The core of lookupMin is implemented as lookupMinSure, a recursive function
-- that does not involve Maybes. lookupMin wraps the result of lookupMinSure in
-- a Just. We inline lookupMin so that GHC optimizations can eliminate the Maybe
-- if it is matched on at the call site.

lookupMinSure :: a -> Set a -> a
lookupMinSure :: forall a. a -> Set a -> a
lookupMinSure a
x Set a
Tip = a
x
lookupMinSure a
_ (Bin Int
_ a
x Set a
l Set a
_) = a -> Set a -> a
forall a. a -> Set a -> a
lookupMinSure a
x Set a
l

-- | \(O(\log n)\). The minimal element of the set. Returns 'Nothing' if the set
-- is empty.
--
-- @since 0.5.9

lookupMin :: Set a -> Maybe a
lookupMin :: forall a. Set a -> Maybe a
lookupMin Set a
Tip = Maybe a
forall a. Maybe a
Nothing
lookupMin (Bin Int
_ a
x Set a
l Set a
_) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$! a -> Set a -> a
forall a. a -> Set a -> a
lookupMinSure a
x Set a
l
{-# INLINE lookupMin #-} -- See Note [Inline lookupMin]

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

lookupMaxSure :: a -> Set a -> a
lookupMaxSure :: forall a. a -> Set a -> a
lookupMaxSure a
x Set a
Tip = a
x
lookupMaxSure a
_ (Bin Int
_ a
x Set a
_ Set a
r) = a -> Set a -> a
forall a. a -> Set a -> a
lookupMaxSure a
x Set a
r

-- | \(O(\log n)\). The maximal element of the set. Returns 'Nothing' if the set
-- is empty.
--
-- @since 0.5.9

lookupMax :: Set a -> Maybe a
lookupMax :: forall a. Set a -> Maybe a
lookupMax Set a
Tip = Maybe a
forall a. Maybe a
Nothing
lookupMax (Bin Int
_ a
x Set a
_ Set a
r) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$! a -> Set a -> a
forall a. a -> Set a -> a
lookupMaxSure a
x Set a
r
{-# INLINE lookupMax #-} -- See Note [Inline lookupMin]

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

-- | \(O(\log n)\). Delete the minimal element. Returns an empty set if the set is empty.
deleteMin :: Set a -> Set a
deleteMin :: forall a. Set a -> Set a
deleteMin (Bin Int
_ a
_ Set a
Tip Set a
r) = Set a
r
deleteMin (Bin Int
_ a
x Set a
l Set a
r)   = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
x (Set a -> Set a
forall a. Set a -> Set a
deleteMin Set a
l) Set a
r
deleteMin Set a
Tip             = Set a
forall a. Set a
Tip

-- | \(O(\log n)\). Delete the maximal element. Returns an empty set if the set is empty.
deleteMax :: Set a -> Set a
deleteMax :: forall a. Set a -> Set a
deleteMax (Bin Int
_ a
_ Set a
l Set a
Tip) = Set a
l
deleteMax (Bin Int
_ a
x Set a
l Set a
r)   = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
x Set a
l (Set a -> Set a
forall a. Set a -> Set a
deleteMax Set a
r)
deleteMax Set a
Tip             = Set a
forall a. Set a
Tip

{--------------------------------------------------------------------
  Union.
--------------------------------------------------------------------}
-- | The union of the sets in a Foldable structure : (@'unions' == 'foldl' 'union' 'empty'@).
unions :: (Foldable f, Ord a) => f (Set a) -> Set a
unions :: forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
unions = (Set a -> Set a -> Set a) -> Set a -> f (Set a) -> Set a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
union Set a
forall a. Set a
empty
#if __GLASGOW_HASKELL__
{-# INLINABLE unions #-}
#endif

-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). The union of two sets, preferring the first set when
-- equal elements are encountered.
union :: Ord a => Set a -> Set a -> Set a
union :: forall a. Ord a => Set a -> Set a -> Set a
union Set a
t1 Set a
Tip  = Set a
t1
union Set a
t1 (Bin Int
1 a
x Set a
_ Set a
_) = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
insertR a
x Set a
t1
union (Bin Int
1 a
x Set a
_ Set a
_) Set a
t2 = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
insert a
x Set a
t2
union Set a
Tip Set a
t2  = Set a
t2
union t1 :: Set a
t1@(Bin Int
_ a
x Set a
l1 Set a
r1) Set a
t2 = case a -> Set a -> StrictPair (Set a) (Set a)
forall a. Ord a => a -> Set a -> StrictPair (Set a) (Set a)
splitS a
x Set a
t2 of
  (Set a
l2 :*: Set a
r2)
    | Set a
l1l2 Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
l1 Bool -> Bool -> Bool
&& Set a
r1r2 Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
r1 -> Set a
t1
    | Bool
otherwise -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l1l2 Set a
r1r2
    where !l1l2 :: Set a
l1l2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
union Set a
l1 Set a
l2
          !r1r2 :: Set a
r1r2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
union Set a
r1 Set a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE union #-}
#endif

{--------------------------------------------------------------------
  Difference
--------------------------------------------------------------------}
-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). Difference of two sets.
--
-- Return elements of the first set not existing in the second set.
--
-- > difference (fromList [5, 3]) (fromList [5, 7]) == singleton 3
difference :: Ord a => Set a -> Set a -> Set a
difference :: forall a. Ord a => Set a -> Set a -> Set a
difference Set a
Tip Set a
_   = Set a
forall a. Set a
Tip
difference Set a
t1 Set a
Tip  = Set a
t1
difference Set a
t1 (Bin Int
_ a
x Set a
l2 Set a
r2) = case a -> Set a -> (Set a, Set a)
forall a. Ord a => a -> Set a -> (Set a, Set a)
split a
x Set a
t1 of
   (Set a
l1, Set a
r1)
     | Set a -> Int
forall a. Set a -> Int
size Set a
l1l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
size Set a
r1r2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Set a -> Int
forall a. Set a -> Int
size Set a
t1 -> Set a
t1
     | Bool
otherwise -> Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
l1l2 Set a
r1r2
     where !l1l2 :: Set a
l1l2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
difference Set a
l1 Set a
l2
           !r1r2 :: Set a
r1r2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
difference Set a
r1 Set a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE difference #-}
#endif

{--------------------------------------------------------------------
  Intersection
--------------------------------------------------------------------}
-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\). The intersection of two sets.
-- Elements of the result come from the first set, so for example
--
-- > import qualified Data.Set as S
-- > data AB = A | B deriving Show
-- > instance Ord AB where compare _ _ = EQ
-- > instance Eq AB where _ == _ = True
-- > main = print (S.singleton A `S.intersection` S.singleton B,
-- >               S.singleton B `S.intersection` S.singleton A)
--
-- prints @(fromList [A],fromList [B])@.
intersection :: Ord a => Set a -> Set a -> Set a
intersection :: forall a. Ord a => Set a -> Set a -> Set a
intersection Set a
Tip Set a
_ = Set a
forall a. Set a
Tip
intersection Set a
_ Set a
Tip = Set a
forall a. Set a
Tip
intersection t1 :: Set a
t1@(Bin Int
_ a
x Set a
l1 Set a
r1) Set a
t2
  | Bool
b = if Set a
l1l2 Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
l1 Bool -> Bool -> Bool
&& Set a
r1r2 Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
r1
        then Set a
t1
        else a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l1l2 Set a
r1r2
  | Bool
otherwise = Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
l1l2 Set a
r1r2
  where
    !(Set a
l2, Bool
b, Set a
r2) = a -> Set a -> (Set a, Bool, Set a)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
t2
    !l1l2 :: Set a
l1l2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
intersection Set a
l1 Set a
l2
    !r1r2 :: Set a
r1r2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
intersection Set a
r1 Set a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE intersection #-}
#endif

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

-- | @Set@s form a 'Semigroup' under 'intersection'.
--
-- @since 0.8
newtype Intersection a = Intersection { forall a. Intersection a -> Set a
getIntersection :: Set a }
    deriving (Int -> Intersection a -> ShowS
[Intersection a] -> ShowS
Intersection a -> [Char]
(Int -> Intersection a -> ShowS)
-> (Intersection a -> [Char])
-> ([Intersection a] -> ShowS)
-> Show (Intersection a)
forall a. Show a => Int -> Intersection a -> ShowS
forall a. Show a => [Intersection a] -> ShowS
forall a. Show a => Intersection a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Intersection a -> ShowS
showsPrec :: Int -> Intersection a -> ShowS
$cshow :: forall a. Show a => Intersection a -> [Char]
show :: Intersection a -> [Char]
$cshowList :: forall a. Show a => [Intersection a] -> ShowS
showList :: [Intersection a] -> ShowS
Show, Intersection a -> Intersection a -> Bool
(Intersection a -> Intersection a -> Bool)
-> (Intersection a -> Intersection a -> Bool)
-> Eq (Intersection a)
forall a. Eq a => Intersection a -> Intersection a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Intersection a -> Intersection a -> Bool
== :: Intersection a -> Intersection a -> Bool
$c/= :: forall a. Eq a => Intersection a -> Intersection a -> Bool
/= :: Intersection a -> Intersection a -> Bool
Eq, Eq (Intersection a)
Eq (Intersection a) =>
(Intersection a -> Intersection a -> Ordering)
-> (Intersection a -> Intersection a -> Bool)
-> (Intersection a -> Intersection a -> Bool)
-> (Intersection a -> Intersection a -> Bool)
-> (Intersection a -> Intersection a -> Bool)
-> (Intersection a -> Intersection a -> Intersection a)
-> (Intersection a -> Intersection a -> Intersection a)
-> Ord (Intersection a)
Intersection a -> Intersection a -> Bool
Intersection a -> Intersection a -> Ordering
Intersection a -> Intersection a -> Intersection a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Intersection a)
forall a. Ord a => Intersection a -> Intersection a -> Bool
forall a. Ord a => Intersection a -> Intersection a -> Ordering
forall a.
Ord a =>
Intersection a -> Intersection a -> Intersection a
$ccompare :: forall a. Ord a => Intersection a -> Intersection a -> Ordering
compare :: Intersection a -> Intersection a -> Ordering
$c< :: forall a. Ord a => Intersection a -> Intersection a -> Bool
< :: Intersection a -> Intersection a -> Bool
$c<= :: forall a. Ord a => Intersection a -> Intersection a -> Bool
<= :: Intersection a -> Intersection a -> Bool
$c> :: forall a. Ord a => Intersection a -> Intersection a -> Bool
> :: Intersection a -> Intersection a -> Bool
$c>= :: forall a. Ord a => Intersection a -> Intersection a -> Bool
>= :: Intersection a -> Intersection a -> Bool
$cmax :: forall a.
Ord a =>
Intersection a -> Intersection a -> Intersection a
max :: Intersection a -> Intersection a -> Intersection a
$cmin :: forall a.
Ord a =>
Intersection a -> Intersection a -> Intersection a
min :: Intersection a -> Intersection a -> Intersection a
Ord)

instance (Ord a) => Semigroup (Intersection a) where
    (Intersection Set a
a) <> :: Intersection a -> Intersection a -> Intersection a
<> (Intersection Set a
b) = Set a -> Intersection a
forall a. Set a -> Intersection a
Intersection (Set a -> Intersection a) -> Set a -> Intersection a
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
intersection Set a
a Set a
b
    {-# INLINABLE (<>) #-}

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

    sconcat :: NonEmpty (Intersection a) -> Intersection a
sconcat =
#ifdef __GLASGOW_HASKELL__
      (NonEmpty (Set a) -> Set a)
-> NonEmpty (Intersection a) -> Intersection a
forall a b. Coercible a b => a -> b
coerce NonEmpty (Set a) -> Set a
forall a. Ord a => NonEmpty (Set a) -> Set a
intersections
#else
      Intersection . intersections . fmap getIntersection
#endif
    {-# INLINABLE sconcat #-}

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

-- | \(O\bigl(m \log\bigl(\frac{n}{m}+1\bigr)\bigr), \; 0 < m \leq n\).
-- The symmetric difference of two sets.
--
-- The result contains elements that appear in exactly one of the two sets.
--
-- @
-- symmetricDifference (fromList [0,2,4,6]) (fromList [0,3,6,9]) == fromList [2,3,4,9]
-- @
--
-- @since 0.8
symmetricDifference :: Ord a => Set a -> Set a -> Set a
symmetricDifference :: forall a. Ord a => Set a -> Set a -> Set a
symmetricDifference Set a
Tip Set a
t2 = Set a
t2
symmetricDifference Set a
t1 Set a
Tip = Set a
t1
symmetricDifference (Bin Int
_ a
x Set a
l1 Set a
r1) Set a
t2
  | Bool
found = Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
l1l2 Set a
r1r2
  | Bool
otherwise = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l1l2 Set a
r1r2
  where
    !(Set a
l2, Bool
found, Set a
r2) = a -> Set a -> (Set a, Bool, Set a)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
t2
    !l1l2 :: Set a
l1l2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
symmetricDifference Set a
l1 Set a
l2
    !r1r2 :: Set a
r1r2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
symmetricDifference Set a
r1 Set a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE symmetricDifference #-}
#endif

{--------------------------------------------------------------------
  Filter and partition
--------------------------------------------------------------------}
-- | \(O(n)\). Filter all elements that satisfy the predicate.
filter :: (a -> Bool) -> Set a -> Set a
filter :: forall a. (a -> Bool) -> Set a -> Set a
filter a -> Bool
_ Set a
Tip = Set a
forall a. Set a
Tip
filter a -> Bool
p t :: Set a
t@(Bin Int
_ a
x Set a
l Set a
r)
    | a -> Bool
p a
x = if Set a
l Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
l' Bool -> Bool -> Bool
&& Set a
r Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
r'
            then Set a
t
            else a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l' Set a
r'
    | Bool
otherwise = Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
l' Set a
r'
    where
      !l' :: Set a
l' = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
filter a -> Bool
p Set a
l
      !r' :: Set a
r' = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
filter a -> Bool
p Set a
r

-- | \(O(n)\). Partition the set into two sets, one with all elements that satisfy
-- the predicate and one with all elements that don't satisfy the predicate.
-- See also 'split'.
partition :: (a -> Bool) -> Set a -> (Set a,Set a)
partition :: forall a. (a -> Bool) -> Set a -> (Set a, Set a)
partition a -> Bool
p0 Set a
t0 = StrictPair (Set a) (Set a) -> (Set a, Set a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Set a) (Set a) -> (Set a, Set a))
-> StrictPair (Set a) (Set a) -> (Set a, Set a)
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
forall {a}. (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
p0 Set a
t0
  where
    go :: (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
_ Set a
Tip = (Set a
forall a. Set a
Tip Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
forall a. Set a
Tip)
    go a -> Bool
p t :: Set a
t@(Bin Int
_ a
x Set a
l Set a
r) = case ((a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
p Set a
l, (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
p Set a
r) of
      ((Set a
l1 :*: Set a
l2), (Set a
r1 :*: Set a
r2))
        | a -> Bool
p a
x       -> (if Set a
l1 Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
l Bool -> Bool -> Bool
&& Set a
r1 Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
r
                        then Set a
t
                        else a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l1 Set a
r1) Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
l2 Set a
r2
        | Bool
otherwise -> Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
l1 Set a
r1 Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*:
                       (if Set a
l2 Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
l Bool -> Bool -> Bool
&& Set a
r2 Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
r
                        then Set a
t
                        else a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l2 Set a
r2)

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

-- | \(O(n \log n)\).
-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
--
-- If `f` is monotonically non-decreasing, this function takes \(O(n)\) time.
--
-- 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 :: Ord b => (a->b) -> Set a -> Set b
map :: forall b a. Ord b => (a -> b) -> Set a -> Set b
map a -> b
f Set a
t = SetBuilder b -> Set b
forall a. SetBuilder a -> Set a
finishB ((SetBuilder b -> a -> SetBuilder b)
-> SetBuilder b -> Set a -> SetBuilder b
forall b a. (b -> a -> b) -> b -> Set a -> b
foldl' (\SetBuilder b
b a
x -> b -> SetBuilder b -> SetBuilder b
forall a. Ord a => a -> SetBuilder a -> SetBuilder a
insertB (a -> b
f a
x) SetBuilder b
b) SetBuilder b
forall a. SetBuilder a
emptyB Set a
t)
#if __GLASGOW_HASKELL__
{-# INLINABLE map #-}
#endif

-- | \(O(n)\).
-- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is strictly increasing.
-- Semi-formally, we have:
--
-- > and [x < y ==> f x < f y | x <- ls, y <- ls]
-- >                     ==> mapMonotonic f s == map f s
-- >     where ls = toList s
--
-- __Warning__: This function should be used only if @f@ is monotonically
-- strictly increasing. This precondition is not checked. Use 'map' if the
-- precondition may not hold.

mapMonotonic :: (a->b) -> Set a -> Set b
mapMonotonic :: forall a b. (a -> b) -> Set a -> Set b
mapMonotonic a -> b
_ Set a
Tip = Set b
forall a. Set a
Tip
mapMonotonic a -> b
f (Bin Int
sz a
x Set a
l Set a
r) = Int -> b -> Set b -> Set b -> Set b
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
sz (a -> b
f a
x) ((a -> b) -> Set a -> Set b
forall a b. (a -> b) -> Set a -> Set b
mapMonotonic a -> b
f Set a
l) ((a -> b) -> Set a -> Set b
forall a b. (a -> b) -> Set a -> Set b
mapMonotonic a -> b
f Set a
r)

{--------------------------------------------------------------------
  Fold
--------------------------------------------------------------------}
-- | \(O(n)\). Fold the elements in the set using the given right-associative
-- binary operator.
--
{-# DEPRECATED fold "Use Data.Set.foldr instead" #-}
fold :: (a -> b -> b) -> b -> Set a -> b
fold :: forall a b. (a -> b -> b) -> b -> Set a -> b
fold = (a -> b -> b) -> b -> Set a -> b
forall a b. (a -> b -> b) -> b -> Set a -> 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 :: (a -> b -> b) -> b -> Set a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldr a -> b -> b
f b
z = b -> Set a -> b
go b
z
  where
    go :: b -> Set a -> b
go b
z' Set a
Tip           = b
z'
    go b
z' (Bin Int
_ a
x Set a
l Set a
r) = b -> Set a -> b
go (a -> b -> b
f a
x (b -> Set a -> b
go b
z' Set a
r)) Set a
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' :: (a -> b -> b) -> b -> Set a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldr' a -> b -> b
f b
z = b -> Set a -> b
go b
z
  where
    go :: b -> Set a -> b
go !b
z' Set a
Tip           = b
z'
    go b
z' (Bin Int
_ a
x Set a
l Set a
r) = b -> Set a -> b
go (a -> b -> b
f a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! b -> Set a -> b
go b
z' Set a
r) Set a
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 -> b -> a) -> a -> Set b -> a
foldl :: forall b a. (b -> a -> b) -> b -> Set a -> b
foldl a -> b -> a
f a
z = a -> Set b -> a
go a
z
  where
    go :: a -> Set b -> a
go a
z' Set b
Tip           = a
z'
    go a
z' (Bin Int
_ b
x Set b
l Set b
r) = a -> Set b -> a
go (a -> b -> a
f (a -> Set b -> a
go a
z' Set b
l) b
x) Set b
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 -> b -> a) -> a -> Set b -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Set a -> b
foldl' a -> b -> a
f a
z = a -> Set b -> a
go a
z
  where
    go :: a -> Set b -> a
go !a
z' Set b
Tip           = a
z'
    go a
z' (Bin Int
_ b
x Set b
l Set b
r) =
      let !z'' :: a
z'' = a -> Set b -> a
go a
z' Set b
l
      in a -> Set b -> a
go (a -> b -> a
f a
z'' b
x) Set b
r
{-# INLINE foldl' #-}

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

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

#ifdef __GLASGOW_HASKELL__
-- | @since 0.5.6.2
instance (Ord a) => GHCExts.IsList (Set a) where
  type Item (Set a) = a
  fromList :: [Item (Set a)] -> Set a
fromList = [a] -> Set a
[Item (Set a)] -> Set a
forall a. Ord a => [a] -> Set a
fromList
  toList :: Set a -> [Item (Set a)]
toList   = Set a -> [a]
Set a -> [Item (Set a)]
forall a. Set a -> [a]
toList
#endif

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

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

-- | \(O(n)\). Convert the set to a descending list of elements. Subject to list
-- fusion.
toDescList :: Set a -> [a]
toDescList :: forall a. Set a -> [a]
toDescList = ([a] -> a -> [a]) -> [a] -> Set a -> [a]
forall b a. (b -> a -> b) -> b -> Set a -> b
foldl ((a -> [a] -> [a]) -> [a] -> a -> [a]
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 :: (a -> b -> b) -> b -> Set a -> b
foldrFB :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldrFB = (a -> b -> b) -> b -> Set a -> b
forall a b. (a -> b -> b) -> b -> Set a -> b
foldr
{-# INLINE[0] foldrFB #-}
foldlFB :: (a -> b -> a) -> a -> Set b -> a
foldlFB :: forall b a. (b -> a -> b) -> b -> Set a -> b
foldlFB = (a -> b -> a) -> a -> Set b -> a
forall b a. (b -> a -> b) -> b -> Set a -> b
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 "Set.toAscList" [~1] forall s . toAscList s = build (\c n -> foldrFB c n s) #-}
{-# RULES "Set.toAscListBack" [1] foldrFB (:) [] = toAscList #-}
{-# RULES "Set.toDescList" [~1] forall s . toDescList s = build (\c n -> foldlFB (\xs x -> c x xs) n s) #-}
{-# RULES "Set.toDescListBack" [1] foldlFB (\xs x -> x : xs) [] = toDescList #-}
#endif

-- | \(O(n \log n)\). Create a set from a list of elements.
--
-- If the elements are in non-decreasing order, this function takes \(O(n)\)
-- time.
fromList :: Ord a => [a] -> Set a
fromList :: forall a. Ord a => [a] -> Set a
fromList [a]
xs = SetBuilder a -> Set a
forall a. SetBuilder a -> Set a
finishB ((SetBuilder a -> a -> SetBuilder a)
-> SetBuilder a -> [a] -> SetBuilder a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' ((a -> SetBuilder a -> SetBuilder a)
-> SetBuilder a -> a -> SetBuilder a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> SetBuilder a -> SetBuilder a
forall a. Ord a => a -> SetBuilder a -> SetBuilder a
insertB) SetBuilder a
forall a. SetBuilder a
emptyB [a]
xs)
{-# INLINE fromList #-}  -- INLINE for fusion

{--------------------------------------------------------------------
  Building trees from ascending/descending lists can be done in linear time.

  Note that if [xs] is ascending that:
    fromAscList xs == fromList xs
--------------------------------------------------------------------}
-- | \(O(n)\). Build a set from an ascending list in linear time.
--
-- __Warning__: This function should be used only if the elements are in
-- non-decreasing order. This precondition is not checked. Use 'fromList' if the
-- precondition may not hold.
fromAscList :: Eq a => [a] -> Set a
fromAscList :: forall a. Eq a => [a] -> Set a
fromAscList [a]
xs = Stack a -> Set a
forall a. Stack a -> Set a
ascLinkAll ((Stack a -> a -> Stack a) -> Stack a -> [a] -> Stack a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Stack a -> a -> Stack a
forall {a}. Eq a => Stack a -> a -> Stack a
next Stack a
forall a. Stack a
Nada [a]
xs)
  where
    next :: Stack a -> a -> Stack a
next Stack a
stk !a
y = case Stack a
stk of
      Push a
x Set a
l Stack a
stk'
        | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x -> a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
l Stack a
stk'
        | Set a
Tip <- Set a
l -> Stack a -> Int -> Set a -> a -> Stack a
forall a. Stack a -> Int -> Set a -> a -> Stack a
ascLinkTop Stack a
stk' Int
1 (a -> Set a
forall a. a -> Set a
singleton a
x) a
y
        | Bool
otherwise -> a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
forall a. Set a
Tip Stack a
stk
      Stack a
Nada -> a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
forall a. Set a
Tip Stack a
stk
{-# INLINE fromAscList #-}  -- INLINE for fusion

-- | \(O(n)\). Build a set from a descending list in linear time.
--
-- __Warning__: This function should be used only if the elements are in
-- non-increasing order. This precondition is not checked. Use 'fromList' if the
-- precondition may not hold.
--
-- @since 0.5.8
fromDescList :: Eq a => [a] -> Set a
fromDescList :: forall a. Eq a => [a] -> Set a
fromDescList [a]
xs = Stack a -> Set a
forall a. Stack a -> Set a
descLinkAll ((Stack a -> a -> Stack a) -> Stack a -> [a] -> Stack a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Stack a -> a -> Stack a
forall {a}. Eq a => Stack a -> a -> Stack a
next Stack a
forall a. Stack a
Nada [a]
xs)
  where
    next :: Stack a -> a -> Stack a
next Stack a
stk !a
y = case Stack a
stk of
      Push a
x Set a
r Stack a
stk'
        | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x -> a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
r Stack a
stk'
        | Set a
Tip <- Set a
r -> a -> Int -> Set a -> Stack a -> Stack a
forall a. a -> Int -> Set a -> Stack a -> Stack a
descLinkTop a
y Int
1 (a -> Set a
forall a. a -> Set a
singleton a
x) Stack a
stk'
        | Bool
otherwise -> a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
forall a. Set a
Tip Stack a
stk
      Stack a
Nada -> a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
forall a. Set a
Tip Stack a
stk
{-# INLINE fromDescList #-}  -- INLINE for fusion

-- | \(O(n)\). Build a set from an ascending list of distinct elements in linear time.
--
-- __Warning__: This function should be used only if the elements are in
-- strictly increasing order. This precondition is not checked. Use 'fromList'
-- if the precondition may not hold.

-- See Note [fromDistinctAscList implementation]
fromDistinctAscList :: [a] -> Set a
fromDistinctAscList :: forall a. [a] -> Set a
fromDistinctAscList [a]
xs = Stack a -> Set a
forall a. Stack a -> Set a
ascLinkAll ((Stack a -> a -> Stack a) -> Stack a -> [a] -> Stack a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Stack a -> a -> Stack a
forall a. Stack a -> a -> Stack a
next Stack a
forall a. Stack a
Nada [a]
xs)
  where
    next :: Stack a -> a -> Stack a
    next :: forall a. Stack a -> a -> Stack a
next (Push a
x Set a
Tip Stack a
stk) !a
y = Stack a -> Int -> Set a -> a -> Stack a
forall a. Stack a -> Int -> Set a -> a -> Stack a
ascLinkTop Stack a
stk Int
1 (a -> Set a
forall a. a -> Set a
singleton a
x) a
y
    next Stack a
stk !a
x = a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
x Set a
forall a. Set a
Tip Stack a
stk
{-# INLINE fromDistinctAscList #-}  -- INLINE for fusion

ascLinkTop :: Stack a -> Int -> Set a -> a -> Stack a
ascLinkTop :: forall a. Stack a -> Int -> Set a -> a -> Stack a
ascLinkTop (Push a
x l :: Set a
l@(Bin Int
lsz a
_ Set a
_ Set a
_) Stack a
stk) !Int
rsz Set a
r a
y
  | Int
lsz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rsz = Stack a -> Int -> Set a -> a -> Stack a
forall a. Stack a -> Int -> Set a -> a -> Stack a
ascLinkTop Stack a
stk Int
sz (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
sz a
x Set a
l Set a
r) a
y
  where
    sz :: Int
sz = Int
lsz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rsz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
ascLinkTop Stack a
stk !Int
_ Set a
r a
y = a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
r Stack a
stk

ascLinkAll :: Stack a -> Set a
ascLinkAll :: forall a. Stack a -> Set a
ascLinkAll Stack a
stk = (Set a -> a -> Set a -> Set a) -> Set a -> Stack a -> Set a
forall b a. (b -> a -> Set a -> b) -> b -> Stack a -> b
foldl'Stack (\Set a
r a
x Set a
l -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
r) Set a
forall a. Set a
Tip Stack a
stk
{-# INLINABLE ascLinkAll #-}

-- | \(O(n)\). Build a set from a descending list of distinct elements in linear time.
--
-- __Warning__: This function should be used only if the elements are in
-- strictly decreasing order. This precondition is not checked. Use 'fromList'
-- if the precondition may not hold.
--
-- @since 0.5.8

-- See Note [fromDistinctAscList implementation]
fromDistinctDescList :: [a] -> Set a
fromDistinctDescList :: forall a. [a] -> Set a
fromDistinctDescList [a]
xs = Stack a -> Set a
forall a. Stack a -> Set a
descLinkAll ((Stack a -> a -> Stack a) -> Stack a -> [a] -> Stack a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Stack a -> a -> Stack a
forall a. Stack a -> a -> Stack a
next Stack a
forall a. Stack a
Nada [a]
xs)
  where
    next :: Stack a -> a -> Stack a
    next :: forall a. Stack a -> a -> Stack a
next (Push a
y Set a
Tip Stack a
stk) !a
x = a -> Int -> Set a -> Stack a -> Stack a
forall a. a -> Int -> Set a -> Stack a -> Stack a
descLinkTop a
x Int
1 (a -> Set a
forall a. a -> Set a
singleton a
y) Stack a
stk
    next Stack a
stk !a
y = a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
forall a. Set a
Tip Stack a
stk
{-# INLINE fromDistinctDescList #-}  -- INLINE for fusion

descLinkTop :: a -> Int -> Set a -> Stack a -> Stack a
descLinkTop :: forall a. a -> Int -> Set a -> Stack a -> Stack a
descLinkTop a
x !Int
lsz Set a
l (Push a
y r :: Set a
r@(Bin Int
rsz a
_ Set a
_ Set a
_) Stack a
stk)
  | Int
lsz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rsz = a -> Int -> Set a -> Stack a -> Stack a
forall a. a -> Int -> Set a -> Stack a -> Stack a
descLinkTop a
x Int
sz (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
sz a
y Set a
l Set a
r) Stack a
stk
  where
    sz :: Int
sz = Int
lsz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rsz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
descLinkTop a
y !Int
_ Set a
r Stack a
stk = a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
r Stack a
stk

descLinkAll :: Stack a -> Set a
descLinkAll :: forall a. Stack a -> Set a
descLinkAll Stack a
stk = (Set a -> a -> Set a -> Set a) -> Set a -> Stack a -> Set a
forall b a. (b -> a -> Set a -> b) -> b -> Stack a -> b
foldl'Stack (\Set a
l a
x Set a
r -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
r) Set a
forall a. Set a
Tip Stack a
stk
{-# INLINABLE descLinkAll #-}

data Stack a = Push !a !(Set a) !(Stack a) | Nada

foldl'Stack :: (b -> a -> Set a -> b) -> b -> Stack a -> b
foldl'Stack :: forall b a. (b -> a -> Set a -> b) -> b -> Stack a -> b
foldl'Stack b -> a -> Set a -> b
f = b -> Stack a -> b
go
  where
    go :: b -> Stack a -> b
go !b
z Stack a
Nada = b
z
    go b
z (Push a
x Set a
t Stack a
stk) = b -> Stack a -> b
go (b -> a -> Set a -> b
f b
z a
x Set a
t) Stack a
stk
{-# INLINE foldl'Stack #-}

{--------------------------------------------------------------------
  Iterator
--------------------------------------------------------------------}

-- Note [Iterator]
-- ~~~~~~~~~~~~~~~
-- Iteration, using a Stack as an iterator, is an efficient way to consume a Set
-- one element at a time. Alternately, this may be done by toAscList. toAscList
-- when consumed via List.foldr will rewrite to Set.foldr (thanks to rewrite
-- rules), which is quite efficient. However, sometimes that is not possible,
-- such as in the second arg of '==' or 'compare', where manifesting the list
-- cons cells is unavoidable and makes things slower.
--
-- Concretely, compare on Set Int using toAscList takes ~21% more time compared
-- to using Iterator, on GHC 9.6.3.
--
-- The heart of this implementation is the `iterDown` function. It walks down
-- the left spine of the tree, pushing the value and right child on the stack,
-- until a Tip is reached. The next value is now at the top of the stack. To get
-- to the value after that, `iterDown` is called again with the right child and
-- the remaining stack.

iterDown :: Set a -> Stack a -> Stack a
iterDown :: forall a. Set a -> Stack a -> Stack a
iterDown (Bin Int
_ a
x Set a
l Set a
r) Stack a
stk = Set a -> Stack a -> Stack a
forall a. Set a -> Stack a -> Stack a
iterDown Set a
l (a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
x Set a
r Stack a
stk)
iterDown Set a
Tip Stack a
stk = Stack a
stk

-- Create an iterator from a Set, starting at the smallest element.
iterator :: Set a -> Stack a
iterator :: forall a. Set a -> Stack a
iterator Set a
s = Set a -> Stack a -> Stack a
forall a. Set a -> Stack a -> Stack a
iterDown Set a
s Stack a
forall a. Stack a
Nada

-- Get the next element and the remaining iterator.
iterNext :: Stack a -> Maybe (StrictPair a (Stack a))
iterNext :: forall a. Stack a -> Maybe (StrictPair a (Stack a))
iterNext (Push a
x Set a
r Stack a
stk) = StrictPair a (Stack a) -> Maybe (StrictPair a (Stack a))
forall a. a -> Maybe a
Just (StrictPair a (Stack a) -> Maybe (StrictPair a (Stack a)))
-> StrictPair a (Stack a) -> Maybe (StrictPair a (Stack a))
forall a b. (a -> b) -> a -> b
$! a
x a -> Stack a -> StrictPair a (Stack a)
forall a b. a -> b -> StrictPair a b
:*: Set a -> Stack a -> Stack a
forall a. Set a -> Stack a -> Stack a
iterDown Set a
r Stack a
stk
iterNext Stack a
Nada = Maybe (StrictPair a (Stack a))
forall a. Maybe a
Nothing
{-# INLINE iterNext #-}

-- Whether there are no more elements in the iterator.
iterNull :: Stack a -> Bool
iterNull :: forall a. Stack a -> Bool
iterNull (Push a
_ Set a
_ Stack a
_) = Bool
False
iterNull Stack a
Nada = Bool
True

{--------------------------------------------------------------------
  Eq
--------------------------------------------------------------------}

instance Eq a => Eq (Set a) where
  Set a
s1 == :: Set a -> Set a -> Bool
== Set a
s2 = (a -> a -> Bool) -> Set a -> Set a -> Bool
forall a b. (a -> b -> Bool) -> Set a -> Set b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) Set a
s1 Set a
s2
  {-# INLINABLE (==) #-}

-- | @since 0.5.9
instance Eq1 Set where
  liftEq :: forall a b. (a -> b -> Bool) -> Set a -> Set b -> Bool
liftEq a -> b -> Bool
eq Set a
s1 Set b
s2 = Set a -> Int
forall a. Set a -> Int
size Set a
s1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Set b -> Int
forall a. Set a -> Int
size Set b
s2 Bool -> Bool -> Bool
&& (a -> b -> Bool) -> Set a -> Set b -> Bool
forall a b. (a -> b -> Bool) -> Set a -> Set b -> Bool
sameSizeLiftEq a -> b -> Bool
eq Set a
s1 Set b
s2
  {-# INLINE liftEq #-}

-- Assumes the sets are of equal size to skip the final check.
sameSizeLiftEq :: (a -> b -> Bool) -> Set a -> Set b -> Bool
sameSizeLiftEq :: forall a b. (a -> b -> Bool) -> Set a -> Set b -> Bool
sameSizeLiftEq a -> b -> Bool
eq Set a
s1 Set b
s2 =
  case EqM (Stack b) -> Stack b -> StrictPair Bool (Stack b)
forall a. EqM a -> a -> StrictPair Bool a
runEqM ((a -> EqM (Stack b)) -> Set a -> EqM (Stack b)
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> EqM (Stack b)
f Set a
s1) (Set b -> Stack b
forall a. Set a -> Stack a
iterator Set b
s2) of Bool
e :*: Stack b
_ -> Bool
e
  where
    f :: a -> EqM (Stack b)
f a
x = (Stack b -> StrictPair Bool (Stack b)) -> EqM (Stack b)
forall a. (a -> StrictPair Bool a) -> EqM a
EqM ((Stack b -> StrictPair Bool (Stack b)) -> EqM (Stack b))
-> (Stack b -> StrictPair Bool (Stack b)) -> EqM (Stack b)
forall a b. (a -> b) -> a -> b
$ \Stack b
it -> case Stack b -> Maybe (StrictPair b (Stack b))
forall a. Stack a -> Maybe (StrictPair a (Stack a))
iterNext Stack b
it of
      Maybe (StrictPair b (Stack b))
Nothing -> Bool
False Bool -> Stack b -> StrictPair Bool (Stack b)
forall a b. a -> b -> StrictPair a b
:*: Stack b
it
      Just (b
y :*: Stack b
it') -> a -> b -> Bool
eq a
x b
y Bool -> Stack b -> StrictPair Bool (Stack b)
forall a b. a -> b -> StrictPair a b
:*: Stack b
it'
{-# INLINE sameSizeLiftEq #-}

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

instance Ord a => Ord (Set a) where
  compare :: Set a -> Set a -> Ordering
compare Set a
s1 Set a
s2 = (a -> a -> Ordering) -> Set a -> Set a -> Ordering
forall a b. (a -> b -> Ordering) -> Set a -> Set b -> Ordering
liftCmp a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Set a
s1 Set a
s2
  {-# INLINABLE compare #-}

-- | @since 0.5.9
instance Ord1 Set where
  liftCompare :: forall a b. (a -> b -> Ordering) -> Set a -> Set b -> Ordering
liftCompare = (a -> b -> Ordering) -> Set a -> Set b -> Ordering
forall a b. (a -> b -> Ordering) -> Set a -> Set b -> Ordering
liftCmp
  {-# INLINE liftCompare #-}

liftCmp :: (a -> b -> Ordering) -> Set a -> Set b -> Ordering
liftCmp :: forall a b. (a -> b -> Ordering) -> Set a -> Set b -> Ordering
liftCmp a -> b -> Ordering
cmp Set a
s1 Set b
s2 = case OrdM (Stack b) -> Stack b -> StrictPair Ordering (Stack b)
forall a. OrdM a -> a -> StrictPair Ordering a
runOrdM ((a -> OrdM (Stack b)) -> Set a -> OrdM (Stack b)
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> OrdM (Stack b)
f Set a
s1) (Set b -> Stack b
forall a. Set a -> Stack a
iterator Set b
s2) of
  Ordering
o :*: Stack b
it -> Ordering
o Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> if Stack b -> Bool
forall a. Stack a -> Bool
iterNull Stack b
it then Ordering
EQ else Ordering
LT
  where
    f :: a -> OrdM (Stack b)
f a
x = (Stack b -> StrictPair Ordering (Stack b)) -> OrdM (Stack b)
forall a. (a -> StrictPair Ordering a) -> OrdM a
OrdM ((Stack b -> StrictPair Ordering (Stack b)) -> OrdM (Stack b))
-> (Stack b -> StrictPair Ordering (Stack b)) -> OrdM (Stack b)
forall a b. (a -> b) -> a -> b
$ \Stack b
it -> case Stack b -> Maybe (StrictPair b (Stack b))
forall a. Stack a -> Maybe (StrictPair a (Stack a))
iterNext Stack b
it of
      Maybe (StrictPair b (Stack b))
Nothing -> Ordering
GT Ordering -> Stack b -> StrictPair Ordering (Stack b)
forall a b. a -> b -> StrictPair a b
:*: Stack b
it
      Just (b
y :*: Stack b
it') -> a -> b -> Ordering
cmp a
x b
y Ordering -> Stack b -> StrictPair Ordering (Stack b)
forall a b. a -> b -> StrictPair a b
:*: Stack b
it'
{-# INLINE liftCmp #-}

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

-- | @since 0.5.9
instance Show1 Set where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Set a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d Set a
m =
        (Int -> [a] -> ShowS) -> [Char] -> Int -> [a] -> ShowS
forall a. (Int -> a -> ShowS) -> [Char] -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) [Char]
"fromList" Int
d (Set a -> [a]
forall a. Set a -> [a]
toList Set a
m)

{--------------------------------------------------------------------
  Read
--------------------------------------------------------------------}
instance (Read a, Ord a) => Read (Set a) where
#if defined(__GLASGOW_HASKELL__) || defined(__MHS__)
  readPrec :: ReadPrec (Set a)
readPrec = ReadPrec (Set a) -> ReadPrec (Set a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Set a) -> ReadPrec (Set a))
-> ReadPrec (Set a) -> ReadPrec (Set a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Set a) -> ReadPrec (Set a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (Set a) -> ReadPrec (Set a))
-> ReadPrec (Set a) -> ReadPrec (Set a)
forall a b. (a -> b) -> a -> b
$ do
    Ident "fromList" <- ReadPrec Lexeme
lexP
    xs <- readPrec
    return (fromList xs)

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

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

instance NFData a => NFData (Set a) where
    rnf :: Set a -> ()
rnf Set a
Tip           = ()
    rnf (Bin Int
_ a
y Set a
l Set a
r) = a -> ()
forall a. NFData a => a -> ()
rnf a
y () -> () -> ()
forall a b. a -> b -> b
`seq` Set a -> ()
forall a. NFData a => a -> ()
rnf Set a
l () -> () -> ()
forall a b. a -> b -> b
`seq` Set a -> ()
forall a. NFData a => a -> ()
rnf Set a
r

-- | @since 0.8
instance NFData1 Set where
    liftRnf :: forall a. (a -> ()) -> Set a -> ()
liftRnf a -> ()
rnfx = Set a -> ()
go
      where
      go :: Set a -> ()
go Set a
Tip           = ()
      go (Bin Int
_ a
y Set a
l Set a
r) = a -> ()
rnfx a
y () -> () -> ()
forall a b. a -> b -> b
`seq` Set a -> ()
go Set a
l () -> () -> ()
forall a b. a -> b -> b
`seq` Set a -> ()
go Set a
r

{--------------------------------------------------------------------
  Split
--------------------------------------------------------------------}
-- | \(O(\log n)\). 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 :: Ord a => a -> Set a -> (Set a,Set a)
split :: forall a. Ord a => a -> Set a -> (Set a, Set a)
split a
x Set a
t = StrictPair (Set a) (Set a) -> (Set a, Set a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Set a) (Set a) -> (Set a, Set a))
-> StrictPair (Set a) (Set a) -> (Set a, Set a)
forall a b. (a -> b) -> a -> b
$ a -> Set a -> StrictPair (Set a) (Set a)
forall a. Ord a => a -> Set a -> StrictPair (Set a) (Set a)
splitS a
x Set a
t
{-# INLINABLE split #-}

splitS :: Ord a => a -> Set a -> StrictPair (Set a) (Set a)
splitS :: forall a. Ord a => a -> Set a -> StrictPair (Set a) (Set a)
splitS a
_ Set a
Tip = (Set a
forall a. Set a
Tip Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
forall a. Set a
Tip)
splitS a
x (Bin Int
_ a
y Set a
l Set a
r)
      = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
          Ordering
LT -> let (Set a
lt :*: Set a
gt) = a -> Set a -> StrictPair (Set a) (Set a)
forall a. Ord a => a -> Set a -> StrictPair (Set a) (Set a)
splitS a
x Set a
l in (Set a
lt Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
y Set a
gt Set a
r)
          Ordering
GT -> let (Set a
lt :*: Set a
gt) = a -> Set a -> StrictPair (Set a) (Set a)
forall a. Ord a => a -> Set a -> StrictPair (Set a) (Set a)
splitS a
x Set a
r in (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
lt Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
gt)
          Ordering
EQ -> (Set a
l Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
r)
{-# INLINABLE splitS #-}

-- | \(O(\log n)\). Performs a 'split' but also returns whether the pivot
-- element was found in the original set.
splitMember :: Ord a => a -> Set a -> (Set a,Bool,Set a)
splitMember :: forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
_ Set a
Tip = (Set a
forall a. Set a
Tip, Bool
False, Set a
forall a. Set a
Tip)
splitMember a
x (Bin Int
_ a
y Set a
l Set a
r)
   = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
       Ordering
LT -> let (Set a
lt, Bool
found, Set a
gt) = a -> Set a -> (Set a, Bool, Set a)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
l
                 !gt' :: Set a
gt' = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
y Set a
gt Set a
r
             in (Set a
lt, Bool
found, Set a
gt')
       Ordering
GT -> let (Set a
lt, Bool
found, Set a
gt) = a -> Set a -> (Set a, Bool, Set a)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
r
                 !lt' :: Set a
lt' = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
lt
             in (Set a
lt', Bool
found, Set a
gt)
       Ordering
EQ -> (Set a
l, Bool
True, Set a
r)
#if __GLASGOW_HASKELL__
{-# INLINABLE splitMember #-}
#endif

{--------------------------------------------------------------------
  Indexing
--------------------------------------------------------------------}

-- | \(O(\log n)\). Return the /index/ of an element, which is its zero-based
-- index in the sorted sequence of elements. The index is a number from /0/ up
-- to, but not including, the 'size' of the set. Calls 'error' when the element
-- is not a 'member' of the set.
--
-- > findIndex 2 (fromList [5,3])    Error: element is not in the set
-- > findIndex 3 (fromList [5,3]) == 0
-- > findIndex 5 (fromList [5,3]) == 1
-- > findIndex 6 (fromList [5,3])    Error: element is not in the set
--
-- @since 0.5.4

-- See Note: Type of local 'go' function
findIndex :: Ord a => a -> Set a -> Int
findIndex :: forall a. Ord a => a -> Set a -> Int
findIndex = Int -> a -> Set a -> Int
forall a. Ord a => Int -> a -> Set a -> Int
go Int
0
  where
    go :: Ord a => Int -> a -> Set a -> Int
    go :: forall a. Ord a => Int -> a -> Set a -> Int
go !Int
_ !a
_ Set a
Tip  = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Set.findIndex: element is not in the set"
    go Int
idx a
x (Bin Int
_ a
kx Set a
l Set a
r) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
kx of
      Ordering
LT -> Int -> a -> Set a -> Int
forall a. Ord a => Int -> a -> Set a -> Int
go Int
idx a
x Set a
l
      Ordering
GT -> Int -> a -> Set a -> Int
forall a. Ord a => Int -> a -> Set a -> Int
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
size Set a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x Set a
r
      Ordering
EQ -> Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
size Set a
l
#if __GLASGOW_HASKELL__
{-# INLINABLE findIndex #-}
#endif

-- | \(O(\log n)\). Look up the /index/ of an element, which is its zero-based index in
-- the sorted sequence of elements. The index is a number from /0/ up to, but not
-- including, the 'size' of the set.
--
-- > isJust   (lookupIndex 2 (fromList [5,3])) == False
-- > fromJust (lookupIndex 3 (fromList [5,3])) == 0
-- > fromJust (lookupIndex 5 (fromList [5,3])) == 1
-- > isJust   (lookupIndex 6 (fromList [5,3])) == False
--
-- @since 0.5.4

-- See Note: Type of local 'go' function
lookupIndex :: Ord a => a -> Set a -> Maybe Int
lookupIndex :: forall a. Ord a => a -> Set a -> Maybe Int
lookupIndex = Int -> a -> Set a -> Maybe Int
forall a. Ord a => Int -> a -> Set a -> Maybe Int
go Int
0
  where
    go :: Ord a => Int -> a -> Set a -> Maybe Int
    go :: forall a. Ord a => Int -> a -> Set a -> Maybe Int
go !Int
_ !a
_ Set a
Tip  = Maybe Int
forall a. Maybe a
Nothing
    go Int
idx a
x (Bin Int
_ a
kx Set a
l Set a
r) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
kx of
      Ordering
LT -> Int -> a -> Set a -> Maybe Int
forall a. Ord a => Int -> a -> Set a -> Maybe Int
go Int
idx a
x Set a
l
      Ordering
GT -> Int -> a -> Set a -> Maybe Int
forall a. Ord a => Int -> a -> Set a -> Maybe Int
go (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
size Set a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x Set a
r
      Ordering
EQ -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
size Set a
l
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupIndex #-}
#endif

-- | \(O(\log n)\). Retrieve an element by its /index/, i.e. by its zero-based
-- index in the sorted sequence of elements. If the /index/ is out of range (less
-- than zero, greater or equal to 'size' of the set), 'error' is called.
--
-- > elemAt 0 (fromList [5,3]) == 3
-- > elemAt 1 (fromList [5,3]) == 5
-- > elemAt 2 (fromList [5,3])    Error: index out of range
--
-- @since 0.5.4

elemAt :: Int -> Set a -> a
elemAt :: forall a. Int -> Set a -> a
elemAt !Int
_ Set a
Tip = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Set.elemAt: index out of range"
elemAt Int
i (Bin Int
_ a
x Set a
l Set a
r)
  = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
      Ordering
LT -> Int -> Set a -> a
forall a. Int -> Set a -> a
elemAt Int
i Set a
l
      Ordering
GT -> Int -> Set a -> a
forall a. Int -> Set a -> a
elemAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sizeLInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Set a
r
      Ordering
EQ -> a
x
  where
    sizeL :: Int
sizeL = Set a -> Int
forall a. Set a -> Int
size Set a
l

-- | \(O(\log n)\). Delete the element at /index/, i.e. by its zero-based index in
-- the sorted sequence of elements. If the /index/ is out of range (less than zero,
-- greater or equal to 'size' of the set), 'error' is called.
--
-- > deleteAt 0    (fromList [5,3]) == singleton 5
-- > deleteAt 1    (fromList [5,3]) == singleton 3
-- > deleteAt 2    (fromList [5,3])    Error: index out of range
-- > deleteAt (-1) (fromList [5,3])    Error: index out of range
--
-- @since 0.5.4

deleteAt :: Int -> Set a -> Set a
deleteAt :: forall a. Int -> Set a -> Set a
deleteAt !Int
i Set a
t =
  case Set a
t of
    Set a
Tip -> [Char] -> Set a
forall a. HasCallStack => [Char] -> a
error [Char]
"Set.deleteAt: index out of range"
    Bin Int
_ a
x Set a
l Set a
r -> case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
      Ordering
LT -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
x (Int -> Set a -> Set a
forall a. Int -> Set a -> Set a
deleteAt Int
i Set a
l) Set a
r
      Ordering
GT -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
x Set a
l (Int -> Set a -> Set a
forall a. Int -> Set a -> Set a
deleteAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sizeLInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Set a
r)
      Ordering
EQ -> Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r
      where
        sizeL :: Int
sizeL = Set a -> Int
forall a. Set a -> Int
size Set a
l

-- | \(O(\log n)\). Take a given number of elements in order, beginning
-- with the smallest ones.
--
-- @
-- take n = 'fromDistinctAscList' . 'Prelude.take' n . 'toAscList'
-- @
--
-- @since 0.5.8
take :: Int -> Set a -> Set a
take :: forall a. Int -> Set a -> Set a
take Int
i Set a
m | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Set a -> Int
forall a. Set a -> Int
size Set a
m = Set a
m
take Int
i0 Set a
m0 = Int -> Set a -> Set a
forall a. Int -> Set a -> Set a
go Int
i0 Set a
m0
  where
    go :: Int -> Set a -> Set a
go Int
i !Set a
_ | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Set a
forall a. Set a
Tip
    go !Int
_ Set a
Tip = Set a
forall a. Set a
Tip
    go Int
i (Bin Int
_ a
x Set a
l Set a
r) =
      case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
        Ordering
LT -> Int -> Set a -> Set a
go Int
i Set a
l
        Ordering
GT -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l (Int -> Set a -> Set a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sizeL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Set a
r)
        Ordering
EQ -> Set a
l
      where sizeL :: Int
sizeL = Set a -> Int
forall a. Set a -> Int
size Set a
l

-- | \(O(\log n)\). Drop a given number of elements in order, beginning
-- with the smallest ones.
--
-- @
-- drop n = 'fromDistinctAscList' . 'Prelude.drop' n . 'toAscList'
-- @
--
-- @since 0.5.8
drop :: Int -> Set a -> Set a
drop :: forall a. Int -> Set a -> Set a
drop Int
i Set a
m | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Set a -> Int
forall a. Set a -> Int
size Set a
m = Set a
forall a. Set a
Tip
drop Int
i0 Set a
m0 = Int -> Set a -> Set a
forall a. Int -> Set a -> Set a
go Int
i0 Set a
m0
  where
    go :: Int -> Set a -> Set a
go Int
i Set a
m | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Set a
m
    go !Int
_ Set a
Tip = Set a
forall a. Set a
Tip
    go Int
i (Bin Int
_ a
x Set a
l Set a
r) =
      case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
        Ordering
LT -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x (Int -> Set a -> Set a
go Int
i Set a
l) Set a
r
        Ordering
GT -> Int -> Set a -> Set a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sizeL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Set a
r
        Ordering
EQ -> a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMin a
x Set a
r
      where sizeL :: Int
sizeL = Set a -> Int
forall a. Set a -> Int
size Set a
l

-- | \(O(\log n)\). Split a set at a particular index.
--
-- @
-- splitAt !n !xs = ('take' n xs, 'drop' n xs)
-- @
splitAt :: Int -> Set a -> (Set a, Set a)
splitAt :: forall a. Int -> Set a -> (Set a, Set a)
splitAt Int
i0 Set a
m0
  | Int
i0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Set a -> Int
forall a. Set a -> Int
size Set a
m0 = (Set a
m0, Set a
forall a. Set a
Tip)
  | Bool
otherwise = StrictPair (Set a) (Set a) -> (Set a, Set a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (Set a) (Set a) -> (Set a, Set a))
-> StrictPair (Set a) (Set a) -> (Set a, Set a)
forall a b. (a -> b) -> a -> b
$ Int -> Set a -> StrictPair (Set a) (Set a)
forall {a}. Int -> Set a -> StrictPair (Set a) (Set a)
go Int
i0 Set a
m0
  where
    go :: Int -> Set a -> StrictPair (Set a) (Set a)
go Int
i Set a
m | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Set a
forall a. Set a
Tip Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
m
    go !Int
_ Set a
Tip = Set a
forall a. Set a
Tip Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
forall a. Set a
Tip
    go Int
i (Bin Int
_ a
x Set a
l Set a
r)
      = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
          Ordering
LT -> case Int -> Set a -> StrictPair (Set a) (Set a)
go Int
i Set a
l of
                  Set a
ll :*: Set a
lr -> Set a
ll Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
lr Set a
r
          Ordering
GT -> case Int -> Set a -> StrictPair (Set a) (Set a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sizeL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Set a
r of
                  Set a
rl :*: Set a
rr -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
rl Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
rr
          Ordering
EQ -> Set a
l Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMin a
x Set a
r
      where sizeL :: Int
sizeL = Set a -> Int
forall a. Set a -> Int
size Set a
l

-- | \(O(\log n)\). Take while a predicate on the elements holds.
-- The user is responsible for ensuring that for all elements @j@ and @k@ in the set,
-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'.
--
-- @
-- takeWhileAntitone p = 'fromDistinctAscList' . 'Data.List.takeWhile' p . 'toList'
-- takeWhileAntitone p = 'filter' p
-- @
--
-- @since 0.5.8

takeWhileAntitone :: (a -> Bool) -> Set a -> Set a
takeWhileAntitone :: forall a. (a -> Bool) -> Set a -> Set a
takeWhileAntitone a -> Bool
_ Set a
Tip = Set a
forall a. Set a
Tip
takeWhileAntitone a -> Bool
p (Bin Int
_ a
x Set a
l Set a
r)
  | a -> Bool
p a
x = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l ((a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
takeWhileAntitone a -> Bool
p Set a
r)
  | Bool
otherwise = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
takeWhileAntitone a -> Bool
p Set a
l

-- | \(O(\log n)\). Drop while a predicate on the elements holds.
-- The user is responsible for ensuring that for all elements @j@ and @k@ in the set,
-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'.
--
-- @
-- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' p . 'toList'
-- dropWhileAntitone p = 'filter' (not . p)
-- @
--
-- @since 0.5.8

dropWhileAntitone :: (a -> Bool) -> Set a -> Set a
dropWhileAntitone :: forall a. (a -> Bool) -> Set a -> Set a
dropWhileAntitone a -> Bool
_ Set a
Tip = Set a
forall a. Set a
Tip
dropWhileAntitone a -> Bool
p (Bin Int
_ a
x Set a
l Set a
r)
  | a -> Bool
p a
x = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
dropWhileAntitone a -> Bool
p Set a
r
  | Bool
otherwise = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x ((a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
dropWhileAntitone a -> Bool
p Set a
l) Set a
r

-- | \(O(\log n)\). Divide a set at the point where a predicate on the elements stops holding.
-- The user is responsible for ensuring that for all elements @j@ and @k@ in the set,
-- @j \< k ==\> p j \>= p k@.
--
-- @
-- spanAntitone p xs = ('takeWhileAntitone' p xs, 'dropWhileAntitone' p xs)
-- spanAntitone p xs = partition p xs
-- @
--
-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the set
-- at some /unspecified/ point where the predicate switches from holding to not
-- holding (where the predicate is seen to hold before the first element and to fail
-- after the last element).
--
-- @since 0.5.8

spanAntitone :: (a -> Bool) -> Set a -> (Set a, Set a)
spanAntitone :: forall a. (a -> Bool) -> Set a -> (Set a, Set a)
spanAntitone a -> Bool
p0 Set a
m = StrictPair (Set a) (Set a) -> (Set a, Set a)
forall a b. StrictPair a b -> (a, b)
toPair ((a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
forall {a}. (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
p0 Set a
m)
  where
    go :: (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
_ Set a
Tip = Set a
forall a. Set a
Tip Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
forall a. Set a
Tip
    go a -> Bool
p (Bin Int
_ a
x Set a
l Set a
r)
      | a -> Bool
p a
x = let Set a
u :*: Set a
v = (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
p Set a
r in a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
u Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
v
      | Bool
otherwise = let Set a
u :*: Set a
v = (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
p Set a
l in Set a
u Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
v Set a
r

{--------------------------------------------------------------------
  SetBuilder
--------------------------------------------------------------------}

-- Note [SetBuilder]
-- ~~~~~~~~~~~~~~~~~
-- SetBuilder serves as an accumulator for element-by-element construction of
-- a Set. It can be used in folds to construct sets. This plays nicely with list
-- fusion if the structure folded over is a list, as in fromList and friends.
--
-- As long as the elements are in non-decreasing order, insertB accumulates them
-- in a Stack, just as fromDistinctAscList does. On encountering an element out
-- of order, it builds a Set from the Stack and switches to using insert for all
-- future elements. This gives us construction in O(n) if the elements are
-- already sorted. If not, the worst case remains O(n log n).
--
-- More complicated implementations are possible, such as repeatedly
-- accumulating runs of increasing elements in Stacks (not just once) and
-- union-ing with an accumulated Set, but this makes the worst case somewhat
-- slower (~10%).

data SetBuilder a
  = BAsc !(Stack a)
  | BSet !(Set a)

-- Empty builder.
emptyB :: SetBuilder a
emptyB :: forall a. SetBuilder a
emptyB = Stack a -> SetBuilder a
forall a. Stack a -> SetBuilder a
BAsc Stack a
forall a. Stack a
Nada

-- Insert an element. Replaces the old element if an equal element already
-- exists.
insertB :: Ord a => a -> SetBuilder a -> SetBuilder a
insertB :: forall a. Ord a => a -> SetBuilder a -> SetBuilder a
insertB !a
y SetBuilder a
b = case SetBuilder a
b of
  BAsc Stack a
stk -> case Stack a
stk of
    Push a
x Set a
l Stack a
stk' -> case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
y a
x of
      Ordering
LT -> Set a -> SetBuilder a
forall a. Set a -> SetBuilder a
BSet (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
insert a
y (Stack a -> Set a
forall a. Stack a -> Set a
ascLinkAll Stack a
stk))
      Ordering
EQ -> Stack a -> SetBuilder a
forall a. Stack a -> SetBuilder a
BAsc (a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
l Stack a
stk')
      Ordering
GT -> case Set a
l of
        Set a
Tip -> Stack a -> SetBuilder a
forall a. Stack a -> SetBuilder a
BAsc (Stack a -> Int -> Set a -> a -> Stack a
forall a. Stack a -> Int -> Set a -> a -> Stack a
ascLinkTop Stack a
stk' Int
1 (a -> Set a
forall a. a -> Set a
singleton a
x) a
y)
        Bin{} -> Stack a -> SetBuilder a
forall a. Stack a -> SetBuilder a
BAsc (a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
forall a. Set a
Tip Stack a
stk)
    Stack a
Nada -> Stack a -> SetBuilder a
forall a. Stack a -> SetBuilder a
BAsc (a -> Set a -> Stack a -> Stack a
forall a. a -> Set a -> Stack a -> Stack a
Push a
y Set a
forall a. Set a
Tip Stack a
forall a. Stack a
Nada)
  BSet Set a
m -> Set a -> SetBuilder a
forall a. Set a -> SetBuilder a
BSet (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
insert a
y Set a
m)
{-# INLINE insertB #-}

-- Finalize the builder into a Set.
finishB :: SetBuilder a -> Set a
finishB :: forall a. SetBuilder a -> Set a
finishB (BAsc Stack a
stk) = Stack a -> Set a
forall a. Stack a -> Set a
ascLinkAll Stack a
stk
finishB (BSet Set a
s) = Set a
s
{-# INLINABLE finishB #-}

{--------------------------------------------------------------------
  Utility functions that maintain the balance properties of the tree.
  All constructors assume that all values in [l] < [x] and all values
  in [r] > [x], and that [l] and [r] are valid trees.

  In order of sophistication:
    [Bin sz x l r]    The type constructor.
    [bin x l r]       Maintains the correct size, assumes that both [l]
                      and [r] are balanced with respect to each other.
    [balance x l r]   Restores the balance and size.
                      Assumes that the original tree was balanced and
                      that [l] or [r] has changed by at most one element.
    [link x l r]      Restores balance and size.

  Furthermore, we can construct a new tree from two trees. Both operations
  assume that all values in [l] < all values in [r] and that [l] and [r]
  are valid:
    [glue l r]        Glues [l] and [r] together. Assumes that [l] and
                      [r] are already balanced with respect to each other.
    [merge l r]       Merges two trees and restores balance.
--------------------------------------------------------------------}

{--------------------------------------------------------------------
  Link
--------------------------------------------------------------------}
link :: a -> Set a -> Set a -> Set a
link :: forall a. a -> Set a -> Set a -> Set a
link a
x Set a
Tip Set a
r  = a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMin a
x Set a
r
link a
x Set a
l Set a
Tip  = a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMax a
x Set a
l
link a
x l :: Set a
l@(Bin Int
sizeL a
y Set a
ly Set a
ry) r :: Set a
r@(Bin Int
sizeR a
z Set a
lz Set a
rz)
  | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sizeL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeR  = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
z (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
lz) Set a
rz
  | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sizeR Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeL  = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
ly (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
ry Set a
r)
  | Bool
otherwise            = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
bin a
x Set a
l Set a
r


-- insertMin and insertMax don't perform potentially expensive comparisons.
insertMax,insertMin :: a -> Set a -> Set a
insertMax :: forall a. a -> Set a -> Set a
insertMax a
x Set a
t
  = case Set a
t of
      Set a
Tip -> a -> Set a
forall a. a -> Set a
singleton a
x
      Bin Int
_ a
y Set a
l Set a
r
          -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l (a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMax a
x Set a
r)

insertMin :: forall a. a -> Set a -> Set a
insertMin a
x Set a
t
  = case Set a
t of
      Set a
Tip -> a -> Set a
forall a. a -> Set a
singleton a
x
      Bin Int
_ a
y Set a
l Set a
r
          -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y (a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMin a
x Set a
l) Set a
r

{--------------------------------------------------------------------
  [merge l r]: merges two trees.
--------------------------------------------------------------------}
merge :: Set a -> Set a -> Set a
merge :: forall a. Set a -> Set a -> Set a
merge Set a
Tip Set a
r   = Set a
r
merge Set a
l Set a
Tip   = Set a
l
merge l :: Set a
l@(Bin Int
sizeL a
x Set a
lx Set a
rx) r :: Set a
r@(Bin Int
sizeR a
y Set a
ly Set a
ry)
  | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sizeL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeR = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y (Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
l Set a
ly) Set a
ry
  | Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sizeR Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sizeL = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
x Set a
lx (Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
rx Set a
r)
  | Bool
otherwise           = Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r

{--------------------------------------------------------------------
  [glue l r]: glues two trees together.
  Assumes that [l] and [r] are already balanced with respect to each other.
--------------------------------------------------------------------}
glue :: Set a -> Set a -> Set a
glue :: forall a. Set a -> Set a -> Set a
glue Set a
Tip Set a
r = Set a
r
glue Set a
l Set a
Tip = Set a
l
glue l :: Set a
l@(Bin Int
sl a
xl Set a
ll Set a
lr) r :: Set a
r@(Bin Int
sr a
xr Set a
rl Set a
rr)
  | Int
sl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sr = let !(a
m :*: Set a
l') = a -> Set a -> Set a -> StrictPair a (Set a)
forall a. a -> Set a -> Set a -> StrictPair a (Set a)
maxViewSure a
xl Set a
ll Set a
lr in Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
slInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sr) a
m Set a
l' Set a
r
  | Bool
otherwise = let !(a
m :*: Set a
r') = a -> Set a -> Set a -> StrictPair a (Set a)
forall a. a -> Set a -> Set a -> StrictPair a (Set a)
minViewSure a
xr Set a
rl Set a
rr in Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
slInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sr) a
m Set a
l Set a
r'

-- | \(O(\log n)\). Delete and find the minimal element.
--
-- > deleteFindMin set = (findMin set, deleteMin set)

deleteFindMin :: Set a -> (a,Set a)
deleteFindMin :: forall a. Set a -> (a, Set a)
deleteFindMin Set a
t
  | Just (a, Set a)
r <- Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
minView Set a
t = (a, Set a)
r
  | Bool
otherwise = ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Set.deleteFindMin: can not return the minimal element of an empty set", Set a
forall a. Set a
Tip)

-- | \(O(\log n)\). Delete and find the maximal element.
--
-- > deleteFindMax set = (findMax set, deleteMax set)
deleteFindMax :: Set a -> (a,Set a)
deleteFindMax :: forall a. Set a -> (a, Set a)
deleteFindMax Set a
t
  | Just (a, Set a)
r <- Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
maxView Set a
t = (a, Set a)
r
  | Bool
otherwise = ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Set.deleteFindMax: can not return the maximal element of an empty set", Set a
forall a. Set a
Tip)

minViewSure :: a -> Set a -> Set a -> StrictPair a (Set a)
minViewSure :: forall a. a -> Set a -> Set a -> StrictPair a (Set a)
minViewSure = a -> Set a -> Set a -> StrictPair a (Set a)
forall a. a -> Set a -> Set a -> StrictPair a (Set a)
go
  where
    go :: t -> Set t -> Set t -> StrictPair t (Set t)
go t
x Set t
Tip Set t
r = t
x t -> Set t -> StrictPair t (Set t)
forall a b. a -> b -> StrictPair a b
:*: Set t
r
    go t
x (Bin Int
_ t
xl Set t
ll Set t
lr) Set t
r =
      case t -> Set t -> Set t -> StrictPair t (Set t)
go t
xl Set t
ll Set t
lr of
        t
xm :*: Set t
l' -> t
xm t -> Set t -> StrictPair t (Set t)
forall a b. a -> b -> StrictPair a b
:*: t -> Set t -> Set t -> Set t
forall a. a -> Set a -> Set a -> Set a
balanceR t
x Set t
l' Set t
r

-- | \(O(\log n)\). Retrieves the minimal key of the set, and the set
-- stripped of that element, or 'Nothing' if passed an empty set.
minView :: Set a -> Maybe (a, Set a)
minView :: forall a. Set a -> Maybe (a, Set a)
minView Set a
Tip = Maybe (a, Set a)
forall a. Maybe a
Nothing
minView (Bin Int
_ a
x Set a
l Set a
r) = (a, Set a) -> Maybe (a, Set a)
forall a. a -> Maybe a
Just ((a, Set a) -> Maybe (a, Set a)) -> (a, Set a) -> Maybe (a, Set a)
forall a b. (a -> b) -> a -> b
$! StrictPair a (Set a) -> (a, Set a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair a (Set a) -> (a, Set a))
-> StrictPair a (Set a) -> (a, Set a)
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a -> StrictPair a (Set a)
forall a. a -> Set a -> Set a -> StrictPair a (Set a)
minViewSure a
x Set a
l Set a
r

maxViewSure :: a -> Set a -> Set a -> StrictPair a (Set a)
maxViewSure :: forall a. a -> Set a -> Set a -> StrictPair a (Set a)
maxViewSure = a -> Set a -> Set a -> StrictPair a (Set a)
forall a. a -> Set a -> Set a -> StrictPair a (Set a)
go
  where
    go :: t -> Set t -> Set t -> StrictPair t (Set t)
go t
x Set t
l Set t
Tip = t
x t -> Set t -> StrictPair t (Set t)
forall a b. a -> b -> StrictPair a b
:*: Set t
l
    go t
x Set t
l (Bin Int
_ t
xr Set t
rl Set t
rr) =
      case t -> Set t -> Set t -> StrictPair t (Set t)
go t
xr Set t
rl Set t
rr of
        t
xm :*: Set t
r' -> t
xm t -> Set t -> StrictPair t (Set t)
forall a b. a -> b -> StrictPair a b
:*: t -> Set t -> Set t -> Set t
forall a. a -> Set a -> Set a -> Set a
balanceL t
x Set t
l Set t
r'

-- | \(O(\log n)\). Retrieves the maximal key of the set, and the set
-- stripped of that element, or 'Nothing' if passed an empty set.
maxView :: Set a -> Maybe (a, Set a)
maxView :: forall a. Set a -> Maybe (a, Set a)
maxView Set a
Tip = Maybe (a, Set a)
forall a. Maybe a
Nothing
maxView (Bin Int
_ a
x Set a
l Set a
r) = (a, Set a) -> Maybe (a, Set a)
forall a. a -> Maybe a
Just ((a, Set a) -> Maybe (a, Set a)) -> (a, Set a) -> Maybe (a, Set a)
forall a b. (a -> b) -> a -> b
$! StrictPair a (Set a) -> (a, Set a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair a (Set a) -> (a, Set a))
-> StrictPair a (Set a) -> (a, Set a)
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a -> StrictPair a (Set a)
forall a. a -> Set a -> Set a -> StrictPair a (Set a)
maxViewSure a
x Set a
l Set a
r

{--------------------------------------------------------------------
  [balance x l r] balances two trees with value x.
  The sizes of the trees should balance after decreasing the
  size of one of them. (a rotation).

  [delta] is the maximal relative difference between the sizes of
          two trees, it corresponds with the [w] in Adams' paper.
  [ratio] is the ratio between an outer and inner sibling of the
          heavier subtree in an unbalanced setting. It determines
          whether a double or single rotation should be performed
          to restore balance. It is corresponds with the inverse
          of $\alpha$ in Adam's article.

  Note that according to the Adam's paper:
  - [delta] should be larger than 4.646 with a [ratio] of 2.
  - [delta] should be larger than 3.745 with a [ratio] of 1.534.

  But the Adam's paper is erroneous:
  - it can be proved that for delta=2 and delta>=5 there does
    not exist any ratio that would work
  - delta=4.5 and ratio=2 does not work

  That leaves two reasonable variants, delta=3 and delta=4,
  both with ratio=2.

  - A lower [delta] leads to a more 'perfectly' balanced tree.
  - A higher [delta] performs less rebalancing.

  In the benchmarks, delta=3 is faster on insert operations,
  and delta=4 has slightly better deletes. As the insert speedup
  is larger, we currently use delta=3.

--------------------------------------------------------------------}
delta,ratio :: Int
delta :: Int
delta = Int
3
ratio :: Int
ratio = Int
2

-- The balance function is equivalent to the following:
--
--   balance :: a -> Set a -> Set a -> Set a
--   balance x l r
--     | sizeL + sizeR <= 1   = Bin sizeX x l r
--     | sizeR > delta*sizeL  = rotateL x l r
--     | sizeL > delta*sizeR  = rotateR x l r
--     | otherwise            = Bin sizeX x l r
--     where
--       sizeL = size l
--       sizeR = size r
--       sizeX = sizeL + sizeR + 1
--
--   rotateL :: a -> Set a -> Set a -> Set a
--   rotateL x l r@(Bin _ _ ly ry) | size ly < ratio*size ry = singleL x l r
--                                 | otherwise               = doubleL x l r
--   rotateR :: a -> Set a -> Set a -> Set a
--   rotateR x l@(Bin _ _ ly ry) r | size ry < ratio*size ly = singleR x l r
--                                 | otherwise               = doubleR x l r
--
--   singleL, singleR :: a -> Set a -> Set a -> Set a
--   singleL x1 t1 (Bin _ x2 t2 t3)  = bin x2 (bin x1 t1 t2) t3
--   singleR x1 (Bin _ x2 t1 t2) t3  = bin x2 t1 (bin x1 t2 t3)
--
--   doubleL, doubleR :: a -> Set a -> Set a -> Set a
--   doubleL x1 t1 (Bin _ x2 (Bin _ x3 t2 t3) t4) = bin x3 (bin x1 t1 t2) (bin x2 t3 t4)
--   doubleR x1 (Bin _ x2 t1 (Bin _ x3 t2 t3)) t4 = bin x3 (bin x2 t1 t2) (bin x1 t3 t4)
--
-- It is only written in such a way that every node is pattern-matched only once.
--
-- Only balanceL and balanceR are needed at the moment, so balance is not here anymore.
-- In case it is needed, it can be found in Data.Map.

-- Functions balanceL and balanceR are specialised versions of balance.
-- balanceL only checks whether the left subtree is too big,
-- balanceR only checks whether the right subtree is too big.

-- Note [Inlining balance]
-- ~~~~~~~~~~~~~~~~~~~~~~~
-- Benchmarks show that we benefit from inlining balanceL and balanceR, but
-- we don't want to cause code bloat from inlining these large functions.
-- As a compromise, we inline only one case: that of two Bins already balanced
-- with respect to each other.
--
-- This is the most common case for typical scenarios. For instance, for n
-- inserts there may be O(n log n) calls to balanceL/balanceR but at most O(n)
-- of them actually require rebalancing. So, inlining this common case provides
-- most of the potential benefits of inlining the full function.

-- balanceL is called when left subtree might have been inserted to or when
-- right subtree might have been deleted from.
balanceL :: a -> Set a -> Set a -> Set a
balanceL :: forall a. a -> Set a -> Set a -> Set a
balanceL a
x Set a
l Set a
r = case (Set a
l, Set a
r) of
  (Bin Int
ls a
_ Set a
_ Set a
_, Bin Int
rs a
_ Set a
_ Set a
_)
    | Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rs -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
x Set a
l Set a
r
  (Set a, Set a)
_ -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL_ a
x Set a
l Set a
r
{-# INLINE balanceL #-} -- See Note [Inlining balance]

balanceL_ :: a -> Set a -> Set a -> Set a
balanceL_ :: forall a. a -> Set a -> Set a -> Set a
balanceL_ a
x Set a
l Set a
r = case Set a
r of
  Set a
Tip -> case Set a
l of
           Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
           (Bin Int
_ a
_ Set a
Tip Set a
Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
2 a
x Set a
l Set a
forall a. Set a
Tip
           (Bin Int
_ a
lx Set a
Tip (Bin Int
_ a
lrx Set a
_ Set a
_)) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
lrx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
lx Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
           (Bin Int
_ a
lx ll :: Set a
ll@(Bin Int
_ a
_ Set a
_ Set a
_) Set a
Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
lx Set a
ll (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
           (Bin Int
ls a
lx ll :: Set a
ll@(Bin Int
lls a
_ Set a
_ Set a
_) lr :: Set a
lr@(Bin Int
lrs a
lrx Set a
lrl Set a
lrr))
             | Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lls -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) a
lx Set a
ll (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lrs) a
x Set a
lr Set a
forall a. Set a
Tip)
             | Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) a
lrx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
llsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
lrl) a
lx Set a
ll Set a
lrl) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
lrr) a
x Set a
lrr Set a
forall a. Set a
Tip)

  (Bin Int
rs a
_ Set a
_ Set a
_) -> case Set a
l of
           Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
x Set a
forall a. Set a
Tip Set a
r

           (Bin Int
ls a
lx Set a
ll Set a
lr) -> case (Set a
ll, Set a
lr) of
                   (Bin Int
lls a
_ Set a
_ Set a
_, Bin Int
lrs a
lrx Set a
lrl Set a
lrr)
                     | Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lls -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
lx Set a
ll (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lrs) a
x Set a
lr Set a
r)
                     | Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
lrx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
llsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
lrl) a
lx Set a
ll Set a
lrl) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
lrr) a
x Set a
lrr Set a
r)
                   (Set a
_, Set a
_) -> [Char] -> Set a
forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Set.balanceL_"
{-# NOINLINE balanceL_ #-}

-- balanceR is called when right subtree might have been inserted to or when
-- left subtree might have been deleted from.
balanceR :: a -> Set a -> Set a -> Set a
balanceR :: forall a. a -> Set a -> Set a -> Set a
balanceR a
x Set a
l Set a
r = case (Set a
l, Set a
r) of
  (Bin Int
ls a
_ Set a
_ Set a
_, Bin Int
rs a
_ Set a
_ Set a
_)
    | Int
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ls -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
x Set a
l Set a
r
  (Set a, Set a)
_ -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR_ a
x Set a
l Set a
r
{-# INLINE balanceR #-} -- See Note [Inlining balance]

balanceR_ :: a -> Set a -> Set a -> Set a
balanceR_ :: forall a. a -> Set a -> Set a -> Set a
balanceR_ a
x Set a
l Set a
r = case Set a
l of
  Set a
Tip -> case Set a
r of
           Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
           (Bin Int
_ a
_ Set a
Tip Set a
Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
2 a
x Set a
forall a. Set a
Tip Set a
r
           (Bin Int
_ a
rx Set a
Tip rr :: Set a
rr@(Bin Int
_ a
_ Set a
_ Set a
_)) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
rx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) Set a
rr
           (Bin Int
_ a
rx (Bin Int
_ a
rlx Set a
_ Set a
_) Set a
Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
rlx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
rx Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
           (Bin Int
rs a
rx rl :: Set a
rl@(Bin Int
rls a
rlx Set a
rll Set a
rlr) rr :: Set a
rr@(Bin Int
rrs a
_ Set a
_ Set a
_))
             | Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rrs -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
rx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rls) a
x Set a
forall a. Set a
Tip Set a
rl) Set a
rr
             | Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
rlx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
rll) a
x Set a
forall a. Set a
Tip Set a
rll) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rrsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
rlr) a
rx Set a
rlr Set a
rr)

  (Bin Int
ls a
_ Set a
_ Set a
_) -> case Set a
r of
           Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) a
x Set a
l Set a
forall a. Set a
Tip

           (Bin Int
rs a
rx Set a
rl Set a
rr) -> case (Set a
rl, Set a
rr) of
                   (Bin Int
rls a
rlx Set a
rll Set a
rlr, Bin Int
rrs a
_ Set a
_ Set a
_)
                     | Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rrs -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
rx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rls) a
x Set a
l Set a
rl) Set a
rr
                     | Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
rlx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
rll) a
x Set a
l Set a
rll) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rrsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
rlr) a
rx Set a
rlr Set a
rr)
                   (Set a
_, Set a
_) -> [Char] -> Set a
forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Set.balanceR_"
{-# NOINLINE balanceR_ #-}

{--------------------------------------------------------------------
  The bin constructor maintains the size of the tree
--------------------------------------------------------------------}
bin :: a -> Set a -> Set a -> Set a
bin :: forall a. a -> Set a -> Set a -> Set a
bin a
x Set a
l Set a
r
  = Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Set a -> Int
forall a. Set a -> Int
size Set a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
size Set a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x Set a
l Set a
r
{-# INLINE bin #-}


{--------------------------------------------------------------------
  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 subset less than all
-- elements in the second, and so on).
--
-- Examples:
--
-- > splitRoot (fromList [1..6]) ==
-- >   [fromList [1,2,3],fromList [4],fromList [5,6]]
--
-- > splitRoot empty == []
--
--  Note that the current implementation does not return more than three subsets,
--  but you should not depend on this behaviour because it can change in the
--  future without notice.
--
-- @since 0.5.4
splitRoot :: Set a -> [Set a]
splitRoot :: forall a. Set a -> [Set a]
splitRoot Set a
orig =
  case Set a
orig of
    Set a
Tip           -> []
    Bin Int
_ a
v Set a
l Set a
r -> [Set a
l, a -> Set a
forall a. a -> Set a
singleton a
v, Set a
r]
{-# INLINE splitRoot #-}


-- | \(O(2^n \log n)\). Calculate the power set of a set: the set of all its subsets.
--
-- @
-- t ``member`` powerSet s == t ``isSubsetOf`` s
-- @
--
-- Example:
--
-- @
-- powerSet (fromList [1,2,3]) =
--   fromList $ map fromList [[],[1],[1,2],[1,2,3],[1,3],[2],[2,3],[3]]
-- @
--
-- @since 0.5.11

-- Proof of complexity: step executes n times. At the ith step,
-- "insertMin x `mapMonotonic` pxs" takes O(2^i log i) time since pxs has size
-- 2^i - 1 and we insertMin into its elements which are sets of size <= i.
-- "insertMin (singleton x)" and "`glue` pxs" are cheaper operations that both
-- take O(i) time. Over n steps, we have a total cost of
--
--   O(\sum_{i=1}^{n-1} 2^i log i)
-- = O(log n * \sum_{i=1}^{n-1} 2^i)
-- = O(2^n log n)

powerSet :: Set a -> Set (Set a)
powerSet :: forall a. Set a -> Set (Set a)
powerSet Set a
xs0 = Set a -> Set (Set a) -> Set (Set a)
forall a. a -> Set a -> Set a
insertMin Set a
forall a. Set a
empty ((a -> Set (Set a) -> Set (Set a))
-> Set (Set a) -> Set a -> Set (Set a)
forall a b. (a -> b -> b) -> b -> Set a -> b
foldr' a -> Set (Set a) -> Set (Set a)
forall {a}. a -> Set (Set a) -> Set (Set a)
step Set (Set a)
forall a. Set a
Tip Set a
xs0) where
  step :: a -> Set (Set a) -> Set (Set a)
step a
x Set (Set a)
pxs = Set a -> Set (Set a) -> Set (Set a)
forall a. a -> Set a -> Set a
insertMin (a -> Set a
forall a. a -> Set a
singleton a
x) (a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMin a
x (Set a -> Set a) -> Set (Set a) -> Set (Set a)
forall a b. (a -> b) -> Set a -> Set b
`mapMonotonic` Set (Set a)
pxs) Set (Set a) -> Set (Set a) -> Set (Set a)
forall a. Set a -> Set a -> Set a
`glue` Set (Set a)
pxs

-- | \(O(nm)\). Calculate the Cartesian product of two sets.
--
-- @
-- cartesianProduct xs ys = fromList $ liftA2 (,) (toList xs) (toList ys)
-- @
--
-- Example:
--
-- @
-- cartesianProduct (fromList [1,2]) (fromList [\'a\',\'b\']) =
--   fromList [(1,\'a\'), (1,\'b\'), (2,\'a\'), (2,\'b\')]
-- @
--
-- @since 0.5.11
cartesianProduct :: Set a -> Set b -> Set (a, b)
-- The obvious big-O optimal (O(nm)) implementation would be
--
--   cartesianProduct _as Tip = Tip
--   cartesianProduct as bs = fromDistinctAscList
--     [(a,b) | a <- toList as, b <- toList bs]
--
-- Unfortunately, this is much slower in practice, at least when the sets are
-- constructed from ascending lists. I tried doing the same thing using a
-- known-length (perfect balancing) variant of fromDistinctAscList, but it
-- still didn't come close to the performance of the implementation we use in my
-- very informal tests.
--
-- The implementation we use (slightly modified from one that Edward Kmett
-- hacked together) is also optimal but performs better in practice. We map
-- each element a in as to a set made up of (a,b) for every element b in bs,
-- taking O(nm) overall. Then we merge these sets up the tree of as, which takes
-- O(n log m). A brief sketch of proof for the latter:
--
-- Consider all nodes in the tree at the same distance from the root to be at
-- the same "level". The nodes farthest from the root are at level 0, with
-- levels increasing by 1 towards the root. Being a balanced tree, there are
-- O(n/2^i) nodes at level i. At every node at level i, we merge the merged left
-- set, current set, and merged right set into a set of size O(2^i*m) in
-- O(log (2^i*m)) = O(i + log m) time. Over all levels, we do a total work of
--
--   O(\sum_{i=0}^{root_level} n * (i + log m) / 2^i)
-- = O(  \sum_{i=0}^{root_level} n * i / 2^i
--     + \sum_{i=0}^{root_level} n * log m / 2^i)
-- = O(  n * \sum_{i=0}^{root_level} i/2^i
--     + n * log m * \sum_{i=0}^{root_level} 1/2^i)
-- = O(  n * \sum_{i=0}^{inf} i/2^i
--     + n * log m * \sum_{i=0}^{inf} 1/2^i)
--
-- The sum terms converge, and we get O(n log m).

-- When the second argument has at most one element, we can be a little
-- clever.
cartesianProduct :: forall a b. Set a -> Set b -> Set (a, b)
cartesianProduct !Set a
_as Set b
Tip = Set (a, b)
forall a. Set a
Tip
cartesianProduct Set a
as (Bin Int
1 b
b Set b
_ Set b
_) = (a -> (a, b)) -> Set a -> Set (a, b)
forall a b. (a -> b) -> Set a -> Set b
mapMonotonic ((a -> b -> (a, b)) -> b -> a -> (a, b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
b) Set a
as
cartesianProduct Set a
as Set b
bs =
  MergeSet (a, b) -> Set (a, b)
forall a. MergeSet a -> Set a
getMergeSet (MergeSet (a, b) -> Set (a, b)) -> MergeSet (a, b) -> Set (a, b)
forall a b. (a -> b) -> a -> b
$ (a -> MergeSet (a, b)) -> Set a -> MergeSet (a, b)
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\a
a -> Set (a, b) -> MergeSet (a, b)
forall a. Set a -> MergeSet a
MergeSet (Set (a, b) -> MergeSet (a, b)) -> Set (a, b) -> MergeSet (a, b)
forall a b. (a -> b) -> a -> b
$ (b -> (a, b)) -> Set b -> Set (a, b)
forall a b. (a -> b) -> Set a -> Set b
mapMonotonic ((,) a
a) Set b
bs) Set a
as

-- A version of Set with peculiar Semigroup and Monoid instances.
-- The result of xs <> ys will only be a valid set if the greatest
-- element of xs is strictly less than the least element of ys.
-- This is used to define cartesianProduct.
newtype MergeSet a = MergeSet { forall a. MergeSet a -> Set a
getMergeSet :: Set a }

instance Semigroup (MergeSet a) where
  MergeSet Set a
xs <> :: MergeSet a -> MergeSet a -> MergeSet a
<> MergeSet Set a
ys = Set a -> MergeSet a
forall a. Set a -> MergeSet a
MergeSet (Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
xs Set a
ys)

instance Monoid (MergeSet a) where
  mempty :: MergeSet a
mempty = Set a -> MergeSet a
forall a. Set a -> MergeSet a
MergeSet Set a
forall a. Set a
empty

  mappend :: MergeSet a -> MergeSet a -> MergeSet a
mappend = MergeSet a -> MergeSet a -> MergeSet a
forall a. Semigroup a => a -> a -> a
(<>)

-- | \(O(n+m)\). Calculate the disjoint union of two sets.
--
-- @ disjointUnion xs ys = map Left xs ``union`` map Right ys @
--
-- Example:
--
-- @
-- disjointUnion (fromList [1,2]) (fromList ["hi", "bye"]) =
--   fromList [Left 1, Left 2, Right "hi", Right "bye"]
-- @
--
-- @since 0.5.11
disjointUnion :: Set a -> Set b -> Set (Either a b)
disjointUnion :: forall a b. Set a -> Set b -> Set (Either a b)
disjointUnion Set a
as Set b
bs = Set (Either a b) -> Set (Either a b) -> Set (Either a b)
forall a. Set a -> Set a -> Set a
merge ((a -> Either a b) -> Set a -> Set (Either a b)
forall a b. (a -> b) -> Set a -> Set b
mapMonotonic a -> Either a b
forall a b. a -> Either a b
Left Set a
as) ((b -> Either a b) -> Set b -> Set (Either a b)
forall a b. (a -> b) -> Set a -> Set b
mapMonotonic b -> Either a b
forall a b. b -> Either a b
Right Set b
bs)

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


{- | \(O(n \log 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.

> Set> putStrLn $ showTreeWith True False $ fromDistinctAscList [1..5]
> 4
> +--2
> |  +--1
> |  +--3
> +--5
>
> Set> putStrLn $ showTreeWith True True $ fromDistinctAscList [1..5]
> 4
> |
> +--2
> |  |
> |  +--1
> |  |
> |  +--3
> |
> +--5
>
> Set> putStrLn $ showTreeWith False True $ fromDistinctAscList [1..5]
> +--5
> |
> 4
> |
> |  +--3
> |  |
> +--2
>    |
>    +--1

-}
showTreeWith :: Show a => Bool -> Bool -> Set a -> String
showTreeWith :: forall a. Show a => Bool -> Bool -> Set a -> [Char]
showTreeWith Bool
hang Bool
wide Set a
t
  | Bool
hang      = (Bool -> [[Char]] -> Set a -> ShowS
forall a. Show a => Bool -> [[Char]] -> Set a -> ShowS
showsTreeHang Bool
wide [] Set a
t) [Char]
""
  | Bool
otherwise = (Bool -> [[Char]] -> [[Char]] -> Set a -> ShowS
forall a. Show a => Bool -> [[Char]] -> [[Char]] -> Set a -> ShowS
showsTree Bool
wide [] [] Set a
t) [Char]
""

showsTree :: Show a => Bool -> [String] -> [String] -> Set a -> ShowS
showsTree :: forall a. Show a => Bool -> [[Char]] -> [[Char]] -> Set a -> ShowS
showsTree Bool
wide [[Char]]
lbars [[Char]]
rbars Set a
t
  = case Set a
t of
      Set a
Tip -> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"
      Bin Int
_ a
x Set a
Tip Set a
Tip
          -> [[Char]] -> ShowS
showsBars [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
      Bin Int
_ a
x Set a
l Set a
r
          -> Bool -> [[Char]] -> [[Char]] -> Set a -> ShowS
forall a. Show a => Bool -> [[Char]] -> [[Char]] -> Set a -> ShowS
showsTree Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
rbars) ([[Char]] -> [[Char]]
withEmpty [[Char]]
rbars) Set a
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
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
lbars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> [[Char]] -> Set a -> ShowS
forall a. Show a => Bool -> [[Char]] -> [[Char]] -> Set a -> ShowS
showsTree Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
lbars) ([[Char]] -> [[Char]]
withBar [[Char]]
lbars) Set a
l

showsTreeHang :: Show a => Bool -> [String] -> Set a -> ShowS
showsTreeHang :: forall a. Show a => Bool -> [[Char]] -> Set a -> ShowS
showsTreeHang Bool
wide [[Char]]
bars Set a
t
  = case Set a
t of
      Set a
Tip -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"
      Bin Int
_ a
x Set a
Tip Set a
Tip
          -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
      Bin Int
_ a
x Set a
l Set a
r
          -> [[Char]] -> ShowS
showsBars [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
bars ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             Bool -> [[Char]] -> Set a -> ShowS
forall a. Show a => Bool -> [[Char]] -> Set a -> ShowS
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
bars) Set a
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]] -> Set a -> ShowS
forall a. Show a => Bool -> [[Char]] -> Set a -> ShowS
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
bars) Set a
r

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

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

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

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

{--------------------------------------------------------------------
  Assertions
--------------------------------------------------------------------}
-- | \(O(n)\). Test if the internal set structure is valid.
valid :: Ord a => Set a -> Bool
valid :: forall a. Ord a => Set a -> Bool
valid Set a
t
  = Set a -> Bool
forall a. Set a -> Bool
balanced Set a
t Bool -> Bool -> Bool
&& Set a -> Bool
forall a. Ord a => Set a -> Bool
ordered Set a
t Bool -> Bool -> Bool
&& Set a -> Bool
forall a. Set a -> Bool
validsize Set a
t

ordered :: Ord a => Set a -> Bool
ordered :: forall a. Ord a => Set a -> Bool
ordered Set a
t
  = (a -> Bool) -> (a -> Bool) -> Set a -> Bool
forall {t}. Ord t => (t -> Bool) -> (t -> Bool) -> Set t -> Bool
bounded (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True) Set a
t
  where
    bounded :: (t -> Bool) -> (t -> Bool) -> Set t -> Bool
bounded t -> Bool
lo t -> Bool
hi Set t
t'
      = case Set t
t' of
          Set t
Tip         -> Bool
True
          Bin Int
_ t
x Set t
l Set t
r -> (t -> Bool
lo t
x) Bool -> Bool -> Bool
&& (t -> Bool
hi t
x) Bool -> Bool -> Bool
&& (t -> Bool) -> (t -> Bool) -> Set t -> Bool
bounded t -> Bool
lo (t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<t
x) Set t
l Bool -> Bool -> Bool
&& (t -> Bool) -> (t -> Bool) -> Set t -> Bool
bounded (t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>t
x) t -> Bool
hi Set t
r

balanced :: Set a -> Bool
balanced :: forall a. Set a -> Bool
balanced Set a
t
  = case Set a
t of
      Set a
Tip         -> Bool
True
      Bin Int
_ a
_ Set a
l Set a
r -> (Set a -> Int
forall a. Set a -> Int
size Set a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
size Set a
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
|| (Set a -> Int
forall a. Set a -> Int
size Set a
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Set a -> Int
forall a. Set a -> Int
size Set a
r Bool -> Bool -> Bool
&& Set a -> Int
forall a. Set a -> Int
size Set a
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Set a -> Int
forall a. Set a -> Int
size Set a
l)) Bool -> Bool -> Bool
&&
                     Set a -> Bool
forall a. Set a -> Bool
balanced Set a
l Bool -> Bool -> Bool
&& Set a -> Bool
forall a. Set a -> Bool
balanced Set a
r

validsize :: Set a -> Bool
validsize :: forall a. Set a -> Bool
validsize Set a
t
  = (Set a -> Maybe Int
forall {a}. Set a -> Maybe Int
realsize Set a
t Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just (Set a -> Int
forall a. Set a -> Int
size Set a
t))
  where
    realsize :: Set a -> Maybe Int
realsize Set a
t'
      = case Set a
t' of
          Set a
Tip          -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
          Bin Int
sz a
_ Set a
l Set a
r -> case (Set a -> Maybe Int
realsize Set a
l,Set a -> Maybe Int
realsize Set a
r) of
                            (Just Int
n,Just Int
m)  | Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz  -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
sz
                            (Maybe Int, Maybe Int)
_                -> Maybe Int
forall a. Maybe a
Nothing

--------------------------------------------------------------------

-- Note [fromDistinctAscList implementation]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- fromDistinctAscList is implemented by building up perfectly balanced trees
-- while we consume elements from the list one by one. A stack of
-- (root, perfectly balanced left branch) pairs is maintained, in increasing
-- order of size from top to bottom. The stack reflects the binary
-- representation of the total number of elements in it, with every level having
-- a power of 2 number of elements.
--
-- When we get an element from the list, we check the (root, left branch) at the
-- top of the stack.
-- If the tree there is not empty, we push the element with an empty left child
-- on the stack.
-- If the tree is empty, the root is packed into a singleton tree to act as a
-- right branch for trees higher up the stack. It is linked with left branches
-- in the stack, but only when they have equal size. This preserves the
-- perfectly balanced property. When there is a size mismatch, the tree is
-- too small to link. It is pushed on the stack as a left branch with the new
-- element as root, awaiting a right branch which will make it large enough to
-- be linked further.
--
-- When we are out of elements, we link the (root, left branch)s in the stack
-- top to bottom to get the final tree.
--
-- How long does this take? We do O(1) work per element excluding the links.
-- Over n elements, we build trees with at most n nodes total, and each link is
-- done in O(1) using `Bin`. The final linking of the stack is done in O(log n)
-- using `link` (proof below). The total time is thus O(n).
--
-- Additionally, the implemention is written using foldl' over the input list,
-- which makes it participate as a good consumer in list fusion.
--
-- fromDistinctDescList is implemented similarly, adapted for left and right
-- sides being swapped.
--
-- ~~~
--
-- A `link` operation links trees L and R with a root in
-- O(|log(size(L)) - log(size(R))|). Let's say there are m (root, tree) in the
-- stack, the size of the ith tree being 2^{k_i} - 1. We also know that
-- k_i > k_j for i > j, and n = \sum_{i=1}^m 2^{k_i}. With this information, we
-- can calculate the total time to link everything on the stack:
--
--   O(\sum_{i=2}^m |log(2^{k_i} - 1) - log(\sum_{j=1}^{i-1} 2^{k_j})|)
-- = O(\sum_{i=2}^m log(2^{k_i} - 1) - log(\sum_{j=1}^{i-1} 2^{k_j}))
-- = O(\sum_{i=2}^m log(2^{k_i} - 1) - log(2^{k_{i-1}}))
-- = O(\sum_{i=2}^m k_i - k_{i-1})
-- = O(k_m - k_1)
-- = O(log n)