{-# LANGUAGE DerivingStrategies, MagicHash, UnboxedTuples, RoleAnnotations, TypeApplications #-}
{-# OPTIONS_HADDOCK prune #-}
{-|
Module      : Parsley.Internal.Common.RangeSet
Description : Packaging of offsets and positions.
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

This module contains the implementation of an efficient set for contiguous data. It has a much
smaller memory footprint than a @Set@, and can result in asymptotically faster operations.

@since 2.1.0.0
-}
module Parsley.Internal.Common.RangeSet (
    RangeSet(..),
    empty, singleton, null, full, isSingle, extractSingle, size, sizeRanges,
    member, notMember, findMin, findMax,
    insert, delete,
    union, intersection, difference, disjoint, complement,
    isSubsetOf, isProperSubsetOf,
    allLess, allMore,
    elems, unelems, fromRanges, insertRange, fromList,
    fold,
    -- Testing
    valid
  ) where

import Prelude hiding (null)
import Control.Applicative (liftA2)

import GHC.Exts (reallyUnsafePtrEquality#, isTrue#)

{-# INLINE ptrEq #-}
ptrEq :: a -> a -> Bool
ptrEq :: a -> a -> Bool
ptrEq a
x a
y = Int# -> Bool
isTrue# (a -> a -> Int#
forall a. a -> a -> Int#
reallyUnsafePtrEquality# a
x a
y)

{-# INLINE range #-}
range :: Enum a => a -> a -> [a]
range :: a -> a -> [a]
range a
l a
u = [a
l..a
u]

{-# INLINE diff #-}
diff :: Enum a => a -> a -> Size
diff :: a -> a -> Size
diff !a
l !a
u = a -> Size
forall a. Enum a => a -> Size
fromEnum a
u Size -> Size -> Size
forall a. Num a => a -> a -> a
- a -> Size
forall a. Enum a => a -> Size
fromEnum a
l Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1

type Size = Int
{-|
A @Set@ type designed for types that are `Enum` as well as `Ord`. This allows the `RangeSet` to
compress the data when it is contiguous, reducing memory-footprint and enabling otherwise impractical
operations like `complement` for `Bounded` types.

@since 2.1.0.0
-}
data RangeSet a = Fork {-# UNPACK #-} !Int {-# UNPACK #-} !Size !a !a !(RangeSet a) !(RangeSet a)
                | Tip
                deriving stock Size -> RangeSet a -> ShowS
[RangeSet a] -> ShowS
RangeSet a -> String
(Size -> RangeSet a -> ShowS)
-> (RangeSet a -> String)
-> ([RangeSet a] -> ShowS)
-> Show (RangeSet a)
forall a. Show a => Size -> RangeSet a -> ShowS
forall a. Show a => [RangeSet a] -> ShowS
forall a. Show a => RangeSet a -> String
forall a.
(Size -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RangeSet a] -> ShowS
$cshowList :: forall a. Show a => [RangeSet a] -> ShowS
show :: RangeSet a -> String
$cshow :: forall a. Show a => RangeSet a -> String
showsPrec :: Size -> RangeSet a -> ShowS
$cshowsPrec :: forall a. Show a => Size -> RangeSet a -> ShowS
Show
type role RangeSet nominal

{-|
The empty `RangeSet`.

@since 2.1.0.0
-}
{-# INLINE empty #-}
empty :: RangeSet a
empty :: RangeSet a
empty = RangeSet a
forall a. RangeSet a
Tip

{-|
A `RangeSet` containing a single value.

@since 2.1.0.0
-}
singleton :: a -> RangeSet a
singleton :: a -> RangeSet a
singleton a
x = Size -> a -> a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a
single Size
1 a
x a
x

{-# INLINE fork #-}
fork :: Enum a => a -> a -> RangeSet a -> RangeSet a -> RangeSet a
fork :: a -> a -> RangeSet a -> RangeSet a -> RangeSet a
fork !a
l !a
u !RangeSet a
lt !RangeSet a
rt = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> 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
+ a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
l a
u) a
l a
u RangeSet a
lt RangeSet a
rt

forkSz :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz !Size
sz !a
l !a
u !RangeSet a
lt !RangeSet a
rt = Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork (Size -> Size -> Size
forall a. Ord a => a -> a -> a
max (RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lt) (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 a
l a
u RangeSet a
lt RangeSet a
rt

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

{-|
Is this set empty?

@since 2.1.0.0
-}
null :: RangeSet a -> Bool
null :: RangeSet a -> Bool
null RangeSet a
Tip = Bool
True
null RangeSet a
_ = Bool
False

{-|
Is this set full?

@since 2.1.0.0
-}
full :: (Eq a, Bounded a) => RangeSet a -> Bool
full :: RangeSet a -> Bool
full RangeSet a
Tip = Bool
False
full (Fork Size
_ Size
_ a
l a
u RangeSet a
_ RangeSet a
_) = a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& a
forall a. Bounded a => a
maxBound a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
u

{-|
Does this set contain a single element?

@since 2.1.0.0
-}
isSingle :: RangeSet a -> Bool
isSingle :: RangeSet a -> Bool
isSingle (Fork Size
_ Size
1 a
_ a
_ RangeSet a
_ RangeSet a
_) = Bool
True
isSingle RangeSet a
_ = Bool
False

{-|
Possibly extract the element contained in the set if it is a singleton set.

@since 2.1.0.0
-}
extractSingle :: Eq a => RangeSet a -> Maybe a
extractSingle :: RangeSet a -> Maybe a
extractSingle (Fork Size
_ Size
_ a
x a
y RangeSet a
Tip RangeSet a
Tip) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = a -> Maybe a
forall a. a -> Maybe a
Just a
x
extractSingle RangeSet a
_                               = Maybe a
forall a. Maybe a
Nothing

{-# INLINE height #-}
height :: RangeSet a -> Int
height :: RangeSet a -> Size
height RangeSet a
Tip = Size
0
height (Fork Size
h Size
_ a
_ a
_ RangeSet a
_ RangeSet a
_) = Size
h

{-|
Return the number of /elements/ in the set.

@since 2.1.0.0
-}
{-# INLINE size #-}
size :: RangeSet a -> Int
size :: RangeSet a -> Size
size RangeSet a
Tip = Size
0
size (Fork Size
_ Size
sz a
_ a
_ RangeSet a
_ RangeSet a
_) = Size
sz

{-|
Return the number of /contiguous ranges/ that populate the set.

@since 2.1.0.0
-}
sizeRanges :: RangeSet a -> Int
sizeRanges :: RangeSet a -> Size
sizeRanges = (a -> a -> Size -> Size -> Size) -> Size -> RangeSet a -> Size
forall a b. (a -> a -> b -> b -> b) -> b -> RangeSet a -> b
fold (\a
_ a
_ Size
szl Size
szr -> Size
szl Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
szr Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) Size
0

{-|
Test whether or not a given value is found within the set.

@since 2.1.0.0
-}
{-# INLINEABLE member #-}
member :: forall a. Ord a => a -> RangeSet a -> Bool
member :: a -> RangeSet a -> Bool
member !a
x = RangeSet a -> Bool
go
  where
    go :: RangeSet a -> Bool
go (Fork Size
_ Size
_ a
l a
u RangeSet a
lt RangeSet a
rt)
      | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x    = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
u Bool -> Bool -> Bool
|| RangeSet a -> Bool
go RangeSet a
rt
      | Bool
otherwise = RangeSet a -> Bool
go RangeSet a
lt
    go RangeSet a
Tip = Bool
False

{-|
Test whether or not a given value is not found within the set.

@since 2.1.0.0
-}
{-# INLINEABLE notMember #-}
notMember :: Ord a => a -> RangeSet a -> Bool
notMember :: a -> RangeSet a -> Bool
notMember a
x = Bool -> Bool
not (Bool -> Bool) -> (RangeSet a -> Bool) -> RangeSet a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RangeSet a -> Bool
forall a. Ord a => a -> RangeSet a -> Bool
member a
x

{-# INLINE ifeq #-}
ifeq :: RangeSet a -> RangeSet a -> RangeSet a -> (RangeSet a -> RangeSet a) -> RangeSet a
ifeq :: RangeSet a
-> RangeSet a
-> RangeSet a
-> (RangeSet a -> RangeSet a)
-> RangeSet a
ifeq !RangeSet a
x !RangeSet a
x' RangeSet a
y RangeSet a -> RangeSet a
f = if RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
x Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
x' then RangeSet a
y else RangeSet a -> RangeSet a
f RangeSet a
x'

{-|
Insert a new element into the set.

@since 2.1.0.0
-}
{-# INLINEABLE insert #-}
insert :: forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
insert :: a -> RangeSet a -> RangeSet a
insert !a
x RangeSet a
Tip = Size -> a -> a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a
single Size
1 a
x a
x
insert a
x t :: RangeSet a
t@(Fork Size
h Size
sz a
l a
u RangeSet a
lt RangeSet a
rt)
  -- Nothing happens when it's already in range
  | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x, a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
u = RangeSet a
t
  -- If it is adjacent to the lower, it may fuse
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
l, a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Enum a => a -> a
pred a
l = Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
fuseLeft Size
h (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) a
x a
u RangeSet a
lt RangeSet a
rt                    -- the equality must be guarded by an existence check
  -- Otherwise, insert and balance for left
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
l = 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
ifeq RangeSet a
lt (a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
insert a
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' -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balance (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) a
l a
u RangeSet a
lt' RangeSet a
rt -- cannot be biased, because fusion can shrink a tree
  -- If it is adjacent to the upper range, it may fuse
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Enum a => a -> a
succ a
u = Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
fuseRight Size
h (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) a
l a
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
ifeq RangeSet a
rt (a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
insert a
x RangeSet a
rt) RangeSet a
t (Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balance (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) a
l a
u RangeSet a
lt)         -- cannot be biased, because fusion can shrink a tree
  where
    {-# INLINE fuseLeft #-}
    fuseLeft :: Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
fuseLeft !Size
h !Size
sz !a
x !a
u RangeSet a
Tip !RangeSet a
rt = Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
h Size
sz a
x a
u RangeSet a
lt RangeSet a
rt
    fuseLeft Size
h Size
sz a
x a
u RangeSet a
lt RangeSet a
rt
      | (# !a
l, !a
x', RangeSet a
lt' #) <- RangeSet a -> (# a, a, RangeSet a #)
forall a. RangeSet a -> (# a, a, RangeSet a #)
unsafeMaxDelete RangeSet a
lt
      -- we know there exists an element larger than x'
      -- if x == x' or x == x' + 1, we fuse
      -- x >= x' since it is one less than x''s strict upper bound
      -- x >= x' && (x == x' || x == x' + 1) === x >= x' && x <= x' + 1
      , a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> a
forall a. Enum a => a -> a
succ a
x' = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceR Size
sz a
l a
u RangeSet a
lt' RangeSet a
rt
      | Bool
otherwise    = Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
h Size
sz a
x a
u RangeSet a
lt RangeSet a
rt
    {-# INLINE fuseRight #-}
    fuseRight :: Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
fuseRight !Size
h !Size
sz !a
l !a
x !RangeSet a
lt RangeSet a
Tip = Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
h Size
sz a
l a
x RangeSet a
lt RangeSet a
rt
    fuseRight Size
h Size
sz a
l a
x RangeSet a
lt RangeSet a
rt
      | (# !a
x', !a
u, RangeSet a
rt' #) <- RangeSet a -> (# a, a, RangeSet a #)
forall a. RangeSet a -> (# a, a, RangeSet a #)
unsafeMinDelete RangeSet a
rt
      -- we know there exists an element smaller than x'
      -- if x == x' or x == x' - 1, we fuse
      -- x <= x' since it is one greater than x''s strict lower bound,
      -- x <= x' && (x == x' || x == x' - 1) === x <= x' && x >= x' - 1
      , a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> a
forall a. Enum a => a -> a
pred a
x' = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceL Size
sz a
l a
u RangeSet a
lt RangeSet a
rt'
      | Bool
otherwise    = Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
h Size
sz a
l a
x RangeSet a
lt RangeSet a
rt

{-|
Remove an element from the set, if it appears.

@since 2.1.0.0
-}
{-# INLINEABLE delete #-}
delete :: (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
delete :: a -> RangeSet a -> RangeSet a
delete !a
_ RangeSet a
Tip = RangeSet a
forall a. RangeSet a
Tip
delete a
x t :: RangeSet a
t@(Fork Size
h Size
sz a
l a
u RangeSet a
lt RangeSet a
rt) =
  case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
l a
x of
    -- If its the only part of the range, the node is removed
    Ordering
EQ | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
u    -> Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> RangeSet a -> RangeSet a -> RangeSet a
glue (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) RangeSet a
lt RangeSet a
rt
    -- If it's at an extreme, it shrinks the range
       | Bool
otherwise -> Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
h (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) (a -> a
forall a. Enum a => a -> a
succ a
l) a
u RangeSet a
lt RangeSet a
rt
    Ordering
LT -> case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
u of
    -- If it's at an extreme, it shrinks the range
       Ordering
EQ          -> Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
h (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) a
l (a -> a
forall a. Enum a => a -> a
pred a
u) RangeSet a
lt RangeSet a
rt
    -- Otherwise, if it's still in range, the range undergoes fission
       Ordering
LT          -> Size -> a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Enum a =>
Size -> a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
fission (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) a
l a
x a
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
ifeq RangeSet a
rt (a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
delete a
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
$ Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balance (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) a
l a
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
ifeq RangeSet a
lt (a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
delete a
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' -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balance (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) a
l a
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 right arbitrarily
       To do this, we have to make it a child of the right-tree's left most position. -}
    {-# INLINE fission #-}
    fission :: Size -> a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
fission !Size
sz !a
l1 !a
x !a
u2 !RangeSet a
lt !RangeSet a
rt =
      let u1 :: a
u1 = a -> a
forall a. Enum a => a -> a
pred a
x
          l2 :: a
l2 = a -> a
forall a. Enum a => a -> a
succ a
x
          rt' :: RangeSet a
rt' = Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertL (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
l2 a
u2) a
l2 a
u2 RangeSet a
rt
      in Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceR Size
sz a
l1 a
u1 RangeSet a
lt RangeSet a
rt'

{-|
Inserts an range at the left-most position in the tree.
It *must* not overlap with any other range within the tree.
It *must* be /known/ not to exist within the tree.
-}
{-# INLINEABLE unsafeInsertL #-}
unsafeInsertL :: Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertL :: Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertL !Size
newSz a
l a
u RangeSet a
Tip = Size -> a -> a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a
single Size
newSz a
l a
u
unsafeInsertL Size
newSz a
l a
u (Fork Size
_ Size
sz a
l' a
u' RangeSet a
lt RangeSet a
rt) = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceL (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
newSz) a
l' a
u' (Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertL Size
newSz a
l a
u RangeSet a
lt) RangeSet a
rt

{-|
Inserts an range at the right-most position in the tree.
It *must* not overlap with any other range within the tree.
It *must* be /known/ not to exist within the tree.
-}
{-# INLINEABLE unsafeInsertR #-}
unsafeInsertR :: Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertR :: Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertR !Size
newSz a
l a
u RangeSet a
Tip = Size -> a -> a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a
single Size
newSz a
l a
u
unsafeInsertR Size
newSz a
l a
u (Fork Size
_ Size
sz a
l' a
u' RangeSet a
lt RangeSet a
rt) = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceR (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
newSz) a
l' a
u' RangeSet a
lt (Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertR Size
newSz a
l a
u RangeSet a
rt)

{-|
This deletes the left-most range of the tree.
It *must not* be used with an empty tree.
-}
{-# INLINEABLE unsafeDeleteL #-}
unsafeDeleteL :: Size -> RangeSet a -> RangeSet a
unsafeDeleteL :: Size -> RangeSet a -> RangeSet a
unsafeDeleteL !Size
_ (Fork Size
_ Size
_ a
_ a
_ RangeSet a
Tip RangeSet a
rt) = RangeSet a
rt
unsafeDeleteL Size
szRemoved (Fork Size
_ Size
sz a
l a
u RangeSet a
lt RangeSet a
rt) = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceR (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
szRemoved) a
l a
u (Size -> RangeSet a -> RangeSet a
forall a. Size -> RangeSet a -> RangeSet a
unsafeDeleteL Size
szRemoved RangeSet a
lt) RangeSet a
rt
unsafeDeleteL Size
_ RangeSet a
_ = String -> RangeSet a
forall a. HasCallStack => String -> a
error String
"unsafeDeleteL called on empty tree"

{-|
This deletes the right-most range of the tree.
It *must not* be used with an empty tree.
-}
{-{-# INLINEABLE unsafeDeleteR #-}
unsafeDeleteR :: Int -> RangeSet a -> RangeSet a
unsafeDeleteR !_ (Fork _ _ _ _ lt Tip) = lt
unsafeDeleteR szRemoved (Fork _ sz l u lt rt) = balanceL (sz - szRemoved) l u lt (unsafeDeleteR szRemoved rt)
unsafeDeleteR _ _ = error "unsafeDeleteR called on empty tree"-}

{-|
Find the minimum value within the set, if one exists.

@since 2.1.0.0
-}
{-# INLINE findMin #-}
findMin :: RangeSet a -> Maybe a
findMin :: RangeSet a -> Maybe a
findMin RangeSet a
Tip = Maybe a
forall a. Maybe a
Nothing
findMin RangeSet a
t = let (# !a
m, !a
_ #) = RangeSet a -> (# a, a #)
forall a. RangeSet a -> (# a, a #)
unsafeMinRange RangeSet a
t in a -> Maybe a
forall a. a -> Maybe a
Just a
m

-- | Should /not/ be called with an empty tree!
{-# INLINEABLE unsafeMinRange #-}
unsafeMinRange :: RangeSet a -> (# a, a #)
unsafeMinRange :: RangeSet a -> (# a, a #)
unsafeMinRange (Fork Size
_ Size
_ a
l a
u RangeSet a
Tip RangeSet a
_) = (# a
l, a
u #)
unsafeMinRange (Fork Size
_ Size
_ a
_ a
_ RangeSet a
lt RangeSet a
_) = RangeSet a -> (# a, a #)
forall a. RangeSet a -> (# a, a #)
unsafeMinRange RangeSet a
lt
unsafeMinRange RangeSet a
Tip = String -> (# a, a #)
forall a. HasCallStack => String -> a
error String
"unsafeMinRange called on empty tree"

{-|
Find the maximum value within the set, if one exists.

@since 2.1.0.0
-}
{-# INLINE findMax #-}
findMax :: RangeSet a -> Maybe a
findMax :: RangeSet a -> Maybe a
findMax RangeSet a
Tip = Maybe a
forall a. Maybe a
Nothing
findMax RangeSet a
t = let (# !a
_, !a
m #) = RangeSet a -> (# a, a #)
forall a. RangeSet a -> (# a, a #)
unsafeMaxRange RangeSet a
t in a -> Maybe a
forall a. a -> Maybe a
Just a
m

-- | Should /not/ be called with an empty tree!
{-# INLINEABLE unsafeMaxRange #-}
unsafeMaxRange :: RangeSet a -> (# a, a #)
unsafeMaxRange :: RangeSet a -> (# a, a #)
unsafeMaxRange (Fork Size
_ Size
_ a
l a
u RangeSet a
_ RangeSet a
Tip) = (# a
l, a
u #)
unsafeMaxRange (Fork Size
_ Size
_ a
_ a
_ RangeSet a
_ RangeSet a
rt) = RangeSet a -> (# a, a #)
forall a. RangeSet a -> (# a, a #)
unsafeMaxRange RangeSet a
rt
unsafeMaxRange RangeSet a
Tip = String -> (# a, a #)
forall a. HasCallStack => String -> a
error String
"unsafeMaxRange called on empty tree"

{-# INLINE unsafeMinDelete #-}
unsafeMinDelete :: RangeSet a -> (# a, a, RangeSet a #)
unsafeMinDelete :: RangeSet a -> (# a, a, RangeSet a #)
unsafeMinDelete (Fork Size
_ Size
sz a
l a
u RangeSet a
lt RangeSet a
rt) = let (# !a
ml, !a
mu, !Size
_, RangeSet a
t' #) = Size
-> a
-> a
-> RangeSet a
-> RangeSet a
-> (# a, a, Size, RangeSet a #)
forall t.
Size
-> t
-> t
-> RangeSet t
-> RangeSet t
-> (# t, t, Size, RangeSet t #)
go Size
sz a
l a
u RangeSet a
lt RangeSet a
rt in (# a
ml, a
mu, RangeSet a
t' #)
  where
    go :: Size
-> t
-> t
-> RangeSet t
-> RangeSet t
-> (# t, t, Size, RangeSet t #)
go !Size
sz !t
l !t
u RangeSet t
Tip !RangeSet t
rt = (# t
l, t
u, Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- RangeSet t -> Size
forall a. RangeSet a -> Size
size RangeSet t
rt, RangeSet t
rt #)
    go Size
sz t
l t
u (Fork Size
_ Size
lsz t
ll t
lu RangeSet t
llt RangeSet t
lrt) RangeSet t
rt =
      let (# !t
ml, !t
mu, !Size
msz, RangeSet t
lt' #) = Size
-> t
-> t
-> RangeSet t
-> RangeSet t
-> (# t, t, Size, RangeSet t #)
go Size
lsz t
ll t
lu RangeSet t
llt RangeSet t
lrt
      in (# t
ml, t
mu, Size
msz, Size -> t -> t -> RangeSet t -> RangeSet t -> RangeSet t
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceR (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
msz) t
l t
u RangeSet t
lt' RangeSet t
rt #)
unsafeMinDelete RangeSet a
Tip = String -> (# a, a, RangeSet a #)
forall a. HasCallStack => String -> a
error String
"unsafeMinDelete called on empty tree"

{-# INLINE unsafeMaxDelete #-}
unsafeMaxDelete :: RangeSet a -> (# a, a, RangeSet a #)
unsafeMaxDelete :: RangeSet a -> (# a, a, RangeSet a #)
unsafeMaxDelete (Fork Size
_ Size
sz a
l a
u RangeSet a
lt RangeSet a
rt) = let (# !a
ml, !a
mu, !Size
_, RangeSet a
t' #) = Size
-> a
-> a
-> RangeSet a
-> RangeSet a
-> (# a, a, Size, RangeSet a #)
forall t.
Size
-> t
-> t
-> RangeSet t
-> RangeSet t
-> (# t, t, Size, RangeSet t #)
go Size
sz a
l a
u RangeSet a
lt RangeSet a
rt in (# a
ml, a
mu, RangeSet a
t' #)
  where
    go :: Size
-> t
-> t
-> RangeSet t
-> RangeSet t
-> (# t, t, Size, RangeSet t #)
go !Size
sz !t
l !t
u !RangeSet t
lt RangeSet t
Tip = (# t
l, t
u, Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- RangeSet t -> Size
forall a. RangeSet a -> Size
size RangeSet t
lt, RangeSet t
lt #)
    go Size
sz t
l t
u RangeSet t
lt (Fork Size
_ Size
rsz t
rl t
ru RangeSet t
rlt RangeSet t
rrt) =
      let (# !t
ml, !t
mu, !Size
msz, RangeSet t
rt' #) = Size
-> t
-> t
-> RangeSet t
-> RangeSet t
-> (# t, t, Size, RangeSet t #)
go Size
rsz t
rl t
ru RangeSet t
rlt RangeSet t
rrt
      in (# t
ml, t
mu, Size
msz, Size -> t -> t -> RangeSet t -> RangeSet t -> RangeSet t
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceL (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
msz) t
l t
u RangeSet t
lt RangeSet t
rt' #)
unsafeMaxDelete RangeSet a
Tip = String -> (# a, a, RangeSet a #)
forall a. HasCallStack => String -> a
error String
"unsafeMaxDelete called on empty tree"

{-# INLINABLE balance #-}
balance :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balance :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balance !Size
sz !a
l !a
u RangeSet a
lt RangeSet a
rt
  | 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 -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceL Size
sz a
l a
u RangeSet a
lt 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 -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceR Size
sz a
l a
u RangeSet a
lt RangeSet a
rt
  | Bool
otherwise = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz a
l a
u RangeSet a
lt RangeSet a
rt

{-# NOINLINE balanceL #-}
balanceL :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
-- PRE: left grew or right shrank, difference in height at most 2 biasing to the left
balanceL :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceL !Size
sz !a
l1 !a
u1 lt :: RangeSet a
lt@(Fork Size
hlt Size
szl a
l2 a
u2 RangeSet a
llt RangeSet a
rlt) !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 -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz a
l1 a
u1 RangeSet a
lt RangeSet a
rt
  -- The bias is 2 (dltrt == 2)
  | Size
hllt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Size
hrlt = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
rotr Size
sz a
l1 a
u1 RangeSet a
lt RangeSet a
rt
  | Bool
otherwise    = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
rotr Size
sz a
l1 a
u1 (Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
rotl Size
szl a
l2 a
u2 RangeSet a
llt RangeSet a
rlt) RangeSet a
rt
  where
    !dltrt :: Size
dltrt = Size
hlt Size -> Size -> Size
forall a. Num a => a -> a -> a
- RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rt
    !hllt :: Size
hllt = RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
llt
    !hrlt :: Size
hrlt = RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rlt
-- If the right shrank (or nothing changed), we have to be prepared to handle the Tip case for lt
balanceL Size
sz a
l a
u RangeSet a
Tip 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
<= Size
1 = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz a
l a
u RangeSet a
forall a. RangeSet a
Tip RangeSet a
rt
balanceL Size
_ a
_ a
_ RangeSet a
Tip RangeSet a
_ = String -> RangeSet a
forall a. HasCallStack => String -> a
error String
"Right should have shrank, but is still 1 taller than a Tip!"

{-# NOINLINE balanceR #-}
balanceR :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
-- PRE: left shrank or right grew, difference in height at most 2 biasing to the right
balanceR :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceR !Size
sz !a
l1 !a
u1 !RangeSet a
lt rt :: RangeSet a
rt@(Fork Size
hrt Size
szr a
l2 a
u2 RangeSet a
lrt RangeSet a
rrt)
  -- both sides are equal height or off by one
  | Size
drtlt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
1 = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz a
l1 a
u1 RangeSet a
lt RangeSet a
rt
  -- The bias is 2 (drtlt == 2)
  | Size
hrrt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Size
hlrt = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
rotl Size
sz a
l1 a
u1 RangeSet a
lt RangeSet a
rt
  | Bool
otherwise    = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
rotl Size
sz a
l1 a
u1 RangeSet a
lt (Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
rotr Size
szr a
l2 a
u2 RangeSet a
lrt RangeSet a
rrt)
  where
    !drtlt :: Size
drtlt = Size
hrt Size -> Size -> Size
forall a. Num a => a -> a -> a
- RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lt
    !hlrt :: Size
hlrt = RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lrt
    !hrrt :: Size
hrrt = RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rrt
-- If the left shrank (or nothing changed), we have to be prepared to handle the Tip case for rt
balanceR Size
sz a
l a
u RangeSet a
lt RangeSet a
Tip | RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
1 = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz a
l a
u RangeSet a
lt RangeSet a
forall a. RangeSet a
Tip
balanceR Size
_ a
_ a
_ RangeSet a
_ RangeSet a
Tip = String -> RangeSet a
forall a. HasCallStack => String -> a
error String
"Left should have shrank, but is still 1 taller than a Tip!"

{-# INLINE rotr #-}
rotr :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
rotr :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
rotr !Size
sz !a
l1 !a
u1 (Fork Size
_ Size
szl a
l2 a
u2 RangeSet a
p RangeSet a
q) !RangeSet a
r = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz a
l2 a
u2 RangeSet a
p (Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> 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) a
l1 a
u1 RangeSet a
q RangeSet a
r)
rotr Size
_ a
_ a
_ RangeSet a
_ RangeSet a
_ = String -> RangeSet a
forall a. HasCallStack => String -> a
error String
"rotr on Tip"

{-# INLINE rotl #-}
rotl :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
rotl :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
rotl !Size
sz !a
l1 !a
u1 !RangeSet a
p (Fork Size
_ Size
szr a
l2 a
u2 RangeSet a
q RangeSet a
r) = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz a
l2 a
u2 (Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> 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) a
l1 a
u1 RangeSet a
p RangeSet a
q) RangeSet a
r
rotl Size
_ a
_ a
_ RangeSet a
_ RangeSet a
_ = String -> RangeSet a
forall a. HasCallStack => String -> a
error String
"rotr on Tip"

{-|
Unions two sets together such that if and only if an element appears in either one of the sets, it
will appear in the result set.

@since 2.1.0.0
-}
{-# INLINABLE union #-}
union :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
union :: RangeSet a -> RangeSet a -> RangeSet a
union RangeSet a
t RangeSet a
Tip = RangeSet a
t
union RangeSet a
Tip RangeSet a
t = RangeSet a
t
union t :: RangeSet a
t@(Fork Size
_ Size
_ a
l a
u RangeSet a
lt RangeSet a
rt) RangeSet a
t' = case a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
forall a.
(Enum a, Ord a) =>
a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
split a
l a
u RangeSet a
t' of
  (# RangeSet a
lt', RangeSet a
rt' #)
    | RangeSet a
ltlt' RangeSet a -> RangeSet a -> Bool
forall a. a -> a -> Bool
`ptrEq` RangeSet a
lt, RangeSet a
rtrt' RangeSet a -> RangeSet a -> Bool
forall a. a -> a -> Bool
`ptrEq` RangeSet a
rt -> RangeSet a
t
    | Bool
otherwise                          -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
(Enum a, Eq a) =>
a -> a -> RangeSet a -> RangeSet a -> RangeSet a
link a
l a
u RangeSet a
ltlt' RangeSet a
rtrt'
    where !ltlt' :: RangeSet a
ltlt' = RangeSet a
lt RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
`union` RangeSet a
lt'
          !rtrt' :: RangeSet a
rtrt' = RangeSet a
rt RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
`union` RangeSet a
rt'

{-|
Intersects two sets such that an element appears in the result if and only if it is present in both
of the provided sets.

@since 2.1.0.0
-}
{-# INLINABLE intersection #-}
intersection :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
intersection :: RangeSet a -> RangeSet a -> RangeSet a
intersection RangeSet a
Tip RangeSet a
_ = RangeSet a
forall a. RangeSet a
Tip
intersection RangeSet a
_ RangeSet a
Tip = RangeSet a
forall a. RangeSet a
Tip
intersection t1 :: RangeSet a
t1@(Fork Size
_ Size
_ a
l1 a
u1 RangeSet a
lt1 RangeSet a
rt1) RangeSet a
t2 =
  case RangeSet a
overlap of
    RangeSet a
Tip -> RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
unsafeMerge RangeSet a
lt1lt2 RangeSet a
rt1rt2
    Fork Size
1 Size
sz a
x a
y RangeSet a
_ RangeSet a
_
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
l1, a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
u1
      , RangeSet a
lt1lt2 RangeSet a -> RangeSet a -> Bool
forall a. a -> a -> Bool
`ptrEq` RangeSet a
lt1, RangeSet a
rt1rt2 RangeSet a -> RangeSet a -> Bool
forall a. a -> a -> Bool
`ptrEq` RangeSet a
rt1 -> RangeSet a
t1
      | Bool
otherwise -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeLink Size
sz a
x a
y RangeSet a
lt1lt2 RangeSet a
rt1rt2
    Fork Size
_ Size
sz a
x a
y RangeSet a
lt' RangeSet a
rt' -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeLink (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- 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') a
x a
y (RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
unsafeMerge RangeSet a
lt1lt2 RangeSet a
lt') (RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
unsafeMerge RangeSet a
rt' RangeSet a
rt1rt2)
  where
    (# !RangeSet a
lt2, !RangeSet a
overlap, !RangeSet a
rt2 #) = a -> a -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
forall a.
(Enum a, Ord a) =>
a -> a -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
splitOverlap a
l1 a
u1 RangeSet a
t2
    !lt1lt2 :: RangeSet a
lt1lt2 = RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
intersection RangeSet a
lt1 RangeSet a
lt2
    !rt1rt2 :: RangeSet a
rt1rt2 = RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
intersection RangeSet a
rt1 RangeSet a
rt2

{-|
Do two sets have no elements in common?

@since 2.1.0.0
-}
{-# INLINE disjoint #-}
disjoint :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
disjoint :: RangeSet a -> RangeSet a -> Bool
disjoint RangeSet a
Tip RangeSet a
_ = Bool
True
disjoint RangeSet a
_ RangeSet a
Tip = Bool
True
disjoint (Fork Size
_ Size
_ a
l a
u RangeSet a
lt RangeSet a
rt) RangeSet a
t = case a -> a -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
forall a.
(Enum a, Ord a) =>
a -> a -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
splitOverlap a
l a
u RangeSet a
t of
  (# RangeSet a
lt', RangeSet a
Tip, RangeSet a
rt' #) -> RangeSet a -> RangeSet a -> Bool
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
disjoint RangeSet a
lt RangeSet a
lt' Bool -> Bool -> Bool
&& RangeSet a -> RangeSet a -> Bool
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
disjoint RangeSet a
rt RangeSet a
rt'
  (# RangeSet a, RangeSet a, RangeSet a #)
_                   -> Bool
False

{-|
Removes all elements from the first set that are found in the second set.

@since 2.1.0.0
-}
{-# INLINEABLE difference #-}
difference :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
difference :: RangeSet a -> RangeSet a -> RangeSet a
difference RangeSet a
Tip RangeSet a
_ = RangeSet a
forall a. RangeSet a
Tip
difference RangeSet a
t RangeSet a
Tip = RangeSet a
t
difference RangeSet a
t (Fork Size
_ Size
_ a
l a
u RangeSet a
lt RangeSet a
rt) = case a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
forall a.
(Enum a, Ord a) =>
a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
split a
l a
u RangeSet a
t of
  (# RangeSet a
lt', RangeSet a
rt' #)
    | RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
lt'lt Size -> Size -> Size
forall a. Num a => a -> a -> a
+ RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
rt'rt Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
t -> RangeSet a
t
    | Bool
otherwise -> RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
unsafeMerge RangeSet a
lt'lt RangeSet a
rt'rt
    where
      !lt'lt :: RangeSet a
lt'lt = RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
difference RangeSet a
lt' RangeSet a
lt
      !rt'rt :: RangeSet a
rt'rt = RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
difference RangeSet a
rt' RangeSet a
rt

{-# INLINEABLE unsafeInsertLAdj #-}
unsafeInsertLAdj :: (Enum a, Eq a) => Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertLAdj :: Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertLAdj !Size
newSz !a
l !a
u !RangeSet a
t = case RangeSet a -> (# a, a #)
forall a. RangeSet a -> (# a, a #)
unsafeMinRange RangeSet a
t of
  (# !a
l', a
_ #) | a
l' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Enum a => a -> a
succ a
u -> Size -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> RangeSet a -> RangeSet a
unsafeFuseL Size
newSz a
l RangeSet a
t
               | Bool
otherwise    -> Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertL Size
newSz a
l a
u RangeSet a
t

{-# INLINEABLE unsafeInsertRAdj #-}
unsafeInsertRAdj :: (Enum a, Eq a) => Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertRAdj :: Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertRAdj !Size
newSz !a
l !a
u !RangeSet a
t = case RangeSet a -> (# a, a #)
forall a. RangeSet a -> (# a, a #)
unsafeMaxRange RangeSet a
t of
  (# a
_, !a
u' #) | a
u' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Enum a => a -> a
pred a
l -> Size -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> RangeSet a -> RangeSet a
unsafeFuseR Size
newSz a
u RangeSet a
t
               | Bool
otherwise    -> Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertR Size
newSz a
l a
u RangeSet a
t

{-# INLINEABLE unsafeFuseL #-}
unsafeFuseL :: Size -> a -> RangeSet a -> RangeSet a
unsafeFuseL :: Size -> a -> RangeSet a -> RangeSet a
unsafeFuseL !Size
newSz !a
l' (Fork Size
h Size
sz a
l a
u RangeSet a
lt RangeSet a
rt) = case RangeSet a
lt of
  RangeSet a
Tip -> Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
h (Size
newSz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
sz) a
l' a
u RangeSet a
forall a. RangeSet a
Tip RangeSet a
rt
  RangeSet a
lt  -> Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
h (Size
newSz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
sz) a
l a
u (Size -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> RangeSet a -> RangeSet a
unsafeFuseL Size
newSz a
l' RangeSet a
lt) RangeSet a
rt
unsafeFuseL Size
_ a
_ RangeSet a
Tip = String -> RangeSet a
forall a. HasCallStack => String -> a
error String
"unsafeFuseL called on Tip"

{-# INLINEABLE unsafeFuseR #-}
unsafeFuseR :: Size -> a -> RangeSet a -> RangeSet a
unsafeFuseR :: Size -> a -> RangeSet a -> RangeSet a
unsafeFuseR !Size
newSz !a
u' (Fork Size
h Size
sz a
l a
u RangeSet a
lt RangeSet a
rt) = case RangeSet a
rt of
  RangeSet a
Tip -> Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
h (Size
newSz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
sz) a
l a
u' RangeSet a
lt RangeSet a
forall a. RangeSet a
Tip
  RangeSet a
rt  -> Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Size -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
Fork Size
h (Size
newSz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
sz) a
l a
u RangeSet a
lt (Size -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> RangeSet a -> RangeSet a
unsafeFuseR Size
newSz a
u' RangeSet a
rt)
unsafeFuseR Size
_ a
_ RangeSet a
Tip = String -> RangeSet a
forall a. HasCallStack => String -> a
error String
"unsafeFuseR called on Tip"

{-# INLINABLE link #-}
link :: (Enum a, Eq a) => a -> a -> RangeSet a -> RangeSet a -> RangeSet a
link :: a -> a -> RangeSet a -> RangeSet a -> RangeSet a
link !a
l !a
u RangeSet a
Tip RangeSet a
Tip = Size -> a -> a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a
single (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
l a
u) a
l a
u
link a
l a
u RangeSet a
Tip RangeSet a
rt = Size -> a -> a -> RangeSet a -> RangeSet a
forall a.
(Enum a, Eq a) =>
Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertLAdj (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
l a
u) a
l a
u RangeSet a
rt
link a
l a
u RangeSet a
lt RangeSet a
Tip = Size -> a -> a -> RangeSet a -> RangeSet a
forall a.
(Enum a, Eq a) =>
Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertRAdj (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
l a
u) a
l a
u RangeSet a
lt
link a
l a
u RangeSet a
lt RangeSet a
rt = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeLink (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
l' a
u') a
l' a
u' RangeSet a
lt'' RangeSet a
rt''
  where
    -- we have to check for fusion up front
    (# !a
lmaxl, !a
lmaxu, RangeSet a
lt' #) = RangeSet a -> (# a, a, RangeSet a #)
forall a. RangeSet a -> (# a, a, RangeSet a #)
unsafeMaxDelete RangeSet a
lt
    (# !a
rminl, !a
rminu, RangeSet a
rt' #) = RangeSet a -> (# a, a, RangeSet a #)
forall a. RangeSet a -> (# a, a, RangeSet a #)
unsafeMinDelete RangeSet a
rt

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

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

{-# INLINEABLE unsafeLink #-}
unsafeLink :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeLink :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeLink !Size
newSz !a
l !a
u RangeSet a
Tip RangeSet a
rt = Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertL Size
newSz a
l a
u RangeSet a
rt
unsafeLink Size
newSz a
l a
u RangeSet a
lt RangeSet a
Tip = Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertR Size
newSz a
l a
u RangeSet a
lt
unsafeLink Size
newSz a
l a
u lt :: RangeSet a
lt@(Fork Size
hl Size
szl a
ll a
lu RangeSet a
llt RangeSet a
lrt) rt :: RangeSet a
rt@(Fork Size
hr Size
szr a
rl a
ru RangeSet a
rlt RangeSet a
rrt)
  | Size
hl Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
hr Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1 = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceL (Size
newSz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
szl Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
szr) a
rl a
ru (Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeLink Size
newSz a
l a
u RangeSet a
lt RangeSet a
rlt) RangeSet a
rrt
  | Size
hr Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
hl Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1 = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceR (Size
newSz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
szl Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
szr) a
ll a
lu RangeSet a
llt (Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeLink Size
newSz a
l a
u RangeSet a
lrt RangeSet a
rt)
  | Bool
otherwise   = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz (Size
newSz Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
szl Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
szr) a
l a
u RangeSet a
lt 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 (diff l2 u2) u2 t1) t2'
     else unsafeMerge t1 t2-}

-- This assumes that the trees are /totally/ disjoint
{-# INLINEABLE unsafeMerge #-}
unsafeMerge :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
unsafeMerge :: RangeSet a -> RangeSet a -> RangeSet a
unsafeMerge RangeSet a
Tip RangeSet a
rt = RangeSet a
rt
unsafeMerge RangeSet a
lt RangeSet a
Tip = RangeSet a
lt
unsafeMerge lt :: RangeSet a
lt@(Fork Size
hl Size
szl a
ll a
lu RangeSet a
llt RangeSet a
lrt) rt :: RangeSet a
rt@(Fork Size
hr Size
szr a
rl a
ru RangeSet a
rlt RangeSet a
rrt)
  | Size
hl Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
hr Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1 = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceL (Size
szl Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
szr) a
rl a
ru (RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
unsafeMerge RangeSet a
lt RangeSet a
rlt) RangeSet a
rrt
  | Size
hr Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
hl Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1 = Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
balanceR (Size
szl Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
szr) a
ll a
lu RangeSet a
llt (RangeSet a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
unsafeMerge RangeSet a
lrt RangeSet a
rt)
  | Bool
otherwise   = Size -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> RangeSet a -> RangeSet a -> RangeSet a
glue (Size
szl Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
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 :: Size -> RangeSet a -> RangeSet a -> RangeSet a
glue !Size
_ RangeSet a
Tip RangeSet a
rt = RangeSet a
rt
glue Size
_ RangeSet a
lt RangeSet a
Tip  = RangeSet a
lt
glue Size
sz RangeSet a
lt RangeSet a
rt
  | 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 = let (# !a
l, !a
u, !RangeSet a
rt' #) = RangeSet a -> (# a, a, RangeSet a #)
forall a. RangeSet a -> (# a, a, RangeSet a #)
unsafeMinDelete RangeSet a
rt in Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz a
l a
u RangeSet a
lt RangeSet a
rt'
  | Bool
otherwise = let (# !a
l, !a
u, !RangeSet a
lt' #) = RangeSet a -> (# a, a, RangeSet a #)
forall a. RangeSet a -> (# a, a, RangeSet a #)
unsafeMaxDelete RangeSet a
lt in Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forkSz Size
sz a
l a
u RangeSet a
lt' RangeSet a
rt

{-|
Filters a set by removing all values greater than or equal to the given value.

@since 2.1.0.0
-}
{-# INLINEABLE allLess #-}
allLess :: (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
allLess :: a -> RangeSet a -> RangeSet a
allLess !a
_ RangeSet a
Tip = RangeSet a
forall a. RangeSet a
Tip
allLess a
x (Fork Size
_ Size
_ a
l a
u RangeSet a
lt RangeSet a
rt) = a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
(Enum a, Ord a) =>
a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeAllLess a
x a
l a
u RangeSet a
lt RangeSet a
rt

{-|
Filters a set by removing all values less than or equal to the given value.

@since 2.1.0.0
-}
{-# INLINEABLE allMore #-}
allMore :: (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
allMore :: a -> RangeSet a -> RangeSet a
allMore !a
_ RangeSet a
Tip = RangeSet a
forall a. RangeSet a
Tip
allMore a
x (Fork Size
_ Size
_ a
l a
u RangeSet a
lt RangeSet a
rt) = a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
(Enum a, Ord a) =>
a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeAllMore a
x a
l a
u RangeSet a
lt RangeSet a
rt

{-# INLINEABLE unsafeAllLess #-}
unsafeAllLess :: (Enum a, Ord a) => a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeAllLess :: a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeAllLess !a
x !a
l !a
u !RangeSet a
lt !RangeSet a
rt = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
l of
  Ordering
EQ          -> RangeSet a
lt
  Ordering
LT          -> a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
allLess a
x RangeSet a
lt
  Ordering
GT | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
u -> Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertR (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
l (a -> a
forall a. Enum a => a -> a
pred a
x)) a
l (a -> a
forall a. Enum a => a -> a
pred a
x) (a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
allLess a
x RangeSet a
lt)
  Ordering
GT          -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
(Enum a, Eq a) =>
a -> a -> RangeSet a -> RangeSet a -> RangeSet a
link a
l a
u RangeSet a
lt (a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
allLess a
x RangeSet a
rt)

{-# INLINEABLE unsafeAllMore #-}
unsafeAllMore :: (Enum a, Ord a) => a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeAllMore :: a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeAllMore !a
x !a
l !a
u !RangeSet a
lt !RangeSet a
rt = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
u a
x of
  Ordering
EQ          -> RangeSet a
rt
  Ordering
LT          -> a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
allMore a
x RangeSet a
rt
  Ordering
GT | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x -> Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertL (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff (a -> a
forall a. Enum a => a -> a
succ a
x) a
u) (a -> a
forall a. Enum a => a -> a
succ a
x) a
u (a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
allMore a
x RangeSet a
rt)
  Ordering
GT          -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
(Enum a, Eq a) =>
a -> a -> RangeSet a -> RangeSet a -> RangeSet a
link a
l a
u (a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
allMore a
x RangeSet a
lt) RangeSet a
rt

{-# INLINEABLE split #-}
split :: (Enum a, Ord a) => a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
split :: a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
split !a
_ !a
_ RangeSet a
Tip = (# RangeSet a
forall a. RangeSet a
Tip, RangeSet a
forall a. RangeSet a
Tip #)
split a
l a
u (Fork Size
_ Size
_ a
l' a
u' RangeSet a
lt RangeSet a
rt)
  | a
u a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
l' = let (# !RangeSet a
llt, !RangeSet a
lgt #) = a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
forall a.
(Enum a, Ord a) =>
a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
split a
l a
u RangeSet a
lt in (# RangeSet a
llt, a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
(Enum a, Eq a) =>
a -> a -> RangeSet a -> RangeSet a -> RangeSet a
link a
l' a
u' RangeSet a
lgt RangeSet a
rt #)
  | a
u' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
l = let (# !RangeSet a
rlt, !RangeSet a
rgt #) = a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
forall a.
(Enum a, Ord a) =>
a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
split a
l a
u RangeSet a
rt in (# a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
(Enum a, Eq a) =>
a -> a -> RangeSet a -> RangeSet a -> RangeSet a
link a
l' a
u' RangeSet a
lt RangeSet a
rlt, RangeSet a
rgt #)
  -- The ranges overlap in some way
  | Bool
otherwise = let !lt' :: RangeSet a
lt' = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
l' a
l of
                      Ordering
EQ -> RangeSet a
lt
                      Ordering
LT -> Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertR (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
l' (a -> a
forall a. Enum a => a -> a
pred a
l)) a
l' (a -> a
forall a. Enum a => a -> a
pred a
l) RangeSet a
lt
                      Ordering
GT -> a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
allLess a
l RangeSet a
lt
                    !rt' :: RangeSet a
rt' = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
u a
u' of
                      Ordering
EQ -> RangeSet a
rt
                      Ordering
LT -> Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertL (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff (a -> a
forall a. Enum a => a -> a
succ a
u) a
u') (a -> a
forall a. Enum a => a -> a
succ a
u) a
u' RangeSet a
rt
                      Ordering
GT -> a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
allMore a
u RangeSet a
rt
                in (# RangeSet a
lt', RangeSet a
rt' #)

{-# INLINE splitOverlap #-}
splitOverlap :: (Enum a, Ord a) => a -> a -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
splitOverlap :: a -> a -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
splitOverlap !a
l !a
u !RangeSet a
t = let (# RangeSet a
lt', RangeSet a
rt' #) = a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
forall a.
(Enum a, Ord a) =>
a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
split a
l a
u RangeSet a
t in (# RangeSet a
lt', a -> a -> RangeSet a -> RangeSet a
forall a. (Ord a, Enum a) => a -> a -> RangeSet a -> RangeSet a
overlapping a
l a
u RangeSet a
t, RangeSet a
rt' #)

{-# INLINABLE overlapping #-}
overlapping :: (Ord a, Enum a) => a -> a -> RangeSet a -> RangeSet a
overlapping :: a -> a -> RangeSet a -> RangeSet a
overlapping !a
_ !a
_ RangeSet a
Tip = RangeSet a
forall a. RangeSet a
Tip
overlapping a
x a
y (Fork Size
_ Size
sz a
l a
u RangeSet a
lt RangeSet a
rt) =
  case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
l a
x of
    -- range is outside to the left
    Ordering
GT -> let !lt' :: RangeSet a
lt' = a -> a -> RangeSet a -> RangeSet a
forall a. (Ord a, Enum a) => a -> a -> RangeSet a -> RangeSet a
overlapping a
x (a -> a -> a
forall a. Ord a => a -> a -> a
min (a -> a
forall a. Enum a => a -> a
pred a
l) a
y) RangeSet a
lt
          in case Ordering
cmpY of
               -- range is totally outside
               Ordering
GT -> Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
unsafeLink Size
nodeSz a
l a
u RangeSet a
lt' RangeSet a
rt'
               Ordering
EQ -> Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertR Size
nodeSz a
l a
u RangeSet a
lt'
               Ordering
LT | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
l -> Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertR (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
l a
y) a
l a
y RangeSet a
lt'
               Ordering
LT          -> RangeSet a
lt'
    -- range is inside on the left
    Ordering
EQ -> case Ordering
cmpY of
      -- range is outside on the right
      Ordering
GT -> Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertL Size
nodeSz a
l a
u RangeSet a
rt'
      Ordering
LT -> RangeSet a
t'
      Ordering
EQ -> Size -> a -> a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a
single Size
nodeSz a
l a
u
    Ordering
LT -> case Ordering
cmpY of
      -- range is outside on the right
      Ordering
GT | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
u -> Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertL (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
x a
u) a
x a
u RangeSet a
rt'
      Ordering
GT          -> RangeSet a
rt'
      Ordering
_           -> RangeSet a
t'
  where
    !cmpY :: Ordering
cmpY = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
y a
u
    !nodeSz :: Size
nodeSz = Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- 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
    -- leave lazy!
    rt' :: RangeSet a
rt' = a -> a -> RangeSet a -> RangeSet a
forall a. (Ord a, Enum a) => a -> a -> RangeSet a -> RangeSet a
overlapping (a -> a -> a
forall a. Ord a => a -> a -> a
max (a -> a
forall a. Enum a => a -> a
succ a
u) a
x) a
y RangeSet a
rt
    t' :: RangeSet a
t' = Size -> a -> a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a
single (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
x a
y) a
x a
y

data StrictMaybe a = SJust !a | SNothing

{-|
Inverts a set: every value which was an element is no longer an element, and every value that
was not an element now is. This is only possible on `Bounded` types.

@since 2.1.0.0
-}
{-# INLINEABLE complement #-}
complement :: forall a. (Bounded a, Enum a, Eq a) => RangeSet a -> RangeSet a
complement :: RangeSet a -> RangeSet a
complement RangeSet a
Tip = Size -> a -> a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a
single (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff @a a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound) a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound
complement RangeSet a
t | RangeSet a -> Bool
forall a. (Eq a, Bounded a) => RangeSet a -> Bool
full RangeSet a
t = RangeSet a
forall a. RangeSet a
Tip
complement t :: RangeSet a
t@Fork{} = RangeSet a
t'''
  where
    (# !a
min, !a
min' #) = RangeSet a -> (# a, a #)
forall a. RangeSet a -> (# a, a #)
unsafeMinRange RangeSet a
t

    -- The complement of a tree is at most 1 larger or smaller than the original
    -- if both min and max are minBound and maxBound, it will shrink
    -- if neither min or max are minBound or maxBound, it will grow
    -- otherwise, the tree will not change size
    -- The insert or shrink will happen at an extremity, and rebalance need only occur along the spine
    (# !RangeSet a
t', !a
initial #) | a
min a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
minBound = (# Size -> RangeSet a -> RangeSet a
forall a. Size -> RangeSet a -> RangeSet a
unsafeDeleteL (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
forall a. Bounded a => a
minBound a
min') RangeSet a
t, a -> a
forall a. Enum a => a -> a
succ a
min' #) -- this is safe, because we've checked for the maxSet case already
                        | Bool
otherwise       = (# RangeSet a
t , a
forall a. Bounded a => a
minBound #)
    (# !RangeSet a
t'', !StrictMaybe a
final #) = a -> RangeSet a -> (# RangeSet a, StrictMaybe a #)
go a
initial RangeSet a
t'
    t''' :: RangeSet a
t''' | SJust a
x <- StrictMaybe a
final = Size -> a -> a -> RangeSet a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a -> RangeSet a
unsafeInsertR (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
x a
forall a. Bounded a => a
maxBound) a
x a
forall a. Bounded a => a
maxBound RangeSet a
t''
         | Bool
otherwise        = RangeSet a
t''

    safeSucc :: a -> StrictMaybe a
safeSucc !a
x
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
maxBound = StrictMaybe a
forall a. StrictMaybe a
SNothing
      | Bool
otherwise     = a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust (a -> a
forall a. Enum a => a -> a
succ a
x)

    -- the argument l should not be altered, it /must/ be the correct lower bound
    -- the return /must/ be the next correct lower bound
    go :: a -> RangeSet a -> (# RangeSet a, StrictMaybe a #)
    go :: a -> RangeSet a -> (# RangeSet a, StrictMaybe a #)
go !a
l RangeSet a
Tip = (# RangeSet a
forall a. RangeSet a
Tip, a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
l #)
    go a
l (Fork Size
_ Size
_ a
u a
l'' RangeSet a
lt RangeSet a
Tip) =
      let (# !RangeSet a
lt', SJust a
l' #) = a -> RangeSet a -> (# RangeSet a, StrictMaybe a #)
go a
l RangeSet a
lt
          !t' :: RangeSet a
t' = a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Enum a =>
a -> a -> RangeSet a -> RangeSet a -> RangeSet a
fork a
l' (a -> a
forall a. Enum a => a -> a
pred a
u) RangeSet a
lt' RangeSet a
forall a. RangeSet a
Tip
      in  (# RangeSet a
t', a -> StrictMaybe a
forall a. (Eq a, Bounded a, Enum a) => a -> StrictMaybe a
safeSucc a
l'' #)
    go a
l (Fork Size
_ Size
_ a
u a
l'' RangeSet a
lt RangeSet a
rt) =
      let (# !RangeSet a
lt', SJust a
l' #) = a -> RangeSet a -> (# RangeSet a, StrictMaybe a #)
go a
l RangeSet a
lt
          (# !RangeSet a
rt', !StrictMaybe a
l''' #) = a -> RangeSet a -> (# RangeSet a, StrictMaybe a #)
go (a -> a
forall a. Enum a => a -> a
succ a
l'') RangeSet a
rt -- this is safe, because we know the right-tree is not Tip
          !t' :: RangeSet a
t' = a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
Enum a =>
a -> a -> RangeSet a -> RangeSet a -> RangeSet a
fork a
l' (a -> a
forall a. Enum a => a -> a
pred a
u) RangeSet a
lt' RangeSet a
rt'
      in  (# RangeSet a
t', StrictMaybe a
l''' #)

{-|
Tests if all the element of the first set appear in the second, but also that the first and second
sets are not equal.

@since 2.1.0.0
-}
{-# INLINE isProperSubsetOf #-}
isProperSubsetOf :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
isProperSubsetOf :: RangeSet a -> RangeSet a -> Bool
isProperSubsetOf RangeSet a
t1 RangeSet a
t2 = RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
t1 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
t2 Bool -> Bool -> Bool
&& RangeSet a -> RangeSet a -> Bool
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
uncheckedSubsetOf RangeSet a
t1 RangeSet a
t2

{-|
Tests if all the elements of the first set appear in the second.

@since 2.1.0.0
-}
{-# INLINEABLE isSubsetOf #-}
isSubsetOf :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
isSubsetOf :: RangeSet a -> RangeSet a -> Bool
isSubsetOf RangeSet a
t1 RangeSet a
t2 = RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
t1 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
t2 Bool -> Bool -> Bool
&& RangeSet a -> RangeSet a -> Bool
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
uncheckedSubsetOf RangeSet a
t1 RangeSet a
t2

uncheckedSubsetOf :: (Enum a, Ord a) => 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 Size
_ Size
_ a
l a
u RangeSet a
lt RangeSet a
rt) RangeSet a
t = case a -> a -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
forall a.
(Enum a, Ord a) =>
a -> a -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
splitOverlap a
l a
u RangeSet a
t of
  (# RangeSet a
lt', Fork Size
1 Size
_ a
x a
y RangeSet a
_ RangeSet a
_, RangeSet a
rt' #) ->
       a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
l Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
u
    Bool -> Bool -> Bool
&& RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
lt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
lt' Bool -> Bool -> Bool
&& RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
rt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
rt'
    Bool -> Bool -> Bool
&& RangeSet a -> RangeSet a -> Bool
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
uncheckedSubsetOf RangeSet a
lt RangeSet a
lt' Bool -> Bool -> Bool
&& RangeSet a -> RangeSet a -> Bool
forall a. (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
uncheckedSubsetOf RangeSet a
rt RangeSet a
rt'
  (# RangeSet a, RangeSet a, RangeSet a #)
_                              -> Bool
False

{-|
Returns all the elements found within the set.

@since 2.1.0.0
-}
{-# INLINE elems #-}
elems :: Enum a => RangeSet a -> [a]
elems :: RangeSet a -> [a]
elems RangeSet a
t = (a -> a -> ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a])
-> ([a] -> [a]) -> RangeSet a -> [a] -> [a]
forall a b. (a -> a -> b -> b -> b) -> b -> RangeSet a -> b
fold (\a
l a
u [a] -> [a]
lt [a] -> [a]
rt -> [a] -> [a]
lt ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> [a]
forall a. Enum a => a -> a -> [a]
range a
l a
u [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
rt) [a] -> [a]
forall a. a -> a
id RangeSet a
t []

{-|
Returns all the values that are not found within the set.

@since 2.1.0.0
-}
{-# INLINEABLE unelems #-}
unelems :: (Bounded a, Enum a, Eq a) => RangeSet a -> [a]
unelems :: RangeSet a -> [a]
unelems RangeSet a
t = (a
 -> a
 -> (a -> a -> [a] -> [a])
 -> (a -> a -> [a] -> [a])
 -> a
 -> a
 -> [a]
 -> [a])
-> (a -> a -> [a] -> [a]) -> RangeSet a -> a -> a -> [a] -> [a]
forall a b. (a -> a -> b -> b -> b) -> b -> RangeSet a -> b
fold a
-> a
-> (a -> a -> [a] -> [a])
-> (a -> a -> [a] -> [a])
-> a
-> a
-> [a]
-> [a]
forall t t c.
(Eq t, Eq t, Enum t, Enum t) =>
t
-> t
-> (t -> t -> c -> c)
-> (t -> t -> c -> c)
-> t
-> t
-> c
-> c
fork a -> a -> [a] -> [a]
forall a. Enum a => a -> a -> [a] -> [a]
tip RangeSet a
t a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound []
  where
    fork :: t
-> t
-> (t -> t -> c -> c)
-> (t -> t -> c -> c)
-> t
-> t
-> c
-> c
fork t
l' t
u' t -> t -> c -> c
lt t -> t -> c -> c
rt t
l t
u = c -> c
dxs (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> c
dys
      where
        dxs :: c -> c
dxs | t
l' t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
l   = c -> c
forall a. a -> a
id
            | Bool
otherwise = t -> t -> c -> c
lt t
l (t -> t
forall a. Enum a => a -> a
pred t
l')
        dys :: c -> c
dys | t
u t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
u'   = c -> c
forall a. a -> a
id
            | Bool
otherwise = t -> t -> c -> c
rt (t -> t
forall a. Enum a => a -> a
succ t
u') t
u
    tip :: a -> a -> [a] -> [a]
tip a
l a
u = (a -> a -> [a]
forall a. Enum a => a -> a -> [a]
range a
l a
u [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++)

{-|
Constructs a `RangeSet` given a list of ranges.

@since 2.1.0.0
-}
-- TODO: This could be better?
{-# INLINEABLE fromRanges #-}
fromRanges :: (Enum a, Ord a) => [(a, a)] -> RangeSet a
fromRanges :: [(a, a)] -> RangeSet a
fromRanges [(a
x, a
y)] = Size -> a -> a -> RangeSet a
forall a. Size -> a -> a -> RangeSet a
single (a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
x a
y) a
x a
y
fromRanges [(a, a)]
rs = ((a, a) -> RangeSet a -> RangeSet a)
-> RangeSet a -> [(a, a)] -> RangeSet a
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> RangeSet a -> RangeSet a)
-> (a, a) -> RangeSet a -> RangeSet a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> a -> RangeSet a -> RangeSet a
insertRange) RangeSet a
forall a. RangeSet a
empty [(a, a)]
rs

{-|
Inserts a range into a `RangeSet`.

@since 2.1.0.0
-}
-- This could be improved, but is OK
{-# INLINE insertRange #-}
insertRange :: (Enum a, Ord a) => a -> a -> RangeSet a -> RangeSet a
insertRange :: a -> a -> RangeSet a -> RangeSet a
insertRange a
l a
u RangeSet a
t = let (# RangeSet a
lt, RangeSet a
rt #) = a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
forall a.
(Enum a, Ord a) =>
a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
split a
l a
u RangeSet a
t in a -> a -> RangeSet a -> RangeSet a -> RangeSet a
forall a.
(Enum a, Eq a) =>
a -> a -> RangeSet a -> RangeSet a -> RangeSet a
link a
l a
u RangeSet a
lt RangeSet a
rt

{-|
Builds a `RangeSet` from a given list of elements.

@since 2.1.0.0
-}
-- TODO: This can be made better if we account for orderedness
{-# INLINE fromList #-}
fromList :: (Enum a, Ord a) => [a] -> RangeSet a
fromList :: [a] -> RangeSet a
fromList = (a -> RangeSet a -> RangeSet a) -> RangeSet a -> [a] -> RangeSet a
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> RangeSet a -> RangeSet a
forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
insert RangeSet a
forall a. RangeSet a
empty

{-|
Folds a range set.

@since 2.1.0.0
-}
{-# INLINEABLE fold #-}
fold :: (a -> a -> b -> b -> b) -- ^ Function that combines the lower and upper values (inclusive) for a range with the folded left- and right-subtrees.
     -> b                       -- ^ Value to be substituted at the leaves.
     -> RangeSet a
     -> b
fold :: (a -> a -> b -> b -> b) -> b -> RangeSet a -> b
fold a -> a -> b -> b -> b
_ b
tip RangeSet a
Tip = b
tip
fold a -> a -> b -> b -> b
fork b
tip (Fork Size
_ Size
_ a
l a
u RangeSet a
lt RangeSet a
rt) = a -> a -> b -> b -> b
fork a
l a
u ((a -> a -> b -> b -> b) -> b -> RangeSet a -> b
forall a b. (a -> a -> b -> b -> b) -> b -> RangeSet a -> b
fold a -> a -> b -> b -> b
fork b
tip RangeSet a
lt) ((a -> a -> b -> b -> b) -> b -> RangeSet a -> b
forall a b. (a -> a -> b -> b -> b) -> b -> RangeSet a -> b
fold a -> a -> b -> b -> b
fork b
tip RangeSet a
rt)

-- Instances
instance Eq a => Eq (RangeSet a) where
  RangeSet a
t1 == :: RangeSet a -> RangeSet a -> Bool
== RangeSet a
t2 = RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
t1 Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== RangeSet a -> Size
forall a. RangeSet a -> Size
size RangeSet a
t2 Bool -> Bool -> Bool
&& RangeSet a -> [(a, a)]
ranges RangeSet a
t1 [(a, a)] -> [(a, a)] -> Bool
forall a. Eq a => a -> a -> Bool
== RangeSet a -> [(a, a)]
ranges RangeSet a
t2
    where
      {-# INLINE ranges #-}
      ranges :: RangeSet a -> [(a, a)]
      ranges :: RangeSet a -> [(a, a)]
ranges RangeSet a
t = (a
 -> a
 -> ([(a, a)] -> [(a, a)])
 -> ([(a, a)] -> [(a, a)])
 -> [(a, a)]
 -> [(a, a)])
-> ([(a, a)] -> [(a, a)]) -> RangeSet a -> [(a, a)] -> [(a, a)]
forall a b. (a -> a -> b -> b -> b) -> b -> RangeSet a -> b
fold (\a
l a
u [(a, a)] -> [(a, a)]
lt [(a, a)] -> [(a, a)]
rt -> [(a, a)] -> [(a, a)]
lt ([(a, a)] -> [(a, a)])
-> ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a
l, a
u) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:) ([(a, a)] -> [(a, a)])
-> ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> [(a, a)]
rt) [(a, a)] -> [(a, a)]
forall a. a -> a
id RangeSet a
t []

-- Testing Utilities
valid :: (Ord a, Enum a) => RangeSet a -> Bool
valid :: RangeSet a -> Bool
valid RangeSet a
t = RangeSet a -> Bool
forall a. RangeSet a -> Bool
balanced RangeSet a
t Bool -> Bool -> Bool
&& RangeSet a -> Bool
forall a. Enum a => RangeSet a -> Bool
wellSized RangeSet a
t Bool -> Bool -> Bool
&& Bool -> RangeSet a -> Bool
forall a. (Enum a, Ord a) => Bool -> RangeSet a -> Bool
orderedNonOverlappingAndCompressed Bool
True RangeSet a
t

balanced :: RangeSet a -> Bool
balanced :: RangeSet a -> Bool
balanced RangeSet a
Tip = Bool
True
balanced (Fork Size
h Size
_ a
_ a
_ RangeSet a
lt RangeSet a
rt) =
  Size
h Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size -> Size -> Size
forall a. Ord a => a -> a -> a
max (RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lt) (RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rt) Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1 Bool -> Bool -> Bool
&&
  RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rt Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
h Bool -> Bool -> Bool
&&
  Size -> Size
forall a. Num a => a -> a
abs (RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
lt Size -> Size -> Size
forall a. Num a => a -> a -> a
- RangeSet a -> Size
forall a. RangeSet a -> Size
height RangeSet a
rt) Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
1 Bool -> Bool -> Bool
&&
  RangeSet a -> Bool
forall a. RangeSet a -> Bool
balanced RangeSet a
lt Bool -> Bool -> Bool
&&
  RangeSet a -> Bool
forall a. RangeSet a -> Bool
balanced RangeSet a
rt

wellSized :: Enum a => RangeSet a -> Bool
wellSized :: RangeSet a -> Bool
wellSized RangeSet a
Tip = Bool
True
wellSized (Fork Size
_ Size
sz a
l a
u RangeSet a
lt RangeSet a
rt) = Size
sz Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== 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
+ a -> a -> Size
forall a. Enum a => a -> a -> Size
diff a
l a
u Bool -> Bool -> Bool
&& RangeSet a -> Bool
forall a. Enum a => RangeSet a -> Bool
wellSized RangeSet a
lt Bool -> Bool -> Bool
&& RangeSet a -> Bool
forall a. Enum a => RangeSet a -> Bool
wellSized RangeSet a
rt

orderedNonOverlappingAndCompressed :: (Enum a, Ord a) => Bool -> RangeSet a -> Bool
orderedNonOverlappingAndCompressed :: Bool -> RangeSet a -> Bool
orderedNonOverlappingAndCompressed Bool
checkCompressed = (a -> Bool) -> (a -> Bool) -> RangeSet a -> Bool
bounded (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
  where
    bounded :: (a -> Bool) -> (a -> Bool) -> RangeSet a -> Bool
bounded a -> Bool
_ a -> Bool
_ RangeSet a
Tip = Bool
True
    bounded a -> Bool
lo a -> Bool
hi (Fork Size
_ Size
_ a
l a
u RangeSet a
lt RangeSet a
rt) =
      a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
u Bool -> Bool -> Bool
&&
      a -> Bool
lo a
l Bool -> Bool -> Bool
&&
      a -> Bool
hi a
u Bool -> Bool -> Bool
&&
      (a -> Bool) -> (a -> Bool) -> RangeSet a -> Bool
bounded a -> Bool
lo (a -> a -> Bool
boundAbove a
l) RangeSet a
lt Bool -> Bool -> Bool
&&
      (a -> Bool) -> (a -> Bool) -> RangeSet a -> Bool
bounded (a -> a -> Bool
boundBelow a
u) a -> Bool
hi RangeSet a
rt

    boundAbove :: a -> a -> Bool
boundAbove a
l | Bool
checkCompressed = (Bool -> Bool -> Bool) -> (a -> Bool) -> (a -> Bool) -> a -> Bool
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
l) (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a -> a
forall a. Enum a => a -> a
pred a
l)
                 | Bool
otherwise = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
l)

    boundBelow :: a -> a -> Bool
boundBelow a
u | Bool
checkCompressed = (Bool -> Bool -> Bool) -> (a -> Bool) -> (a -> Bool) -> a -> Bool
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
u) (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a -> a
forall a. Enum a => a -> a
succ a
u)
                 | Bool
otherwise = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
u)