{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.Continuous.Set.Internal
  ( Set(..)
  , Inclusivity(..)
  , empty
  , universe
  , null
  , universal
  , singleton
  , append
  , member
  , equals
  , showsPrec
  ) where

import Prelude hiding (lookup,showsPrec,concat,map,foldr,negate,null)

import Control.Monad.ST (ST,runST)
import Data.Word (Word8)
import Data.Primitive.Contiguous (Contiguous,ContiguousU,Element,Mutable)
import Data.Primitive (PrimArray,MutablePrimArray)
import Data.Bits (unsafeShiftL,unsafeShiftR,(.|.),(.&.))
import qualified Prelude as P
import qualified Data.Primitive.Contiguous as I

-- Although the data constructor for this type is exported,
-- it isn't needed by anything in the continuous Set modules. It is needed
-- by the continuous Map modules to implement conversion functions.
--
-- All ranges in the set must be in order. Also, the set containing
-- everything must be represented with SetAll.
data Set arr a = Set
  -- (Maybe (Inclusivity,a)) -- negative infinity upper bound
  !(arr a) -- pairs of keys, last two keys are neg-inf upper and pos-inf lower, in that order
  !(PrimArray Word8) -- pairs of inclusive/exclusive, last element is edge information
  -- (Maybe (Inclusivity,a)) -- positive infinite lower bound

-- note: do not reorder these data constructors. Functions in
-- this module rely on the generated Ord instance.
data Inclusivity = Exclusive | Inclusive
  deriving (Inclusivity -> Inclusivity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inclusivity -> Inclusivity -> Bool
$c/= :: Inclusivity -> Inclusivity -> Bool
== :: Inclusivity -> Inclusivity -> Bool
$c== :: Inclusivity -> Inclusivity -> Bool
Eq,Eq Inclusivity
Inclusivity -> Inclusivity -> Bool
Inclusivity -> Inclusivity -> Ordering
Inclusivity -> Inclusivity -> Inclusivity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Inclusivity -> Inclusivity -> Inclusivity
$cmin :: Inclusivity -> Inclusivity -> Inclusivity
max :: Inclusivity -> Inclusivity -> Inclusivity
$cmax :: Inclusivity -> Inclusivity -> Inclusivity
>= :: Inclusivity -> Inclusivity -> Bool
$c>= :: Inclusivity -> Inclusivity -> Bool
> :: Inclusivity -> Inclusivity -> Bool
$c> :: Inclusivity -> Inclusivity -> Bool
<= :: Inclusivity -> Inclusivity -> Bool
$c<= :: Inclusivity -> Inclusivity -> Bool
< :: Inclusivity -> Inclusivity -> Bool
$c< :: Inclusivity -> Inclusivity -> Bool
compare :: Inclusivity -> Inclusivity -> Ordering
$ccompare :: Inclusivity -> Inclusivity -> Ordering
Ord,Int -> Inclusivity -> ShowS
[Inclusivity] -> ShowS
Inclusivity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inclusivity] -> ShowS
$cshowList :: [Inclusivity] -> ShowS
show :: Inclusivity -> String
$cshow :: Inclusivity -> String
showsPrec :: Int -> Inclusivity -> ShowS
$cshowsPrec :: Int -> Inclusivity -> ShowS
Show,ReadPrec [Inclusivity]
ReadPrec Inclusivity
Int -> ReadS Inclusivity
ReadS [Inclusivity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Inclusivity]
$creadListPrec :: ReadPrec [Inclusivity]
readPrec :: ReadPrec Inclusivity
$creadPrec :: ReadPrec Inclusivity
readList :: ReadS [Inclusivity]
$creadList :: ReadS [Inclusivity]
readsPrec :: Int -> ReadS Inclusivity
$creadsPrec :: Int -> ReadS Inclusivity
Read)

data Edge
  = EdgeInclusive
  | EdgeExclusive
  | EdgeAbsent
  | EdgeUniversal

equals :: (Contiguous arr, Element arr a, Eq a) => Set arr a -> Set arr a -> Bool
equals :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Eq a) =>
Set arr a -> Set arr a -> Bool
equals (Set arr a
keys1 PrimArray Word8
incs1) (Set arr a
keys2 PrimArray Word8
incs2) =
  forall (arr :: * -> *) b.
(Contiguous arr, Element arr b, Eq b) =>
arr b -> arr b -> Bool
I.equals arr a
keys1 arr a
keys2 Bool -> Bool -> Bool
&& PrimArray Word8
incs1 forall a. Eq a => a -> a -> Bool
== PrimArray Word8
incs2

empty :: Contiguous arr => Set arr a
empty :: forall (arr :: * -> *) a. Contiguous arr => Set arr a
empty = forall (arr :: * -> *) a. arr a -> PrimArray Word8 -> Set arr a
Set forall (arr :: * -> *) a. Contiguous arr => arr a
I.empty forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  Mutable PrimArray s Word8
marr <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
I.new Int
1
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable PrimArray s Word8
marr Int
0 (Edge -> Edge -> Word8
edgePairToWord8 Edge
EdgeAbsent Edge
EdgeAbsent)
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze Mutable PrimArray s Word8
marr

universe :: Contiguous arr => Set arr a
universe :: forall (arr :: * -> *) a. Contiguous arr => Set arr a
universe = forall (arr :: * -> *) a. arr a -> PrimArray Word8 -> Set arr a
Set forall (arr :: * -> *) a. Contiguous arr => arr a
I.empty forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  Mutable PrimArray s Word8
marr <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
I.new Int
1
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable PrimArray s Word8
marr Int
0 (Edge -> Edge -> Word8
edgePairToWord8 Edge
EdgeUniversal Edge
EdgeUniversal)
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze Mutable PrimArray s Word8
marr

-- If the keys are null, then we know that there is only one
-- element in the inclusivity array.
null :: Contiguous arr => Set arr a -> Bool
null :: forall (arr :: * -> *) a. Contiguous arr => Set arr a -> Bool
null (Set arr a
keys PrimArray Word8
incs) = forall (arr :: * -> *) b. Contiguous arr => arr b -> Bool
I.null arr a
keys
  Bool -> Bool -> Bool
&& forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index PrimArray Word8
incs Int
0 forall a. Eq a => a -> a -> Bool
== Edge -> Edge -> Word8
edgePairToWord8 Edge
EdgeAbsent Edge
EdgeAbsent

universal :: Contiguous arr => Set arr a -> Bool
universal :: forall (arr :: * -> *) a. Contiguous arr => Set arr a -> Bool
universal (Set arr a
keys PrimArray Word8
incs) = forall (arr :: * -> *) b. Contiguous arr => arr b -> Bool
I.null arr a
keys
  Bool -> Bool -> Bool
&& forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index PrimArray Word8
incs Int
0 forall a. Eq a => a -> a -> Bool
== Edge -> Edge -> Word8
edgePairToWord8 Edge
EdgeUniversal Edge
EdgeUniversal

