{-# 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 :: Set a -> Int
size Tip = 0
size (Bin sz :: Int
sz _ _ _) = Int
sz
empty :: Set a
empty :: Set a
empty = Set a
forall a. Set a
Tip
singleton :: a -> Set a
singleton :: a -> Set a
singleton x :: a
x = Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 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' :: (a -> a -> Ordering) -> a -> Set a -> Maybe (Set a)
insertBy' compare :: 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 orig :: a
orig !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 orig :: a
orig !a
x (Bin _ y :: a
y l :: Set a
l r :: Set a
r) = case a -> a -> Ordering
compare a
x a
y of
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
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
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
<$!> :: (a -> b) -> Maybe a -> Maybe b
(<$!>) f :: a -> b
f = \ case
Nothing -> Maybe b
forall a. Maybe a
Nothing
Just a :: 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 = 3
ratio :: Int
ratio = 2
balanceL :: a -> Set a -> Set a -> Set a
balanceL :: a -> Set a -> Set a -> Set a
balanceL x :: a
x l :: Set a
l r :: Set a
r = case Set a
r of
Tip -> case Set a
l of
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
(Bin _ _ Tip Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 2 a
x Set a
l Set a
forall a. Set a
Tip
(Bin _ lx :: a
lx Tip (Bin _ lrx :: a
lrx _ _)) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 3 a
lrx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 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 1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
(Bin _ lx :: a
lx ll :: Set a
ll@(Bin _ _ _ _) Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 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 1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
(Bin ls :: Int
ls lx :: a
lx ll :: Set a
ll@(Bin lls :: Int
lls _ _ _) lr :: Set a
lr@(Bin lrs :: Int
lrs lrx :: a
lrx lrl :: Set a
lrl lrr :: 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 (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 (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 (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 (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 (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 rs :: Int
rs _ _ _) -> case Set a
l of
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (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 ls :: Int
ls lx :: a
lx ll :: Set a
ll lr :: 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 lls :: Int
lls _ _ _, Bin lrs :: Int
lrs lrx :: a
lrx lrl :: Set a
lrl lrr :: 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 (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 (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 (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 (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 (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)
(_, _) -> [Char] -> Set a
forall a. HasCallStack => [Char] -> a
error "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 (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 :: a -> Set a -> Set a -> Set a
balanceR x :: a
x l :: Set a
l r :: Set a
r = case Set a
l of
Tip -> case Set a
r of
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
(Bin _ _ Tip Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 2 a
x Set a
forall a. Set a
Tip Set a
r
(Bin _ rx :: a
rx Tip rr :: Set a
rr@(Bin _ _ _ _)) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 3 a
rx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) Set a
rr
(Bin _ rx :: a
rx (Bin _ rlx :: a
rlx _ _) Tip) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 3 a
rlx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin 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 1 a
rx Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
(Bin rs :: Int
rs rx :: a
rx rl :: Set a
rl@(Bin rls :: Int
rls rlx :: a
rlx rll :: Set a
rll rlr :: Set a
rlr) rr :: Set a
rr@(Bin rrs :: Int
rrs _ _ _))
| 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 (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 (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 (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 (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 (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 ls :: Int
ls _ _ _) -> case Set a
r of
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (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 rs :: Int
rs rx :: a
rx rl :: Set a
rl rr :: 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 rls :: Int
rls rlx :: a
rlx rll :: Set a
rll rlr :: Set a
rlr, Bin rrs :: Int
rrs _ _ _)
| 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 (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 (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 (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 (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 (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)
(_, _) -> [Char] -> Set a
forall a. HasCallStack => [Char] -> a
error "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 (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 #-}