{-# LANGUAGE BangPatterns, UnboxedTuples, Safe #-}
module Data.RangeSet.Internal.Lumpers (module Data.RangeSet.Internal.Lumpers) where

import Prelude

import Data.RangeSet.Internal.Types
import Data.RangeSet.Internal.SmartConstructors
import Data.RangeSet.Internal.Inserters
import Data.RangeSet.Internal.Extractors

{-# INLINABLE link #-}
link :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
link :: forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
link !E
l !E
u RangeSet a
Tip RangeSet a
Tip = forall a. E -> E -> RangeSet a
single E
l E
u
link E
l E
u RangeSet a
Tip (Fork H
rh E
rl E
ru RangeSet a
rlt RangeSet a
rrt) = forall a.
E -> E -> H -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
insertLAdj E
l E
u H
rh E
rl E
ru RangeSet a
rlt RangeSet a
rrt
link E
l E
u (Fork H
lh E
ll E
lu RangeSet a
llt RangeSet a
lrt) RangeSet a
Tip = forall a.
E -> E -> H -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
insertRAdj E
l E
u H
lh E
ll E
lu RangeSet a
llt RangeSet a
lrt
link E
l E
u lt :: RangeSet a
lt@(Fork H
_ E
ll E
lu RangeSet a
llt RangeSet a
lrt) rt :: RangeSet a
rt@(Fork H
_ E
rl E
ru RangeSet a
rlt RangeSet a
rrt) =
  forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
disjointLink E
l' E
u' RangeSet a
lt'' RangeSet a
rt''
  where
    -- we have to check for fusion up front
    (# !E
lmaxl, !E
lmaxu, RangeSet a
lt' #) = forall a.
E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
maxDelete E
ll E
lu RangeSet a
llt RangeSet a
lrt
    (# !E
rminl, !E
rminu, RangeSet a
rt' #) = forall a.
E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
minDelete E
rl E
ru RangeSet a
rlt RangeSet a
rrt

    (# !E
l', !RangeSet a
lt'' #) | E
lmaxu forall a. Eq a => a -> a -> Bool
== forall a. Enum a => a -> a
pred E
l = (# E
lmaxl, RangeSet a
lt' #)
                     | Bool
otherwise       = (# E
l, RangeSet a
lt #)

    (# !E
u', !RangeSet a
rt'' #) | E
rminl forall a. Eq a => a -> a -> Bool
== forall a. Enum a => a -> a
succ E
u = (# E
rminu, RangeSet a
rt' #)
                     | Bool
otherwise       = (# E
u, RangeSet a
rt #)

{-# INLINEABLE disjointLink #-}
disjointLink :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
disjointLink :: forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
disjointLink !E
l !E
u RangeSet a
Tip RangeSet a
rt = forall a. E -> E -> RangeSet a -> RangeSet a
unsafeInsertL E
l E
u RangeSet a
rt
disjointLink E
l E
u RangeSet a
lt RangeSet a
Tip = forall a. E -> E -> RangeSet a -> RangeSet a
unsafeInsertR E
l E
u RangeSet a
lt
disjointLink E
l E
u lt :: RangeSet a
lt@(Fork H
hl E
ll E
lu RangeSet a
llt RangeSet a
lrt) rt :: RangeSet a
rt@(Fork H
hr E
rl E
ru RangeSet a
rlt RangeSet a
rrt)
  | H
hl forall a. Ord a => a -> a -> Bool
< H
hr forall a. Num a => a -> a -> a
+ H
1 = forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balanceL E
rl E
ru (forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
disjointLink E
l E
u RangeSet a
lt RangeSet a
rlt) RangeSet a
rrt
  | H
hr forall a. Ord a => a -> a -> Bool
< H
hl forall a. Num a => a -> a -> a
+ H
1 = forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balanceR E
ll E
lu RangeSet a
llt (forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
disjointLink E
l E
u RangeSet a
lrt RangeSet a
rt)
  | Bool
otherwise   = forall a.
E -> E -> H -> RangeSet a -> H -> RangeSet a -> RangeSet a
forkH E
l E
u H
hl RangeSet a
lt H
hr RangeSet a
rt

-- This version checks for fusion between the two trees to be merged
{-{-# INLINEABLE merge #-}
merge :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
merge Tip Tip = Tip
merge t Tip = t
merge Tip t = t
merge t1 t2 =
  let (# !_, !u1 #) = unsafeMaxRange t1
      (# !l2, !u2, t2' #) = unsafeMinDelete t2
  in if succ u1 == l2 then unsafeMerge (unsafeFuseR (diffE l2 u2) u2 t1) t2'
     else unsafeMerge t1 t2-}

-- This assumes that the trees are /totally/ disjoint
{-# INLINEABLE disjointMerge #-}
disjointMerge :: RangeSet a -> RangeSet a -> RangeSet a
disjointMerge :: forall a. RangeSet a -> RangeSet a -> RangeSet a
disjointMerge RangeSet a
Tip RangeSet a
rt = RangeSet a
rt
disjointMerge RangeSet a
lt RangeSet a
Tip = RangeSet a
lt
disjointMerge lt :: RangeSet a
lt@(Fork H
hl E
ll E
lu RangeSet a
llt RangeSet a
lrt) rt :: RangeSet a
rt@(Fork H
hr E
rl E
ru RangeSet a
rlt RangeSet a
rrt)
  | H
hl forall a. Ord a => a -> a -> Bool
< H
hr forall a. Num a => a -> a -> a
+ H
1 = forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balanceL E
rl E
ru (forall a. RangeSet a -> RangeSet a -> RangeSet a
disjointMerge RangeSet a
lt RangeSet a
rlt) RangeSet a
rrt
  | H
hr forall a. Ord a => a -> a -> Bool
< H
hl forall a. Num a => a -> a -> a
+ H
1 = forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balanceR E
ll E
lu RangeSet a
llt (forall a. RangeSet a -> RangeSet a -> RangeSet a
disjointMerge RangeSet a
lrt RangeSet a
rt)
  | Bool
otherwise   = forall a.
RangeSet a
-> H
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> H
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
glue' RangeSet a
lt H
hl E
ll E
lu RangeSet a
llt RangeSet a
lrt RangeSet a
rt H
hr E
rl E
ru RangeSet a
rlt RangeSet a
rrt

-- Trees must be balanced with respect to eachother, since we pull from the tallest, no balancing is required
{-# INLINEABLE glue #-}
glue :: RangeSet a -> RangeSet a -> RangeSet a
glue :: forall a. RangeSet a -> RangeSet a -> RangeSet a
glue RangeSet a
Tip RangeSet a
rt = RangeSet a
rt
glue RangeSet a
lt RangeSet a
Tip  = RangeSet a
lt
glue lt :: RangeSet a
lt@(Fork H
lh E
ll E
lu RangeSet a
llt RangeSet a
lrt) rt :: RangeSet a
rt@(Fork H
rh E
rl E
ru RangeSet a
rlt RangeSet a
rrt) = forall a.
RangeSet a
-> H
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> H
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
glue' RangeSet a
lt H
lh E
ll E
lu RangeSet a
llt RangeSet a
lrt RangeSet a
rt H
rh E
rl E
ru RangeSet a
rlt RangeSet a
rrt

{-# INLINEABLE glue' #-}
glue' :: RangeSet a -> H -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a -> H -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
glue' :: forall a.
RangeSet a
-> H
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
-> H
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
glue' RangeSet a
lt H
lh E
ll E
lu RangeSet a
llt RangeSet a
lrt RangeSet a
rt H
rh E
rl E
ru RangeSet a
rlt RangeSet a
rrt
  | H
lh forall a. Ord a => a -> a -> Bool
< H
rh = let (# !E
l, !E
u, !RangeSet a
rt' #) = forall a.
E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
minDelete E
rl E
ru RangeSet a
rlt RangeSet a
rrt in forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fork E
l E
u RangeSet a
lt RangeSet a
rt'
  | Bool
otherwise = let (# !E
l, !E
u, !RangeSet a
lt' #) = forall a.
E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
maxDelete E
ll E
lu RangeSet a
llt RangeSet a
lrt in forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fork E
l E
u RangeSet a
lt' RangeSet a
rt