singleton :: (Contiguous arr, Element arr a, Ord a)
  => Maybe (Inclusivity,a) -- ^ lower bound, @Nothing@ means @-∞@
  -> Maybe (Inclusivity,a) -- ^ upper bound, @Nothing@ means @+∞@
  -> Set arr a
singleton :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Ord a) =>
Maybe (Inclusivity, a) -> Maybe (Inclusivity, a) -> Set arr a
singleton Maybe (Inclusivity, a)
Nothing Maybe (Inclusivity, a)
Nothing = forall (arr :: * -> *) a. Contiguous arr => Set arr a
universe
singleton Maybe (Inclusivity, a)
Nothing (Just (Inclusivity
incHi,a
hi)) = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  arr a
keys <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
I.replicateMut Int
1 a
hi forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze
  PrimArray Word8
incs <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
I.replicateMut Int
1 (Edge -> Edge -> Word8
edgePairToWord8 (Inclusivity -> Edge
inclusivityToEdge Inclusivity
incHi) Edge
EdgeAbsent) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (arr :: * -> *) a. arr a -> PrimArray Word8 -> Set arr a
Set arr a
keys PrimArray Word8
incs)
singleton (Just (Inclusivity
incLo,a
lo)) Maybe (Inclusivity, a)
Nothing = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  arr a
keys <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
I.replicateMut Int
1 a
lo forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze
  PrimArray Word8
incs <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
I.replicateMut Int
1 (Edge -> Edge -> Word8
edgePairToWord8 Edge
EdgeAbsent (Inclusivity -> Edge
inclusivityToEdge Inclusivity
incLo)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (arr :: * -> *) a. arr a -> PrimArray Word8 -> Set arr a
Set arr a
keys PrimArray Word8
incs)
singleton (Just (Inclusivity
incLo,a
lo)) (Just (Inclusivity
incHi,a
hi)) = case forall a. Ord a => a -> a -> Ordering
compare a
lo a
hi of
  Ordering
GT -> forall (arr :: * -> *) a. Contiguous arr => Set arr a
empty
  Ordering
EQ -> if Inclusivity
incLo forall a. Eq a => a -> a -> Bool
== Inclusivity
Inclusive Bool -> Bool -> Bool
&& Inclusivity
incHi forall a. Eq a => a -> a -> Bool
== Inclusivity
Inclusive
    then forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
      arr a
keys <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
I.replicateMut Int
2 a
lo forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze
      Mutable PrimArray s Word8
incsMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
I.new Int
2
      forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable PrimArray s Word8
incsMut Int
0 (Inclusivity -> Inclusivity -> Word8
inclusivityPairToWord8 Inclusivity
Inclusive Inclusivity
Inclusive)
      forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable PrimArray s Word8
incsMut Int
1 (Edge -> Edge -> Word8
edgePairToWord8 Edge
EdgeAbsent Edge
EdgeAbsent)
      PrimArray Word8
incs <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze Mutable PrimArray s Word8
incsMut
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall (arr :: * -> *) a. arr a -> PrimArray Word8 -> Set arr a
Set arr a
keys PrimArray Word8
incs)
    else forall (arr :: * -> *) a. Contiguous arr => Set arr a
empty
  Ordering
LT -> forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Inclusivity -> a -> Inclusivity -> a -> Set arr a
unsafeSingleton Inclusivity
incLo a
lo Inclusivity
incHi a
hi

-- the caller must ensure that lo is less than hi
unsafeSingleton :: (Contiguous arr, Element arr a) => Inclusivity -> a -> Inclusivity -> a -> Set arr a
unsafeSingleton :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Inclusivity -> a -> Inclusivity -> a -> Set arr a
unsafeSingleton Inclusivity
incLo a
lo Inclusivity
incHi a
hi = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  Mutable arr s a
keysMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
I.replicateMut Int
2 a
lo
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable arr s a
keysMut Int
1 a
hi
  arr a
keys <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze Mutable arr s a
keysMut
  Mutable PrimArray s Word8
incsMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
I.new Int
2
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable PrimArray s Word8
incsMut Int
0 (Inclusivity -> Inclusivity -> Word8
inclusivityPairToWord8 Inclusivity
incLo Inclusivity
incHi)
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable PrimArray s Word8
incsMut Int
1 (Edge -> Edge -> Word8
edgePairToWord8 Edge
EdgeAbsent Edge
EdgeAbsent)
  PrimArray Word8
incs <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze Mutable PrimArray s Word8
incsMut
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (arr :: * -> *) a. arr a -> PrimArray Word8 -> Set arr a
Set arr a
keys PrimArray Word8
incs)

except :: (Contiguous arr, Element arr a) => a -> Set arr a
except :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
a -> Set arr a
except a
x = forall (arr :: * -> *) a. arr a -> PrimArray Word8 -> Set arr a
Set arr a
keys PrimArray Word8
incs where
  keys :: arr a
keys = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
I.replicateMut Int
2 a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze
  incs :: PrimArray Word8
incs = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    Mutable PrimArray s Word8
m <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
I.new Int
1
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable PrimArray s Word8
m Int
0 (Edge -> Edge -> Word8
edgePairToWord8 Edge
EdgeExclusive Edge
EdgeExclusive)
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze Mutable PrimArray s Word8
m

infinities :: (Contiguous arr, Element arr a, Ord a)
  => Inclusivity
  -> a -- ^ upper bound for negative infinity
  -> Inclusivity
  -> a -- ^ lower bound for positive infinite
  -> Set arr a
infinities :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Ord a) =>
Inclusivity -> a -> Inclusivity -> a -> Set arr a
infinities Inclusivity
negInfHiInc a
negInfHi Inclusivity
posInfLoInc a
posInfLo =
  case forall a. Ord a => a -> a -> Ordering
compare a
negInfHi a
posInfLo of
    Ordering
GT -> forall (arr :: * -> *) a. Contiguous arr => Set arr a
universe
    Ordering
EQ -> if Inclusivity
negInfHiInc forall a. Eq a => a -> a -> Bool
== Inclusivity
Exclusive Bool -> Bool -> Bool
&& Inclusivity
posInfLoInc forall a. Eq a => a -> a -> Bool
== Inclusivity
Exclusive
      then forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
a -> Set arr a
except a
negInfHi
      else forall (arr :: * -> *) a. Contiguous arr => Set arr a
universe
    Ordering
LT -> forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Inclusivity -> a -> Inclusivity -> a -> Set arr a
unsafeInfinities Inclusivity
negInfHiInc a
negInfHi Inclusivity
posInfLoInc a
posInfLo

