{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
#endif
{-# OPTIONS_HADDOCK not-home #-}
#include "containers.h"
module Data.Set.Internal (
Set(..)
, Size
, (\\)
, null
, size
, member
, notMember
, lookupLT
, lookupGT
, lookupLE
, lookupGE
, isSubsetOf
, isProperSubsetOf
, disjoint
, empty
, singleton
, insert
, delete
, alterF
, powerSet
, union
, unions
, difference
, intersection
, cartesianProduct
, disjointUnion
, filter
, takeWhileAntitone
, dropWhileAntitone
, spanAntitone
, partition
, split
, splitMember
, splitRoot
, lookupIndex
, findIndex
, elemAt
, deleteAt
, take
, drop
, splitAt
, map
, mapMonotonic
, foldr
, foldl
, foldr'
, foldl'
, fold
, lookupMin
, lookupMax
, findMin
, findMax
, deleteMin
, deleteMax
, deleteFindMin
, deleteFindMax
, maxView
, minView
, elems
, toList
, fromList
, toAscList
, toDescList
, fromAscList
, fromDistinctAscList
, fromDescList
, fromDistinctDescList
, showTree
, showTreeWith
, valid
, bin
, balanced
, link
, merge
) where
import Prelude hiding (filter,foldl,foldr,null,map,take,drop,splitAt)
import Control.Applicative (Const(..))
import qualified Data.List as List
import Data.Bits (shiftL, shiftR)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..))
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(stimes))
#endif
#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup((<>)))
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (stimesIdempotentMonoid)
import Data.Functor.Classes
#endif
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity (Identity)
#endif
import qualified Data.Foldable as Foldable
#if !MIN_VERSION_base(4,8,0)
import Data.Foldable (Foldable (foldMap))
#endif
import Data.Typeable
import Control.DeepSeq (NFData(rnf))
import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.PtrEquality
#if __GLASGOW_HASKELL__
import GHC.Exts ( build, lazy )
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as GHCExts
#endif
import Text.Read ( readPrec, Read (..), Lexeme (..), parens, prec
, lexP, readListPrecDefault )
import Data.Data
#endif
infixl 9 \\
(\\) :: Ord a => Set a -> Set a -> Set a
Set a
m1 \\ :: forall a. Ord a => Set a -> Set a -> Set a
\\ Set a
m2 = forall a. Ord a => Set a -> Set a -> Set a
difference Set a
m1 Set a
m2
#if __GLASGOW_HASKELL__
{-# INLINABLE (\\) #-}
#endif
data Set a = Bin {-# UNPACK #-} !Size !a !(Set a) !(Set a)
| Tip
type Size = Int
#if __GLASGOW_HASKELL__ >= 708
type role Set nominal
#endif
instance Ord a => Monoid (Set a) where
mempty :: Set a
mempty = forall a. Set a
empty
mconcat :: [Set a] -> Set a
mconcat = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
unions
#if !(MIN_VERSION_base(4,9,0))
mappend = union
#else
mappend :: Set a -> Set a -> Set a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Ord a => Semigroup (Set a) where
<> :: 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 = forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid
#endif
instance Foldable.Foldable Set where
fold :: forall m. Monoid m => Set m -> m
fold = forall m. Monoid m => Set m -> m
go
where go :: Set a -> a
go Set a
Tip = forall a. Monoid a => a
mempty
go (Bin Int
1 a
k Set a
_ Set a
_) = a
k
go (Bin Int
_ a
k Set a
l Set a
r) = Set a -> a
go Set a
l forall a. Monoid a => a -> a -> a
`mappend` (a
k 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 = 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 = 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 = forall a. Monoid a => a
mempty
go (Bin Int
1 a
k Set a
_ Set a
_) = a -> m
f a
k
go (Bin Int
_ a
k Set a
l Set a
r) = Set a -> m
go Set a
l forall a. Monoid a => a -> a -> a
`mappend` (a -> m
f a
k 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' = 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' = forall a b. (a -> b -> b) -> b -> Set a -> b
foldr'
{-# INLINE foldr' #-}
#if MIN_VERSION_base(4,8,0)
length :: forall a. Set a -> Int
length = forall a. Set a -> Int
size
{-# INLINE length #-}
null :: forall a. Set a -> Bool
null = forall a. Set a -> Bool
null
{-# INLINE null #-}
toList :: forall a. Set a -> [a]
toList = forall a. Set a -> [a]
toList
{-# INLINE toList #-}
elem :: forall a. Eq a => a -> Set a -> Bool
elem = forall a. Eq a => a -> Set a -> Bool
go
where go :: t -> Set t -> Bool
go !t
_ Set t
Tip = Bool
False
go t
x (Bin Int
_ t
y Set t
l Set t
r) = t
x 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 = forall a. Set a -> a
findMin
{-# INLINE minimum #-}
maximum :: forall a. Ord a => Set a -> a
maximum = forall a. Set a -> a
findMax
{-# INLINE maximum #-}
sum :: forall a. Num a => Set a -> a
sum = forall b a. (b -> a -> b) -> b -> Set a -> b
foldl' forall a. Num a => a -> a -> a
(+) a
0
{-# INLINABLE sum #-}
product :: forall a. Num a => Set a -> a
product = forall b a. (b -> a -> b) -> b -> Set a -> b
foldl' forall a. Num a => a -> a -> a
(*) a
1
{-# INLINABLE product #-}
#endif
#if __GLASGOW_HASKELL__
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 = forall g. g -> c g
z forall a. Ord a => [a] -> Set a
fromList forall d b. Data d => c (d -> b) -> d -> c b
`f` (forall a. Set a -> [a]
toList Set a
set)
toConstr :: Set a -> Constr
toConstr Set a
_ = Constr
fromListConstr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Set a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
1 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall a. Ord a => [a] -> Set a
fromList)
Int
_ -> 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 = 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 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
null :: Set a -> Bool
null :: forall a. Set a -> Bool
null Set a
Tip = Bool
True
null (Bin {}) = Bool
False
{-# INLINE null #-}
size :: Set a -> Int
size :: forall a. Set a -> Int
size Set a
Tip = Int
0
size (Bin Int
sz a
_ Set a
_ Set a
_) = Int
sz
{-# INLINE size #-}
member :: Ord a => a -> Set a -> Bool
member :: forall a. Ord a => a -> Set a -> Bool
member = forall a. Ord a => a -> Set a -> Bool
go
where
go :: t -> Set t -> Bool
go !t
_ Set t
Tip = Bool
False
go t
x (Bin Int
_ t
y Set t
l Set t
r) = case forall a. Ord a => a -> a -> Ordering
compare t
x t
y of
Ordering
LT -> t -> Set t -> Bool
go t
x Set t
l
Ordering
GT -> t -> Set t -> Bool
go t
x Set t
r
Ordering
EQ -> Bool
True
#if __GLASGOW_HASKELL__
{-# INLINABLE member #-}
#else
{-# INLINE member #-}
#endif
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 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Bool
member a
a Set a
t
#if __GLASGOW_HASKELL__
{-# INLINABLE notMember #-}
#else
{-# INLINE notMember #-}
#endif
lookupLT :: Ord a => a -> Set a -> Maybe a
lookupLT :: forall a. Ord a => a -> Set a -> Maybe a
lookupLT = forall a. Ord a => a -> Set a -> Maybe a
goNothing
where
goNothing :: a -> Set a -> Maybe a
goNothing !a
_ Set a
Tip = forall a. Maybe a
Nothing
goNothing a
x (Bin Int
_ a
y Set a
l Set a
r) | a
x forall a. Ord a => a -> a -> Bool
<= a
y = a -> Set a -> Maybe a
goNothing a
x Set a
l
| Bool
otherwise = 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 = forall a. a -> Maybe a
Just t
best
goJust t
x t
best (Bin Int
_ t
y Set t
l Set t
r) | t
x forall a. Ord a => a -> a -> Bool
<= t
y = t -> t -> Set t -> Maybe t
goJust t
x t
best Set t
l
| Bool
otherwise = t -> t -> Set t -> Maybe t
goJust t
x t
y Set t
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupLT #-}
#else
{-# INLINE lookupLT #-}
#endif
lookupGT :: Ord a => a -> Set a -> Maybe a
lookupGT :: forall a. Ord a => a -> Set a -> Maybe a
lookupGT = forall a. Ord a => a -> Set a -> Maybe a
goNothing
where
goNothing :: t -> Set t -> Maybe t
goNothing !t
_ Set t
Tip = forall a. Maybe a
Nothing
goNothing t
x (Bin Int
_ t
y Set t
l Set t
r) | t
x forall a. Ord a => a -> a -> Bool
< t
y = 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 = forall a. a -> Maybe a
Just t
best
goJust t
x t
best (Bin Int
_ t
y Set t
l Set t
r) | t
x forall a. Ord a => a -> a -> Bool
< t
y = t -> t -> Set t -> Maybe t
goJust t
x t
y Set t
l
| Bool
otherwise = t -> t -> Set t -> Maybe t
goJust t
x t
best Set t
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupGT #-}
#else
{-# INLINE lookupGT #-}
#endif
lookupLE :: Ord a => a -> Set a -> Maybe a
lookupLE :: forall a. Ord a => a -> Set a -> Maybe a
lookupLE = forall a. Ord a => a -> Set a -> Maybe a
goNothing
where
goNothing :: a -> Set a -> Maybe a
goNothing !a
_ Set a
Tip = forall a. Maybe a
Nothing
goNothing a
x (Bin Int
_ a
y Set a
l Set a
r) = case 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 -> forall a. a -> Maybe a
Just a
y
Ordering
GT -> 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 = forall a. a -> Maybe a
Just t
best
goJust t
x t
best (Bin Int
_ t
y Set t
l Set t
r) = case 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 -> forall a. a -> Maybe a
Just t
y
Ordering
GT -> t -> t -> Set t -> Maybe t
goJust t
x t
y Set t
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupLE #-}
#else
{-# INLINE lookupLE #-}
#endif
lookupGE :: Ord a => a -> Set a -> Maybe a
lookupGE :: forall a. Ord a => a -> Set a -> Maybe a
lookupGE = forall a. Ord a => a -> Set a -> Maybe a
goNothing
where
goNothing :: t -> Set t -> Maybe t
goNothing !t
_ Set t
Tip = forall a. Maybe a
Nothing
goNothing t
x (Bin Int
_ t
y Set t
l Set t
r) = case forall a. Ord a => a -> a -> Ordering
compare t
x t
y of Ordering
LT -> forall {t}. Ord t => t -> t -> Set t -> Maybe t
goJust t
x t
y Set t
l
Ordering
EQ -> 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 = forall a. a -> Maybe a
Just a
best
goJust a
x a
best (Bin Int
_ a
y Set a
l Set a
r) = case 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 -> forall a. a -> Maybe a
Just a
y
Ordering
GT -> a -> a -> Set a -> Maybe a
goJust a
x a
best Set a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupGE #-}
#else
{-# INLINE lookupGE #-}
#endif
empty :: Set a
empty :: forall a. Set a
empty = forall a. Set a
Tip
{-# INLINE empty #-}
singleton :: a -> Set a
singleton :: forall a. a -> Set a
singleton a
x = forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip
{-# INLINE singleton #-}
insert :: Ord a => a -> Set a -> Set a
insert :: forall a. Ord a => a -> Set a -> Set a
insert a
x0 = 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 = forall a. a -> Set a
singleton (forall a. a -> a
lazy a
orig)
go a
orig !a
x t :: Set a
t@(Bin Int
sz a
y Set a
l Set a
r) = case forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
Ordering
LT | Set a
l' forall a. a -> a -> Bool
`ptrEq` Set a
l -> Set a
t
| Bool
otherwise -> forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
l' Set a
r
where !l' :: Set a
l' = forall a. Ord a => a -> a -> Set a -> Set a
go a
orig a
x Set a
l
Ordering
GT | Set a
r' forall a. a -> a -> Bool
`ptrEq` Set a
r -> Set a
t
| Bool
otherwise -> forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l Set a
r'
where !r' :: Set a
r' = forall a. Ord a => a -> a -> Set a -> Set a
go a
orig a
x Set a
r
Ordering
EQ | forall a. a -> a
lazy a
orig seq :: forall a b. a -> b -> b
`seq` (a
orig forall a. a -> a -> Bool
`ptrEq` a
y) -> Set a
t
| Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
sz (forall a. a -> a
lazy a
orig) Set a
l Set a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE insert #-}
#else
{-# INLINE insert #-}
#endif
#ifndef __GLASGOW_HASKELL__
lazy :: a -> a
lazy a = a
#endif
insertR :: Ord a => a -> Set a -> Set a
insertR :: forall a. Ord a => a -> Set a -> Set a
insertR a
x0 = 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 = forall a. a -> Set a
singleton (forall a. a -> a
lazy a
orig)
go a
orig !a
x t :: Set a
t@(Bin Int
_ a
y Set a
l Set a
r) = case forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
Ordering
LT | Set a
l' forall a. a -> a -> Bool
`ptrEq` Set a
l -> Set a
t
| Bool
otherwise -> forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
l' Set a
r
where !l' :: Set a
l' = forall a. Ord a => a -> a -> Set a -> Set a
go a
orig a
x Set a
l
Ordering
GT | Set a
r' forall a. a -> a -> Bool
`ptrEq` Set a
r -> Set a
t
| Bool
otherwise -> forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l Set a
r'
where !r' :: Set a
r' = forall a. Ord a => a -> a -> Set a -> Set a
go a
orig a
x Set a
r
Ordering
EQ -> Set a
t
#if __GLASGOW_HASKELL__
{-# INLINABLE insertR #-}
#else
{-# INLINE insertR #-}
#endif
delete :: Ord a => a -> Set a -> Set a
delete :: forall a. Ord a => a -> Set a -> Set a
delete = 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 = forall a. Set a
Tip
go a
x t :: Set a
t@(Bin Int
_ a
y Set a
l Set a
r) = case forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
Ordering
LT | Set a
l' forall a. a -> a -> Bool
`ptrEq` Set a
l -> Set a
t
| Bool
otherwise -> forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l' Set a
r
where !l' :: Set a
l' = forall a. Ord a => a -> Set a -> Set a
go a
x Set a
l
Ordering
GT | Set a
r' forall a. a -> a -> Bool
`ptrEq` Set a
r -> Set a
t
| Bool
otherwise -> forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
l Set a
r'
where !r' :: Set a
r' = forall a. Ord a => a -> Set a -> Set a
go a
x Set a
r
Ordering
EQ -> forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r
#if __GLASGOW_HASKELL__
{-# INLINABLE delete #-}
#else
{-# INLINE delete #-}
#endif
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Set a
choose (Bool -> f Bool
f Bool
member_)
where
(Bool
member_, Set a
inserted, Set a
deleted) = case forall a. Ord a => a -> Set a -> AlteredSet a
alteredSet a
k Set a
s of
Deleted Set a
d -> (Bool
True , Set a
s, Set a
d)
Inserted Set a
i -> (Bool
False, Set a
i, Set a
s)
choose :: Bool -> Set a
choose Bool
True = Set a
inserted
choose Bool
False = Set a
deleted
#ifndef __GLASGOW_HASKELL__
{-# INLINE alterF #-}
#else
{-# INLINABLE [2] alterF #-}
{-# RULES
"alterF/Const" forall k (f :: Bool -> Const a Bool) . alterF f k = \s -> Const . getConst . f $ member k s
#-}
#endif
#if MIN_VERSION_base(4,8,0)
{-# SPECIALIZE alterF :: Ord a => (Bool -> Identity Bool) -> a -> Set a -> Identity (Set a) #-}
#endif
data AlteredSet a
= Deleted !(Set a)
| Inserted !(Set a)
alteredSet :: Ord a => a -> Set a -> AlteredSet a
alteredSet :: forall a. Ord a => a -> Set a -> AlteredSet a
alteredSet a
x0 Set a
s0 = forall a. Ord a => a -> Set a -> AlteredSet a
go a
x0 Set a
s0
where
go :: Ord a => a -> Set a -> AlteredSet a
go :: forall a. Ord a => a -> Set a -> AlteredSet a
go a
x Set a
Tip = forall a. Set a -> AlteredSet a
Inserted (forall a. a -> Set a
singleton a
x)
go a
x (Bin Int
_ a
y Set a
l Set a
r) = case forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
Ordering
LT -> case forall a. Ord a => a -> Set a -> AlteredSet a
go a
x Set a
l of
Deleted Set a
d -> forall a. Set a -> AlteredSet a
Deleted (forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
d Set a
r)
Inserted Set a
i -> forall a. Set a -> AlteredSet a
Inserted (forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
i Set a
r)
Ordering
GT -> case forall a. Ord a => a -> Set a -> AlteredSet a
go a
x Set a
r of
Deleted Set a
d -> forall a. Set a -> AlteredSet a
Deleted (forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
l Set a
d)
Inserted Set a
i -> forall a. Set a -> AlteredSet a
Inserted (forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l Set a
i)
Ordering
EQ -> forall a. Set a -> AlteredSet a
Deleted (forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r)
#if __GLASGOW_HASKELL__
{-# INLINABLE alteredSet #-}
#else
{-# INLINE alteredSet #-}
#endif
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
= forall a. Set a -> Int
size Set a
s1 forall a. Ord a => a -> a -> Bool
< forall a. Set a -> Int
size Set a
s2 Bool -> Bool -> Bool
&& forall a. Ord a => Set a -> Set a -> Bool
isSubsetOfX Set a
s1 Set a
s2
#if __GLASGOW_HASKELL__
{-# INLINABLE isProperSubsetOf #-}
#endif
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
= forall a. Set a -> Int
size Set a
t1 forall a. Ord a => a -> a -> Bool
<= forall a. Set a -> Int
size Set a
t2 Bool -> Bool -> Bool
&& forall a. Ord a => Set a -> Set a -> Bool
isSubsetOfX Set a
t1 Set a
t2
#if __GLASGOW_HASKELL__
{-# INLINABLE isSubsetOf #-}
#endif
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
isSubsetOfX (Bin Int
1 a
x Set a
_ Set a
_) Set a
t = forall a. Ord a => a -> Set a -> Bool
member a
x Set a
t
isSubsetOfX (Bin Int
_ a
x Set a
l Set a
r) Set a
t
= Bool
found Bool -> Bool -> Bool
&&
forall a. Set a -> Int
size Set a
l forall a. Ord a => a -> a -> Bool
<= forall a. Set a -> Int
size Set a
lt Bool -> Bool -> Bool
&& forall a. Set a -> Int
size Set a
r forall a. Ord a => a -> a -> Bool
<= forall a. Set a -> Int
size Set a
gt Bool -> Bool -> Bool
&&
forall a. Ord a => Set a -> Set a -> Bool
isSubsetOfX Set a
l Set a
lt Bool -> Bool -> 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) = forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
t
#if __GLASGOW_HASKELL__
{-# INLINABLE isSubsetOfX #-}
#endif
disjoint :: 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
disjoint (Bin Int
1 a
x Set a
_ Set a
_) Set a
t = a
x forall a. Ord a => a -> Set a -> Bool
`notMember` Set a
t
disjoint (Bin Int
_ a
x Set a
l Set a
r) Set a
t
= Bool -> Bool
not Bool
found Bool -> Bool -> Bool
&& forall a. Ord a => Set a -> Set a -> Bool
disjoint Set a
l Set a
lt Bool -> Bool -> 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) = forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
t
lookupMinSure :: a -> Set a -> a
lookupMinSure :: forall a. a -> Set a -> a
lookupMinSure a
x Set a
Tip = a
x
lookupMinSure a
_ (Bin Int
_ a
x Set a
l Set a
_) = forall a. a -> Set a -> a
lookupMinSure a
x Set a
l
lookupMin :: Set a -> Maybe a
lookupMin :: forall a. Set a -> Maybe a
lookupMin Set a
Tip = forall a. Maybe a
Nothing
lookupMin (Bin Int
_ a
x Set a
l Set a
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall a. a -> Set a -> a
lookupMinSure a
x Set a
l
findMin :: Set a -> a
findMin :: forall a. Set a -> a
findMin Set a
t
| Just a
r <- forall a. Set a -> Maybe a
lookupMin Set a
t = a
r
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"Set.findMin: empty set has no minimal element"
lookupMaxSure :: a -> Set a -> a
lookupMaxSure :: forall a. a -> Set a -> a
lookupMaxSure a
x Set a
Tip = a
x
lookupMaxSure a
_ (Bin Int
_ a
x Set a
_ Set a
r) = forall a. a -> Set a -> a
lookupMaxSure a
x Set a
r
lookupMax :: Set a -> Maybe a
lookupMax :: forall a. Set a -> Maybe a
lookupMax Set a
Tip = forall a. Maybe a
Nothing
lookupMax (Bin Int
_ a
x Set a
_ Set a
r) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall a. a -> Set a -> a
lookupMaxSure a
x Set a
r
findMax :: Set a -> a
findMax :: forall a. Set a -> a
findMax Set a
t
| Just a
r <- forall a. Set a -> Maybe a
lookupMax Set a
t = a
r
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"Set.findMax: empty set has no maximal element"
deleteMin :: Set a -> Set a
deleteMin :: forall a. Set a -> Set a
deleteMin (Bin Int
_ a
_ Set a
Tip Set a
r) = Set a
r
deleteMin (Bin Int
_ a
x Set a
l Set a
r) = forall a. a -> Set a -> Set a -> Set a
balanceR a
x (forall a. Set a -> Set a
deleteMin Set a
l) Set a
r
deleteMin Set a
Tip = forall a. Set a
Tip
deleteMax :: Set a -> Set a
deleteMax :: forall a. Set a -> Set a
deleteMax (Bin Int
_ a
_ Set a
l Set a
Tip) = Set a
l
deleteMax (Bin Int
_ a
x Set a
l Set a
r) = forall a. a -> Set a -> Set a -> Set a
balanceL a
x Set a
l (forall a. Set a -> Set a
deleteMax Set a
r)
deleteMax Set a
Tip = forall a. Set a
Tip
unions :: (Foldable f, Ord a) => f (Set a) -> Set a
unions :: forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
unions = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' forall a. Ord a => Set a -> Set a -> Set a
union forall a. Set a
empty
#if __GLASGOW_HASKELL__
{-# INLINABLE unions #-}
#endif
union :: Ord a => Set a -> Set a -> Set a
union :: forall a. Ord a => Set a -> Set a -> Set a
union Set a
t1 Set a
Tip = Set a
t1
union Set a
t1 (Bin Int
1 a
x Set a
_ Set a
_) = forall a. Ord a => a -> Set a -> Set a
insertR a
x Set a
t1
union (Bin Int
1 a
x Set a
_ Set a
_) Set a
t2 = forall a. Ord a => a -> Set a -> Set a
insert a
x Set a
t2
union Set a
Tip Set a
t2 = Set a
t2
union t1 :: Set a
t1@(Bin Int
_ a
x Set a
l1 Set a
r1) Set a
t2 = case 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 forall a. a -> a -> Bool
`ptrEq` Set a
l1 Bool -> Bool -> Bool
&& Set a
r1r2 forall a. a -> a -> Bool
`ptrEq` Set a
r1 -> Set a
t1
| Bool
otherwise -> forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l1l2 Set a
r1r2
where !l1l2 :: Set a
l1l2 = forall a. Ord a => Set a -> Set a -> Set a
union Set a
l1 Set a
l2
!r1r2 :: Set a
r1r2 = forall a. Ord a => Set a -> Set a -> Set a
union Set a
r1 Set a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE union #-}
#endif
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
_ = forall a. Set a
Tip
difference Set a
t1 Set a
Tip = Set a
t1
difference Set a
t1 (Bin Int
_ a
x Set a
l2 Set a
r2) = case forall a. Ord a => a -> Set a -> (Set a, Set a)
split a
x Set a
t1 of
(Set a
l1, Set a
r1)
| forall a. Set a -> Int
size Set a
l1l2 forall a. Num a => a -> a -> a
+ forall a. Set a -> Int
size Set a
r1r2 forall a. Eq a => a -> a -> Bool
== forall a. Set a -> Int
size Set a
t1 -> Set a
t1
| Bool
otherwise -> forall a. Set a -> Set a -> Set a
merge Set a
l1l2 Set a
r1r2
where !l1l2 :: Set a
l1l2 = forall a. Ord a => Set a -> Set a -> Set a
difference Set a
l1 Set a
l2
!r1r2 :: Set a
r1r2 = forall a. Ord a => Set a -> Set a -> Set a
difference Set a
r1 Set a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE difference #-}
#endif
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
_ = forall a. Set a
Tip
intersection Set a
_ Set a
Tip = forall a. Set a
Tip
intersection t1 :: Set a
t1@(Bin Int
_ a
x Set a
l1 Set a
r1) Set a
t2
| Bool
b = if Set a
l1l2 forall a. a -> a -> Bool
`ptrEq` Set a
l1 Bool -> Bool -> Bool
&& Set a
r1r2 forall a. a -> a -> Bool
`ptrEq` Set a
r1
then Set a
t1
else forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l1l2 Set a
r1r2
| Bool
otherwise = forall a. Set a -> Set a -> Set a
merge Set a
l1l2 Set a
r1r2
where
!(Set a
l2, Bool
b, Set a
r2) = forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
t2
!l1l2 :: Set a
l1l2 = forall a. Ord a => Set a -> Set a -> Set a
intersection Set a
l1 Set a
l2
!r1r2 :: Set a
r1r2 = forall a. Ord a => Set a -> Set a -> Set a
intersection Set a
r1 Set a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE intersection #-}
#endif
filter :: (a -> Bool) -> Set a -> Set a
filter :: forall a. (a -> Bool) -> Set a -> Set a
filter a -> Bool
_ Set a
Tip = forall a. Set a
Tip
filter a -> Bool
p t :: Set a
t@(Bin Int
_ a
x Set a
l Set a
r)
| a -> Bool
p a
x = if Set a
l forall a. a -> a -> Bool
`ptrEq` Set a
l' Bool -> Bool -> Bool
&& Set a
r forall a. a -> a -> Bool
`ptrEq` Set a
r'
then Set a
t
else forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l' Set a
r'
| Bool
otherwise = forall a. Set a -> Set a -> Set a
merge Set a
l' Set a
r'
where
!l' :: Set a
l' = forall a. (a -> Bool) -> Set a -> Set a
filter a -> Bool
p Set a
l
!r' :: Set a
r' = forall a. (a -> Bool) -> Set a -> Set a
filter a -> Bool
p Set a
r
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 = forall a b. StrictPair a b -> (a, b)
toPair forall a b. (a -> b) -> a -> b
$ 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 = (forall a. Set a
Tip forall a b. a -> b -> StrictPair a b
:*: forall a. Set a
Tip)
go a -> Bool
p t :: Set a
t@(Bin Int
_ a
x Set a
l Set a
r) = case ((a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
p Set a
l, (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
p Set a
r) of
((Set a
l1 :*: Set a
l2), (Set a
r1 :*: Set a
r2))
| a -> Bool
p a
x -> (if Set a
l1 forall a. a -> a -> Bool
`ptrEq` Set a
l Bool -> Bool -> Bool
&& Set a
r1 forall a. a -> a -> Bool
`ptrEq` Set a
r
then Set a
t
else forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l1 Set a
r1) forall a b. a -> b -> StrictPair a b
:*: forall a. Set a -> Set a -> Set a
merge Set a
l2 Set a
r2
| Bool
otherwise -> forall a. Set a -> Set a -> Set a
merge Set a
l1 Set a
r1 forall a b. a -> b -> StrictPair a b
:*:
(if Set a
l2 forall a. a -> a -> Bool
`ptrEq` Set a
l Bool -> Bool -> Bool
&& Set a
r2 forall a. a -> a -> Bool
`ptrEq` Set a
r
then Set a
t
else forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l2 Set a
r2)
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 = forall a. Ord a => [a] -> Set a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
toList
#if __GLASGOW_HASKELL__
{-# INLINABLE map #-}
#endif
mapMonotonic :: (a->b) -> Set a -> Set b
mapMonotonic :: forall a b. (a -> b) -> Set a -> Set b
mapMonotonic a -> b
_ Set a
Tip = forall a. Set a
Tip
mapMonotonic a -> b
f (Bin Int
sz a
x Set a
l Set a
r) = forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
sz (a -> b
f a
x) (forall a b. (a -> b) -> Set a -> Set b
mapMonotonic a -> b
f Set a
l) (forall a b. (a -> b) -> Set a -> Set b
mapMonotonic a -> b
f Set a
r)
fold :: (a -> b -> b) -> b -> Set a -> b
fold :: forall a b. (a -> b -> b) -> b -> Set a -> b
fold = forall a b. (a -> b -> b) -> b -> Set a -> b
foldr
{-# INLINE fold #-}
foldr :: (a -> b -> b) -> b -> Set a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldr a -> b -> b
f b
z = b -> Set a -> b
go b
z
where
go :: b -> Set a -> b
go b
z' Set a
Tip = b
z'
go b
z' (Bin Int
_ a
x Set a
l Set a
r) = b -> Set a -> b
go (a -> b -> b
f a
x (b -> Set a -> b
go b
z' Set a
r)) Set a
l
{-# INLINE foldr #-}
foldr' :: (a -> b -> b) -> b -> Set a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldr' a -> b -> b
f b
z = b -> Set a -> b
go b
z
where
go :: b -> Set a -> b
go !b
z' Set a
Tip = b
z'
go b
z' (Bin Int
_ a
x Set a
l Set a
r) = b -> Set a -> b
go (a -> b -> b
f a
x forall a b. (a -> b) -> a -> b
$! b -> Set a -> b
go b
z' Set a
r) Set a
l
{-# INLINE foldr' #-}
foldl :: (a -> b -> a) -> a -> Set b -> a
foldl :: forall b a. (b -> a -> b) -> b -> Set a -> b
foldl a -> b -> a
f a
z = a -> Set b -> a
go a
z
where
go :: a -> Set b -> a
go a
z' Set b
Tip = a
z'
go a
z' (Bin Int
_ b
x Set b
l Set b
r) = a -> Set b -> a
go (a -> b -> a
f (a -> Set b -> a
go a
z' Set b
l) b
x) Set b
r
{-# INLINE foldl #-}
foldl' :: (a -> b -> a) -> a -> Set b -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Set a -> b
foldl' a -> b -> a
f a
z = a -> Set b -> a
go a
z
where
go :: a -> Set b -> a
go !a
z' Set b
Tip = a
z'
go a
z' (Bin Int
_ b
x Set b
l Set b
r) =
let !z'' :: a
z'' = a -> Set b -> a
go a
z' Set b
l
in a -> Set b -> a
go (a -> b -> a
f a
z'' b
x) Set b
r
{-# INLINE foldl' #-}
elems :: Set a -> [a]
elems :: forall a. Set a -> [a]
elems = forall a. Set a -> [a]
toAscList
#if __GLASGOW_HASKELL__ >= 708
instance (Ord a) => GHCExts.IsList (Set a) where
type Item (Set a) = a
fromList :: [Item (Set a)] -> Set a
fromList = forall a. Ord a => [a] -> Set a
fromList
toList :: Set a -> [Item (Set a)]
toList = forall a. Set a -> [a]
toList
#endif
toList :: Set a -> [a]
toList :: forall a. Set a -> [a]
toList = forall a. Set a -> [a]
toAscList
toAscList :: Set a -> [a]
toAscList :: forall a. Set a -> [a]
toAscList = forall a b. (a -> b -> b) -> b -> Set a -> b
foldr (:) []
toDescList :: Set a -> [a]
toDescList :: forall a. Set a -> [a]
toDescList = forall b a. (b -> a -> b) -> b -> Set a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []
#if __GLASGOW_HASKELL__
foldrFB :: (a -> b -> b) -> b -> Set a -> b
foldrFB :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldrFB = 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 = forall b a. (b -> a -> b) -> b -> Set a -> b
foldl
{-# INLINE[0] foldlFB #-}
{-# INLINE elems #-}
{-# INLINE toList #-}
{-# 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
fromList :: Ord a => [a] -> Set a
fromList :: forall a. Ord a => [a] -> Set a
fromList [] = forall a. Set a
Tip
fromList [a
x] = forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip
fromList (a
x0 : [a]
xs0) | forall {a}. Ord a => a -> [a] -> Bool
not_ordered a
x0 [a]
xs0 = forall {t :: * -> *} {a}.
(Foldable t, Ord a) =>
Set a -> t a -> Set a
fromList' (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x0 forall a. Set a
Tip forall a. Set a
Tip) [a]
xs0
| Bool
otherwise = forall {a} {t}.
(Ord a, Num t, Bits t) =>
t -> Set a -> [a] -> Set a
go (Int
1::Int) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x0 forall a. Set a
Tip forall a. Set a
Tip) [a]
xs0
where
not_ordered :: a -> [a] -> Bool
not_ordered a
_ [] = Bool
False
not_ordered a
x (a
y : [a]
_) = a
x forall a. Ord a => a -> a -> Bool
>= a
y
{-# INLINE not_ordered #-}
fromList' :: Set a -> t a -> Set a
fromList' Set a
t0 t a
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' forall {a}. Ord a => Set a -> a -> Set a
ins Set a
t0 t a
xs
where ins :: Set a -> a -> Set a
ins Set a
t a
x = forall a. Ord a => a -> Set a -> Set a
insert a
x Set a
t
go :: t -> Set a -> [a] -> Set a
go !t
_ Set a
t [] = Set a
t
go t
_ Set a
t [a
x] = forall a. a -> Set a -> Set a
insertMax a
x Set a
t
go t
s Set a
l xs :: [a]
xs@(a
x : [a]
xss) | forall {a}. Ord a => a -> [a] -> Bool
not_ordered a
x [a]
xss = forall {t :: * -> *} {a}.
(Foldable t, Ord a) =>
Set a -> t a -> Set a
fromList' Set a
l [a]
xs
| Bool
otherwise = case forall {t} {a}.
(Num t, Ord a, Bits t) =>
t -> [a] -> (Set a, [a], [a])
create t
s [a]
xss of
(Set a
r, [a]
ys, []) -> t -> Set a -> [a] -> Set a
go (t
s forall a. Bits a => a -> Int -> a
`shiftL` Int
1) (forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
r) [a]
ys
(Set a
r, [a]
_, [a]
ys) -> forall {t :: * -> *} {a}.
(Foldable t, Ord a) =>
Set a -> t a -> Set a
fromList' (forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
r) [a]
ys
create :: t -> [a] -> (Set a, [a], [a])
create !t
_ [] = (forall a. Set a
Tip, [], [])
create t
s xs :: [a]
xs@(a
x : [a]
xss)
| t
s forall a. Eq a => a -> a -> Bool
== t
1 = if forall {a}. Ord a => a -> [a] -> Bool
not_ordered a
x [a]
xss then (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip, [], [a]
xss)
else (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip, [a]
xss, [])
| Bool
otherwise = case t -> [a] -> (Set a, [a], [a])
create (t
s forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [a]
xs of
res :: (Set a, [a], [a])
res@(Set a
_, [], [a]
_) -> (Set a, [a], [a])
res
(Set a
l, [a
y], [a]
zs) -> (forall a. a -> Set a -> Set a
insertMax a
y Set a
l, [], [a]
zs)
(Set a
l, ys :: [a]
ys@(a
y:[a]
yss), [a]
_) | forall {a}. Ord a => a -> [a] -> Bool
not_ordered a
y [a]
yss -> (Set a
l, [], [a]
ys)
| Bool
otherwise -> case t -> [a] -> (Set a, [a], [a])
create (t
s forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [a]
yss of
(Set a
r, [a]
zs, [a]
ws) -> (forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
r, [a]
zs, [a]
ws)
#if __GLASGOW_HASKELL__
{-# INLINABLE fromList #-}
#endif
fromAscList :: Eq a => [a] -> Set a
fromAscList :: forall a. Eq a => [a] -> Set a
fromAscList [a]
xs = forall a. [a] -> Set a
fromDistinctAscList (forall a. Eq a => [a] -> [a]
combineEq [a]
xs)
#if __GLASGOW_HASKELL__
{-# INLINABLE fromAscList #-}
#endif
fromDescList :: Eq a => [a] -> Set a
fromDescList :: forall a. Eq a => [a] -> Set a
fromDescList [a]
xs = forall a. [a] -> Set a
fromDistinctDescList (forall a. Eq a => [a] -> [a]
combineEq [a]
xs)
#if __GLASGOW_HASKELL__
{-# INLINABLE fromDescList #-}
#endif
combineEq :: Eq a => [a] -> [a]
combineEq :: forall a. Eq a => [a] -> [a]
combineEq [] = []
combineEq (a
x : [a]
xs) = forall {t}. Eq t => t -> [t] -> [t]
combineEq' a
x [a]
xs
where
combineEq' :: t -> [t] -> [t]
combineEq' t
z [] = [t
z]
combineEq' t
z (t
y:[t]
ys)
| t
z forall a. Eq a => a -> a -> Bool
== t
y = t -> [t] -> [t]
combineEq' t
z [t]
ys
| Bool
otherwise = t
z forall a. a -> [a] -> [a]
: t -> [t] -> [t]
combineEq' t
y [t]
ys
fromDistinctAscList :: [a] -> Set a
fromDistinctAscList :: forall a. [a] -> Set a
fromDistinctAscList [] = forall a. Set a
Tip
fromDistinctAscList (a
x0 : [a]
xs0) = forall {t} {a}. (Num t, Bits t) => t -> Set a -> [a] -> Set a
go (Int
1::Int) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x0 forall a. Set a
Tip forall a. Set a
Tip) [a]
xs0
where
go :: t -> Set a -> [a] -> Set a
go !t
_ Set a
t [] = Set a
t
go t
s Set a
l (a
x : [a]
xs) = case forall {t} {a}.
(Num t, Bits t) =>
t -> [a] -> StrictPair (Set a) [a]
create t
s [a]
xs of
(Set a
r :*: [a]
ys) -> let !t' :: Set a
t' = forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
r
in t -> Set a -> [a] -> Set a
go (t
s forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Set a
t' [a]
ys
create :: t -> [a] -> StrictPair (Set a) [a]
create !t
_ [] = (forall a. Set a
Tip forall a b. a -> b -> StrictPair a b
:*: [])
create t
s xs :: [a]
xs@(a
x : [a]
xs')
| t
s forall a. Eq a => a -> a -> Bool
== t
1 = (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip forall a b. a -> b -> StrictPair a b
:*: [a]
xs')
| Bool
otherwise = case t -> [a] -> StrictPair (Set a) [a]
create (t
s forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [a]
xs of
res :: StrictPair (Set a) [a]
res@(Set a
_ :*: []) -> StrictPair (Set a) [a]
res
(Set a
l :*: (a
y:[a]
ys)) -> case t -> [a] -> StrictPair (Set a) [a]
create (t
s forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [a]
ys of
(Set a
r :*: [a]
zs) -> (forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
r forall a b. a -> b -> StrictPair a b
:*: [a]
zs)
fromDistinctDescList :: [a] -> Set a
fromDistinctDescList :: forall a. [a] -> Set a
fromDistinctDescList [] = forall a. Set a
Tip
fromDistinctDescList (a
x0 : [a]
xs0) = forall {t} {a}. (Num t, Bits t) => t -> Set a -> [a] -> Set a
go (Int
1::Int) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x0 forall a. Set a
Tip forall a. Set a
Tip) [a]
xs0
where
go :: t -> Set a -> [a] -> Set a
go !t
_ Set a
t [] = Set a
t
go t
s Set a
r (a
x : [a]
xs) = case forall {t} {a}.
(Num t, Bits t) =>
t -> [a] -> StrictPair (Set a) [a]
create t
s [a]
xs of
(Set a
l :*: [a]
ys) -> let !t' :: Set a
t' = forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
r
in t -> Set a -> [a] -> Set a
go (t
s forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Set a
t' [a]
ys
create :: t -> [a] -> StrictPair (Set a) [a]
create !t
_ [] = (forall a. Set a
Tip forall a b. a -> b -> StrictPair a b
:*: [])
create t
s xs :: [a]
xs@(a
x : [a]
xs')
| t
s forall a. Eq a => a -> a -> Bool
== t
1 = (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip forall a b. a -> b -> StrictPair a b
:*: [a]
xs')
| Bool
otherwise = case t -> [a] -> StrictPair (Set a) [a]
create (t
s forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [a]
xs of
res :: StrictPair (Set a) [a]
res@(Set a
_ :*: []) -> StrictPair (Set a) [a]
res
(Set a
r :*: (a
y:[a]
ys)) -> case t -> [a] -> StrictPair (Set a) [a]
create (t
s forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [a]
ys of
(Set a
l :*: [a]
zs) -> (forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
r forall a b. a -> b -> StrictPair a b
:*: [a]
zs)
instance Eq a => Eq (Set a) where
Set a
t1 == :: Set a -> Set a -> Bool
== Set a
t2 = (forall a. Set a -> Int
size Set a
t1 forall a. Eq a => a -> a -> Bool
== forall a. Set a -> Int
size Set a
t2) Bool -> Bool -> Bool
&& (forall a. Set a -> [a]
toAscList Set a
t1 forall a. Eq a => a -> a -> Bool
== forall a. Set a -> [a]
toAscList Set a
t2)
instance Ord a => Ord (Set a) where
compare :: Set a -> Set a -> Ordering
compare Set a
s1 Set a
s2 = forall a. Ord a => a -> a -> Ordering
compare (forall a. Set a -> [a]
toAscList Set a
s1) (forall a. Set a -> [a]
toAscList Set a
s2)
instance Show a => Show (Set a) where
showsPrec :: Int -> Set a -> ShowS
showsPrec Int
p Set a
xs = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
[Char] -> ShowS
showString [Char]
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. Set a -> [a]
toList Set a
xs)
#if MIN_VERSION_base(4,9,0)
instance Eq1 Set where
liftEq :: forall a b. (a -> b -> Bool) -> Set a -> Set b -> Bool
liftEq a -> b -> Bool
eq Set a
m Set b
n =
forall a. Set a -> Int
size Set a
m forall a. Eq a => a -> a -> Bool
== forall a. Set a -> Int
size Set b
n Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (forall a. Set a -> [a]
toList Set a
m) (forall a. Set a -> [a]
toList Set b
n)
instance Ord1 Set where
liftCompare :: forall a b. (a -> b -> Ordering) -> Set a -> Set b -> Ordering
liftCompare a -> b -> Ordering
cmp Set a
m Set b
n =
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (forall a. Set a -> [a]
toList Set a
m) (forall a. Set a -> [a]
toList Set b
n)
instance Show1 Set where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Set a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d Set a
m =
forall a. (Int -> a -> ShowS) -> [Char] -> Int -> a -> ShowS
showsUnaryWith (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) [Char]
"fromList" Int
d (forall a. Set a -> [a]
toList Set a
m)
#endif
instance (Read a, Ord a) => Read (Set a) where
#ifdef __GLASGOW_HASKELL__
readPrec :: ReadPrec (Set a)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
[a]
xs <- forall a. Read a => ReadPrec a
readPrec
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => [a] -> Set a
fromList [a]
xs)
readListPrec :: ReadPrec [Set a]
readListPrec = 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
INSTANCE_TYPEABLE1(Set)
instance NFData a => NFData (Set a) where
rnf :: Set a -> ()
rnf Set a
Tip = ()
rnf (Bin Int
_ a
y Set a
l Set a
r) = forall a. NFData a => a -> ()
rnf a
y seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Set a
l seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Set a
r
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 = forall a b. StrictPair a b -> (a, b)
toPair forall a b. (a -> b) -> a -> b
$ 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 = (forall a. Set a
Tip forall a b. a -> b -> StrictPair a b
:*: forall a. Set a
Tip)
splitS a
x (Bin Int
_ a
y Set a
l Set a
r)
= case forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
Ordering
LT -> let (Set a
lt :*: Set a
gt) = forall a. Ord a => a -> Set a -> StrictPair (Set a) (Set a)
splitS a
x Set a
l in (Set a
lt forall a b. a -> b -> StrictPair a b
:*: forall a. a -> Set a -> Set a -> Set a
link a
y Set a
gt Set a
r)
Ordering
GT -> let (Set a
lt :*: Set a
gt) = forall a. Ord a => a -> Set a -> StrictPair (Set a) (Set a)
splitS a
x Set a
r in (forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
lt forall a b. a -> b -> StrictPair a b
:*: Set a
gt)
Ordering
EQ -> (Set a
l forall a b. a -> b -> StrictPair a b
:*: Set a
r)
{-# INLINABLE splitS #-}
splitMember :: Ord a => a -> Set a -> (Set a,Bool,Set a)
splitMember :: forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
_ Set a
Tip = (forall a. Set a
Tip, Bool
False, forall a. Set a
Tip)
splitMember a
x (Bin Int
_ a
y Set a
l Set a
r)
= case forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
Ordering
LT -> let (Set a
lt, Bool
found, Set a
gt) = forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
l
!gt' :: Set a
gt' = forall a. a -> Set a -> Set a -> Set a
link a
y Set a
gt Set a
r
in (Set a
lt, Bool
found, Set a
gt')
Ordering
GT -> let (Set a
lt, Bool
found, Set a
gt) = forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
r
!lt' :: Set a
lt' = forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
lt
in (Set a
lt', Bool
found, Set a
gt)
Ordering
EQ -> (Set a
l, Bool
True, Set a
r)
#if __GLASGOW_HASKELL__
{-# INLINABLE splitMember #-}
#endif
findIndex :: Ord a => a -> Set a -> Int
findIndex :: forall a. Ord a => a -> Set a -> Int
findIndex = forall a. Ord a => Int -> a -> Set a -> Int
go Int
0
where
go :: Ord a => Int -> a -> Set a -> Int
go :: forall a. Ord a => Int -> a -> Set a -> Int
go !Int
_ !a
_ Set a
Tip = forall a. HasCallStack => [Char] -> a
error [Char]
"Set.findIndex: element is not in the set"
go Int
idx a
x (Bin Int
_ a
kx Set a
l Set a
r) = case forall a. Ord a => a -> a -> Ordering
compare a
x a
kx of
Ordering
LT -> forall a. Ord a => Int -> a -> Set a -> Int
go Int
idx a
x Set a
l
Ordering
GT -> forall a. Ord a => Int -> a -> Set a -> Int
go (Int
idx forall a. Num a => a -> a -> a
+ forall a. Set a -> Int
size Set a
l forall a. Num a => a -> a -> a
+ Int
1) a
x Set a
r
Ordering
EQ -> Int
idx forall a. Num a => a -> a -> a
+ forall a. Set a -> Int
size Set a
l
#if __GLASGOW_HASKELL__
{-# INLINABLE findIndex #-}
#endif
lookupIndex :: Ord a => a -> Set a -> Maybe Int
lookupIndex :: forall a. Ord a => a -> Set a -> Maybe Int
lookupIndex = forall a. Ord a => Int -> a -> Set a -> Maybe Int
go Int
0
where
go :: Ord a => Int -> a -> Set a -> Maybe Int
go :: forall a. Ord a => Int -> a -> Set a -> Maybe Int
go !Int
_ !a
_ Set a
Tip = forall a. Maybe a
Nothing
go Int
idx a
x (Bin Int
_ a
kx Set a
l Set a
r) = case forall a. Ord a => a -> a -> Ordering
compare a
x a
kx of
Ordering
LT -> forall a. Ord a => Int -> a -> Set a -> Maybe Int
go Int
idx a
x Set a
l
Ordering
GT -> forall a. Ord a => Int -> a -> Set a -> Maybe Int
go (Int
idx forall a. Num a => a -> a -> a
+ forall a. Set a -> Int
size Set a
l forall a. Num a => a -> a -> a
+ Int
1) a
x Set a
r
Ordering
EQ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Int
idx forall a. Num a => a -> a -> a
+ forall a. Set a -> Int
size Set a
l
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupIndex #-}
#endif
elemAt :: Int -> Set a -> a
elemAt :: forall a. Int -> Set a -> a
elemAt !Int
_ Set a
Tip = forall a. HasCallStack => [Char] -> a
error [Char]
"Set.elemAt: index out of range"
elemAt Int
i (Bin Int
_ a
x Set a
l Set a
r)
= case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
Ordering
LT -> forall a. Int -> Set a -> a
elemAt Int
i Set a
l
Ordering
GT -> forall a. Int -> Set a -> a
elemAt (Int
iforall a. Num a => a -> a -> a
-Int
sizeLforall a. Num a => a -> a -> a
-Int
1) Set a
r
Ordering
EQ -> a
x
where
sizeL :: Int
sizeL = forall a. Set a -> Int
size Set a
l
deleteAt :: Int -> Set a -> Set a
deleteAt :: forall a. Int -> Set a -> Set a
deleteAt !Int
i Set a
t =
case Set a
t of
Set a
Tip -> forall a. HasCallStack => [Char] -> a
error [Char]
"Set.deleteAt: index out of range"
Bin Int
_ a
x Set a
l Set a
r -> case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
Ordering
LT -> forall a. a -> Set a -> Set a -> Set a
balanceR a
x (forall a. Int -> Set a -> Set a
deleteAt Int
i Set a
l) Set a
r
Ordering
GT -> forall a. a -> Set a -> Set a -> Set a
balanceL a
x Set a
l (forall a. Int -> Set a -> Set a
deleteAt (Int
iforall a. Num a => a -> a -> a
-Int
sizeLforall a. Num a => a -> a -> a
-Int
1) Set a
r)
Ordering
EQ -> forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r
where
sizeL :: Int
sizeL = forall a. Set a -> Int
size Set a
l
take :: Int -> Set a -> Set a
take :: forall a. Int -> Set a -> Set a
take Int
i Set a
m | Int
i forall a. Ord a => a -> a -> Bool
>= forall a. Set a -> Int
size Set a
m = Set a
m
take Int
i0 Set a
m0 = forall a. Int -> Set a -> Set a
go Int
i0 Set a
m0
where
go :: Int -> Set a -> Set a
go Int
i !Set a
_ | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Set a
Tip
go !Int
_ Set a
Tip = forall a. Set a
Tip
go Int
i (Bin Int
_ a
x Set a
l Set a
r) =
case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
Ordering
LT -> Int -> Set a -> Set a
go Int
i Set a
l
Ordering
GT -> forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l (Int -> Set a -> Set a
go (Int
i forall a. Num a => a -> a -> a
- Int
sizeL forall a. Num a => a -> a -> a
- Int
1) Set a
r)
Ordering
EQ -> Set a
l
where sizeL :: Int
sizeL = forall a. Set a -> Int
size Set a
l
drop :: Int -> Set a -> Set a
drop :: forall a. Int -> Set a -> Set a
drop Int
i Set a
m | Int
i forall a. Ord a => a -> a -> Bool
>= forall a. Set a -> Int
size Set a
m = forall a. Set a
Tip
drop Int
i0 Set a
m0 = forall a. Int -> Set a -> Set a
go Int
i0 Set a
m0
where
go :: Int -> Set a -> Set a
go Int
i Set a
m | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = Set a
m
go !Int
_ Set a
Tip = forall a. Set a
Tip
go Int
i (Bin Int
_ a
x Set a
l Set a
r) =
case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
Ordering
LT -> forall a. a -> Set a -> Set a -> Set a
link a
x (Int -> Set a -> Set a
go Int
i Set a
l) Set a
r
Ordering
GT -> Int -> Set a -> Set a
go (Int
i forall a. Num a => a -> a -> a
- Int
sizeL forall a. Num a => a -> a -> a
- Int
1) Set a
r
Ordering
EQ -> forall a. a -> Set a -> Set a
insertMin a
x Set a
r
where sizeL :: Int
sizeL = forall a. Set a -> Int
size Set a
l
splitAt :: Int -> Set a -> (Set a, Set a)
splitAt :: forall a. Int -> Set a -> (Set a, Set a)
splitAt Int
i0 Set a
m0
| Int
i0 forall a. Ord a => a -> a -> Bool
>= forall a. Set a -> Int
size Set a
m0 = (Set a
m0, forall a. Set a
Tip)
| Bool
otherwise = forall a b. StrictPair a b -> (a, b)
toPair forall a b. (a -> b) -> a -> b
$ forall {a}. Int -> Set a -> StrictPair (Set a) (Set a)
go Int
i0 Set a
m0
where
go :: Int -> Set a -> StrictPair (Set a) (Set a)
go Int
i Set a
m | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Set a
Tip forall a b. a -> b -> StrictPair a b
:*: Set a
m
go !Int
_ Set a
Tip = forall a. Set a
Tip forall a b. a -> b -> StrictPair a b
:*: forall a. Set a
Tip
go Int
i (Bin Int
_ a
x Set a
l Set a
r)
= case forall a. Ord a => a -> a -> Ordering
compare Int
i Int
sizeL of
Ordering
LT -> case Int -> Set a -> StrictPair (Set a) (Set a)
go Int
i Set a
l of
Set a
ll :*: Set a
lr -> Set a
ll forall a b. a -> b -> StrictPair a b
:*: forall a. a -> Set a -> Set a -> Set a
link a
x Set a
lr Set a
r
Ordering
GT -> case Int -> Set a -> StrictPair (Set a) (Set a)
go (Int
i forall a. Num a => a -> a -> a
- Int
sizeL forall a. Num a => a -> a -> a
- Int
1) Set a
r of
Set a
rl :*: Set a
rr -> forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
rl forall a b. a -> b -> StrictPair a b
:*: Set a
rr
Ordering
EQ -> Set a
l forall a b. a -> b -> StrictPair a b
:*: forall a. a -> Set a -> Set a
insertMin a
x Set a
r
where sizeL :: Int
sizeL = forall a. Set a -> Int
size Set a
l
takeWhileAntitone :: (a -> Bool) -> Set a -> Set a
takeWhileAntitone :: forall a. (a -> Bool) -> Set a -> Set a
takeWhileAntitone a -> Bool
_ Set a
Tip = forall a. Set a
Tip
takeWhileAntitone a -> Bool
p (Bin Int
_ a
x Set a
l Set a
r)
| a -> Bool
p a
x = forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l (forall a. (a -> Bool) -> Set a -> Set a
takeWhileAntitone a -> Bool
p Set a
r)
| Bool
otherwise = forall a. (a -> Bool) -> Set a -> Set a
takeWhileAntitone a -> Bool
p Set a
l
dropWhileAntitone :: (a -> Bool) -> Set a -> Set a
dropWhileAntitone :: forall a. (a -> Bool) -> Set a -> Set a
dropWhileAntitone a -> Bool
_ Set a
Tip = forall a. Set a
Tip
dropWhileAntitone a -> Bool
p (Bin Int
_ a
x Set a
l Set a
r)
| a -> Bool
p a
x = forall a. (a -> Bool) -> Set a -> Set a
dropWhileAntitone a -> Bool
p Set a
r
| Bool
otherwise = forall a. a -> Set a -> Set a -> Set a
link a
x (forall a. (a -> Bool) -> Set a -> Set a
dropWhileAntitone a -> Bool
p Set a
l) Set a
r
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 = forall a b. StrictPair a b -> (a, b)
toPair (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 = forall a. Set a
Tip forall a b. a -> b -> StrictPair a b
:*: forall a. Set a
Tip
go a -> Bool
p (Bin Int
_ a
x Set a
l Set a
r)
| a -> Bool
p a
x = let Set a
u :*: Set a
v = (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
p Set a
r in forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
u 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 forall a b. a -> b -> StrictPair a b
:*: forall a. a -> Set a -> Set a -> Set a
link a
x Set a
v Set a
r
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 = forall a. a -> Set a -> Set a
insertMin a
x Set a
r
link a
x Set a
l Set a
Tip = forall a. a -> Set a -> Set a
insertMax a
x Set a
l
link a
x l :: Set a
l@(Bin Int
sizeL a
y Set a
ly Set a
ry) r :: Set a
r@(Bin Int
sizeR a
z Set a
lz Set a
rz)
| Int
deltaforall a. Num a => a -> a -> a
*Int
sizeL forall a. Ord a => a -> a -> Bool
< Int
sizeR = forall a. a -> Set a -> Set a -> Set a
balanceL a
z (forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
lz) Set a
rz
| Int
deltaforall a. Num a => a -> a -> a
*Int
sizeR forall a. Ord a => a -> a -> Bool
< Int
sizeL = forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
ly (forall a. a -> Set a -> Set a -> Set a
link a
x Set a
ry Set a
r)
| Bool
otherwise = forall a. a -> Set a -> Set a -> Set a
bin a
x Set a
l Set a
r
insertMax,insertMin :: a -> Set a -> Set a
insertMax :: forall a. a -> Set a -> Set a
insertMax a
x Set a
t
= case Set a
t of
Set a
Tip -> forall a. a -> Set a
singleton a
x
Bin Int
_ a
y Set a
l Set a
r
-> forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l (forall a. a -> Set a -> Set a
insertMax a
x Set a
r)
insertMin :: forall a. a -> Set a -> Set a
insertMin a
x Set a
t
= case Set a
t of
Set a
Tip -> forall a. a -> Set a
singleton a
x
Bin Int
_ a
y Set a
l Set a
r
-> forall a. a -> Set a -> Set a -> Set a
balanceL a
y (forall a. a -> Set a -> Set a
insertMin a
x Set a
l) Set a
r
merge :: Set a -> Set a -> Set a
merge :: forall a. Set a -> Set a -> Set a
merge Set a
Tip Set a
r = Set a
r
merge Set a
l Set a
Tip = Set a
l
merge l :: Set a
l@(Bin Int
sizeL a
x Set a
lx Set a
rx) r :: Set a
r@(Bin Int
sizeR a
y Set a
ly Set a
ry)
| Int
deltaforall a. Num a => a -> a -> a
*Int
sizeL forall a. Ord a => a -> a -> Bool
< Int
sizeR = forall a. a -> Set a -> Set a -> Set a
balanceL a
y (forall a. Set a -> Set a -> Set a
merge Set a
l Set a
ly) Set a
ry
| Int
deltaforall a. Num a => a -> a -> a
*Int
sizeR forall a. Ord a => a -> a -> Bool
< Int
sizeL = forall a. a -> Set a -> Set a -> Set a
balanceR a
x Set a
lx (forall a. Set a -> Set a -> Set a
merge Set a
rx Set a
r)
| Bool
otherwise = forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r
glue :: Set a -> Set a -> Set a
glue :: forall a. Set a -> Set a -> Set a
glue Set a
Tip Set a
r = Set a
r
glue Set a
l Set a
Tip = Set a
l
glue l :: Set a
l@(Bin Int
sl a
xl Set a
ll Set a
lr) r :: Set a
r@(Bin Int
sr a
xr Set a
rl Set a
rr)
| Int
sl forall a. Ord a => a -> a -> Bool
> Int
sr = let !(a
m :*: Set a
l') = forall a. a -> Set a -> Set a -> StrictPair a (Set a)
maxViewSure a
xl Set a
ll Set a
lr in forall a. a -> Set a -> Set a -> Set a
balanceR a
m Set a
l' Set a
r
| Bool
otherwise = let !(a
m :*: Set a
r') = forall a. a -> Set a -> Set a -> StrictPair a (Set a)
minViewSure a
xr Set a
rl Set a
rr in forall a. a -> Set a -> Set a -> Set a
balanceL a
m Set a
l Set a
r'
deleteFindMin :: Set a -> (a,Set a)
deleteFindMin :: forall a. Set a -> (a, Set a)
deleteFindMin Set a
t
| Just (a, Set a)
r <- forall a. Set a -> Maybe (a, Set a)
minView Set a
t = (a, Set a)
r
| Bool
otherwise = (forall a. HasCallStack => [Char] -> a
error [Char]
"Set.deleteFindMin: can not return the minimal element of an empty set", forall a. Set a
Tip)
deleteFindMax :: Set a -> (a,Set a)
deleteFindMax :: forall a. Set a -> (a, Set a)
deleteFindMax Set a
t
| Just (a, Set a)
r <- forall a. Set a -> Maybe (a, Set a)
maxView Set a
t = (a, Set a)
r
| Bool
otherwise = (forall a. HasCallStack => [Char] -> a
error [Char]
"Set.deleteFindMax: can not return the maximal element of an empty set", 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 = 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 forall a b. a -> b -> StrictPair a b
:*: Set t
r
go t
x (Bin Int
_ t
xl Set t
ll Set t
lr) Set t
r =
case t -> Set t -> Set t -> StrictPair t (Set t)
go t
xl Set t
ll Set t
lr of
t
xm :*: Set t
l' -> t
xm forall a b. a -> b -> StrictPair a b
:*: forall a. a -> Set a -> Set a -> Set a
balanceR t
x Set t
l' Set t
r
minView :: Set a -> Maybe (a, Set a)
minView :: forall a. Set a -> Maybe (a, Set a)
minView Set a
Tip = forall a. Maybe a
Nothing
minView (Bin Int
_ a
x Set a
l Set a
r) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall a b. StrictPair a b -> (a, b)
toPair forall a b. (a -> b) -> a -> b
$ 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 = 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 forall a b. a -> b -> StrictPair a b
:*: Set t
l
go t
x Set t
l (Bin Int
_ t
xr Set t
rl Set t
rr) =
case t -> Set t -> Set t -> StrictPair t (Set t)
go t
xr Set t
rl Set t
rr of
t
xm :*: Set t
r' -> t
xm forall a b. a -> b -> StrictPair a b
:*: forall a. a -> Set a -> Set a -> Set a
balanceL t
x Set t
l Set t
r'
maxView :: Set a -> Maybe (a, Set a)
maxView :: forall a. Set a -> Maybe (a, Set a)
maxView Set a
Tip = forall a. Maybe a
Nothing
maxView (Bin Int
_ a
x Set a
l Set a
r) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall a b. StrictPair a b -> (a, b)
toPair forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a -> Set a -> StrictPair a (Set a)
maxViewSure a
x Set a
l Set a
r
delta,ratio :: Int
delta :: Int
delta = Int
3
ratio :: Int
ratio = Int
2
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 -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip
(Bin Int
_ a
_ Set a
Tip Set a
Tip) -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
2 a
x Set a
l forall a. Set a
Tip
(Bin Int
_ a
lx Set a
Tip (Bin Int
_ a
lrx Set a
_ Set a
_)) -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
lrx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
lx forall a. Set a
Tip forall a. Set a
Tip) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip)
(Bin Int
_ a
lx ll :: Set a
ll@(Bin Int
_ a
_ Set a
_ Set a
_) Set a
Tip) -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
lx Set a
ll (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip)
(Bin Int
ls a
lx ll :: Set a
ll@(Bin Int
lls a
_ Set a
_ Set a
_) lr :: Set a
lr@(Bin Int
lrs a
lrx Set a
lrl Set a
lrr))
| Int
lrs forall a. Ord a => a -> a -> Bool
< Int
ratioforall a. Num a => a -> a -> a
*Int
lls -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
ls) a
lx Set a
ll (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lrs) a
x Set a
lr forall a. Set a
Tip)
| Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
ls) a
lrx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
llsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
size Set a
lrl) a
lx Set a
ll Set a
lrl) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+forall a. Set a -> Int
size Set a
lrr) a
x Set a
lrr forall a. Set a
Tip)
(Bin Int
rs a
_ Set a
_ Set a
_) -> case Set a
l of
Set a
Tip -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rs) a
x forall a. Set a
Tip Set a
r
(Bin Int
ls a
lx Set a
ll Set a
lr)
| Int
ls forall a. Ord a => a -> a -> Bool
> Int
deltaforall a. Num a => a -> a -> a
*Int
rs -> case (Set a
ll, Set a
lr) of
(Bin Int
lls a
_ Set a
_ Set a
_, Bin Int
lrs a
lrx Set a
lrl Set a
lrr)
| Int
lrs forall a. Ord a => a -> a -> Bool
< Int
ratioforall a. Num a => a -> a -> a
*Int
lls -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rs) a
lx Set a
ll (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rsforall a. Num a => a -> a -> a
+Int
lrs) a
x Set a
lr Set a
r)
| Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rs) a
lrx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
llsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
size Set a
lrl) a
lx Set a
ll Set a
lrl) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
size Set a
lrr) a
x Set a
lrr Set a
r)
(Set a
_, Set a
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balanceL"
| Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rs) a
x Set a
l Set a
r
{-# NOINLINE balanceL #-}
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 -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip
(Bin Int
_ a
_ Set a
Tip Set a
Tip) -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
2 a
x forall a. Set a
Tip Set a
r
(Bin Int
_ a
rx Set a
Tip rr :: Set a
rr@(Bin Int
_ a
_ Set a
_ Set a
_)) -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
rx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip) Set a
rr
(Bin Int
_ a
rx (Bin Int
_ a
rlx Set a
_ Set a
_) Set a
Tip) -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
rlx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
rx forall a. Set a
Tip forall a. Set a
Tip)
(Bin Int
rs a
rx rl :: Set a
rl@(Bin Int
rls a
rlx Set a
rll Set a
rlr) rr :: Set a
rr@(Bin Int
rrs a
_ Set a
_ Set a
_))
| Int
rls forall a. Ord a => a -> a -> Bool
< Int
ratioforall a. Num a => a -> a -> a
*Int
rrs -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rs) a
rx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rls) a
x forall a. Set a
Tip Set a
rl) Set a
rr
| Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rs) a
rlx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+forall a. Set a -> Int
size Set a
rll) a
x forall a. Set a
Tip Set a
rll) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rrsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
size Set a
rlr) a
rx Set a
rlr Set a
rr)
(Bin Int
ls a
_ Set a
_ Set a
_) -> case Set a
r of
Set a
Tip -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
ls) a
x Set a
l forall a. Set a
Tip
(Bin Int
rs a
rx Set a
rl Set a
rr)
| Int
rs forall a. Ord a => a -> a -> Bool
> Int
deltaforall a. Num a => a -> a -> a
*Int
ls -> case (Set a
rl, Set a
rr) of
(Bin Int
rls a
rlx Set a
rll Set a
rlr, Bin Int
rrs a
_ Set a
_ Set a
_)
| Int
rls forall a. Ord a => a -> a -> Bool
< Int
ratioforall a. Num a => a -> a -> a
*Int
rrs -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rs) a
rx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rls) a
x Set a
l Set a
rl) Set a
rr
| Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rs) a
rlx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
size Set a
rll) a
x Set a
l Set a
rll) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rrsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
size Set a
rlr) a
rx Set a
rlr Set a
rr)
(Set a
_, Set a
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balanceR"
| Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rs) a
x Set a
l Set a
r
{-# NOINLINE balanceR #-}
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
= forall a. Int -> a -> Set a -> Set a -> Set a
Bin (forall a. Set a -> Int
size Set a
l forall a. Num a => a -> a -> a
+ forall a. Set a -> Int
size Set a
r forall a. Num a => a -> a -> a
+ Int
1) a
x Set a
l Set a
r
{-# INLINE bin #-}
splitRoot :: Set a -> [Set a]
splitRoot :: forall a. Set a -> [Set a]
splitRoot Set a
orig =
case Set a
orig of
Set a
Tip -> []
Bin Int
_ a
v Set a
l Set a
r -> [Set a
l, forall a. a -> Set a
singleton a
v, Set a
r]
{-# INLINE splitRoot #-}
powerSet :: Set a -> Set (Set a)
powerSet :: forall a. Set a -> Set (Set a)
powerSet Set a
xs0 = forall a. a -> Set a -> Set a
insertMin forall a. Set a
empty (forall a b. (a -> b -> b) -> b -> Set a -> b
foldr' forall {a}. a -> Set (Set a) -> Set (Set a)
step forall a. Set a
Tip Set a
xs0) where
step :: a -> Set (Set a) -> Set (Set a)
step a
x Set (Set a)
pxs = forall a. a -> Set a -> Set a
insertMin (forall a. a -> Set a
singleton a
x) (forall a. a -> Set a -> Set a
insertMin a
x forall a b. (a -> b) -> Set a -> Set b
`mapMonotonic` Set (Set a)
pxs) forall a. Set a -> Set a -> Set a
`glue` Set (Set a)
pxs
cartesianProduct :: Set a -> Set b -> Set (a, b)
cartesianProduct :: forall a b. Set a -> Set b -> Set (a, b)
cartesianProduct !Set a
_as Set b
Tip = forall a. Set a
Tip
cartesianProduct Set a
as (Bin Int
1 b
b Set b
_ Set b
_) = forall a b. (a -> b) -> Set a -> Set b
mapMonotonic (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
b) Set a
as
cartesianProduct Set a
as Set b
bs =
forall a. MergeSet a -> Set a
getMergeSet forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\a
a -> forall a. Set a -> MergeSet a
MergeSet forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Set a -> Set b
mapMonotonic ((,) a
a) Set b
bs) Set a
as
newtype MergeSet a = MergeSet { forall a. MergeSet a -> Set a
getMergeSet :: Set a }
#if (MIN_VERSION_base(4,9,0))
instance Semigroup (MergeSet a) where
MergeSet Set a
xs <> :: MergeSet a -> MergeSet a -> MergeSet a
<> MergeSet Set a
ys = forall a. Set a -> MergeSet a
MergeSet (forall a. Set a -> Set a -> Set a
merge Set a
xs Set a
ys)
#endif
instance Monoid (MergeSet a) where
mempty :: MergeSet a
mempty = forall a. Set a -> MergeSet a
MergeSet forall a. Set a
empty
#if (MIN_VERSION_base(4,9,0))
mappend :: MergeSet a -> MergeSet a -> MergeSet a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
#else
mappend (MergeSet xs) (MergeSet ys) = MergeSet (merge xs ys)
#endif
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 = forall a. Set a -> Set a -> Set a
merge (forall a b. (a -> b) -> Set a -> Set b
mapMonotonic forall a b. a -> Either a b
Left Set a
as) (forall a b. (a -> b) -> Set a -> Set b
mapMonotonic forall a b. b -> Either a b
Right Set b
bs)
showTree :: Show a => Set a -> String
showTree :: forall a. Show a => Set a -> [Char]
showTree Set a
s
= forall a. Show a => Bool -> Bool -> Set a -> [Char]
showTreeWith Bool
True Bool
False Set a
s
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 = (forall a. Show a => Bool -> [[Char]] -> Set a -> ShowS
showsTreeHang Bool
wide [] Set a
t) [Char]
""
| Bool
otherwise = (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"
Bin Int
_ a
x Set a
Tip Set a
Tip
-> [[Char]] -> ShowS
showsBars [[Char]]
lbars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
Bin Int
_ a
x Set a
l Set a
r
-> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
rbars forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[[Char]] -> ShowS
showsBars [[Char]]
lbars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
lbars forall b c a. (b -> c) -> (a -> b) -> a -> c
.
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"
Bin Int
_ a
x Set a
Tip Set a
Tip
-> [[Char]] -> ShowS
showsBars [[Char]]
bars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n"
Bin Int
_ a
x Set a
l Set a
r
-> [[Char]] -> ShowS
showsBars [[Char]]
bars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
bars forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Show a => Bool -> [[Char]] -> Set a -> ShowS
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
bars) Set a
l forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> ShowS
showWide Bool
wide [[Char]]
bars forall b c a. (b -> c) -> (a -> b) -> a -> c
.
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 (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. [a] -> [a]
reverse [[Char]]
bars)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"|\n"
| Bool
otherwise = forall a. a -> a
id
showsBars :: [String] -> ShowS
showsBars :: [[Char]] -> ShowS
showsBars [[Char]]
bars
= case [[Char]]
bars of
[] -> forall a. a -> a
id
[[Char]]
_ -> [Char] -> ShowS
showString (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. [a] -> [a]
reverse (forall a. [a] -> [a]
tail [[Char]]
bars))) 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]
"| "forall a. a -> [a] -> [a]
:[[Char]]
bars
withEmpty :: [[Char]] -> [[Char]]
withEmpty [[Char]]
bars = [Char]
" "forall a. a -> [a] -> [a]
:[[Char]]
bars
valid :: Ord a => Set a -> Bool
valid :: forall a. Ord a => Set a -> Bool
valid Set a
t
= forall a. Set a -> Bool
balanced Set a
t Bool -> Bool -> Bool
&& forall a. Ord a => Set a -> Bool
ordered Set a
t Bool -> Bool -> 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
= forall {t}. Ord t => (t -> Bool) -> (t -> Bool) -> Set t -> Bool
bounded (forall a b. a -> b -> a
const Bool
True) (forall a b. a -> b -> a
const Bool
True) Set a
t
where
bounded :: (t -> Bool) -> (t -> Bool) -> Set t -> Bool
bounded t -> Bool
lo t -> Bool
hi Set t
t'
= case Set t
t' of
Set t
Tip -> Bool
True
Bin Int
_ t
x Set t
l Set t
r -> (t -> Bool
lo t
x) Bool -> Bool -> Bool
&& (t -> Bool
hi t
x) Bool -> Bool -> Bool
&& (t -> Bool) -> (t -> Bool) -> Set t -> Bool
bounded t -> Bool
lo (forall a. Ord a => a -> a -> Bool
<t
x) Set t
l Bool -> Bool -> Bool
&& (t -> Bool) -> (t -> Bool) -> Set t -> Bool
bounded (forall a. Ord a => a -> a -> Bool
>t
x) t -> Bool
hi Set t
r
balanced :: Set a -> Bool
balanced :: forall a. Set a -> Bool
balanced Set a
t
= case Set a
t of
Set a
Tip -> Bool
True
Bin Int
_ a
_ Set a
l Set a
r -> (forall a. Set a -> Int
size Set a
l forall a. Num a => a -> a -> a
+ forall a. Set a -> Int
size Set a
r forall a. Ord a => a -> a -> Bool
<= Int
1 Bool -> Bool -> Bool
|| (forall a. Set a -> Int
size Set a
l forall a. Ord a => a -> a -> Bool
<= Int
deltaforall a. Num a => a -> a -> a
*forall a. Set a -> Int
size Set a
r Bool -> Bool -> Bool
&& forall a. Set a -> Int
size Set a
r forall a. Ord a => a -> a -> Bool
<= Int
deltaforall a. Num a => a -> a -> a
*forall a. Set a -> Int
size Set a
l)) Bool -> Bool -> Bool
&&
forall a. Set a -> Bool
balanced Set a
l Bool -> Bool -> Bool
&& forall a. Set a -> Bool
balanced Set a
r
validsize :: Set a -> Bool
validsize :: forall a. Set a -> Bool
validsize Set a
t
= (forall {a}. Set a -> Maybe Int
realsize Set a
t forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall a. Set a -> Int
size Set a
t))
where
realsize :: Set a -> Maybe Int
realsize Set a
t'
= case Set a
t' of
Set a
Tip -> forall a. a -> Maybe a
Just Int
0
Bin Int
sz a
_ Set a
l Set a
r -> case (Set a -> Maybe Int
realsize Set a
l,Set a -> Maybe Int
realsize Set a
r) of
(Just Int
n,Just Int
m) | Int
nforall a. Num a => a -> a -> a
+Int
mforall a. Num a => a -> a -> a
+Int
1 forall a. Eq a => a -> a -> Bool
== Int
sz -> forall a. a -> Maybe a
Just Int
sz
(Maybe Int, Maybe Int)
_ -> forall a. Maybe a
Nothing