{-# LANGUAGE MagicHash, UnboxedTuples, MultiWayIf, BangPatterns, CPP #-}
#ifdef SAFE
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
module Data.RangeSet.Internal (
    module Data.RangeSet.Internal,
    RangeSet(..), E, SRangeList(..), StrictMaybeE(..),
    size, height, foldE,
    module Data.RangeSet.Internal.Enum,
    module Data.RangeSet.Internal.SmartConstructors,
    module Data.RangeSet.Internal.Inserters,
    module Data.RangeSet.Internal.Extractors,
    module Data.RangeSet.Internal.Lumpers,
    module Data.RangeSet.Internal.Splitters,
    module Data.RangeSet.Internal.Heuristics
  ) where

import Prelude

import Data.RangeSet.Internal.Types
import Data.RangeSet.Internal.Enum
import Data.RangeSet.Internal.SmartConstructors
import Data.RangeSet.Internal.Inserters
import Data.RangeSet.Internal.Extractors
import Data.RangeSet.Internal.Lumpers
import Data.RangeSet.Internal.Splitters
import Data.RangeSet.Internal.Heuristics

{-# INLINEABLE insertE #-}
insertE :: E -> RangeSet a -> RangeSet a
insertE :: E -> RangeSet a -> RangeSet a
insertE !E
x RangeSet a
Tip = E -> E -> E -> RangeSet a
forall a. E -> E -> E -> RangeSet a
single E
1 E
x E
x
insertE E
x t :: RangeSet a
t@(Fork E
h E
sz E
l E
u RangeSet a
lt RangeSet a
rt)
  -- Nothing happens when it's already in range
  | E
l E -> E -> Bool
forall a. Ord a => a -> a -> Bool
<= E
x = if
    | E
x E -> E -> Bool
forall a. Ord a => a -> a -> Bool
<= E
u -> RangeSet a
t
  -- If it is adjacent to the upper range, it may fuse
    | E
x E -> E -> Bool
forall a. Eq a => a -> a -> Bool
== E -> E
forall a. Enum a => a -> a
succ E
u -> E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fuseRight E
h (E
sz E -> E -> E
forall a. Num a => a -> a -> a
+ E
1) E
l E
x RangeSet a
lt RangeSet a
rt                                         -- we know x > u since x <= l && not x <= u
  -- Otherwise, insert and balance for right
    | Bool
otherwise -> RangeSet a
-> RangeSet a
-> RangeSet a
-> (RangeSet a -> RangeSet a)
-> RangeSet a
forall a.
RangeSet a
-> RangeSet a
-> RangeSet a
-> (RangeSet a -> RangeSet a)
-> RangeSet a
ifStayedSame RangeSet a
rt (E -> RangeSet a -> RangeSet a
forall a. E -> RangeSet a -> RangeSet a
insertE E
x RangeSet a
rt) RangeSet a
t (E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balance (E
sz E -> E -> E
forall a. Num a => a -> a -> a
+ E
1) E
l E
u RangeSet a
lt)               -- cannot be biased, because fusion can shrink a tree
  | {- x < l -} Bool
otherwise = if
  -- If it is adjacent to the lower, it may fuse
    E
x E -> E -> Bool
forall a. Eq a => a -> a -> Bool
== E -> E
forall a. Enum a => a -> a
pred E
l then E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fuseLeft E
h (E
sz E -> E -> E
forall a. Num a => a -> a -> a
+ E
1) E
x E
u RangeSet a
lt RangeSet a
rt                                          -- the equality must be guarded by an existence check
  -- Otherwise, insert and balance for left
                else RangeSet a
-> RangeSet a
-> RangeSet a
-> (RangeSet a -> RangeSet a)
-> RangeSet a
forall a.
RangeSet a
-> RangeSet a
-> RangeSet a
-> (RangeSet a -> RangeSet a)
-> RangeSet a
ifStayedSame RangeSet a
lt (E -> RangeSet a -> RangeSet a
forall a. E -> RangeSet a -> RangeSet a
insertE E
x RangeSet a
lt) RangeSet a
t ((RangeSet a -> RangeSet a) -> RangeSet a)
-> (RangeSet a -> RangeSet a) -> RangeSet a
forall a b. (a -> b) -> a -> b
$ \RangeSet a
lt' -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balance (E
sz E -> E -> E
forall a. Num a => a -> a -> a
+ E
1) E
l E
u RangeSet a
lt' RangeSet a
rt -- cannot be biased, because fusion can shrink a tree
  where
    {-# INLINE fuseLeft #-}
    fuseLeft :: E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fuseLeft !E
h !E
sz !E
x !E
u RangeSet a
Tip !RangeSet a
rt = E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork E
h E
sz E
x E
u RangeSet a
forall a. RangeSet a
Tip RangeSet a
rt
    fuseLeft E
h E
sz E
x E
u (Fork E
_ E
lsz E
ll E
lu RangeSet a
llt RangeSet a
lrt) RangeSet a
rt
      | (# !E
l, !E
x', 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
      -- we know there exists an element larger than x'
      -- if x == x' + 1, we fuse (x != x' since that breaks disjointness, x == pred l)
      , E
x E -> E -> Bool
forall a. Eq a => a -> a -> Bool
== E -> E
forall a. Enum a => a -> a
succ E
x' = E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balanceR E
sz E
l E
u RangeSet a
lt' RangeSet a
rt
      | Bool
otherwise    = E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork E
h E
sz E
x E
u RangeSet a
lt RangeSet a
rt
    {-# INLINE fuseRight #-}
    fuseRight :: E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fuseRight !E
h !E
sz !E
l !E
x !RangeSet a
lt RangeSet a
Tip = E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork E
h E
sz E
l E
x RangeSet a
lt RangeSet a
forall a. RangeSet a
Tip
    fuseRight E
h E
sz E
l E
x RangeSet a
lt (Fork E
_ E
rsz E
rl E
ru RangeSet a
rlt RangeSet a
rrt)
      | (# !E
x', !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
      -- we know there exists an element smaller than x'
      -- if x == x' - 1, we fuse (x != x' since that breaks disjointness, as x == succ u)
      , E
x E -> E -> Bool
forall a. Eq a => a -> a -> Bool
== E -> E
forall a. Enum a => a -> a
pred E
x' = E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balanceL E
sz E
l E
u RangeSet a
lt RangeSet a
rt'
      | Bool
otherwise    = E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork E
h E
sz E
l E
x RangeSet a
lt RangeSet a
rt

{-# INLINEABLE deleteE #-}
deleteE :: E -> RangeSet a -> RangeSet a
deleteE :: E -> RangeSet a -> RangeSet a
deleteE !E
_ RangeSet a
Tip = RangeSet a
forall a. RangeSet a
Tip
deleteE E
x t :: RangeSet a
t@(Fork E
h E
sz E
l E
u RangeSet a
lt RangeSet a
rt) =
  case E -> E -> Ordering
forall a. Ord a => a -> a -> Ordering
compare E
l E
x of
    -- If its the only part of the range, the node is removed
    Ordering
EQ | E
x E -> E -> Bool
forall a. Eq a => a -> a -> Bool
== E
u    -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> RangeSet a -> RangeSet a -> RangeSet a
glue (E
sz E -> E -> E
forall a. Num a => a -> a -> a
- E
1) RangeSet a
lt RangeSet a
rt
    -- If it's at an extreme, it shrinks the range
       | Bool
otherwise -> E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork E
h (E
sz E -> E -> E
forall a. Num a => a -> a -> a
- E
1) (E -> E
forall a. Enum a => a -> a
succ E
l) E
u RangeSet a
lt RangeSet a
rt
    Ordering
LT -> case E -> E -> Ordering
forall a. Ord a => a -> a -> Ordering
compare E
x E
u of
    -- If it's at an extreme, it shrinks the range
       Ordering
EQ          -> E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
Fork E
h (E
sz E -> E -> E
forall a. Num a => a -> a -> a
- E
1) E
l (E -> E
forall a. Enum a => a -> a
pred E
u) RangeSet a
lt RangeSet a
rt
    -- Otherwise, if it's still in range, the range undergoes fission
       Ordering
LT          -> E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fission (E
sz E -> E -> E
forall a. Num a => a -> a -> a
- E
1) E
l E
x E
u RangeSet a
lt RangeSet a
rt
    -- Otherwise delete and balance for one of the left or right
       Ordering
GT          -> RangeSet a
-> RangeSet a
-> RangeSet a
-> (RangeSet a -> RangeSet a)
-> RangeSet a
forall a.
RangeSet a
-> RangeSet a
-> RangeSet a
-> (RangeSet a -> RangeSet a)
-> RangeSet a
ifStayedSame RangeSet a
rt (E -> RangeSet a -> RangeSet a
forall a. E -> RangeSet a -> RangeSet a
deleteE E
x RangeSet a
rt) RangeSet a
t ((RangeSet a -> RangeSet a) -> RangeSet a)
-> (RangeSet a -> RangeSet a) -> RangeSet a
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balance (E
sz E -> E -> E
forall a. Num a => a -> a -> a
- E
1) E
l E
u RangeSet a
lt             -- cannot be biased, because fisson can grow a tree
    Ordering
GT             -> RangeSet a
-> RangeSet a
-> RangeSet a
-> (RangeSet a -> RangeSet a)
-> RangeSet a
forall a.
RangeSet a
-> RangeSet a
-> RangeSet a
-> (RangeSet a -> RangeSet a)
-> RangeSet a
ifStayedSame RangeSet a
lt (E -> RangeSet a -> RangeSet a
forall a. E -> RangeSet a -> RangeSet a
deleteE E
x RangeSet a
lt) RangeSet a
t ((RangeSet a -> RangeSet a) -> RangeSet a)
-> (RangeSet a -> RangeSet a) -> RangeSet a
forall a b. (a -> b) -> a -> b
$ \RangeSet a
lt' -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
balance (E
sz E -> E -> E
forall a. Num a => a -> a -> a
- E
1) E
l E
u RangeSet a
lt' RangeSet a
rt -- cannot be biased, because fisson can grow a tree
  where
    {- Fission breaks a node into two new ranges
       we'll push the range down into the smallest child, ensuring it's balanced -}
    {-# INLINE fission #-}
    fission :: Size -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
    fission :: E -> E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fission !E
sz !E
l1 !E
x !E
u2 !RangeSet a
lt !RangeSet a
rt
      | RangeSet a -> E
forall a. RangeSet a -> E
height RangeSet a
lt E -> E -> Bool
forall a. Ord a => a -> a -> Bool
> RangeSet a -> E
forall a. RangeSet a -> E
height RangeSet a
rt = E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forkSz E
sz E
l1 E
u1 RangeSet a
lt (E -> E -> E -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a
unsafeInsertL E
sz' E
l2 E
u2 RangeSet a
rt)
      | Bool
otherwise = E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forkSz E
sz E
l1 E
u1 (E -> E -> E -> RangeSet a -> RangeSet a
forall a. E -> E -> E -> RangeSet a -> RangeSet a
unsafeInsertR E
sz' E
l2 E
u2 RangeSet a
lt) RangeSet a
rt
      where
        !u1 :: E
u1 = E -> E
forall a. Enum a => a -> a
pred E
x
        !l2 :: E
l2 = E -> E
forall a. Enum a => a -> a
succ E
x
        !sz' :: E
sz' = E -> E -> E
diffE E
l2 E
u2

uncheckedSubsetOf :: RangeSet a -> RangeSet a -> Bool
uncheckedSubsetOf :: RangeSet a -> RangeSet a -> Bool
uncheckedSubsetOf RangeSet a
Tip RangeSet a
_ = Bool
True
uncheckedSubsetOf RangeSet a
_ RangeSet a
Tip = Bool
False
uncheckedSubsetOf (Fork E
_ E
_ E
l E
u RangeSet a
lt RangeSet a
rt) RangeSet a
t = case E -> E -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
forall a.
E -> E -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
splitOverlap E
l E
u RangeSet a
t of
  (# RangeSet a
lt', Fork E
1 E
_ E
x E
y RangeSet a
_ RangeSet a
_, RangeSet a
rt' #) ->
       E
x E -> E -> Bool
forall a. Eq a => a -> a -> Bool
== E
l Bool -> Bool -> Bool
&& E
y E -> E -> Bool
forall a. Eq a => a -> a -> Bool
== E
u
    Bool -> Bool -> Bool
&& RangeSet a -> E
forall a. RangeSet a -> E
size RangeSet a
lt E -> E -> Bool
forall a. Ord a => a -> a -> Bool
<= RangeSet a -> E
forall a. RangeSet a -> E
size RangeSet a
lt' Bool -> Bool -> Bool
&& RangeSet a -> E
forall a. RangeSet a -> E
size RangeSet a
rt E -> E -> Bool
forall a. Ord a => a -> a -> Bool
<= RangeSet a -> E
forall a. RangeSet a -> E
size RangeSet a
rt'
    Bool -> Bool -> Bool
&& RangeSet a -> RangeSet a -> Bool
forall a. RangeSet a -> RangeSet a -> Bool
uncheckedSubsetOf RangeSet a
lt RangeSet a
lt' Bool -> Bool -> Bool
&& RangeSet a -> RangeSet a -> Bool
forall a. RangeSet a -> RangeSet a -> Bool
uncheckedSubsetOf RangeSet a
rt RangeSet a
rt'
  (# RangeSet a, RangeSet a, RangeSet a #)
_                                -> Bool
False

fromDistinctAscRangesSz :: SRangeList -> Int -> RangeSet a
fromDistinctAscRangesSz :: SRangeList -> E -> RangeSet a
fromDistinctAscRangesSz SRangeList
rs !E
n = case SRangeList -> E -> E -> (# RangeSet a, SRangeList #)
forall a. SRangeList -> E -> E -> (# RangeSet a, SRangeList #)
go SRangeList
rs E
0 (E
n E -> E -> E
forall a. Num a => a -> a -> a
- E
1) of (# RangeSet a
t, SRangeList
_ #) -> RangeSet a
t
  where
    go :: SRangeList -> Int -> Int -> (# RangeSet a, SRangeList #)
    go :: SRangeList -> E -> E -> (# RangeSet a, SRangeList #)
go SRangeList
rs !E
i !E
j
      | E
i E -> E -> Bool
forall a. Ord a => a -> a -> Bool
> E
j     = (# RangeSet a
forall a. RangeSet a
Tip, SRangeList
rs #)
      | Bool
otherwise =
        let !mid :: E
mid = (E
i E -> E -> E
forall a. Num a => a -> a -> a
+ E
j) E -> E -> E
forall a. Integral a => a -> a -> a
`div` E
2
        in case SRangeList -> E -> E -> (# RangeSet a, SRangeList #)
forall a. SRangeList -> E -> E -> (# RangeSet a, SRangeList #)
go SRangeList
rs E
i (E
mid E -> E -> E
forall a. Num a => a -> a -> a
- E
1) of
             (# RangeSet a
lt, SRangeList
rs' #) ->
                let !(SRangeCons E
l E
u SRangeList
rs'') = SRangeList
rs'
                in case SRangeList -> E -> E -> (# RangeSet a, SRangeList #)
forall a. SRangeList -> E -> E -> (# RangeSet a, SRangeList #)
go SRangeList
rs'' (E
mid E -> E -> E
forall a. Num a => a -> a -> a
+ E
1) E
j of
                      (# RangeSet a
rt, SRangeList
rs''' #) -> (# E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
fork E
l E
u RangeSet a
lt RangeSet a
rt, SRangeList
rs''' #)

{-# INLINE insertRangeE #-}
-- This could be improved, but is OK
insertRangeE :: E -> E -> RangeSet a -> RangeSet a
insertRangeE :: E -> E -> RangeSet a -> RangeSet a
insertRangeE !E
l !E
u RangeSet a
t = let (# RangeSet a
lt, RangeSet a
rt #) = E -> E -> RangeSet a -> (# RangeSet a, RangeSet a #)
forall a. E -> E -> RangeSet a -> (# RangeSet a, RangeSet a #)
split E
l E
u RangeSet a
t in E -> E -> RangeSet a -> RangeSet a -> RangeSet a
forall a. E -> E -> RangeSet a -> RangeSet a -> RangeSet a
link E
l E
u RangeSet a
lt RangeSet a
rt