-- the caller must ensure that the upper bound for neg-inf is
-- less than the lower bound for pos inf
unsafeInfinities :: (Contiguous arr, Element arr a) => Inclusivity -> a -> Inclusivity -> a -> Set arr a
unsafeInfinities :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Inclusivity -> a -> Inclusivity -> a -> Set arr a
unsafeInfinities Inclusivity
negInfHiInc a
negInfHi Inclusivity
posInfLoInc a
posInfLo = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  Mutable arr s a
keysMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
I.replicateMut Int
2 a
negInfHi
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable arr s a
keysMut Int
1 a
posInfLo
  arr a
keys <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze Mutable arr s a
keysMut
  Mutable PrimArray s Word8
incsMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
I.new Int
1
  forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable PrimArray s Word8
incsMut Int
0 (Edge -> Edge -> Word8
edgePairToWord8 (Inclusivity -> Edge
inclusivityToEdge Inclusivity
negInfHiInc) (Inclusivity -> Edge
inclusivityToEdge Inclusivity
posInfLoInc))
  PrimArray Word8
incs <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze Mutable PrimArray s Word8
incsMut
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (arr :: * -> *) a. arr a -> PrimArray Word8 -> Set arr a
Set arr a
keys PrimArray Word8
incs)

append :: forall arr a. (Ord a, ContiguousU arr, Element arr a) => Set arr a -> Set arr a -> Set arr a
append :: forall (arr :: * -> *) a.
(Ord a, ContiguousU arr, Element arr a) =>
Set arr a -> Set arr a -> Set arr a
append s1 :: Set arr a
s1@(Set arr a
keys1 PrimArray Word8
incs1) s2 :: Set arr a
s2@(Set arr a
keys2 PrimArray Word8
incs2)
  | forall (arr :: * -> *) a. Contiguous arr => Set arr a -> Bool
null Set arr a
s1 = Set arr a
s2
  | forall (arr :: * -> *) a. Contiguous arr => Set arr a -> Bool
null Set arr a
s2 = Set arr a
s1
  | forall (arr :: * -> *) a. Contiguous arr => Set arr a -> Bool
universal Set arr a
s1 = Set arr a
s1
  | forall (arr :: * -> *) a. Contiguous arr => Set arr a -> Bool
universal Set arr a
s2 = Set arr a
s2
  | Int
pairsCount1 forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
pairsCount2 forall a. Eq a => a -> a -> Bool
== Int
0 = case Maybe (Inclusivity, a)
lowerPair1 of
      Maybe (Inclusivity, a)
Nothing -> case Maybe (Inclusivity, a)
upperPair1 of
        Maybe (Inclusivity, a)
Nothing -> forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
9)
        Just (Inclusivity
posInfLoInc1,a
posInfLo1) -> case Maybe (Inclusivity, a)
lowerPair2 of
          Maybe (Inclusivity, a)
Nothing -> case Maybe (Inclusivity, a)
upperPair2 of
            Just (Inclusivity
posInfLoInc2,a
posInfLo2) -> case forall a. Ord a => a -> a -> Ordering
compare a
posInfLo1 a
posInfLo2 of
              Ordering
EQ -> if Inclusivity
posInfLoInc1 forall a. Ord a => a -> a -> Bool
> Inclusivity
posInfLoInc2 then Set arr a
s1 else Set arr a
s2
              Ordering
GT -> Set arr a
s2
              Ordering
LT -> Set arr a
s1
      Just (Inclusivity
negInfHiInc1,a
negInfHi1) -> case Maybe (Inclusivity, a)
upperPair1 of
        Maybe (Inclusivity, a)
Nothing -> case Maybe (Inclusivity, a)
lowerPair2 of
          Maybe (Inclusivity, a)
Nothing -> case Maybe (Inclusivity, a)
upperPair2 of
            Maybe (Inclusivity, a)
Nothing -> forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
1)
            Just (Inclusivity
posInfLoInc2,a
posInfLo2) ->
              case forall a. Ord a => a -> a -> Ordering
compare a
negInfHi1 a
posInfLo2 of
                Ordering
GT -> forall (arr :: * -> *) a. Contiguous arr => Set arr a
universe
                Ordering
EQ -> if Inclusivity
negInfHiInc1 forall a. Eq a => a -> a -> Bool
== Inclusivity
Inclusive Bool -> Bool -> Bool
|| Inclusivity
posInfLoInc2 forall a. Eq a => a -> a -> Bool
== Inclusivity
Inclusive
                  then forall (arr :: * -> *) a. Contiguous arr => Set arr a
universe
                  else forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
a -> Set arr a
except a
negInfHi1
                Ordering
LT -> forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Inclusivity -> a -> Inclusivity -> a -> Set arr a
unsafeInfinities Inclusivity
negInfHiInc1 a
negInfHi1 Inclusivity
posInfLoInc2 a
posInfLo2
          Just (Inclusivity
negInfHiInc2,a
negInfHi2) -> case Maybe (Inclusivity, a)
upperPair2 of
            Maybe (Inclusivity, a)
Nothing -> case forall a. Ord a => a -> a -> Ordering
compare a
negInfHi1 a
negInfHi2 of
              Ordering
EQ -> if Inclusivity
negInfHiInc1 forall a. Ord a => a -> a -> Bool
> Inclusivity
negInfHiInc2 then Set arr a
s1 else Set arr a
s2
              Ordering
GT -> Set arr a
s1
              Ordering
LT -> Set arr a
s2
            Just (Inclusivity
posInfLoInc2,a
posInfLo2) -> case forall a. Ord a => a -> a -> Ordering
compare a
negInfHi1 a
negInfHi2 of
              Ordering
LT -> Set arr a
s2
              Ordering
EQ -> if Inclusivity
negInfHiInc1 forall a. Ord a => a -> a -> Bool
> Inclusivity
negInfHiInc2
                then forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Ord a) =>
Inclusivity -> a -> Inclusivity -> a -> Set arr a
infinities Inclusivity
negInfHiInc1 a
negInfHi1 Inclusivity
posInfLoInc2 a
posInfLo2
                else Set arr a
s2
              Ordering
GT -> forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Ord a) =>
Inclusivity -> a -> Inclusivity -> a -> Set arr a
infinities Inclusivity
negInfHiInc1 a
negInfHi1 Inclusivity
posInfLoInc2 a
posInfLo2
  | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
      let maxSz :: Int
maxSz = Int
pairsCount1 forall a. Num a => a -> a -> a
+ Int
pairsCount2 forall a. Num a => a -> a -> a
+ Int
1
      Mutable arr s a
keysMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
I.new (Int
maxSz forall a. Num a => a -> a -> a
* Int
2)
      MutablePrimArray s Word8
incsMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
I.new Int
maxSz
      case Maybe (Inclusivity, a)
lowerPairRes of
        Just (Inclusivity
negInfHiIncOriginal,a
negInfHiOriginal) -> do
          let (Inclusivity
negInfHiIncFinal,a
negInfHiFinal,Int
ixInit1,Int
ixInit2) = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Ord a) =>
Inclusivity
-> a
-> arr a
-> PrimArray Word8
-> Int
-> arr a
-> PrimArray Word8
-> Int
-> (Inclusivity, a, Int, Int)
eatFromNegativeInfinity Inclusivity
negInfHiIncOriginal a
negInfHiOriginal arr a
keys1 PrimArray Word8
incs1 Int
pairsCount1 arr a
keys2 PrimArray Word8
incs2 Int
pairsCount2
          case Maybe (Inclusivity, a)
