{-# 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
import Data.RangeSet.Internal.Enum

{-# INLINABLE link #-}
link :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
link :: E -> E -> RangeSet a -> RangeSet a -> RangeSet a
link !E
l !E
u RangeSet a
Tip RangeSet a
Tip = E -> E -> E -> RangeSet a
forall a. E -> E -> E -> RangeSet a
single (E -> E -> E
diffE E
l E
u) E
l E
u
link E
l E
u RangeSet a
Tip (Fork E
rh E
rsz E
rl E
ru RangeSet a
rlt RangeSet a
rrt) = E
-> E
-> E
-> E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
E
-> E
-> E
-> E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
insertLAdj (E -> E -> E
diffE E
l E
u) E
l E
u E
rh E
rsz E
rl E
ru RangeSet a
rlt RangeSet a
rrt
link E
l E
u (Fork E
lh E
lsz E
ll E
lu RangeSet a
llt RangeSet a
lrt) RangeSet a
Tip = E
-> E
-> E
-> E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
forall a.
E
-> E
-> E
-> E
-> E
-> E
-> E
-> RangeSet a
-> RangeSet a
-> RangeSet a
insertRAdj (E -> E -> E
diffE E
l E
u) E
l E
u E
lh E
lsz E
ll E
lu RangeSet a
llt RangeSet a
lrt
link E
l E
u lt :: RangeSet a
lt@(Fork E
_ E
lsz E
ll E
lu RangeSet a
llt RangeSet a
lrt) rt :: RangeSet a
rt@(Fork E
_ E
rsz E
rl E
ru RangeSet a
rlt RangeSet a
rrt) =
  E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
disjointLink (E -> E -> E
diffE E
l' E
u') 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' #) = E -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
forall a.
E -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
maxDelete E
lsz E
ll E
lu RangeSet a
llt RangeSet a
lrt
    (# !E
rminl, !E
rminu, RangeSet a
rt' #) = E -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
forall a.
E -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
minDelete E
rsz E
rl E
ru RangeSet a
rlt RangeSet a
rrt

    (# !E
l', !RangeSet a
lt'' #) | E
lmaxu E -> E -> Bool
forall a. Eq a => a -> a -> Bool
== E -> E
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 E -> E -> Bool
forall a. Eq a => a -> a -> Bool
== E -> E
forall a. Enum a => a -> a
succ E
u = (# E
rminu, RangeSet a
rt' #)
                     | Bool
otherwise       = (# E
u, RangeSet a
rt #)

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

-- Trees must be balanced with respect to eachother, since we pull from the tallest, no balancing is required
{-# INLINEABLE glue #-}
glue :: Size -> RangeSet a -> RangeSet a -> RangeSet a
glue :: E -> RangeSet a -> RangeSet a -> RangeSet a
glue !E
_ RangeSet a
Tip RangeSet a
rt = RangeSet a
rt
glue E
_ RangeSet a
lt RangeSet a
Tip  = RangeSet a
lt
glue E
sz lt :: RangeSet a
lt@(Fork E
lh E
lsz E
ll E
lu RangeSet a
llt RangeSet a
lrt) rt :: RangeSet a
rt@(Fork E
rh E
rsz E
rl E
ru RangeSet a
rlt RangeSet a
rrt)
  | E
lh E -> E -> Bool
forall a. Ord a => a -> a -> Bool
< E
rh = let (# !E
l, !E
u, !RangeSet a
rt' #) = E -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
forall a.
E -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
minDelete E
rsz E
rl E
ru RangeSet a
rlt RangeSet a
rrt in E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forkSz E
sz E
l E
u RangeSet a
lt RangeSet a
rt'
  | Bool
otherwise = let (# !E
l, !E
u, !RangeSet a
lt' #) = E -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
forall a.
E -> E -> E -> RangeSet a -> RangeSet a -> (# E, E, RangeSet a #)
maxDelete E
lsz E
ll E
lu RangeSet a
llt RangeSet a
lrt in E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forkSz E
sz E
l E
u RangeSet a
lt' RangeSet a
rt