{-# LANGUAGE BangPatterns, Safe #-}
module Data.RangeSet.Internal.SmartConstructors (
    single,
    fork, forkSz, forkH,
    balance, balanceL, balanceR,
    uncheckedBalanceL, uncheckedBalanceR
  ) where

import Prelude
import Data.RangeSet.Internal.Types
import Data.RangeSet.Internal.Enum

-- Basic tree constructors
{-# INLINE single #-}
single :: Size -> E -> E -> RangeSet a
single :: Size -> Size -> Size -> RangeSet a
single !Size
sz !Size
l !Size
u = Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
1 Size
sz Size
l Size
u RangeSet a
forall a. RangeSet a
Tip RangeSet a
forall a. RangeSet a
Tip

{-# INLINE heightOfFork #-}
heightOfFork :: Int -> Int -> Int
heightOfFork :: Size -> Size -> Size
heightOfFork Size
lh Size
rh = Size -> Size -> Size
forall a. Ord a => a -> a -> a
max Size
lh Size
rh Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1

{-# INLINE fork #-}
fork :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fork :: Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
fork !Size
l !Size
u !RangeSet a
lt !RangeSet a
rt = Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forkSz (RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
lt Size -> Size -> Size
forall a. Num a => a -> a -> a
+ RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
rt Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size -> Size -> Size
diffE Size
l Size
u) Size
l Size
u RangeSet a
lt RangeSet a
rt

--{-# INLINE forkSz #-} -- this does bad things
forkSz :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forkSz :: Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forkSz !Size
sz !Size
l !Size
u !RangeSet a
lt !RangeSet a
rt = Size
-> Size
-> Size
-> Size
-> RangeSet a
-> Size
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> Size
-> RangeSet a
-> Size
-> RangeSet a
-> RangeSet a
forkH Size
sz Size
l Size
u (RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lt) RangeSet a
lt (RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rt) RangeSet a
rt

{-# INLINE forkH #-}
forkH :: Size -> E -> E -> Int -> RangeSet a -> Int -> RangeSet a -> RangeSet a
forkH :: Size
-> Size
-> Size
-> Size
-> RangeSet a
-> Size
-> RangeSet a
-> RangeSet a
forkH !Size
sz !Size
l !Size
u !Size
lh !RangeSet a
lt !Size
rh !RangeSet a
rt =  Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
Fork (Size -> Size -> Size
heightOfFork Size
lh Size
rh) Size
sz Size
l Size
u RangeSet a
lt RangeSet a
rt

-- Balancers
{-# NOINLINE balance #-}
balance :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balance :: Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
balance !Size
sz !Size
l !Size
u RangeSet a
Tip RangeSet a
Tip = Size -> Size -> Size -> RangeSet a
forall a. Size -> Size -> Size -> RangeSet a
single Size
sz Size
l Size
u
balance Size
sz Size
l Size
u lt :: RangeSet a
lt@(Fork Size
lh Size
lsz Size
ll Size
lu RangeSet a
llt RangeSet a
lrt) RangeSet a
Tip
  | Size
lh Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
1   = Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
Fork (Size
lh Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) Size
sz Size
l Size
u RangeSet a
lt RangeSet a
forall a. RangeSet a
Tip
  | Bool
otherwise = Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceL Size
sz Size
l Size
u Size
lsz Size
ll Size
lu RangeSet a
llt RangeSet a
lrt RangeSet a
forall a. RangeSet a
Tip
balance Size
sz Size
l Size
u RangeSet a
Tip rt :: RangeSet a
rt@(Fork Size
rh Size
rsz Size
rl Size
ru RangeSet a
rlt RangeSet a
rrt)
  | Size
rh Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
1   = Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
Fork (Size
rh Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) Size
sz Size
l Size
u RangeSet a
forall a. RangeSet a
Tip RangeSet a
rt
  | Bool
otherwise = Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceR Size
sz Size
l Size
u RangeSet a
forall a. RangeSet a
Tip Size
rsz Size
rl Size
ru RangeSet a
rlt RangeSet a
rrt
balance Size
sz Size
l Size
u lt :: RangeSet a
lt@(Fork Size
lh Size
lsz Size
ll Size
lu RangeSet a
llt RangeSet a
lrt) rt :: RangeSet a
rt@(Fork Size
rh Size
rsz Size
rl Size
ru RangeSet a
rlt RangeSet a
rrt)
  | RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rt Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1 = Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceL Size
sz Size
l Size
u Size
lsz Size
ll Size
lu RangeSet a
llt RangeSet a
lrt RangeSet a
rt
  | RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lt Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1 = Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceR Size
sz Size
l Size
u RangeSet a
lt Size
rsz Size
rl Size
ru RangeSet a
rlt RangeSet a
rrt
  | Bool
otherwise = Size
-> Size
-> Size
-> Size
-> RangeSet a
-> Size
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> Size
-> RangeSet a
-> Size
-> RangeSet a
-> RangeSet a
forkH Size
sz Size
l Size
u Size
lh RangeSet a
lt Size
rh RangeSet a
rt

{-# INLINEABLE balanceL #-}
balanceL :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
-- PRE: left grew or right shrank, difference in height at most 2 biasing to the left
balanceL :: Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
balanceL !Size
sz !Size
l1 !Size
u1 lt :: RangeSet a
lt@(Fork Size
lh Size
lsz Size
l2 Size
u2 RangeSet a
llt RangeSet a
lrt) !RangeSet a
rt
  -- both sides are equal height or off by one
  | Size
dltrt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
1 = Size
-> Size
-> Size
-> Size
-> RangeSet a
-> Size
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> Size
-> RangeSet a
-> Size
-> RangeSet a
-> RangeSet a
forkH Size
sz Size
l1 Size
u1 Size
lh RangeSet a
lt Size
rh RangeSet a
rt
  -- The bias is 2 (dltrt == 2)
  | Bool
otherwise  = Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceL Size
sz Size
l1 Size
u1 Size
lsz Size
l2 Size
u2 RangeSet a
llt RangeSet a
lrt RangeSet a
rt
  where
    !rh :: Size
rh = RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rt
    !dltrt :: Size
dltrt = Size
lh Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
rh
-- If the right shrank (or nothing changed), we have to be prepared to handle the Tip case for lt
balanceL Size
sz Size
l Size
u RangeSet a
Tip RangeSet a
rt = Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
Fork (RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rt Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) Size
sz Size
l Size
u RangeSet a
forall a. RangeSet a
Tip RangeSet a
rt

{-# INLINEABLE balanceR #-}
balanceR :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
-- PRE: left shrank or right grew, difference in height at most 2 biasing to the right
balanceR :: Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
balanceR !Size
sz !Size
l1 !Size
u1 !RangeSet a
lt rt :: RangeSet a
rt@(Fork Size
rh Size
rsz Size
l2 Size
u2 RangeSet a
rlt RangeSet a
rrt)
  -- both sides are equal height or off by one
  | Size
dltrt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
1 = Size
-> Size
-> Size
-> Size
-> RangeSet a
-> Size
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> Size
-> RangeSet a
-> Size
-> RangeSet a
-> RangeSet a
forkH Size
sz Size
l1 Size
u1 Size
lh RangeSet a
lt Size
rh RangeSet a
rt
  | Bool
otherwise  = Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceR Size
sz Size
l1 Size
u1 RangeSet a
lt Size
rsz Size
l2 Size
u2 RangeSet a
rlt RangeSet a
rrt
  where
    !lh :: Size
lh = RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lt
    !dltrt :: Size
dltrt = Size
rh Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
lh
-- If the left shrank (or nothing changed), we have to be prepared to handle the Tip case for rt
balanceR Size
sz Size
l Size
u RangeSet a
lt RangeSet a
Tip = Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size
-> Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
Fork (RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lt Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) Size
sz Size
l Size
u RangeSet a
lt RangeSet a
forall a. RangeSet a
Tip

{-# NOINLINE uncheckedBalanceL #-}
-- PRE: left grew or right shrank, difference in height at most 2 biasing to the left
uncheckedBalanceL :: Size -> E -> E -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a -> RangeSet a
uncheckedBalanceL :: Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceL !Size
sz !Size
l1 !Size
u1 !Size
szl !Size
l2 !Size
u2 !RangeSet a
llt !RangeSet a
lrt !RangeSet a
rt
  -- The bias is 2 (dltrt == 2)
  | Size
hllt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Size
hlrt = Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotr' Size
sz Size
l1 Size
u1 Size
szl Size
l2 Size
u2 RangeSet a
llt RangeSet a
lrt RangeSet a
rt
  | Bool
otherwise    = Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
rotr Size
sz Size
l1 Size
u1 (Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
rotl Size
szl Size
l2 Size
u2 RangeSet a
llt RangeSet a
lrt) RangeSet a
rt
  where
    !hllt :: Size
hllt = RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
llt
    !hlrt :: Size
hlrt = RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lrt

{-# NOINLINE uncheckedBalanceR #-}
uncheckedBalanceR :: Size -> E -> E -> RangeSet a -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
-- PRE: left shrank or right grew, difference in height at most 2 biasing to the right
uncheckedBalanceR :: Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
uncheckedBalanceR !Size
sz !Size
l1 !Size
u1 !RangeSet a
lt !Size
szr !Size
l2 !Size
u2 !RangeSet a
rlt !RangeSet a
rrt
  -- The bias is 2 (drtlt == 2)
  | Size
hrrt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Size
hrlt = Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotl' Size
sz Size
l1 Size
u1 RangeSet a
lt Size
szr Size
l2 Size
u2 RangeSet a
rlt RangeSet a
rrt
  | Bool
otherwise    = Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
rotl Size
sz Size
l1 Size
u1 RangeSet a
lt (Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
rotr Size
szr Size
l2 Size
u2 RangeSet a
rlt RangeSet a
rrt)
  where
    !hrlt :: Size
hrlt = RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rlt
    !hrrt :: Size
hrrt = RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rrt

{-# INLINE rotr #-}
rotr :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotr :: Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
rotr !Size
sz !Size
l1 !Size
u1 (Fork Size
_ Size
szl Size
l2 Size
u2 RangeSet a
p RangeSet a
q) !RangeSet a
r = Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotr' Size
sz Size
l1 Size
u1 Size
szl Size
l2 Size
u2 RangeSet a
p RangeSet a
q RangeSet a
r
rotr Size
_ Size
_ Size
_ RangeSet a
_ RangeSet a
_ = [Char] -> RangeSet a
forall a. HasCallStack => [Char] -> a
error [Char]
"rotr on Tip"

{-# INLINE rotl #-}
rotl :: Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotl :: Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
rotl !Size
sz !Size
l1 !Size
u1 !RangeSet a
p (Fork Size
_ Size
szr Size
l2 Size
u2 RangeSet a
q RangeSet a
r) = Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotl' Size
sz Size
l1 Size
u1 RangeSet a
p Size
szr Size
l2 Size
u2 RangeSet a
q RangeSet a
r
rotl Size
_ Size
_ Size
_ RangeSet a
_ RangeSet a
_ = [Char] -> RangeSet a
forall a. HasCallStack => [Char] -> a
error [Char]
"rotr on Tip"

{-# INLINE rotr' #-}
rotr' :: Size -> E -> E -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a -> RangeSet a
rotr' :: Size
-> Size
-> Size
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotr' !Size
sz !Size
l1 !Size
u1 !Size
szl !Size
l2 !Size
u2 !RangeSet a
p !RangeSet a
q !RangeSet a
r = Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz Size
l2 Size
u2 RangeSet a
p (Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forkSz (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
szl Size -> Size -> Size
forall a. Num a => a -> a -> a
+ RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
q) Size
l1 Size
u1 RangeSet a
q RangeSet a
r)

{-# INLINE rotl' #-}
rotl' :: Size -> E -> E -> RangeSet a -> Size -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
rotl' :: Size
-> Size
-> Size
-> RangeSet a
-> Size
-> Size
-> Size
-> RangeSet a
-> RangeSet a
-> RangeSet a
rotl' !Size
sz !Size
l1 !Size
u1 !RangeSet a
p !Size
szr !Size
l2 !Size
u2 !RangeSet a
q !RangeSet a
r = Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz Size
l2 Size
u2 (Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forkSz (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
szr Size -> Size -> Size
forall a. Num a => a -> a -> a
+ RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
q) Size
l1 Size
u1 RangeSet a
p RangeSet a
q) RangeSet a
r