upperPairRes of
            Just (Inclusivity
posInfLoIncOriginal,a
posInfLoOriginal) -> do
              let (Inclusivity
posInfLoIncFinal,a
posInfLoFinal,Int
ixLast1,Int
ixLast2) = forall a (arr :: * -> *).
Inclusivity
-> a
-> arr a
-> PrimArray Word8
-> Int
-> arr a
-> PrimArray Word8
-> Int
-> (Inclusivity, a, Int, Int)
eatFromPositiveInfinity Inclusivity
posInfLoIncOriginal a
posInfLoOriginal arr a
keys1 PrimArray Word8
incs1 Int
pairsCount1 arr a
keys2 PrimArray Word8
incs2 Int
pairsCount2
              Int
finalIx <- forall s.
Mutable arr s a
-> MutablePrimArray s Word8
-> Int
-> Int
-> Int
-> Int
-> Int
-> Inclusivity
-> a
-> ST s Int
go Mutable arr s a
keysMut MutablePrimArray s Word8
incsMut Int
ixInit1 Int
ixLast1 Int
ixInit2 Int
ixLast2 Int
0 Inclusivity
negInfHiIncFinal a
negInfHiFinal
              forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write MutablePrimArray s Word8
incsMut Int
finalIx (Edge -> Edge -> Word8
edgePairToWord8 (Inclusivity -> Edge
inclusivityToEdge Inclusivity
negInfHiIncFinal) (Inclusivity -> Edge
inclusivityToEdge Inclusivity
posInfLoIncFinal))
              forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable arr s a
keysMut (Int
finalIx forall a. Num a => a -> a -> a
* Int
2) a
negInfHiFinal
              forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
I.write Mutable arr s a
keysMut (Int
finalIx forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1) a
posInfLoFinal
              arr a
keysFrozen <- forall (arr :: * -> *) (m :: * -> *) b.
(ContiguousU arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> m (Mutable arr (PrimState m) b)
I.resize Mutable arr s a
keysMut (Int
finalIx forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
2) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze
              PrimArray Word8
incsFrozen <- forall (arr :: * -> *) (m :: * -> *) b.
(ContiguousU arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> m (Mutable arr (PrimState m) b)
I.resize MutablePrimArray s Word8
incsMut (Int
finalIx forall a. Num a => a -> a -> a
* Int
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
I.unsafeFreeze
              forall (m :: * -> *) a. Monad m => a -> m a
return (forall (arr :: * -> *) a. arr a -> PrimArray Word8 -> Set arr a
Set arr a
keysFrozen PrimArray Word8
incsFrozen)
            Maybe (Inclusivity, a)
Nothing -> forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
102)
        Maybe (Inclusivity, a)
Nothing -> forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
101)
  where
  -- do not make these patterns strict
  (Maybe (Inclusivity, a)
lowerPair1,Maybe (Inclusivity, a)
upperPair1,Int
pairsCount1) = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a
-> PrimArray Word8
-> (Maybe (Inclusivity, a), Maybe (Inclusivity, a), Int)
edges arr a
keys1 PrimArray Word8
incs1
  (Maybe (Inclusivity, a)
lowerPair2,Maybe (Inclusivity, a)
upperPair2,Int
pairsCount2) = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a
-> PrimArray Word8
-> (Maybe (Inclusivity, a), Maybe (Inclusivity, a), Int)
edges arr a
keys2 PrimArray Word8
incs2
  lowerPairRes :: Maybe (Inclusivity, a)
lowerPairRes = forall a.
Ord a =>
Maybe (Inclusivity, a)
-> Maybe (Inclusivity, a) -> Maybe (Inclusivity, a)
combineNegativeInfinities Maybe (Inclusivity, a)
lowerPair1 Maybe (Inclusivity, a)
lowerPair2
  upperPairRes :: Maybe (Inclusivity, a)
upperPairRes = forall a.
Ord a =>
Maybe (Inclusivity, a)
-> Maybe (Inclusivity, a) -> Maybe (Inclusivity, a)
combineNegativeInfinities Maybe (Inclusivity, a)
upperPair1 Maybe (Inclusivity, a)
upperPair2
  go :: forall s.
        Mutable arr s a
     -> MutablePrimArray s Word8
     -> Int -- index 1
     -> Int -- index 1 last
     -> Int -- index 2
     -> Int -- index 2 last
     -> Int -- destination index
     -> Inclusivity -- previous inclusivity
     -> a -- previous destination value
     -> ST s Int -- returns size
  go :: forall s.
Mutable arr s a
-> MutablePrimArray s Word8
-> Int
-> Int
-> Int
-> Int
-> Int
-> Inclusivity
-> a
-> ST s Int
go !Mutable arr s a
keysMut !MutablePrimArray s Word8
incsMut !Int
ix1 !Int
ixLast1 !Int
ix2 !Int
ixLast2 !Int
ixDst Inclusivity
inc a
a = if Int
ix1 forall a. Ord a => a -> a -> Bool
<= Int
ixLast1
    then forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
103)
    else if Int
ix2 forall a. Ord a => a -> a -> Bool
<= Int
ixLast2
      then forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
104)
      else case Maybe (Inclusivity, a)
upperPair1 of
        Just (Inclusivity, a)
_ -> forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
105)
        Maybe (Inclusivity, a)
Nothing -> case Maybe (Inclusivity, a)
upperPair2 of
          Maybe (Inclusivity, a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
ixDst

combineNegativeInfinities :: Ord a => Maybe (Inclusivity,a) -> Maybe (Inclusivity,a) -> Maybe (Inclusivity,a)
combineNegativeInfinities :: forall a.
Ord a =>
Maybe (Inclusivity, a)
-> Maybe (Inclusivity, a) -> Maybe (Inclusivity, a)
combineNegativeInfinities Maybe (Inclusivity, a)
Nothing Maybe (Inclusivity, a)
Nothing = forall a. Maybe a
Nothing
combineNegativeInfinities Maybe (Inclusivity, a)
Nothing x :: Maybe (Inclusivity, a)
x@(Just (Inclusivity, a)
_) = Maybe (Inclusivity, a)
x
combineNegativeInfinities x :: Maybe (Inclusivity, a)
x@(Just (Inclusivity, a)
_) Maybe (Inclusivity, a)
Nothing = Maybe (Inclusivity, a)
x
combineNegativeInfinities (Just (Inclusivity
xinc,a
x)) (Just (Inclusivity
yinc,a
y)) = case forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
  Ordering
GT -> forall a. a -> Maybe a
Just (Inclusivity
xinc,a
x)
  Ordering
LT -> forall a. a -> Maybe a
Just (Inclusivity
yinc,a
y)
  Ordering
EQ -> forall a. a -> Maybe a
Just (forall a. Ord a => a -> a -> a
max Inclusivity
xinc Inclusivity
yinc,a
y)

eatFromPositiveInfinity ::
     Inclusivity -- inclusivity for positive infinity
  -> a -- lower bound for positive infinity
  -> arr a -- set 1
  -> PrimArray Word8
  -> Int -- pairs in set 1
  -> arr a -- set 2
  -> PrimArray Word8
  -> Int -- pairs in set 2
  -> (Inclusivity,a,Int,Int) -- index for set 1 and set2, lower bound for positive infinity
eatFromPositiveInfinity :: forall a (arr :: * -> *).
Inclusivity
-> a
-> arr a
-> PrimArray Word8
-> Int
-> arr a
-> PrimArray Word8
-> Int
-> (Inclusivity, a, Int, Int)
eatFromPositiveInfinity = forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
110)

