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

{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- 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]
-- ~~~~~~~~~~~~~~~~~~~~
-- We mark some functions INLINE where it is more beneficial than INLINABLE.
-- There is a price to pay -- code growth. The code INLINED is therefore usually
-- only the tree navigation, other work such as rebalancing is not INLINED.
--
-- 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
            , pop
            , alterF
            , powerSet

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


            -- * Filter
            , filter
            , filterA
            , takeWhileAntitone
            , dropWhileAntitone
            , spanAntitone
            , mapMaybe
            , 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

            -- * General merge functions
            , WhenMissing(..)
            , SimpleWhenMissing
            , dropMissing
            , preserveMissing
            , filterMissing
            , filterAMissing
            , whenMissing
            , runWhenMissing
            , WhenMatched(..)
            , SimpleWhenMatched
            , dropMatched
            , preserveMatched
            , filterMatched
            , filterAMatched
            , runWhenMatched
            , merge
            , mergeA

            -- Internals (for testing)
            , bin
            , balanced
            , link
            , link2
            , balanceL
            , balanceR
            , glue
            , insertMin
            , insertMax
            ) where

import Utils.Containers.Internal.Prelude hiding
  (filter,foldl,foldl',foldr,null,map,take,drop,splitAt)
import Prelude ()
import Control.Applicative (Const(..), liftA3)
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.Strict
  (StrictPair(..), StrictTriple(..), toPair)
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
#  if __GLASGOW_HASKELL__ >= 914
import Language.Haskell.TH.Lift (Lift)
#  else
import Language.Haskell.TH.Syntax (Lift)
-- See Note [ Template Haskell Dependencies ]
import Language.Haskell.TH ()
#  endif
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
{-# INLINABLE (\\) #-}

{--------------------------------------------------------------------
  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
#if !MIN_VERSION_base(4,11,0)
    mappend = (<>)
#endif

-- | @(<>)@ = '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 a -> a
go Set a
Tip = a
forall a. Monoid a => a
mempty
            go (Bin Size
1 a
k Set a
_ Set a
_) = a
k
            go (Bin Size
_ a
k Set a
l Set a
r) = Set a -> a
go Set a
l a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` (a
k a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` Set a -> a
go Set a
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 Size
1 a
k Set a
_ Set a
_) = a -> m
f a
k
            go (Bin Size
_ 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 -> Size
length = Set a -> Size
forall a. Set a -> Size
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 Size
_ 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 -> Size
constrIndex Constr
c of
    Size
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)
    Size
_ -> [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 -> Size
size Set a
Tip = Size
0
size (Bin Size
sz a
_ Set a
_ Set a
_) = Size
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 Size
_ 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
{-# INLINABLE member #-}

-- | \(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
{-# INLINABLE notMember #-}

-- | \(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 Size
_ 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 Size
_ 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
{-# INLINABLE lookupLT #-}

-- | \(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 Size
_ 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 Size
_ 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
{-# INLINABLE lookupGT #-}

-- | \(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 Size
_ 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 Size
_ 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
{-# INLINABLE lookupLE #-}

-- | \(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 Size
_ 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 Size
_ 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
{-# INLINABLE lookupGE #-}

{--------------------------------------------------------------------
  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 = Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
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 Size
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 -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
sz (a -> a
forall a. a -> a
lazy a
orig) Set a
l Set a
r
{-# INLINABLE insert #-}

#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 Size
_ 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
{-# INLINABLE insertR #-}

-- | \(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 Size
_ 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
{-# INLINABLE delete #-}

-- | \(O(\log n)\). Pop an element from the set.
--
-- Returns @Nothing@ if the element is not a member of the set. Otherwise
-- returns @Just@ the set with the element removed.
--
-- @
-- pop 1 (fromList [0,2,4]) == Nothing
-- pop 2 (fromList [0,2,4]) == Just (fromList [0,4])
-- @
--
-- @since 0.8.1
pop :: Ord a => a -> Set a -> Maybe (Set a)
pop :: forall a. Ord a => a -> Set a -> Maybe (Set a)
pop a
x0 Set a
t0 = case a -> Set a -> StrictPair Bool (Set a)
forall {a}. Ord a => a -> Set a -> StrictPair Bool (Set a)
go a
x0 Set a
t0 of
  Bool
True :*: Set a
t -> Set a -> Maybe (Set a)
forall a. a -> Maybe a
Just Set a
t
  StrictPair Bool (Set a)
_ -> Maybe (Set a)
forall a. Maybe a
Nothing
  where
    -- We use `StrictPair Bool (Set a)` instead of a sum to avoid allocations.
    -- See Note [Popped impl] in Data.Map.Internal
    go :: a -> Set a -> StrictPair Bool (Set a)
go !a
x (Bin Size
_ 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 -> StrictPair Bool (Set a)
go a
x Set a
l of
        Bool
True :*: Set a
l' -> Bool
True Bool -> Set a -> StrictPair Bool (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
balanceR a
y Set a
l' Set a
r
        StrictPair Bool (Set a)
q -> StrictPair Bool (Set a)
q
      Ordering
EQ -> Bool
True Bool -> Set a -> StrictPair Bool (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r
      Ordering
GT -> case a -> Set a -> StrictPair Bool (Set a)
go a
x Set a
r of
        Bool
True :*: Set a
r' -> Bool
True Bool -> Set a -> StrictPair Bool (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
balanceL a
y Set a
l Set a
r'
        StrictPair Bool (Set a)
q -> StrictPair Bool (Set a)
q
    go !a
_ Set a
Tip = Bool
False Bool -> Set a -> StrictPair Bool (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
forall a. Set a
Tip
{-# INLINABLE pop #-}

-- | \(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".
--
-- === Examples
--
-- @
-- -- Get whether the element is a member, and also insert or remove it.
-- getAndSet :: Ord a => a -> Bool -> Set a -> (Bool, Set a)
-- getAndSet x new = alterF (\\old -> (old, new)) x
-- @
--
-- @
-- -- Delete the element. If it is absent the result is Nothing.
-- mustDelete :: Ord a => a -> Set a -> Maybe (Set a)
-- mustDelete = alterF (\\b -> if b then Just False else Nothing)
-- @
--
-- @since 0.6.3.1

-- See Note [alterF implementation]
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
    MemberIndex Bool
member_ Size
i = a -> Set a -> MemberIndex
forall a. Ord a => a -> Set a -> MemberIndex
memberIndex a
k Set a
s
    inserted :: Set a
inserted = if Bool
member_ then Set a
s else Size -> a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a
insertAt Size
i a
k Set a
s
    deleted :: Set a
deleted = if Bool
member_ then Size -> Set a -> Set a
forall a. Size -> Set a -> Set a
deleteAt Size
i Set a
s else Set a
s
    choose :: Bool -> Set a
choose Bool
True  = Set a
inserted
    choose Bool
False = Set a
deleted
#ifdef __GLASGOW_HASKELL__
{-# INLINE [2] alterF #-}

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

data MemberIndex = MemberIndex !Bool {-# UNPACK #-} !Int

-- Whether the element is a member of the set along with its index.
-- If it is not a member, the index is the index it would have if inserted.
memberIndex :: Ord a => a -> Set a -> MemberIndex
memberIndex :: forall a. Ord a => a -> Set a -> MemberIndex
memberIndex = Size -> a -> Set a -> MemberIndex
forall {a}. Ord a => Size -> a -> Set a -> MemberIndex
go Size
0
  where
    go :: Size -> a -> Set a -> MemberIndex
go !Size
i !a
_ Set a
Tip = Bool -> Size -> MemberIndex
MemberIndex Bool
False Size
i
    go !Size
i !a
x (Bin Size
_ 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 -> Size -> a -> Set a -> MemberIndex
go Size
i a
x Set a
l
      Ordering
EQ -> Bool -> Size -> MemberIndex
MemberIndex Bool
True (Size
i Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Set a -> Size
forall a. Set a -> Size
size Set a
l)
      Ordering
GT -> Size -> a -> Set a -> MemberIndex
go (Size
i Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Set a -> Size
forall a. Set a -> Size
size Set a
l Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) a
x Set a
r
{-# INLINABLE memberIndex #-}

-- Insert the element at the given index. The caller must ensure that the index
-- is correct and will not violate Set invariants.
insertAt :: Int -> a -> Set a -> Set a
insertAt :: forall a. Size -> a -> Set a -> Set a
insertAt !Size
_ !a
x Set a
Tip = a -> Set a
forall a. a -> Set a
singleton a
x
insertAt !Size
i !a
x (Bin Size
_ a
y Set a
l Set a
r)
  | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
sizeL = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y (Size -> a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a
insertAt Size
i a
x Set a
l) Set a
r
  | Bool
otherwise = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l (Size -> a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a
insertAt (Size
i Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
sizeL Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) a
x Set a
r)
  where
    !sizeL :: Size
sizeL = Set a -> Size
forall a. Set a -> Size
size Set a
l

{--------------------------------------------------------------------
  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 -> Size
forall a. Set a -> Size
size Set a
s1 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Set a -> Size
forall a. Set a -> Size
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
{-# INLINABLE isProperSubsetOf #-}


-- | \(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 -> Size
forall a. Set a -> Size
size Set a
t1 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Set a -> Size
forall a. Set a -> Size
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
{-# INLINABLE isSubsetOf #-}

-- 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 Size
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 Size
_ 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 -> Size
forall a. Set a -> Size
size Set a
l Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Set a -> Size
forall a. Set a -> Size
size Set a
lt Bool -> Bool -> Bool
&& Set a -> Size
forall a. Set a -> Size
size Set a
r Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Set a -> Size
forall a. Set a -> Size
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
{-# INLINABLE isSubsetOfX #-}

{--------------------------------------------------------------------
  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 Size
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 Size
_ 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 Size
_ 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 Size
_ 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.
--
-- __Note__: This function is partial. Prefer 'lookupMin'.
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 Size
_ 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 Size
_ 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.
--
-- __Note__: This function is partial. Prefer 'lookupMax'.
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 Size
_ a
_ Set a
Tip Set a
r) = Set a
r
deleteMin (Bin Size
_ 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 Size
_ a
_ Set a
l Set a
Tip) = Set a
l
deleteMax (Bin Size
_ 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
{-# INLINE unions #-} -- Inline for list fusion

-- | \(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 Size
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 Size
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 Size
_ 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
{-# INLINABLE union #-}

{--------------------------------------------------------------------
  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 Size
_ 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 -> Size
forall a. Set a -> Size
size Set a
l1l2 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Set a -> Size
forall a. Set a -> Size
size Set a
r1r2 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Set a -> Size
forall a. Set a -> Size
size Set a
t1 -> Set a
t1
     | Bool
otherwise -> Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
link2 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
{-# INLINABLE difference #-}

{--------------------------------------------------------------------
  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 Size
_ 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
link2 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
{-# INLINABLE intersection #-}

-- | 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 (Size -> Intersection a -> ShowS
[Intersection a] -> ShowS
Intersection a -> [Char]
(Size -> Intersection a -> ShowS)
-> (Intersection a -> [Char])
-> ([Intersection a] -> ShowS)
-> Show (Intersection a)
forall a. Show a => Size -> Intersection a -> ShowS
forall a. Show a => [Intersection a] -> ShowS
forall a. Show a => Intersection a -> [Char]
forall a.
(Size -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Size -> Intersection a -> ShowS
showsPrec :: Size -> 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 Size
_ 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
link2 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
{-# INLINABLE symmetricDifference #-}

{--------------------------------------------------------------------
  Filter and partition
--------------------------------------------------------------------}
-- | \(O(n)\). Keep 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 Size
_ 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
link2 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)\). Keep all elements that satisfy the Applicative predicate.
--
-- @since 0.8.1
filterA :: Applicative f => (a -> f Bool) -> Set a -> f (Set a)
filterA :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> Set a -> f (Set a)
filterA a -> f Bool
p = Set a -> f (Set a)
go
  where
    -- Handle the singleton case separately as it is possible for fmap to be
    -- cheaper than liftA3.
    go :: Set a -> f (Set a)
go t :: Set a
t@(Bin Size
1 a
x Set a
_ Set a
_) = Bool -> Set a
finish (Bool -> Set a) -> f Bool -> f (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f Bool
p a
x
      where
        finish :: Bool -> Set a
finish Bool
False = Set a
forall a. Set a
Tip
        finish Bool
True = Set a
t
    go t :: Set a
t@(Bin Size
_ a
x Set a
l Set a
r) = (Set a -> Bool -> Set a -> Set a)
-> f (Set a) -> f Bool -> f (Set a) -> f (Set a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Set a -> Bool -> Set a -> Set a
doLink (Set a -> f (Set a)
go Set a
l) (a -> f Bool
p a
x) (Set a -> f (Set a)
go Set a
r)
      where
        doLink :: Set a -> Bool -> Set a -> Set a
doLink !Set a
l' Bool
keepx !Set a
r'
          | Bool
keepx = 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
link2 Set a
l' Set a
r'
    go Set a
Tip = Set a -> f (Set a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
forall a. Set a
Tip
{-# INLINABLE filterA #-}

-- | \(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 Size
_ 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
link2 Set a
l2 Set a
r2
        | Bool
otherwise -> Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
link2 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)

{--------------------------------------------------------------------
  Maybes
--------------------------------------------------------------------}

-- | \(O(n \log n)\). Map elements and collect the 'Just' results.
--
-- If the function is monotonically non-decreasing, this function takes \(O(n)\)
-- time.
--
-- @since 0.8.1
mapMaybe :: Ord b => (a -> Maybe b) -> Set a -> Set b
mapMaybe :: forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
mapMaybe a -> Maybe 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 -> a -> SetBuilder b
go SetBuilder b
forall a. SetBuilder a
emptyB Set a
t)
  where go :: SetBuilder b -> a -> SetBuilder b
go SetBuilder b
b a
x = case a -> Maybe b
f a
x of
          Maybe b
Nothing -> SetBuilder b
b
          Just b
x' -> b -> SetBuilder b -> SetBuilder b
forall a. Ord a => a -> SetBuilder a -> SetBuilder a
insertB b
x' SetBuilder b
b
{-# INLINABLE mapMaybe #-}

{----------------------------------------------------------------------
  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)
{-# INLINABLE map #-}

-- | \(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 Size
sz a
x Set a
l Set a
r) = Size -> b -> Set b -> Set b -> Set b
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
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 Size
_ 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 Size
_ 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 Size
_ 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 Size
_ 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 -> Size -> Set a -> a -> Stack a
forall a. Stack a -> Size -> Set a -> a -> Stack a
ascLinkTop Stack a
stk' Size
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 -> Size -> Set a -> Stack a -> Stack a
forall a. a -> Size -> Set a -> Stack a -> Stack a
descLinkTop a
y Size
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 -> Size -> Set a -> a -> Stack a
forall a. Stack a -> Size -> Set a -> a -> Stack a
ascLinkTop Stack a
stk Size
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 -> Size -> Set a -> a -> Stack a
ascLinkTop (Push a
x l :: Set a
l@(Bin Size
lsz a
_ Set a
_ Set a
_) Stack a
stk) !Size
rsz Set a
r a
y
  | Size
lsz Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
rsz = Stack a -> Size -> Set a -> a -> Stack a
forall a. Stack a -> Size -> Set a -> a -> Stack a
ascLinkTop Stack a
stk Size
sz (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
sz a
x Set a
l Set a
r) a
y
  where
    sz :: Size
sz = Size
lsz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
rsz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1
ascLinkTop Stack a
stk !Size
_ 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
linkL 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 -> Size -> Set a -> Stack a -> Stack a
forall a. a -> Size -> Set a -> Stack a -> Stack a
descLinkTop a
x Size
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 -> Size -> Set a -> Stack a -> Stack a
descLinkTop a
x !Size
lsz Set a
l (Push a
y r :: Set a
r@(Bin Size
rsz a
_ Set a
_ Set a
_) Stack a
stk)
  | Size
lsz Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
rsz = a -> Size -> Set a -> Stack a -> Stack a
forall a. a -> Size -> Set a -> Stack a -> Stack a
descLinkTop a
x Size
sz (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
sz a
y Set a
l Set a
r) Stack a
stk
  where
    sz :: Size
sz = Size
lsz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
rsz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1
descLinkTop a
y !Size
_ 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
linkR 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 Size
_ 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 -> Size
forall a. Set a -> Size
size Set a
s1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Set b -> Size
forall a. Set a -> Size
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 :: Size -> Set a -> ShowS
showsPrec Size
p Set a
xs = Bool -> ShowS -> ShowS
showParen (Size
p Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
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.
(Size -> a -> ShowS) -> ([a] -> ShowS) -> Size -> Set a -> ShowS
liftShowsPrec Size -> a -> ShowS
sp [a] -> ShowS
sl Size
d Set a
m =
        (Size -> [a] -> ShowS) -> [Char] -> Size -> [a] -> ShowS
forall a. (Size -> a -> ShowS) -> [Char] -> Size -> a -> ShowS
showsUnaryWith ((Size -> a -> ShowS) -> ([a] -> ShowS) -> Size -> [a] -> ShowS
forall a.
(Size -> a -> ShowS) -> ([a] -> ShowS) -> Size -> [a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Size -> a -> ShowS) -> ([a] -> ShowS) -> Size -> f a -> ShowS
liftShowsPrec Size -> a -> ShowS
sp [a] -> ShowS
sl) [Char]
"fromList" Size
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
$ Size -> ReadPrec (Set a) -> ReadPrec (Set a)
forall a. Size -> ReadPrec a -> ReadPrec a
prec Size
10 (ReadPrec (Set a) -> ReadPrec (Set a))
-> ReadPrec (Set a) -> ReadPrec (Set a)
forall a b. (a -> b) -> a -> b
$ do
    Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
    [a]
xs <- ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
    Set a -> ReadPrec (Set a)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Set a
forall a. Ord a => [a] -> Set a
fromList [a]
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 Size
_ 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 Size
_ 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 Size
_ 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
linkR 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
linkL 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
x0 Set a
t = case a -> Set a -> StrictTriple (Set a) Bool (Set a)
forall {a}.
Ord a =>
a -> Set a -> StrictTriple (Set a) Bool (Set a)
go a
x0 Set a
t of
  TripleS Set a
lt Bool
found Set a
gt -> (Set a
lt, Bool
found, Set a
gt)
  where
    go :: a -> Set a -> StrictTriple (Set a) Bool (Set a)
go a
_ Set a
Tip = Set a -> Bool -> Set a -> StrictTriple (Set a) Bool (Set a)
forall a b c. a -> b -> c -> StrictTriple a b c
TripleS Set a
forall a. Set a
Tip Bool
False Set a
forall a. Set a
Tip
    go a
x (Bin Size
_ 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 -> StrictTriple (Set a) Bool (Set a)
go a
x Set a
l of
          TripleS Set a
lt Bool
found Set a
gt -> Set a -> Bool -> Set a -> StrictTriple (Set a) Bool (Set a)
forall a b c. a -> b -> c -> StrictTriple a b c
TripleS Set a
lt Bool
found (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
linkR a
y Set a
gt Set a
r)
        Ordering
GT -> case a -> Set a -> StrictTriple (Set a) Bool (Set a)
go a
x Set a
r of
          TripleS Set a
lt Bool
found Set a
gt -> Set a -> Bool -> Set a -> StrictTriple (Set a) Bool (Set a)
forall a b c. a -> b -> c -> StrictTriple a b c
TripleS (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
linkL a
y Set a
l Set a
lt) Bool
found Set a
gt
        Ordering
EQ -> Set a -> Bool -> Set a -> StrictTriple (Set a) Bool (Set a)
forall a b c. a -> b -> c -> StrictTriple a b c
TripleS Set a
l Bool
True Set a
r
{-# INLINABLE splitMember #-}

{--------------------------------------------------------------------
  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.
--
-- __Note__: This function is partial. Prefer 'lookupIndex'.
--
-- > 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 -> Size
findIndex = Size -> a -> Set a -> Size
forall a. Ord a => Size -> a -> Set a -> Size
go Size
0
  where
    go :: Ord a => Int -> a -> Set a -> Int
    go :: forall a. Ord a => Size -> a -> Set a -> Size
go !Size
_ !a
_ Set a
Tip  = [Char] -> Size
forall a. HasCallStack => [Char] -> a
error [Char]
"Set.findIndex: element is not in the set"
    go Size
idx a
x (Bin Size
_ 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 -> Size -> a -> Set a -> Size
forall a. Ord a => Size -> a -> Set a -> Size
go Size
idx a
x Set a
l
      Ordering
GT -> Size -> a -> Set a -> Size
forall a. Ord a => Size -> a -> Set a -> Size
go (Size
idx Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Set a -> Size
forall a. Set a -> Size
size Set a
l Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) a
x Set a
r
      Ordering
EQ -> Size
idx Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Set a -> Size
forall a. Set a -> Size
size Set a
l
{-# INLINABLE findIndex #-}

-- | \(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 Size
lookupIndex = Size -> a -> Set a -> Maybe Size
forall a. Ord a => Size -> a -> Set a -> Maybe Size
go Size
0
  where
    go :: Ord a => Int -> a -> Set a -> Maybe Int
    go :: forall a. Ord a => Size -> a -> Set a -> Maybe Size
go !Size
_ !a
_ Set a
Tip  = Maybe Size
forall a. Maybe a
Nothing
    go Size
idx a
x (Bin Size
_ 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 -> Size -> a -> Set a -> Maybe Size
forall a. Ord a => Size -> a -> Set a -> Maybe Size
go Size
idx a
x Set a
l
      Ordering
GT -> Size -> a -> Set a -> Maybe Size
forall a. Ord a => Size -> a -> Set a -> Maybe Size
go (Size
idx Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Set a -> Size
forall a. Set a -> Size
size Set a
l Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) a
x Set a
r
      Ordering
EQ -> Size -> Maybe Size
forall a. a -> Maybe a
Just (Size -> Maybe Size) -> Size -> Maybe Size
forall a b. (a -> b) -> a -> b
$! Size
idx Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Set a -> Size
forall a. Set a -> Size
size Set a
l
{-# INLINABLE lookupIndex #-}

-- | \(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.
--
-- __Note__: This function is partial.
--
-- > 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. Size -> Set a -> a
elemAt !Size
_ Set a
Tip = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Set.elemAt: index out of range"
elemAt Size
i (Bin Size
_ a
x Set a
l Set a
r)
  = case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
      Ordering
LT -> Size -> Set a -> a
forall a. Size -> Set a -> a
elemAt Size
i Set a
l
      Ordering
GT -> Size -> Set a -> a
forall a. Size -> Set a -> a
elemAt (Size
iSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
sizeLSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
1) Set a
r
      Ordering
EQ -> a
x
  where
    sizeL :: Size
sizeL = Set a -> Size
forall a. Set a -> Size
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.
--
-- __Note__: This function is partial.
--
-- > 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. Size -> Set a -> Set a
deleteAt !Size
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 Size
_ a
x Set a
l Set a
r -> case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
      Ordering
LT -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
x (Size -> Set a -> Set a
forall a. Size -> Set a -> Set a
deleteAt Size
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 (Size -> Set a -> Set a
forall a. Size -> Set a -> Set a
deleteAt (Size
iSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
sizeLSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
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 :: Size
sizeL = Set a -> Size
forall a. Set a -> Size
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. Size -> Set a -> Set a
take Size
i Set a
m | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Set a -> Size
forall a. Set a -> Size
size Set a
m = Set a
m
take Size
i0 Set a
m0 = Size -> Set a -> Set a
forall a. Size -> Set a -> Set a
go Size
i0 Set a
m0
  where
    go :: Size -> Set a -> Set a
go Size
i !Set a
_ | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
0 = Set a
forall a. Set a
Tip
    go !Size
_ Set a
Tip = Set a
forall a. Set a
Tip
    go Size
i (Bin Size
_ a
x Set a
l Set a
r) =
      case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
        Ordering
LT -> Size -> Set a -> Set a
go Size
i Set a
l
        Ordering
GT -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
linkL a
x Set a
l (Size -> Set a -> Set a
go (Size
i Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
sizeL Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) Set a
r)
        Ordering
EQ -> Set a
l
      where sizeL :: Size
sizeL = Set a -> Size
forall a. Set a -> Size
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. Size -> Set a -> Set a
drop Size
i Set a
m | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Set a -> Size
forall a. Set a -> Size
size Set a
m = Set a
forall a. Set a
Tip
drop Size
i0 Set a
m0 = Size -> Set a -> Set a
forall a. Size -> Set a -> Set a
go Size
i0 Set a
m0
  where
    go :: Size -> Set a -> Set a
go Size
i Set a
m | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
0 = Set a
m
    go !Size
_ Set a
Tip = Set a
forall a. Set a
Tip
    go Size
i (Bin Size
_ a
x Set a
l Set a
r) =
      case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
        Ordering
LT -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
linkR a
x (Size -> Set a -> Set a
go Size
i Set a
l) Set a
r
        Ordering
GT -> Size -> Set a -> Set a
go (Size
i Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
sizeL Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
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 :: Size
sizeL = Set a -> Size
forall a. Set a -> Size
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. Size -> Set a -> (Set a, Set a)
splitAt Size
i0 Set a
m0
  | Size
i0 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Set a -> Size
forall a. Set a -> Size
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
$ Size -> Set a -> StrictPair (Set a) (Set a)
forall {a}. Size -> Set a -> StrictPair (Set a) (Set a)
go Size
i0 Set a
m0
  where
    go :: Size -> Set a -> StrictPair (Set a) (Set a)
go Size
i Set a
m | Size
i Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
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 !Size
_ 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 Size
i (Bin Size
_ a
x Set a
l Set a
r)
      = case Size -> Size -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Size
i Size
sizeL of
          Ordering
LT -> case Size -> Set a -> StrictPair (Set a) (Set a)
go Size
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
linkR a
x Set a
lr Set a
r
          Ordering
GT -> case Size -> Set a -> StrictPair (Set a) (Set a)
go (Size
i Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
sizeL Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
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
linkL 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 :: Size
sizeL = Set a -> Size
forall a. Set a -> Size
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 Size
_ 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
linkL 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 Size
_ 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
linkR 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 Size
_ 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
linkL 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
linkR 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 -> Size -> Set a -> a -> Stack a
forall a. Stack a -> Size -> Set a -> a -> Stack a
ascLinkTop Stack a
stk' Size
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.
    [link2 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 Size
lsz a
lx Set a
ll Set a
lr) r :: Set a
r@(Bin Size
rsz a
rx Set a
rl Set a
rr)
  | Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
lsz Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
rsz = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
rx (a -> Size -> Set a -> Set a -> Set a
forall a. a -> Size -> Set a -> Set a -> Set a
linkR_ a
x Size
lsz Set a
l Set a
rl) Set a
rr
  | Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
rsz Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
lsz = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
lx Set a
ll (a -> Set a -> Size -> Set a -> Set a
forall a. a -> Set a -> Size -> Set a -> Set a
linkL_ a
x Set a
lr Size
rsz Set a
r)
  | Bool
otherwise = Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lszSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rsz) a
x Set a
l Set a
r

-- Variant of link. Restores balance when the left tree may be too large for the
-- right tree, but not the other way around.
linkL :: a -> Set a -> Set a -> Set a
linkL :: forall a. a -> Set a -> Set a -> Set a
linkL a
x Set a
l Set a
r = case Set a
r of
  Set a
Tip -> a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMax a
x Set a
l
  Bin Size
rsz a
_ Set a
_ Set a
_ -> a -> Set a -> Size -> Set a -> Set a
forall a. a -> Set a -> Size -> Set a -> Set a
linkL_ a
x Set a
l Size
rsz Set a
r

linkL_ :: a -> Set a -> Int -> Set a -> Set a
linkL_ :: forall a. a -> Set a -> Size -> Set a -> Set a
linkL_ a
x Set a
l !Size
rsz Set a
r = case Set a
l of
  Bin Size
lsz a
lx Set a
ll Set a
lr
    | Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
rsz Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
lsz -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
lx Set a
ll (a -> Set a -> Size -> Set a -> Set a
forall a. a -> Set a -> Size -> Set a -> Set a
linkL_ a
x Set a
lr Size
rsz Set a
r)
    | Bool
otherwise -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lszSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rsz) a
x Set a
l Set a
r
  Set a
Tip -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rsz) a
x Set a
forall a. Set a
Tip Set a
r

-- Variant of link. Restores balance when the right tree may be too large for
-- the left tree, but not the other way around.
linkR :: a -> Set a -> Set a -> Set a
linkR :: forall a. a -> Set a -> Set a -> Set a
linkR a
x Set a
l Set a
r = case Set a
l of
  Set a
Tip -> a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMin a
x Set a
r
  Bin Size
lsz a
_ Set a
_ Set a
_ -> a -> Size -> Set a -> Set a -> Set a
forall a. a -> Size -> Set a -> Set a -> Set a
linkR_ a
x Size
lsz Set a
l Set a
r

linkR_ :: a -> Int -> Set a -> Set a -> Set a
linkR_ :: forall a. a -> Size -> Set a -> Set a -> Set a
linkR_ a
x !Size
lsz Set a
l Set a
r = case Set a
r of
  Bin Size
rsz a
rx Set a
rl Set a
rr
    | Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
lsz Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
rsz -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
rx (a -> Size -> Set a -> Set a -> Set a
forall a. a -> Size -> Set a -> Set a -> Set a
linkR_ a
x Size
lsz Set a
l Set a
rl) Set a
rr
    | Bool
otherwise -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lszSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rsz) a
x Set a
l Set a
r
  Set a
Tip -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsz) a
x Set a
l Set a
forall a. Set a
Tip

-- insertMin and insertMax don't perform potentially expensive comparisons.
-- @since 0.8.1
insertMax :: 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 Size
_ 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)

-- @since 0.8.1
insertMin :: a -> Set a -> Set a
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 Size
_ 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

{--------------------------------------------------------------------
  [link2 l r]: merges two trees.
--------------------------------------------------------------------}
-- @since 0.8.1
link2 :: Set a -> Set a -> Set a
link2 :: forall a. Set a -> Set a -> Set a
link2 Set a
Tip Set a
r   = Set a
r
link2 Set a
l Set a
Tip   = Set a
l
link2 l :: Set a
l@(Bin Size
lsz a
lx Set a
ll Set a
lr) r :: Set a
r@(Bin Size
rsz a
rx Set a
rl Set a
rr)
  | Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
lsz Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
rsz = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
rx (Size -> Set a -> Set a -> Set a
forall a. Size -> Set a -> Set a -> Set a
link2R_ Size
lsz Set a
l Set a
rl) Set a
rr
  | Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
rsz Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
lsz = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
lx Set a
ll (Set a -> Size -> Set a -> Set a
forall a. Set a -> Size -> Set a -> Set a
link2L_ Set a
lr Size
rsz 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

link2L_ :: Set a -> Int -> Set a -> Set a
link2L_ :: forall a. Set a -> Size -> Set a -> Set a
link2L_ Set a
l !Size
rsz Set a
r = case Set a
l of
  Bin Size
lsz a
lx Set a
ll Set a
lr
    | Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
rsz Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
lsz -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
lx Set a
ll (Set a -> Size -> Set a -> Set a
forall a. Set a -> Size -> Set a -> Set a
link2L_ Set a
lr Size
rsz 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
  Set a
Tip -> Set a
r

link2R_ :: Int -> Set a -> Set a -> Set a
link2R_ :: forall a. Size -> Set a -> Set a -> Set a
link2R_ !Size
lsz Set a
l Set a
r = case Set a
r of
  Bin Size
rsz a
rx Set a
rl Set a
rr
    | Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
lsz Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
rsz -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
rx (Size -> Set a -> Set a -> Set a
forall a. Size -> Set a -> Set a -> Set a
link2R_ Size
lsz Set a
l Set a
rl) Set a
rr
    | Bool
otherwise -> Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r
  Set a
Tip -> Set a
l

{--------------------------------------------------------------------
  [glue l r]: glues two trees together.
  Assumes that [l] and [r] are already balanced with respect to each other.
--------------------------------------------------------------------}
-- @since 0.8.1
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 Size
sl a
xl Set a
ll Set a
lr) r :: Set a
r@(Bin Size
sr a
xr Set a
rl Set a
rr)
  | Size
sl Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
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 Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
slSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
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 Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
slSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
sr) a
m Set a
l Set a
r'

-- | \(O(\log n)\). Delete and find the minimal element.
--
-- Calls 'error' if the set is empty.
--
-- __Note__: This function is partial. Prefer 'minView'.
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.
--
-- Calls 'error' if the set is empty.
--
-- __Note__: This function is partial. Prefer 'maxView'.
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 Size
_ 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 Size
_ 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 Size
_ 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 Size
_ 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 :: Size
delta = Size
3
ratio :: Size
ratio = Size
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 specialized 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.
-- @since 0.8.1
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 Size
ls a
_ Set a
_ Set a
_, Bin Size
rs a
_ Set a
_ Set a
_)
    | Size
ls Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
rs -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
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 -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
           (Bin Size
_ a
_ Set a
Tip Set a
Tip) -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
2 a
x Set a
l Set a
forall a. Set a
Tip
           (Bin Size
_ a
lx Set a
Tip (Bin Size
_ a
lrx Set a
_ Set a
_)) -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
3 a
lrx (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
lx Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
           (Bin Size
_ a
lx ll :: Set a
ll@(Bin Size
_ a
_ Set a
_ Set a
_) Set a
Tip) -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
3 a
lx Set a
ll (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
           (Bin Size
ls a
lx ll :: Set a
ll@(Bin Size
lls a
_ Set a
_ Set a
_) lr :: Set a
lr@(Bin Size
lrs a
lrx Set a
lrl Set a
lrr))
             | Size
lrs Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
ratioSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
lls -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
ls) a
lx Set a
ll (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lrs) a
x Set a
lr Set a
forall a. Set a
Tip)
             | Bool
otherwise -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
ls) a
lrx (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
llsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Set a -> Size
forall a. Set a -> Size
size Set a
lrl) a
lx Set a
ll Set a
lrl) (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Set a -> Size
forall a. Set a -> Size
size Set a
lrr) a
x Set a
lrr Set a
forall a. Set a
Tip)

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

           (Bin Size
ls a
lx Set a
ll Set a
lr) -> case (Set a
ll, Set a
lr) of
                   (Bin Size
lls a
_ Set a
_ Set a
_, Bin Size
lrs a
lrx Set a
lrl Set a
lrr)
                     | Size
lrs Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
ratioSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
lls -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rs) a
lx Set a
ll (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lrs) a
x Set a
lr Set a
r)
                     | Bool
otherwise -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rs) a
lrx (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
llsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Set a -> Size
forall a. Set a -> Size
size Set a
lrl) a
lx Set a
ll Set a
lrl) (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Set a -> Size
forall a. Set a -> Size
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.
-- @since 0.8.1
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 Size
ls a
_ Set a
_ Set a
_, Bin Size
rs a
_ Set a
_ Set a
_)
    | Size
rs Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
ls -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
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 -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
           (Bin Size
_ a
_ Set a
Tip Set a
Tip) -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
2 a
x Set a
forall a. Set a
Tip Set a
r
           (Bin Size
_ a
rx Set a
Tip rr :: Set a
rr@(Bin Size
_ a
_ Set a
_ Set a
_)) -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
3 a
rx (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) Set a
rr
           (Bin Size
_ a
rx (Bin Size
_ a
rlx Set a
_ Set a
_) Set a
Tip) -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
3 a
rlx (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
rx Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
           (Bin Size
rs a
rx rl :: Set a
rl@(Bin Size
rls a
rlx Set a
rll Set a
rlr) rr :: Set a
rr@(Bin Size
rrs a
_ Set a
_ Set a
_))
             | Size
rls Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
ratioSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
rrs -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rs) a
rx (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rls) a
x Set a
forall a. Set a
Tip Set a
rl) Set a
rr
             | Bool
otherwise -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rs) a
rlx (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Set a -> Size
forall a. Set a -> Size
size Set a
rll) a
x Set a
forall a. Set a
Tip Set a
rll) (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rrsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Set a -> Size
forall a. Set a -> Size
size Set a
rlr) a
rx Set a
rlr Set a
rr)

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

           (Bin Size
rs a
rx Set a
rl Set a
rr) -> case (Set a
rl, Set a
rr) of
                   (Bin Size
rls a
rlx Set a
rll Set a
rlr, Bin Size
rrs a
_ Set a
_ Set a
_)
                     | Size
rls Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
ratioSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
rrs -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rs) a
rx (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rls) a
x Set a
l Set a
rl) Set a
rr
                     | Bool
otherwise -> Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rs) a
rlx (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Set a -> Size
forall a. Set a -> Size
size Set a
rll) a
x Set a
l Set a
rll) (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rrsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Set a -> Size
forall a. Set a -> Size
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
  = Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin (Set a -> Size
forall a. Set a -> Size
size Set a
l Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Set a -> Size
forall a. Set a -> Size
size Set a
r Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
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 Size
_ 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 Size
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
link2 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
#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

-- | \(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
link2 ((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)

{--------------------------------------------------------------------
  Merging Sets
--------------------------------------------------------------------}

-- | A tactic for dealing with elements present in one set but not the other in
-- 'merge' or 'mergeA'.
--
-- A tactic of type @WhenMissing f a@ is an abstract representation of a
-- function of type @a -> f Bool@.
--
-- @since 0.8.1
data WhenMissing f a = WhenMissing
  { forall (f :: * -> *) a. WhenMissing f a -> Set a -> f (Set a)
missingSubtree :: Set a -> f (Set a)
  , forall (f :: * -> *) a. WhenMissing f a -> a -> f Bool
missingElem :: a -> f Bool
  }

-- | A tactic for dealing with elements present in one set but not the other in
-- 'merge'.
--
-- A tactic of type @SimpleWhenMissing a@ is an abstract representation
-- of a function of type @a -> Bool@.
--
-- @since 0.8.1
type SimpleWhenMissing = WhenMissing Identity

-- | Along with 'filterAMissing', witnesses the isomorphism between
-- @WhenMissing f a@ and @a -> f Bool@.
--
-- @since 0.8.1
runWhenMissing :: WhenMissing f a -> a -> f Bool
runWhenMissing :: forall (f :: * -> *) a. WhenMissing f a -> a -> f Bool
runWhenMissing = WhenMissing f a -> a -> f Bool
forall (f :: * -> *) a. WhenMissing f a -> a -> f Bool
missingElem

-- | A tactic for dealing with elements present in both sets in 'merge' or
-- 'mergeA'.
--
-- A tactic of type @WhenMatched f a@ is an abstract representation of a
-- function of type @a -> f Bool@.
--
-- @since 0.8.1
newtype WhenMatched f a = WhenMatched { forall (f :: * -> *) a. WhenMatched f a -> a -> f Bool
matchedElem :: a -> f Bool }

-- | A tactic for dealing with elements present in both sets in 'merge'.
--
-- A tactic of type @SimpleWhenMatched a@ is an abstract representation of a
-- function of type @a -> Bool@.
--
-- @since 0.8.1
type SimpleWhenMatched = WhenMatched Identity

-- | Along with 'filterAMatched', witnesses the isomorphism between
-- @WhenMatched f a@ and @a -> f Bool@.
--
-- @since 0.8.1
runWhenMatched :: WhenMatched f a -> a -> f Bool
runWhenMatched :: forall (f :: * -> *) a. WhenMatched f a -> a -> f Bool
runWhenMatched = WhenMatched f a -> a -> f Bool
forall (f :: * -> *) a. WhenMatched f a -> a -> f Bool
matchedElem

-- | When an element is found in both sets, drop the element.
--
-- @since 0.8.1
dropMatched :: Applicative f => WhenMatched f a
dropMatched :: forall (f :: * -> *) a. Applicative f => WhenMatched f a
dropMatched = (a -> f Bool) -> WhenMatched f a
forall (f :: * -> *) a. (a -> f Bool) -> WhenMatched f a
WhenMatched (\a
_ -> Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
{-# INLINE dropMatched #-}

-- | When an element is found in both sets, keep the element.
--
-- @since 0.8.1
preserveMatched :: Applicative f => WhenMatched f a
preserveMatched :: forall (f :: * -> *) a. Applicative f => WhenMatched f a
preserveMatched = (a -> f Bool) -> WhenMatched f a
forall (f :: * -> *) a. (a -> f Bool) -> WhenMatched f a
WhenMatched (\a
_ -> Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
{-# INLINE preserveMatched #-}

-- | When an element is found in both sets, choose whether to keep the element
-- in the merged set.
--
-- @since 0.8.1
filterMatched :: Applicative f => (a -> Bool) -> WhenMatched f a
filterMatched :: forall (f :: * -> *) a.
Applicative f =>
(a -> Bool) -> WhenMatched f a
filterMatched a -> Bool
f = (a -> f Bool) -> WhenMatched f a
forall (f :: * -> *) a. (a -> f Bool) -> WhenMatched f a
WhenMatched (Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> f Bool) -> (a -> Bool) -> a -> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
f)
{-# INLINE filterMatched #-}

-- | When an element is found in both sets, choose whether to keep the element
-- in the merged set.
--
-- @since 0.8.1
filterAMatched :: (a -> f Bool) -> WhenMatched f a
filterAMatched :: forall a (f :: * -> *). (a -> f Bool) -> WhenMatched f a
filterAMatched = (a -> f Bool) -> WhenMatched f a
forall (f :: * -> *) a. (a -> f Bool) -> WhenMatched f a
WhenMatched

-- | Create a @WhenMissing@ from two functions.
--
-- @whenMissing@ must be called with two functions @f@ and @g@ such that
-- @g = 'filterA' f@. @g@ may be a more efficient way of applying @f@ to all
-- elements in a @Set@.
--
-- __Warning__: It is the caller's responsibility to ensure the above property.
--
-- === __Examples__
--
-- @
-- preserveMissing :: Applicative f => WhenMissing f a
-- preserveMissing = whenMissing f g
--   where
--     f _x = pure True
--     g s = pure s
--     -- Note that this satisfies g = filterA f
-- @
--
-- @
-- import Data.Functor.Const (Const(..))
-- import Data.Monoid (All(..))
--
-- -- For a usage of this, see examples on mergeA
-- isEmpty :: WhenMissing (Const All) a
-- isEmpty = whenMissing f g
--   where
--     f _x = Const (All False)
--     g s = Const (All (null s))
--     -- Note that this satisfies g = filterA f
-- @
--
-- @since 0.8.1
whenMissing :: (a -> f Bool) -> (Set a -> f (Set a)) -> WhenMissing f a
whenMissing :: forall a (f :: * -> *).
(a -> f Bool) -> (Set a -> f (Set a)) -> WhenMissing f a
whenMissing = ((Set a -> f (Set a)) -> (a -> f Bool) -> WhenMissing f a)
-> (a -> f Bool) -> (Set a -> f (Set a)) -> WhenMissing f a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Set a -> f (Set a)) -> (a -> f Bool) -> WhenMissing f a
forall (f :: * -> *) a.
(Set a -> f (Set a)) -> (a -> f Bool) -> WhenMissing f a
WhenMissing

-- | Drop all the elements that are missing from the other set.
--
-- @
-- dropMissing :: 'SimpleWhenMissing' a
-- @
--
-- > dropMissing = filterMissing (\_ -> False)
--
-- but @dropMissing@ is more efficient.
--
-- @since 0.8.1
dropMissing :: Applicative f => WhenMissing f a
dropMissing :: forall (f :: * -> *) a. Applicative f => WhenMissing f a
dropMissing = WhenMissing
  { missingSubtree :: Set a -> f (Set a)
missingSubtree = \Set a
_ -> Set a -> f (Set a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
forall a. Set a
Tip
  , missingElem :: a -> f Bool
missingElem = \a
_ -> Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  }
{-# INLINE dropMissing #-}

-- | Preserve the elements that are missing from the other set.
--
-- @
-- preserveMissing :: 'SimpleWhenMissing' a
-- @
--
-- > preserveMissing = filterMissing (\_ -> True)
--
-- but @preserveMissing@ is more efficient.
--
-- @since 0.8.1
preserveMissing :: Applicative f => WhenMissing f a
preserveMissing :: forall (f :: * -> *) a. Applicative f => WhenMissing f a
preserveMissing = WhenMissing
  { missingSubtree :: Set a -> f (Set a)
missingSubtree = Set a -> f (Set a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  , missingElem :: a -> f Bool
missingElem = \a
_ -> Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  }
{-# INLINE preserveMissing #-}

-- | Filter the elements that are missing from the other set.
--
-- @
-- filterMissing :: (a -> Bool) -> 'SimpleWhenMissing' a
-- @
--
-- @since 0.8.1
filterMissing :: Applicative f => (a -> Bool) -> WhenMissing f a
filterMissing :: forall (f :: * -> *) a.
Applicative f =>
(a -> Bool) -> WhenMissing f a
filterMissing a -> Bool
f = WhenMissing
  { missingSubtree :: Set a -> f (Set a)
missingSubtree = Set a -> f (Set a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set a -> f (Set a)) -> (Set a -> Set a) -> Set a -> f (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
filter a -> Bool
f
  , missingElem :: a -> f Bool
missingElem = Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> f Bool) -> (a -> Bool) -> a -> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
f
  }
{-# INLINE filterMissing #-}

-- | Filter the elements that are missing from the other set using some
-- 'Applicative' action.
--
-- @since 0.8.1
filterAMissing :: Applicative f => (a -> f Bool) -> WhenMissing f a
filterAMissing :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> WhenMissing f a
filterAMissing a -> f Bool
f = WhenMissing
  { missingSubtree :: Set a -> f (Set a)
missingSubtree = (a -> f Bool) -> Set a -> f (Set a)
forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> Set a -> f (Set a)
filterA a -> f Bool
f
  , missingElem :: a -> f Bool
missingElem = a -> f Bool
f
  }
{-# INLINE filterAMissing #-}

-- | Merge two sets.
--
-- 'merge' takes two 'SimpleWhenMissing' tactics, a 'SimpleWhenMatched' tactic,
-- and two sets. It uses the tactics to merge the sets.
--
-- Consider
--
-- @
-- merge (filterMissing g1) (filterMissing g2) (filterMatched f) s1 s2
-- @
--
-- @
-- g1 = (==2)
-- g2 = (==3)
-- f  = (==6)
-- s1 = [2, 4, 6, 8, 10, 12]
-- s2 = [3, 6, 9, 12]
-- @
--
-- 'merge' will pass the elements to @g1@, @g2@, or @f@ as appropriate,
-- producing a @Bool@ for each element.
--
-- @
-- m1:      [   2,            4,     6,     8,           10     12]
-- m2:      [          3,            6,            9,           12]
-- result:  [g1 2,  g2 3,  g1 4,   f 6,  g1 8,  g2 9, g1 10,  f 12]
--        = [True,  True, False,  True, False, False, False, False]
-- @
--
-- The result set contains the element for which we have @True@.
--
-- >>> merge (filterMissing g1) (filterMissing g2) (filterMatched f) s1 s2
-- fromList [2,3,6]
--
-- The other tactics below are optimizations or simplifications of
-- 'filterMissing' for special cases. Most importantly,
--
-- * 'dropMissing' drops all elements.
-- * 'preserveMissing' leaves all elements alone.
--
-- When 'merge' is given three arguments, it is inlined at the call
-- site. To prevent excessive inlining, you should typically use 'merge'
-- to define your custom combining functions.
--
-- @since 0.8.1
merge
  :: Ord a
  => SimpleWhenMissing a -- ^ What to do with elements in @s1@ but not @s2@
  -> SimpleWhenMissing a -- ^ What to do with elements in @s2@ but not @s1@
  -> SimpleWhenMatched a -- ^ What to do with elements in both @s1@ and @s2@
  -> Set a -- ^ Set @s1@
  -> Set a -- ^ Set @s2@
  -> Set a
merge :: forall a.
Ord a =>
SimpleWhenMissing a
-> SimpleWhenMissing a
-> SimpleWhenMatched a
-> Set a
-> Set a
-> Set a
merge SimpleWhenMissing a
g1 SimpleWhenMissing a
g2 SimpleWhenMatched a
f = \Set a
s1 Set a
s2 -> Identity (Set a) -> Set a
forall a. Identity a -> a
runIdentity (SimpleWhenMissing a
-> SimpleWhenMissing a
-> SimpleWhenMatched a
-> Set a
-> Set a
-> Identity (Set a)
forall (f :: * -> *) a.
(Applicative f, Ord a) =>
WhenMissing f a
-> WhenMissing f a
-> WhenMatched f a
-> Set a
-> Set a
-> f (Set a)
mergeA SimpleWhenMissing a
g1 SimpleWhenMissing a
g2 SimpleWhenMatched a
f Set a
s1 Set a
s2)
{-# INLINE merge #-}

-- | An applicative version of 'merge'.
--
-- 'mergeA' takes two 'WhenMissing' tactics, a 'WhenMatched' tactic, and two
-- sets. It uses the tactics to merge the sets.
--
-- Behaves just like 'merge' while allowing @Applicative@ effects. Effects are
-- performed in increasing order of elements.
--
-- Consider,
--
-- @
-- mergeA (filterAMissing g1) (filterAMissing g2) (filterAMatched f) s1 s2
-- @
--
-- @
-- g1 x = (x == 2) <$ putStrLn ("g1 " ++ show x)
-- g2 x = (x == 3) <$ putStrLn ("g2 " ++ show x)
-- f x = (x == 6) <$ putStrLn ("f " ++ show x)
-- s1 = [2, 4, 6, 8, 10, 12]
-- s2 = [3, 6, 9, 12]
-- @
--
-- As with 'merge', the result set is @[2,3,6]@. Additionally, @g1@, @g2@, and
-- @f@ perform @IO@ effects, printing the elements in increasing order.
--
-- >>> mergeA (filterAMissing g1) (filterAMissing g2) (filterAMatched f) s1 s2
-- g1 2
-- g2 3
-- g1 4
-- f 6
-- g1 8
-- g2 9
-- g1 10
-- f 12
-- fromList [2,3,6]
--
-- When 'mergeA' is given three arguments, it is inlined at the call
-- site. To prevent excessive inlining, you should generally only use
-- 'mergeA' to define custom combining functions.
--
-- === __Examples__
--
-- @
-- data Pair a = Pair !a !a deriving Functor
--
-- instance Applicative Pair where
--    pure x = Pair x x
--    liftA2 f (Pair x1 y1) (Pair x2 y2) = Pair (f x1 x2) (f y1 y2)
--
-- -- | Calculate the union and intersection of two sets.
-- unionIntersection :: Ord a => Set a -> Set a -> (Set a, Set a)
-- unionIntersection m1 m2 =
--   case mergeA preserveAndDropMissing preserveAndDropMissing 'preserveMatched' m1 m2 of
--     Pair mu mi -> (mu, mi)
--   where
--     -- use Pair to build the union and intersection together
--     preserveAndDropMissing = 'whenMissing' (\\_x -> Pair True False) (\\s -> Pair s empty)
-- @
--
-- @
-- import Data.Functor.Const (Const(..))
-- import Data.Monoid (All(..))
--
-- -- | Whether the first set is a subset of the second set.
-- isSubsetOf :: Ord a => Set a -> Set a -> Bool
-- isSubsetOf m1 m2 =
--   getAll (getConst (mergeA isEmpty 'dropMissing' 'dropMatched' m1 m2))
--   where
--     isEmpty = 'whenMissing' (\\_x -> Const (All False)) (\\s -> Const (All (null s)))
-- @
--
-- @since 0.8.1
mergeA
  :: (Applicative f, Ord a)
  => WhenMissing f a -- ^ What to do with elements in @s1@ but not @s2@
  -> WhenMissing f a -- ^ What to do with elements in @s2@ but not @s1@
  -> WhenMatched f a -- ^ What to do with elements in both @s1@ and @s2@
  -> Set a -- ^ Set @s1@
  -> Set a -- ^ Set @s2@
  -> f (Set a)
mergeA :: forall (f :: * -> *) a.
(Applicative f, Ord a) =>
WhenMissing f a
-> WhenMissing f a
-> WhenMatched f a
-> Set a
-> Set a
-> f (Set a)
mergeA
    WhenMissing{missingSubtree :: forall (f :: * -> *) a. WhenMissing f a -> Set a -> f (Set a)
missingSubtree = Set a -> f (Set a)
g1t, missingElem :: forall (f :: * -> *) a. WhenMissing f a -> a -> f Bool
missingElem = a -> f Bool
g1k}
    WhenMissing{missingSubtree :: forall (f :: * -> *) a. WhenMissing f a -> Set a -> f (Set a)
missingSubtree = Set a -> f (Set a)
g2t}
    WhenMatched{matchedElem :: forall (f :: * -> *) a. WhenMatched f a -> a -> f Bool
matchedElem = a -> f Bool
f} = Set a -> Set a -> f (Set a)
go
  where
    go :: Set a -> Set a -> f (Set a)
go Set a
t1 Set a
Tip = Set a -> f (Set a)
g1t Set a
t1
    go Set a
Tip Set a
t2 = Set a -> f (Set a)
g2t Set a
t2
    go (Bin Size
_ a
x1 Set a
l1 Set a
r1) Set a
t2 = case a -> Set a -> (Set a, Bool, Set a)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x1 Set a
t2 of
      (Set a
l2, Bool
found, Set a
r2)
        | Bool
found -> (Set a -> Bool -> Set a -> Set a)
-> f (Set a) -> f Bool -> f (Set a) -> f (Set a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Set a -> Bool -> Set a -> Set a
doLink f (Set a)
l1l2 (a -> f Bool
f a
x1) f (Set a)
r1r2
        | Bool
otherwise -> (Set a -> Bool -> Set a -> Set a)
-> f (Set a) -> f Bool -> f (Set a) -> f (Set a)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Set a -> Bool -> Set a -> Set a
doLink f (Set a)
l1l2 (a -> f Bool
g1k a
x1) f (Set a)
r1r2
        where
          doLink :: Set a -> Bool -> Set a -> Set a
doLink Set a
l' Bool
True Set a
r' = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x1 Set a
l' Set a
r'
          doLink Set a
l' Bool
False Set a
r' = Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
link2 Set a
l' Set a
r'
          l1l2 :: f (Set a)
l1l2 = Set a -> Set a -> f (Set a)
go Set a
l1 Set a
l2
          r1r2 :: f (Set a)
r1r2 = Set a -> Set a -> f (Set a)
go Set a
r1 Set a
r2
{-# INLINE mergeA #-}

{--------------------------------------------------------------------
  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 Size
_ 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 Size
_ 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 Size
_ 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 Size
_ 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 Size
_ 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 Size
_ a
_ Set a
l Set a
r -> (Set a -> Size
forall a. Set a -> Size
size Set a
l Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Set a -> Size
forall a. Set a -> Size
size Set a
r Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
1 Bool -> Bool -> Bool
|| (Set a -> Size
forall a. Set a -> Size
size Set a
l Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Set a -> Size
forall a. Set a -> Size
size Set a
r Bool -> Bool -> Bool
&& Set a -> Size
forall a. Set a -> Size
size Set a
r Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Set a -> Size
forall a. Set a -> Size
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 Size
forall {a}. Set a -> Maybe Size
realsize Set a
t Maybe Size -> Maybe Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size -> Maybe Size
forall a. a -> Maybe a
Just (Set a -> Size
forall a. Set a -> Size
size Set a
t))
  where
    realsize :: Set a -> Maybe Size
realsize Set a
t'
      = case Set a
t' of
          Set a
Tip          -> Size -> Maybe Size
forall a. a -> Maybe a
Just Size
0
          Bin Size
sz a
_ Set a
l Set a
r -> case (Set a -> Maybe Size
realsize Set a
l,Set a -> Maybe Size
realsize Set a
r) of
                            (Just Size
n,Just Size
m)  | Size
nSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
mSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
sz  -> Size -> Maybe Size
forall a. a -> Maybe a
Just Size
sz
                            (Maybe Size, Maybe Size)
_                -> Maybe Size
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 implementation 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)

-- Note [alterF implementation]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- When implementing alterF, there are various costs to consider:
--
-- 1. The number of times we travel down the tree to the target
-- 2. The number of times we travel back up the tree
-- 3. The number of element comparisons we perform
-- 4. The number of times we apply fmap
-- 5. The amount of allocations we perform
--
-- The weights of these further depend on the Ord instance of the element type,
-- the Functor used, and GHC optimizations. Unfortunately, there is no clear
-- winning implementation which performs best in all situations. The current
-- implementation is chosen for its good characteristics:
--
-- 1. It travels down the tree once if the membership is demanded, and once more
--    if the changed Set is demanded.
-- 2. It travels up the tree once if the changed Set is demanded.
-- 3. It compares the given element against stored elements on the path to the
--    target at most once.
-- 4. It applies fmap exactly once.
-- 5. It allocates the changed Set if it is demanded. It does not allocate any
--    intermediate structure.
--
-- Note that 2,3,4,5 are all optimal. As for 1, implementations that travel down
-- the tree at most once are possible, but they are worse in at least one of the
-- other categories.
-- See https://github.com/haskell/containers/issues/1209#issuecomment-4530740850
-- for some other implementations and benchmarks.