{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
{-# OPTIONS_HADDOCK not-home #-}
module Data.Set.Private (
Set(..)
, Size
, insertBy'
, empty
) where
import Prelude hiding (filter,foldl,foldr,null,map,take,drop,splitAt)
import Control.Monad (join)
#if __GLASGOW_HASKELL__
import GHC.Exts ( lazy )
#endif
data Set a = Bin {-# UNPACK #-} !Size !a !(Set a) !(Set a) | Tip
type Size = Int
size :: Set a -> Int
size :: forall a. Set a -> Int
size Set a
Tip = Int
0
size (Bin Int
sz a
_ Set a
_ Set a
_) = Int
sz
empty :: Set a
empty :: forall a. Set a
empty = Set a
forall a. Set a
Tip
singleton :: a -> Set a
singleton :: forall a. a -> Set a
singleton a
x = Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
insertBy' :: (a -> a -> Ordering) -> a -> Set a -> Maybe (Set a)
insertBy' :: forall a. (a -> a -> Ordering) -> a -> Set a -> Maybe (Set a)
insertBy' a -> a -> Ordering
compare = (a -> a -> Set a -> Maybe (Set a)) -> a -> Set a -> Maybe (Set a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join a -> a -> Set a -> Maybe (Set a)
go
where
go :: a -> a -> Set a -> Maybe (Set a)
go a
orig !a
_ Set a
Tip = Set a -> Maybe (Set a)
forall a. a -> Maybe a
Just (Set a -> Maybe (Set a)) -> Set a -> Maybe (Set a)
forall a b. (a -> b) -> a -> b
$! a -> Set a
forall a. a -> Set a
singleton (a -> a
forall a. a -> a
lazy a
orig)
go a
orig !a
x (Bin Int
_ a
y Set a
l Set a
r) = case a -> a -> Ordering
compare a
x a
y of
Ordering
LT -> (\ !Set a
l' -> 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) (Set a -> Set a) -> Maybe (Set a) -> Maybe (Set a)
forall a b. (a -> b) -> Maybe a -> Maybe b
<$!> a -> a -> Set a -> Maybe (Set a)
go a
orig a
x Set a
l
Ordering
GT -> (\ !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 Set a
r') (Set a -> Set a) -> Maybe (Set a) -> Maybe (Set a)
forall a b. (a -> b) -> Maybe a -> Maybe b
<$!> a -> a -> Set a -> Maybe (Set a)
go a
orig a
x Set a
r
Ordering
EQ -> Maybe (Set a)
forall a. Maybe a
Nothing
#if __GLASGOW_HASKELL__
{-# INLINABLE insertBy' #-}
#else
{-# INLINE insertBy' #-}
#endif
infixl 4 <$!>
(<$!>) :: (a -> b) -> Maybe a -> Maybe b
<$!> :: forall a b. (a -> b) -> Maybe a -> Maybe b
(<$!>) a -> b
f = \ case
Maybe a
Nothing -> Maybe b
forall a. Maybe a
Nothing
Just a
a -> b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
#ifndef __GLASGOW_HASKELL__
lazy :: a -> a
lazy a = a
#endif
delta,ratio :: Int
delta :: Int
delta = Int
3
ratio :: Int
ratio = Int
2
balanceL :: a -> Set a -> Set a -> Set a
balanceL :: forall a. a -> Set a -> Set a -> Set a
balanceL a
x Set a
l Set a
r = case Set a
r of
Set a
Tip -> case Set a
l of
Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
(Bin Int
_ a
_ Set a
Tip Set a
Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
2 a
x Set a
l Set a
forall a. Set a
Tip
(Bin Int
_ a
lx Set a
Tip (Bin Int
_ a
lrx Set a
_ Set a
_)) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
lrx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
lx Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
(Bin Int
_ a
lx ll :: Set a
ll@(Bin Int
_ a
_ Set a
_ Set a
_) Set a
Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
lx Set a
ll (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
(Bin Int
ls a
lx ll :: Set a
ll@(Bin Int
lls a
_ Set a
_ Set a
_) lr :: Set a
lr@(Bin Int
lrs a
lrx Set a
lrl Set a
lrr))
| Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lls -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) a
lx Set a
ll (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lrs) a
x Set a
lr Set a
forall a. Set a
Tip)
| Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) a
lrx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
llsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
lrl) a
lx Set a
ll Set a
lrl) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
lrr) a
x Set a
lrr Set a
forall a. Set a
Tip)
(Bin Int
rs a
_ Set a
_ Set a
_) -> case Set a
l of
Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
x Set a
forall a. Set a
Tip Set a
r
(Bin Int
ls a
lx Set a
ll Set a
lr)
| Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rs -> case (Set a
ll, Set a
lr) of
(Bin Int
lls a
_ Set a
_ Set a
_, Bin Int
lrs a
lrx Set a
lrl Set a
lrr)
| Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lls -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
lx Set a
ll (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lrs) a
x Set a
lr Set a
r)
| Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
lrx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
llsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
lrl) a
lx Set a
ll Set a
lrl) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
lrr) a
x Set a
lrr Set a
r)
(Set a
_, Set a
_) -> [Char] -> Set a
forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balanceL"
| Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
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 -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
(Bin Int
_ a
_ Set a
Tip Set a
Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
2 a
x Set a
forall a. Set a
Tip Set a
r
(Bin Int
_ a
rx Set a
Tip rr :: Set a
rr@(Bin Int
_ a
_ Set a
_ Set a
_)) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
rx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) Set a
rr
(Bin Int
_ a
rx (Bin Int
_ a
rlx Set a
_ Set a
_) Set a
Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
rlx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
rx Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
(Bin Int
rs a
rx rl :: Set a
rl@(Bin Int
rls a
rlx Set a
rll Set a
rlr) rr :: Set a
rr@(Bin Int
rrs a
_ Set a
_ Set a
_))
| Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rrs -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
rx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rls) a
x Set a
forall a. Set a
Tip Set a
rl) Set a
rr
| Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
rlx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
rll) a
x Set a
forall a. Set a
Tip Set a
rll) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rrsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
rlr) a
rx Set a
rlr Set a
rr)
(Bin Int
ls a
_ Set a
_ Set a
_) -> case Set a
r of
Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls) a
x Set a
l Set a
forall a. Set a
Tip
(Bin Int
rs a
rx Set a
rl Set a
rr)
| Int
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
deltaInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ls -> case (Set a
rl, Set a
rr) of
(Bin Int
rls a
rlx Set a
rll Set a
rlr, Bin Int
rrs a
_ Set a
_ Set a
_)
| Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratioInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rrs -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
rx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rls) a
x Set a
l Set a
rl) Set a
rr
| Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
rlx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
rll) a
x Set a
l Set a
rll) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rrsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Set a -> Int
forall a. Set a -> Int
size Set a
rlr) a
rx Set a
rlr Set a
rr)
(Set a
_, Set a
_) -> [Char] -> Set a
forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balanceR"
| Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rs) a
x Set a
l Set a
r
{-# NOINLINE balanceR #-}