eatFromNegativeInfinity :: (Contiguous arr, Element arr a, Ord a)
  => Inclusivity -- inclusivity for negative infinity
  -> a -- upper bound for negative infinity
  -> arr a -- set 1
  -> PrimArray Word8
  -> Int -- pairs in set 1
  -> arr a -- set 2
  -> PrimArray Word8
  -> Int -- pairs in set 2
  -> (Inclusivity,a,Int,Int) -- index for set 1 and set2, upper bound for negative infinity
eatFromNegativeInfinity :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Ord a) =>
Inclusivity
-> a
-> arr a
-> PrimArray Word8
-> Int
-> arr a
-> PrimArray Word8
-> Int
-> (Inclusivity, a, Int, Int)
eatFromNegativeInfinity Inclusivity
negInfInc0 a
negInfHi0 arr a
keys1 PrimArray Word8
incs1 Int
sz1 arr a
keys2 PrimArray Word8
incs2 Int
sz2 = Inclusivity -> a -> Int -> Int -> (Inclusivity, a, Int, Int)
go Inclusivity
negInfInc0 a
negInfHi0 Int
0 Int
0
  where
  go :: Inclusivity -> a -> Int -> Int -> (Inclusivity, a, Int, Int)
go Inclusivity
negInfHiInc a
negInfHi !Int
ix1 !Int
ix2 = if Int
ix1 forall a. Ord a => a -> a -> Bool
< Int
sz1
    then forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
111)
    else if Int
ix2 forall a. Ord a => a -> a -> Bool
< Int
sz2
      then let (# a
lo #) = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> (# b #)
I.index# arr a
keys2 (Int
ix2 forall a. Num a => a -> a -> a
* Int
2)
               (# a
hi #) = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> (# b #)
I.index# arr a
keys2 (Int
ix2 forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1)
               (Inclusivity
loInc,Inclusivity
hiInc) = PrimArray Word8 -> Int -> (Inclusivity, Inclusivity)
indexInclusivityPair PrimArray Word8
incs2 Int
ix2
            in case forall a. Ord a => a -> a -> Ordering
compare a
negInfHi a
lo of
                 Ordering
LT -> (Inclusivity
negInfHiInc,a
negInfHi,Int
ix1,Int
ix2)
                 Ordering
GT -> case forall a. Ord a => a -> a -> Ordering
compare a
negInfHi a
hi of
                   Ordering
LT -> Inclusivity -> a -> Int -> Int -> (Inclusivity, a, Int, Int)
go Inclusivity
hiInc a
hi Int
ix1 (Int
ix2 forall a. Num a => a -> a -> a
+ Int
1)
                   Ordering
GT -> Inclusivity -> a -> Int -> Int -> (Inclusivity, a, Int, Int)
go Inclusivity
negInfHiInc a
negInfHi Int
ix1 (Int
ix2 forall a. Num a => a -> a -> a
+ Int
1)
                   Ordering
EQ -> Inclusivity -> a -> Int -> Int -> (Inclusivity, a, Int, Int)
go (forall a. Ord a => a -> a -> a
max Inclusivity
hiInc Inclusivity
negInfHiInc) a
hi Int
ix1 (Int
ix2 forall a. Num a => a -> a -> a
+ Int
1)
                 Ordering
EQ -> if Inclusivity
negInfHiInc forall a. Eq a => a -> a -> Bool
== Inclusivity
Exclusive Bool -> Bool -> Bool
&& Inclusivity
loInc forall a. Eq a => a -> a -> Bool
== Inclusivity
Exclusive
                   then (Inclusivity
Exclusive,a
negInfHi,Int
ix1,Int
ix2)
                   else case forall a. Ord a => a -> a -> Ordering
compare a
negInfHi a
hi of
                     Ordering
LT -> Inclusivity -> a -> Int -> Int -> (Inclusivity, a, Int, Int)
go Inclusivity
hiInc a
hi Int
ix1 (Int
ix2 forall a. Num a => a -> a -> a
+ Int
1)
                     Ordering
GT -> Inclusivity -> a -> Int -> Int -> (Inclusivity, a, Int, Int)
go Inclusivity
negInfHiInc a
negInfHi Int
ix1 (Int
ix2 forall a. Num a => a -> a -> a
+ Int
1)
                     Ordering
EQ -> Inclusivity -> a -> Int -> Int -> (Inclusivity, a, Int, Int)
go (forall a. Ord a => a -> a -> a
max Inclusivity
hiInc Inclusivity
negInfHiInc) a
hi Int
ix1 (Int
ix2 forall a. Num a => a -> a -> a
+ Int
1)
      else (Inclusivity
negInfHiInc,a
negInfHi,Int
ix1,Int
ix2)

inclusivityToEdge :: Inclusivity -> Edge
inclusivityToEdge :: Inclusivity -> Edge
inclusivityToEdge Inclusivity
Inclusive = Edge
EdgeInclusive
inclusivityToEdge Inclusivity
Exclusive = Edge
EdgeExclusive

inclusivityToWord8 :: Inclusivity -> Word8
inclusivityToWord8 :: Inclusivity -> Word8
inclusivityToWord8 Inclusivity
Inclusive = Word8
0
inclusivityToWord8 Inclusivity
Exclusive = Word8
1

inclusivityPairToWord8 :: Inclusivity -> Inclusivity -> Word8
inclusivityPairToWord8 :: Inclusivity -> Inclusivity -> Word8
inclusivityPairToWord8 Inclusivity
a Inclusivity
b =
      forall a. Bits a => a -> Int -> a
unsafeShiftL (Inclusivity -> Word8
inclusivityToWord8 Inclusivity
a) Int
1
  forall a. Bits a => a -> a -> a
.|. Inclusivity -> Word8
inclusivityToWord8 Inclusivity
b

word8ToInclusivity :: Word8 -> Inclusivity
word8ToInclusivity :: Word8 -> Inclusivity
word8ToInclusivity Word8
0 = Inclusivity
Inclusive
word8ToInclusivity Word8
_ = Inclusivity
Exclusive

indexInclusivityPair :: PrimArray Word8 -> Int -> (Inclusivity,Inclusivity)
indexInclusivityPair :: PrimArray Word8 -> Int -> (Inclusivity, Inclusivity)
indexInclusivityPair PrimArray Word8
xs Int
ix = case forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index PrimArray Word8
xs Int
ix of
  Word8
0 -> (Inclusivity
Inclusive,Inclusivity
Inclusive)
  Word8
1 -> (Inclusivity
Inclusive,Inclusivity
Exclusive)
  Word8
2 -> (Inclusivity
Exclusive,Inclusivity
Inclusive)
  Word8
_ -> (Inclusivity
Exclusive,Inclusivity
Exclusive)

edgeToWord8 :: Edge -> Word8
edgeToWord8 :: Edge -> Word8
edgeToWord8 Edge
EdgeInclusive = Word8
0
edgeToWord8 Edge
EdgeExclusive = Word8
1
edgeToWord8 Edge
EdgeAbsent = Word8
2
edgeToWord8 Edge
EdgeUniversal = Word8
3

word8ToEdge :: Word8 -> Edge
word8ToEdge :: Word8 -> Edge
word8ToEdge Word8
x = case Word8
x of
  Word8
0 -> Edge
EdgeInclusive
  Word8
1 -> Edge
EdgeExclusive
  Word8
2 -> Edge
EdgeAbsent
  Word8
_ -> Edge
EdgeUniversal

edgePairToWord8 :: Edge -> Edge -> Word8
edgePairToWord8 :: Edge -> Edge -> Word8
edgePairToWord8 Edge
a Edge
b = forall a. Bits a => a -> Int -> a
unsafeShiftL (Edge -> Word8
edgeToWord8 Edge
a) Int
2 forall a. Bits a => a -> a -> a
.|. Edge -> Word8
edgeToWord8 Edge
b

edgeMetadata :: PrimArray Word8 -> (Edge,Edge)
edgeMetadata :: PrimArray Word8 -> (Edge, Edge)
edgeMetadata PrimArray Word8
xs = (Word8 -> Edge
word8ToEdge (forall a. Bits a => a -> Int -> a
unsafeShiftR Word8
w Int
2), Word8 -> Edge
word8ToEdge (Word8
0b00000011 forall a. Bits a => a -> a -> a
.&. Word8
w))
  where
  w :: Word8
w = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index PrimArray Word8
xs (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
I.size PrimArray Word8
xs forall a. Num a => a -> a -> a
- Int
1)

-- please check for EdgeUniversal before calling this function. The
-- resulting triple includes the size of the keys array in pairs. The
-- divisions used internally here should always divide two evenly.
edges :: (Contiguous arr, Element arr a)
  => arr a
  -> PrimArray Word8
  -> (Maybe (Inclusivity,a), Maybe (Inclusivity,a),Int)
edges :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a
-> PrimArray Word8
-> (Maybe (Inclusivity, a), Maybe (Inclusivity, a), Int)
edges arr a
keys PrimArray Word8
incs = case PrimArray Word8 -> (Edge, Edge)
edgeMetadata PrimArray Word8
incs of
  (Edge
lower,Edge
upper) -> case Edge
lower of
    Edge
EdgeUniversal -> forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
2)
    Edge
EdgeAbsent -> case Edge
upper of
      Edge
EdgeInclusive -> (forall a. Maybe a
Nothing,forall a. a -> Maybe a
Just (Inclusivity
Inclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
1)),forall a. Integral a => a -> a -> a
div (Int
sz forall a. Num a => a -> a -> a
- Int
1) Int
2)
      Edge
