{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# 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
, intersections
, cartesianProduct
, disjointUnion
, Intersection(..)
, 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 Utils.Containers.Internal.Prelude hiding
(filter,foldl,foldr,null,map,take,drop,splitAt)
import Prelude ()
import Control.Applicative (Const(..))
import qualified Data.List as List
import Data.Bits (shiftL, shiftR)
import Data.Semigroup (Semigroup(stimes))
import Data.List.NonEmpty (NonEmpty(..))
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup((<>)))
#endif
import Data.Semigroup (stimesIdempotentMonoid, stimesIdempotent)
import Data.Functor.Classes
import Data.Functor.Identity (Identity)
import qualified Data.Foldable as Foldable
import Control.DeepSeq (NFData(rnf))
import Utils.Containers.Internal.StrictPair
import Utils.Containers.Internal.PtrEquality
#if __GLASGOW_HASKELL__
import GHC.Exts ( build, lazy )
import qualified GHC.Exts as GHCExts
import Text.Read ( readPrec, Read (..), Lexeme (..), parens, prec
, lexP, readListPrecDefault )
import Data.Data
import Language.Haskell.TH.Syntax (Lift)
import Language.Haskell.TH ()
#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 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
difference Set a
m1 Set a
m2
#if __GLASGOW_HASKELL__
{-# INLINABLE (\\) #-}
#endif
data Set a = Bin {-# UNPACK #-} !Size !a !(Set a) !(Set a)
| Tip
type Size = Int
#ifdef __GLASGOW_HASKELL__
type role Set nominal
#endif
deriving instance Lift a => Lift (Set a)
instance Ord a => Monoid (Set a) where
mempty :: Set a
mempty = Set a
forall a. Set a
empty
mconcat :: [Set a] -> Set a
mconcat = [Set a] -> Set a
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
unions
mappend :: Set a -> Set a -> Set a
mappend = Set a -> Set a -> Set a
forall a. Semigroup a => a -> a -> a
(<>)
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
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__
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
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 -> Size
size Set a
Tip = Size
0
size (Bin Size
sz a
_ Set a
_ Set a
_) = Size
sz
{-# INLINE size #-}
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
#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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
member a
a Set a
t
#if __GLASGOW_HASKELL__
{-# INLINABLE notMember #-}
#else
{-# INLINE notMember #-}
#endif
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
#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 = 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
#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 = 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
#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 = 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
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupGE #-}
#else
{-# INLINE lookupGE #-}
#endif
empty :: Set a
empty :: forall a. Set a
empty = Set a
forall a. Set a
Tip
{-# INLINE empty #-}
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 #-}
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
#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 = 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
#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 = 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
#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 = (Bool -> Set a) -> f Bool -> f (Set a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Set a
choose (Bool -> f Bool
f Bool
member_)
where
(Bool
member_, Set a
inserted, Set a
deleted) = case a -> Set a -> AlteredSet a
forall a. Ord a => a -> Set a -> AlteredSet a
alteredSet a
k Set a
s of
Deleted Set a
d -> (Bool
True , Set a
s, Set a
d)
Inserted Set a
i -> (Bool
False, Set a
i, Set a
s)
choose :: Bool -> Set a
choose Bool
True = Set a
inserted
choose Bool
False = Set a
deleted
#ifndef __GLASGOW_HASKELL__
{-# INLINE alterF #-}
#else
{-# INLINABLE [2] alterF #-}
{-# RULES
"alterF/Const" forall k (f :: Bool -> Const a Bool) . alterF f k = \s -> Const . getConst . f $ member k s
#-}
#endif
{-# SPECIALIZE alterF :: Ord a => (Bool -> Identity Bool) -> a -> Set a -> Identity (Set a) #-}
data AlteredSet a
= 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 = a -> Set a -> AlteredSet a
forall a. Ord a => a -> Set a -> AlteredSet a
go a
x0 Set a
s0
where
go :: Ord a => a -> Set a -> AlteredSet a
go :: forall a. Ord a => a -> Set a -> AlteredSet a
go a
x Set a
Tip = Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Inserted (a -> Set a
forall a. a -> Set a
singleton a
x)
go a
x (Bin 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 -> AlteredSet a
forall a. Ord a => a -> Set a -> AlteredSet a
go a
x Set a
l of
Deleted Set a
d -> Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Deleted (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
d Set a
r)
Inserted Set a
i -> Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Inserted (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
i Set a
r)
Ordering
GT -> case a -> Set a -> AlteredSet a
forall a. Ord a => a -> Set a -> AlteredSet a
go a
x Set a
r of
Deleted Set a
d -> Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Deleted (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y Set a
l Set a
d)
Inserted Set a
i -> Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Inserted (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l Set a
i)
Ordering
EQ -> Set a -> AlteredSet a
forall a. Set a -> AlteredSet a
Deleted (Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r)
#if __GLASGOW_HASKELL__
{-# INLINABLE alteredSet #-}
#else
{-# INLINE alteredSet #-}
#endif
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
#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
= 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
#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 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
&&
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
#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 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
= 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
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
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
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
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
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"
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
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
unions :: (Foldable f, Ord a) => f (Set a) -> Set a
unions :: forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
unions = (Set a -> Set a -> Set a) -> Set a -> f (Set a) -> Set a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
union Set a
forall a. Set a
empty
#if __GLASGOW_HASKELL__
{-# INLINABLE unions #-}
#endif
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
#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
_ = 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
merge Set a
l1l2 Set a
r1r2
where !l1l2 :: Set a
l1l2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
difference Set a
l1 Set a
l2
!r1r2 :: Set a
r1r2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
difference Set a
r1 Set a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE difference #-}
#endif
intersection :: 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
merge Set a
l1l2 Set a
r1r2
where
!(Set a
l2, Bool
b, Set a
r2) = a -> Set a -> (Set a, Bool, Set a)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
t2
!l1l2 :: Set a
l1l2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
intersection Set a
l1 Set a
l2
!r1r2 :: Set a
r1r2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
intersection Set a
r1 Set a
r2
#if __GLASGOW_HASKELL__
{-# INLINABLE intersection #-}
#endif
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 -> (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 -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
intersection Set a
acc Set a
s)
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
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
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
merge Set a
l' Set a
r'
where
!l' :: Set a
l' = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
filter a -> Bool
p Set a
l
!r' :: Set a
r' = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
filter a -> Bool
p Set a
r
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
merge Set a
l2 Set a
r2
| Bool
otherwise -> Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
l1 Set a
r1 Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*:
(if Set a
l2 Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
l Bool -> Bool -> Bool
&& Set a
r2 Set a -> Set a -> Bool
forall a. a -> a -> Bool
`ptrEq` Set a
r
then Set a
t
else a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l2 Set a
r2)
map :: Ord b => (a->b) -> Set a -> Set b
map :: forall b a. Ord b => (a -> b) -> Set a -> Set b
map a -> b
f = [b] -> Set b
forall a. Ord a => [a] -> Set a
fromList ([b] -> Set b) -> (Set a -> [b]) -> Set a -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
List.map a -> b
f ([a] -> [b]) -> (Set a -> [a]) -> Set a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
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 = 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 :: (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 #-}
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 #-}
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' #-}
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 #-}
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' #-}
elems :: Set a -> [a]
elems :: forall a. Set a -> [a]
elems = Set a -> [a]
forall a. Set a -> [a]
toAscList
#ifdef __GLASGOW_HASKELL__
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
toList :: Set a -> [a]
toList :: forall a. Set a -> [a]
toList = Set a -> [a]
forall a. Set a -> [a]
toAscList
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 (:) []
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 (:)) []
#if __GLASGOW_HASKELL__
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 #-}
{-# 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 [] = Set a
forall a. Set a
Tip
fromList [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
fromList (a
x0 : [a]
xs0) | a -> [a] -> Bool
forall {a}. Ord a => a -> [a] -> Bool
not_ordered a
x0 [a]
xs0 = Set a -> [a] -> Set a
forall {t :: * -> *} {a}.
(Foldable t, Ord a) =>
Set a -> t a -> Set a
fromList' (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
x0 Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) [a]
xs0
| Bool
otherwise = Size -> Set a -> [a] -> Set a
forall {a} {t}.
(Ord a, Num t, Bits t) =>
t -> Set a -> [a] -> Set a
go (Size
1::Int) (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
x0 Set a
forall a. Set a
Tip Set a
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 a -> a -> Bool
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 = (Set a -> a -> Set a) -> Set a -> t a -> Set a
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Set a -> a -> Set a
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 = a -> Set a -> Set a
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] = a -> Set a -> Set a
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) | a -> [a] -> Bool
forall {a}. Ord a => a -> [a] -> Bool
not_ordered a
x [a]
xss = Set a -> [a] -> Set a
forall {t :: * -> *} {a}.
(Foldable t, Ord a) =>
Set a -> t a -> Set a
fromList' Set a
l [a]
xs
| Bool
otherwise = case t -> [a] -> (Set a, [a], [a])
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 t -> Size -> t
forall a. Bits a => a -> Size -> a
`shiftL` Size
1) (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) [a]
ys
(Set a
r, [a]
_, [a]
ys) -> Set a -> [a] -> Set a
forall {t :: * -> *} {a}.
(Foldable t, Ord a) =>
Set a -> t a -> Set a
fromList' (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) [a]
ys
create :: t -> [a] -> (Set a, [a], [a])
create !t
_ [] = (Set a
forall a. Set a
Tip, [], [])
create t
s xs :: [a]
xs@(a
x : [a]
xss)
| t
s t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1 = if a -> [a] -> Bool
forall {a}. Ord a => a -> [a] -> Bool
not_ordered a
x [a]
xss then (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, [], [a]
xss)
else (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, [a]
xss, [])
| Bool
otherwise = case t -> [a] -> (Set a, [a], [a])
create (t
s t -> Size -> t
forall a. Bits a => a -> Size -> a
`shiftR` Size
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) -> (a -> Set a -> Set a
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]
_) | a -> [a] -> Bool
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 t -> Size -> t
forall a. Bits a => a -> Size -> a
`shiftR` Size
1) [a]
yss of
(Set a
r, [a]
zs, [a]
ws) -> (a -> Set a -> Set a -> Set a
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 = [a] -> Set a
forall a. [a] -> Set a
fromDistinctAscList ([a] -> [a]
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 = [a] -> Set a
forall a. [a] -> Set a
fromDistinctDescList ([a] -> [a]
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) = a -> [a] -> [a]
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 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
y = t -> [t] -> [t]
combineEq' t
z [t]
ys
| Bool
otherwise = t
z t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t] -> [t]
combineEq' t
y [t]
ys
fromDistinctAscList :: [a] -> Set a
fromDistinctAscList :: forall a. [a] -> Set a
fromDistinctAscList [] = Set a
forall a. Set a
Tip
fromDistinctAscList (a
x0 : [a]
xs0) = Size -> Set a -> [a] -> Set a
forall {t} {a}. (Num t, Bits t) => t -> Set a -> [a] -> Set a
go (Size
1::Int) (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
x0 Set a
forall a. Set a
Tip Set a
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 t -> [a] -> StrictPair (Set a) [a]
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' = 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
in t -> Set a -> [a] -> Set a
go (t
s t -> Size -> t
forall a. Bits a => a -> Size -> a
`shiftL` Size
1) Set a
t' [a]
ys
create :: t -> [a] -> StrictPair (Set a) [a]
create !t
_ [] = (Set a
forall a. Set a
Tip Set a -> [a] -> StrictPair (Set a) [a]
forall a b. a -> b -> StrictPair a b
:*: [])
create t
s xs :: [a]
xs@(a
x : [a]
xs')
| t
s t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1 = (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 -> [a] -> StrictPair (Set a) [a]
forall a b. a -> b -> StrictPair a b
:*: [a]
xs')
| Bool
otherwise = case t -> [a] -> StrictPair (Set a) [a]
create (t
s t -> Size -> t
forall a. Bits a => a -> Size -> a
`shiftR` Size
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 t -> Size -> t
forall a. Bits a => a -> Size -> a
`shiftR` Size
1) [a]
ys of
(Set a
r :*: [a]
zs) -> (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
r Set a -> [a] -> StrictPair (Set a) [a]
forall a b. a -> b -> StrictPair a b
:*: [a]
zs)
fromDistinctDescList :: [a] -> Set a
fromDistinctDescList :: forall a. [a] -> Set a
fromDistinctDescList [] = Set a
forall a. Set a
Tip
fromDistinctDescList (a
x0 : [a]
xs0) = Size -> Set a -> [a] -> Set a
forall {t} {a}. (Num t, Bits t) => t -> Set a -> [a] -> Set a
go (Size
1::Int) (Size -> a -> Set a -> Set a -> Set a
forall a. Size -> a -> Set a -> Set a -> Set a
Bin Size
1 a
x0 Set a
forall a. Set a
Tip Set a
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 t -> [a] -> StrictPair (Set a) [a]
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' = 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
in t -> Set a -> [a] -> Set a
go (t
s t -> Size -> t
forall a. Bits a => a -> Size -> a
`shiftL` Size
1) Set a
t' [a]
ys
create :: t -> [a] -> StrictPair (Set a) [a]
create !t
_ [] = (Set a
forall a. Set a
Tip Set a -> [a] -> StrictPair (Set a) [a]
forall a b. a -> b -> StrictPair a b
:*: [])
create t
s xs :: [a]
xs@(a
x : [a]
xs')
| t
s t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1 = (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 -> [a] -> StrictPair (Set a) [a]
forall a b. a -> b -> StrictPair a b
:*: [a]
xs')
| Bool
otherwise = case t -> [a] -> StrictPair (Set a) [a]
create (t
s t -> Size -> t
forall a. Bits a => a -> Size -> a
`shiftR` Size
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 t -> Size -> t
forall a. Bits a => a -> Size -> a
`shiftR` Size
1) [a]
ys of
(Set a
l :*: [a]
zs) -> (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
r Set a -> [a] -> StrictPair (Set a) [a]
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 = (Set a -> Size
forall a. Set a -> Size
size Set a
t1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Set a -> Size
forall a. Set a -> Size
size Set a
t2) Bool -> Bool -> Bool
&& (Set a -> [a]
forall a. Set a -> [a]
toAscList Set a
t1 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Set a -> [a]
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 = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Set a -> [a]
forall a. Set a -> [a]
toAscList Set a
s1) (Set a -> [a]
forall a. Set a -> [a]
toAscList Set a
s2)
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)
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 =
Set a -> Size
forall a. Set a -> Size
size Set a
m Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Set b -> Size
forall a. Set a -> Size
size Set b
n Bool -> Bool -> Bool
&& (a -> b -> Bool) -> [a] -> [b] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (Set a -> [a]
forall a. Set a -> [a]
toList Set a
m) (Set b -> [b]
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 =
(a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (Set a -> [a]
forall a. Set a -> [a]
toList Set a
m) (Set b -> [b]
forall a. Set a -> [a]
toList Set b
n)
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)
instance (Read a, Ord a) => Read (Set a) where
#ifdef __GLASGOW_HASKELL__
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
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
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
link a
y Set a
gt Set a
r)
Ordering
GT -> let (Set a
lt :*: Set a
gt) = a -> Set a -> StrictPair (Set a) (Set a)
forall a. Ord a => a -> Set a -> StrictPair (Set a) (Set a)
splitS a
x Set a
r in (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
lt Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
gt)
Ordering
EQ -> (Set a
l Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
r)
{-# INLINABLE splitS #-}
splitMember :: Ord a => a -> Set a -> (Set a,Bool,Set a)
splitMember :: forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
_ Set a
Tip = (Set a
forall a. Set a
Tip, Bool
False, Set a
forall a. Set a
Tip)
splitMember a
x (Bin 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, Bool
found, Set a
gt) = a -> Set a -> (Set a, Bool, Set a)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
l
!gt' :: Set a
gt' = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
y Set a
gt Set a
r
in (Set a
lt, Bool
found, Set a
gt')
Ordering
GT -> let (Set a
lt, Bool
found, Set a
gt) = a -> Set a -> (Set a, Bool, Set a)
forall a. Ord a => a -> Set a -> (Set a, Bool, Set a)
splitMember a
x Set a
r
!lt' :: Set a
lt' = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
y Set a
l Set a
lt
in (Set a
lt', Bool
found, Set a
gt)
Ordering
EQ -> (Set a
l, Bool
True, Set a
r)
#if __GLASGOW_HASKELL__
{-# INLINABLE splitMember #-}
#endif
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
#if __GLASGOW_HASKELL__
{-# INLINABLE findIndex #-}
#endif
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
#if __GLASGOW_HASKELL__
{-# INLINABLE lookupIndex #-}
#endif
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
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
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
link 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
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
link 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
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
link 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
link a
x Set a
l Set a
rl Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
rr
Ordering
EQ -> Set a
l Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMin a
x Set a
r
where sizeL :: Size
sizeL = Set a -> Size
forall a. Set a -> Size
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 = 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
link a
x Set a
l ((a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
takeWhileAntitone a -> Bool
p Set a
r)
| Bool
otherwise = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
takeWhileAntitone a -> Bool
p Set a
l
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
link a
x ((a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
dropWhileAntitone a -> Bool
p Set a
l) Set a
r
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
link a
x Set a
l Set a
u Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: Set a
v
| Bool
otherwise = let Set a
u :*: Set a
v = (a -> Bool) -> Set a -> StrictPair (Set a) (Set a)
go a -> Bool
p Set a
l in Set a
u Set a -> Set a -> StrictPair (Set a) (Set a)
forall a b. a -> b -> StrictPair a b
:*: a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
v Set a
r
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
sizeL a
y Set a
ly Set a
ry) r :: Set a
r@(Bin Size
sizeR a
z Set a
lz Set a
rz)
| Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
sizeL Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
sizeR = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
z (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
l Set a
lz) Set a
rz
| Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
sizeR 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
balanceR a
y Set a
ly (a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
link a
x Set a
ry Set a
r)
| Bool
otherwise = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
bin a
x Set a
l Set a
r
insertMax,insertMin :: a -> Set a -> Set a
insertMax :: forall a. a -> Set a -> Set a
insertMax a
x Set a
t
= case Set a
t of
Set a
Tip -> a -> Set a
forall a. a -> Set a
singleton a
x
Bin 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)
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
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 Size
sizeL a
x Set a
lx Set a
rx) r :: Set a
r@(Bin Size
sizeR a
y Set a
ly Set a
ry)
| Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
sizeL Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
sizeR = a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y (Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
l Set a
ly) Set a
ry
| Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
sizeR 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
balanceR a
x Set a
lx (Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
rx Set a
r)
| Bool
otherwise = Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
glue Set a
l Set a
r
glue :: 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 a -> Set a -> Set a -> Set a
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') = 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 a -> Set a -> Set a -> Set a
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 <- 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)
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
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'
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
delta,ratio :: Int
delta :: Size
delta = Size
3
ratio :: Size
ratio = Size
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 -> 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)
| 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 -> 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"
| 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
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 -> 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)
| 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 -> 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"
| 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
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
= 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 #-}
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 #-}
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
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 = 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
newtype MergeSet a = MergeSet { forall a. MergeSet a -> Set a
getMergeSet :: Set a }
instance Semigroup (MergeSet a) where
MergeSet Set a
xs <> :: MergeSet a -> MergeSet a -> MergeSet a
<> MergeSet Set a
ys = Set a -> MergeSet a
forall a. Set a -> MergeSet a
MergeSet (Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
merge Set a
xs Set a
ys)
instance Monoid (MergeSet a) where
mempty :: MergeSet a
mempty = Set a -> MergeSet a
forall a. Set a -> MergeSet a
MergeSet Set a
forall a. Set a
empty
mappend :: MergeSet a -> MergeSet a -> MergeSet a
mappend = MergeSet a -> MergeSet a -> MergeSet a
forall a. Semigroup a => a -> a -> a
(<>)
disjointUnion :: Set a -> Set b -> Set (Either a b)
disjointUnion :: forall a b. Set a -> Set b -> Set (Either a b)
disjointUnion Set a
as Set b
bs = Set (Either a b) -> Set (Either a b) -> Set (Either a b)
forall a. Set a -> Set a -> Set a
merge ((a -> Either a b) -> Set a -> Set (Either a b)
forall a b. (a -> b) -> Set a -> Set b
mapMonotonic a -> Either a b
forall a b. a -> Either a b
Left Set a
as) ((b -> Either a b) -> Set b -> Set (Either a b)
forall a b. (a -> b) -> Set a -> Set b
mapMonotonic b -> Either a b
forall a b. b -> Either a b
Right Set b
bs)
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
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
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