EdgeExclusive -> (forall a. Maybe a
Nothing,forall a. a -> Maybe a
Just (Inclusivity
Exclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
1)),forall a. Integral a => a -> a -> a
div (Int
sz forall a. Num a => a -> a -> a
- Int
1) Int
2)
      Edge
EdgeAbsent -> (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing,forall a. Integral a => a -> a -> a
div Int
sz Int
2)
      Edge
_ -> forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
3)
    Edge
EdgeInclusive -> case Edge
upper of
      Edge
EdgeInclusive -> (forall a. a -> Maybe a
Just (Inclusivity
Inclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
2)),forall a. a -> Maybe a
Just (Inclusivity
Inclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
1)),forall a. Integral a => a -> a -> a
div (Int
sz forall a. Num a => a -> a -> a
- Int
2) Int
2)
      Edge
EdgeExclusive -> (forall a. a -> Maybe a
Just (Inclusivity
Inclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
2)),forall a. a -> Maybe a
Just (Inclusivity
Exclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
1)),forall a. Integral a => a -> a -> a
div (Int
sz forall a. Num a => a -> a -> a
- Int
2) Int
2)
      Edge
EdgeAbsent -> (forall a. a -> Maybe a
Just (Inclusivity
Inclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
1)),forall a. Maybe a
Nothing,forall a. Integral a => a -> a -> a
div (Int
sz forall a. Num a => a -> a -> a
- Int
1) Int
2)
      Edge
EdgeUniversal -> forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
4)
    Edge
EdgeExclusive -> case Edge
upper of
      Edge
EdgeInclusive -> (forall a. a -> Maybe a
Just (Inclusivity
Exclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
2)),forall a. a -> Maybe a
Just (Inclusivity
Inclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
1)),forall a. Integral a => a -> a -> a
div (Int
sz forall a. Num a => a -> a -> a
- Int
2) Int
2)
      Edge
EdgeExclusive -> (forall a. a -> Maybe a
Just (Inclusivity
Exclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
2)),forall a. a -> Maybe a
Just (Inclusivity
Exclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
1)),forall a. Integral a => a -> a -> a
div (Int
sz forall a. Num a => a -> a -> a
- Int
2) Int
2)
      Edge
EdgeAbsent -> (forall a. a -> Maybe a
Just (Inclusivity
Exclusive,forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
sz forall a. Num a => a -> a -> a
- Int
1)),forall a. Maybe a
Nothing,forall a. Integral a => a -> a -> a
div (Int
sz forall a. Num a => a -> a -> a
- Int
1) Int
2)
      Edge
EdgeUniversal -> forall a. HasCallStack => String -> a
error (Int -> String
errMsg Int
5)
  where
  sz :: Int
sz = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
I.size arr a
keys

member :: forall arr a. (Contiguous arr, Element arr a, Ord a)
  => a
  -> Set arr a
  -> Bool
member :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Ord a) =>
a -> Set arr a -> Bool
member a
val (Set arr a
keys PrimArray Word8
incs) = case forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a
-> PrimArray Word8
-> (Maybe (Inclusivity, a), Maybe (Inclusivity, a), Int)
edges arr a
keys PrimArray Word8
incs of
  (!Maybe (Inclusivity, a)
mnegInfHi,!Maybe (Inclusivity, a)
mposInfLo,!Int
n) ->
    case Maybe (Inclusivity, a)
mnegInfHi of
      Maybe (Inclusivity, a)
Nothing -> case Maybe (Inclusivity, a)
mposInfLo of
        Maybe (Inclusivity, a)
Nothing -> Int -> Int -> Bool
go Int
0 (Int
n forall a. Num a => a -> a -> a
- Int
1)
        Just (!Inclusivity
posInfLoInc,!a
posInfLo) -> case forall a. Ord a => a -> a -> Ordering
compare a
val a
posInfLo of
          Ordering
GT -> Bool
True
          Ordering
LT -> Int -> Int -> Bool
go Int
0 (Int
n forall a. Num a => a -> a -> a
- Int
1)
          Ordering
EQ -> Inclusivity
posInfLoInc forall a. Eq a => a -> a -> Bool
== Inclusivity
Inclusive
      Just (!Inclusivity
negInfHiInc,!a
negInfHi) -> case Maybe (Inclusivity, a)
mposInfLo of
        Maybe (Inclusivity, a)
Nothing -> case forall a. Ord a => a -> a -> Ordering
compare a
val a
negInfHi of
          Ordering
LT -> Bool
True
          Ordering
GT -> Int -> Int -> Bool
go Int
0 (Int
n forall a. Num a => a -> a -> a
- Int
1)
          Ordering
EQ -> Inclusivity
negInfHiInc forall a. Eq a => a -> a -> Bool
== Inclusivity
Inclusive
        Just (!Inclusivity
posInfLoInc,!a
posInfLo) -> case forall a. Ord a => a -> a -> Ordering
compare a
val a
posInfLo of
          Ordering
GT -> Bool
True
          Ordering
LT -> case forall a. Ord a => a -> a -> Ordering
compare a
val a
negInfHi of
            Ordering
GT -> Int -> Int -> Bool
go Int
0 (Int
n forall a. Num a => a -> a -> a
- Int
1)
            Ordering
LT -> Bool
True
            Ordering
EQ -> Inclusivity
negInfHiInc forall a. Eq a => a -> a -> Bool
== Inclusivity
Inclusive
          Ordering
EQ -> Inclusivity
posInfLoInc forall a. Eq a => a -> a -> Bool
== Inclusivity
Inclusive
  where
  go :: Int -> Int -> Bool
go !Int
start !Int
end = if Int
end forall a. Ord a => a -> a -> Bool
<= Int
start
    then if Int
end forall a. Eq a => a -> a -> Bool
== Int
start
      then
        let !(# a
valLo #) = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> (# b #)
I.index# arr a
keys (Int
2 forall a. Num a => a -> a -> a
* Int
start)
            !(# a
valHi #) = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> (# b #)
I.index# arr a
keys (Int
2 forall a. Num a => a -> a -> a
* Int
start forall a. Num a => a -> a -> a
+ Int
1)
         in case PrimArray Word8 -> Int -> (Inclusivity, Inclusivity)
indexInclusivityPair PrimArray Word8
incs Int
start of
              (Inclusivity
Exclusive,Inclusivity
Exclusive) -> a
val forall a. Ord a => a -> a -> Bool
> a
valLo Bool -> Bool -> Bool
&& a
val forall a. Ord a => a -> a -> Bool
< a
valHi
              (Inclusivity
Exclusive,Inclusivity
Inclusive) -> a
val forall a. Ord a => a -> a -> Bool
> a
valLo Bool -> Bool -> Bool
&& a
val forall a. Ord a => a -> a -> Bool
<= a
valHi
              (Inclusivity
Inclusive,Inclusivity
Exclusive) -> a
val forall a. Ord a => a -> a -> Bool
>= a
valLo Bool -> Bool -> Bool
&& a
val forall a. Ord a => a -> a -> Bool
< a
valHi
              (Inclusivity
Inclusive,Inclusivity
Inclusive) -> a
val forall a. Ord a => a -> a -> Bool
>= a
valLo Bool -> Bool -> Bool
&& a
val forall a. Ord a => a -> a -> Bool
<= a
valHi
      else Bool
False
    else
      let !mid :: Int
mid = forall a. Integral a => a -> a -> a
div (Int
end forall a. Num a => a -> a -> a
+ Int
start forall a. Num a => a -> a -> a
+ Int
1) Int
2
          !valLo :: a
valLo = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
2 forall a. Num a => a -> a -> a
* Int
mid)
       in case forall a. Ord a => a -> a -> Ordering
P.compare a
val a
valLo of
            Ordering
LT -> Int -> Int -> Bool
go Int
start (Int
mid forall a. Num a => a -> a -> a
- Int
1)
            Ordering
EQ -> Bool
True
            Ordering
GT -> Int -> Int -> Bool
go Int
mid Int
end
{-# INLINEABLE member #-}

errMsg :: Int -> String
errMsg :: Int -> String
errMsg Int
n = String
"Data.Continuous.Set.Internal: invariant " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" violated"

toPairs :: (Contiguous arr, Element arr a) => Int -> Set arr a -> [(Inclusivity,a,Inclusivity,a)]
toPairs :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Int -> Set arr a -> [(Inclusivity, a, Inclusivity, a)]
toPairs Int
n (Set arr a
keys PrimArray Word8
incs) = Int -> [(Inclusivity, a, Inclusivity, a)]
go Int
0 where
  go :: Int -> [(Inclusivity, a, Inclusivity, a)]
go !Int
ix = if Int
ix forall a. Ord a => a -> a -> Bool
< Int
n
    then
      let (Inclusivity
incLo,Inclusivity
incHi) = PrimArray Word8 -> Int -> (Inclusivity, Inclusivity)
indexInclusivityPair PrimArray Word8
incs Int
ix
          lo :: a
lo = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
2 forall a. Num a => a -> a -> a
* Int
ix)
          hi :: a
hi = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
I.index arr a
keys (Int
2 forall a. Num a => a -> a -> a
* Int
ix forall a. Num a => a -> a -> a
+ Int
1)
       in (Inclusivity
incLo,a
lo,Inclusivity
incHi,a
hi) forall a. a -> [a] -> [a]
: Int -> [(Inclusivity, a, Inclusivity, a)]
go (Int
ix forall a. Num a => a -> a -> a
+ Int
1)
    else []

showsPrec :: (Contiguous arr, Element arr a, Show a)
  => Int
  -> Set arr a
  -> ShowS
showsPrec :: forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Show a) =>
Int -> Set arr a -> ShowS
showsPrec Int
_ s :: Set arr a
s@(Set arr a
keys PrimArray Word8
incs)
  | forall (arr :: * -> *) a. Contiguous arr => Set arr a -> Bool
null Set arr a
s = String -> ShowS
showString String
"{}"
  | forall (arr :: * -> *) a. Contiguous arr => Set arr a -> Bool
universal Set arr a
s = String -> ShowS
showString String
"{(-∞,+∞)}"
  | Bool
otherwise = Char -> ShowS
showChar Char
'{' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> ShowS)
-> Maybe (Inclusivity, a)
-> [(Inclusivity, a, Inclusivity, a)]
-> Maybe (Inclusivity, a)
-> ShowS
showListInf forall a. Show a => a -> ShowS
shows Maybe (Inclusivity, a)
lowerPair (forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Int -> Set arr a -> [(Inclusivity, a, Inclusivity, a)]
toPairs Int
pairsCount Set arr a
s) Maybe (Inclusivity, a)
upperPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
  where
  -- do not make these patterns strict
  (Maybe (Inclusivity, a)
lowerPair,Maybe (Inclusivity, a)
upperPair,Int
pairsCount) = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a
-> PrimArray Word8
-> (Maybe (Inclusivity, a), Maybe (Inclusivity, a), Int)
edges arr a
keys PrimArray Word8
incs

showListInf :: (a -> ShowS) -> Maybe (Inclusivity,a) -> [(Inclusivity,a,Inclusivity,a)] -> Maybe (Inclusivity,a) -> ShowS
showListInf :: forall a.
(a -> ShowS)
-> Maybe (Inclusivity, a)
-> [(Inclusivity, a, Inclusivity, a)]
-> Maybe (Inclusivity, a)
-> ShowS
showListInf a -> ShowS
showx Maybe (Inclusivity, a)
mnegInfHi [] Maybe (Inclusivity, a)
mposInfLo String
s = case Maybe (Inclusivity, a)
mnegInfHi of
  Maybe (Inclusivity, a)
Nothing -> case Maybe (Inclusivity, a)
mposInfLo of
    Maybe (Inclusivity, a)
Nothing -> String
s
    Just (Inclusivity
posInfLoInc,a
posInfLo) -> forall a. (a -> ShowS) -> Inclusivity -> a -> ShowS
showPosInfLo a -> ShowS
showx Inclusivity
posInfLoInc a
posInfLo String
s
  Just (Inclusivity
negInfHiInc,a
negInfHi) -> case Maybe (Inclusivity, a)
mposInfLo of
    Maybe (Inclusivity, a)
Nothing -> forall a. (a -> ShowS) -> Inclusivity -> a -> ShowS
showNegInfHi a -> ShowS
showx Inclusivity
negInfHiInc a
negInfHi String
s
    Just (Inclusivity
posInfLoInc,a
posInfLo) -> Char -> ShowS
showChar Char
'{'
      forall a b. (a -> b) -> a -> b
$ forall a. (a -> ShowS) -> Inclusivity -> a -> ShowS
showNegInfHi a -> ShowS
showx Inclusivity
negInfHiInc a
negInfHi
      forall a b. (a -> b) -> a -> b
$ Char -> ShowS
showChar Char
','
      forall a b. (a -> b) -> a -> b
$ forall a. (a -> ShowS) -> Inclusivity -> a -> ShowS
showPosInfLo a -> ShowS
showx Inclusivity
posInfLoInc a
posInfLo
      forall a b. (a -> b) -> a -> b
$ Char -> ShowS
showChar Char
'}'
      forall a b. (a -> b) -> a -> b
$ String
s
showListInf a -> ShowS
showx Maybe (Inclusivity, a)
mnegInfHi ((Inclusivity
ainc0,a
a0,Inclusivity
binc0,a
b0):[(Inclusivity, a, Inclusivity, a)]
xs) Maybe (Inclusivity, a)
mposInfLo String
s =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\(Inclusivity
negInfHiInc,a
negInfHi) String
s' -> forall a. (a -> ShowS) -> Inclusivity -> a -> ShowS
showNegInfHi a -> ShowS
showx Inclusivity
negInfHiInc a
negInfHi (Char
',' forall a. a -> [a] -> [a]
: String
s')) Maybe (Inclusivity, a)
mnegInfHi (case Inclusivity
ainc0 of {Inclusivity
Inclusive -> Char
'[';Inclusivity
Exclusive -> Char
'('} forall a. a -> [a] -> [a]
: a -> ShowS
showx a
a0 (Char
',' forall a. a -> [a] -> [a]
: a -> ShowS
showx a
b0 (case Inclusivity
binc0 of {Inclusivity
Inclusive -> Char
']'; Inclusivity
Exclusive -> Char
')'} forall a. a -> [a] -> [a]
: [(Inclusivity, a, Inclusivity, a)] -> String
showl [(Inclusivity, a, Inclusivity, a)]
xs)))
  where
    showl :: [(Inclusivity, a, Inclusivity, a)] -> String
showl [] = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\(Inclusivity
posInfLoInc,a
posInfLo) -> Char -> ShowS
showChar Char
',' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> ShowS) -> Inclusivity -> a -> ShowS
showPosInfLo a -> ShowS
showx Inclusivity
posInfLoInc a
posInfLo) Maybe (Inclusivity, a)
mposInfLo (Char
']' forall a. a -> [a] -> [a]
: String
s)
    showl ((Inclusivity
ainc,a
a,Inclusivity
binc,a
b):[(Inclusivity, a, Inclusivity, a)]
ys) = Char
',' forall a. a -> [a] -> [a]
: case Inclusivity
ainc of {Inclusivity
Inclusive -> Char
'[';Inclusivity
Exclusive -> Char
'('} forall a. a -> [a] -> [a]
: a -> ShowS
showx a
a (Char
',' forall a. a -> [a] -> [a]
: a -> ShowS
showx a
b (case Inclusivity
binc of {Inclusivity
Inclusive -> Char
']'; Inclusivity
Exclusive -> Char
')'} forall a. a -> [a] -> [a]
: [(Inclusivity, a, Inclusivity, a)] -> String
showl [(Inclusivity, a, Inclusivity, a)]
ys))

showNegInfHi :: (a -> ShowS) -> Inclusivity -> a -> ShowS
showNegInfHi :: forall a. (a -> ShowS) -> Inclusivity -> a -> ShowS
showNegInfHi a -> ShowS
showx Inclusivity
inc a
x String
s = String
"(-∞," forall a. [a] -> [a] -> [a]
++ a -> ShowS
showx a
x ((case Inclusivity
inc of { Inclusivity
Inclusive -> Char
']'; Inclusivity
Exclusive -> Char
')'} forall a. a -> [a] -> [a]
: String
s))

showPosInfLo :: (a -> ShowS) -> Inclusivity -> a -> ShowS
showPosInfLo :: forall a. (a -> ShowS) -> Inclusivity -> a -> ShowS
showPosInfLo a -> ShowS
showx Inclusivity
inc a
x String
s = case Inclusivity
inc of { Inclusivity
Inclusive -> Char
'['; Inclusivity
Exclusive -> Char
'('} forall a. a -> [a] -> [a]
: (a -> ShowS
showx a
x (String
",+∞)" forall a. [a] -> [a] -> [a]
++ String
s))