{-# LANGUAGE Unsafe #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.Struct.Internal.Order where
import Control.Exception
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Bits
import Data.Struct.Internal
import Data.Struct.Internal.Label (Label, Key)
import qualified Data.Struct.Label as Label
import qualified Data.Struct.Internal.Label as Label (key)
import Data.Word
newtype Order a s = Order { Order a s -> Object s
runOrder :: Object s }
instance Eq (Order a s) where == :: Order a s -> Order a s -> Bool
(==) = Order a s -> Order a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> t s -> Bool
eqStruct
instance Struct (Order a)
key :: Field (Order a) Key
key :: Field (Order a) Key
key = Int -> Field (Order a) Key
forall k (s :: k) a. Int -> Field s a
field Int
0
{-# INLINE key #-}
value :: Field (Order a) a
value :: Field (Order a) a
value = Int -> Field (Order a) a
forall k (s :: k) a. Int -> Field s a
field Int
1
{-# INLINE value #-}
next :: Slot (Order a) (Order a)
next :: Slot (Order a) (Order a)
next = Int -> Slot (Order a) (Order a)
forall k1 k2 (s :: k1) (t :: k2). Int -> Slot s t
slot Int
2
{-# INLINE next #-}
prev :: Slot (Order a) (Order a)
prev :: Slot (Order a) (Order a)
prev = Int -> Slot (Order a) (Order a)
forall k1 k2 (s :: k1) (t :: k2). Int -> Slot s t
slot Int
3
{-# INLINE prev #-}
parent :: Slot (Order a) Label
parent :: Slot (Order a) Label
parent = Int -> Slot (Order a) Label
forall k1 k2 (s :: k1) (t :: k2). Int -> Slot s t
slot Int
4
{-# INLINE parent #-}
makeOrder :: PrimMonad m => Label (PrimState m) -> Key -> a -> Order a (PrimState m) -> Order a (PrimState m) -> m (Order a (PrimState m))
makeOrder :: Label (PrimState m)
-> Key
-> a
-> Order a (PrimState m)
-> Order a (PrimState m)
-> m (Order a (PrimState m))
makeOrder Label (PrimState m)
mom Key
a a
v Order a (PrimState m)
p Order a (PrimState m)
n = ST (PrimState m) (Order a (PrimState m))
-> m (Order a (PrimState m))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) (Order a (PrimState m))
-> m (Order a (PrimState m)))
-> ST (PrimState m) (Order a (PrimState m))
-> m (Order a (PrimState m))
forall a b. (a -> b) -> a -> b
$ do
Order a (PrimState m)
this <- Int -> ST (PrimState m) (Order a (PrimState (ST (PrimState m))))
forall (m :: * -> *) (t :: * -> *).
(PrimMonad m, Struct t) =>
Int -> m (t (PrimState m))
alloc Int
5
Slot (Order a) Label
-> Order a (PrimState (ST (PrimState m)))
-> Label (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this Label (PrimState m)
Label (PrimState (ST (PrimState m)))
mom
Field (Order a) Key
-> Order a (PrimState (ST (PrimState m)))
-> Key
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (Order a) Key
forall a. Field (Order a) Key
key Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this Key
a
Field (Order a) a
-> Order a (PrimState (ST (PrimState m)))
-> a
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (Order a) a
forall a. Field (Order a) a
value Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this a
v
Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
prev Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
p
Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
next Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n
Order a (PrimState m) -> ST (PrimState m) (Order a (PrimState m))
forall (m :: * -> *) a. Monad m => a -> m a
return Order a (PrimState m)
this
{-# INLINE makeOrder #-}
compareM :: PrimMonad m => Order a (PrimState m) -> Order a (PrimState m) -> m Ordering
compareM :: Order a (PrimState m) -> Order a (PrimState m) -> m Ordering
compareM Order a (PrimState m)
i Order a (PrimState m)
j
| Order a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil Order a (PrimState m)
i Bool -> Bool -> Bool
|| Order a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil Order a (PrimState m)
j = NullPointerException -> m Ordering
forall a e. Exception e => e -> a
throw NullPointerException
NullPointerException
| Bool
otherwise = ST (PrimState m) Ordering -> m Ordering
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) Ordering -> m Ordering)
-> ST (PrimState m) Ordering -> m Ordering
forall a b. (a -> b) -> a -> b
$ do
Label (PrimState m)
ui <- Slot (Order a) Label
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Label (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
i
Label (PrimState m)
uj <- Slot (Order a) Label
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Label (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
j
Ordering
xs <- Label (PrimState (ST (PrimState m)))
-> Label (PrimState (ST (PrimState m)))
-> ST (PrimState m) Ordering
forall (m :: * -> *).
PrimMonad m =>
Label (PrimState m) -> Label (PrimState m) -> m Ordering
Label.compareM Label (PrimState m)
Label (PrimState (ST (PrimState m)))
ui Label (PrimState m)
Label (PrimState (ST (PrimState m)))
uj
case Ordering
xs of
Ordering
EQ -> Key -> Key -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Key -> Key -> Ordering)
-> ST (PrimState m) Key -> ST (PrimState m) (Key -> Ordering)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field (Order a) Key
-> Order a (PrimState (ST (PrimState m))) -> ST (PrimState m) Key
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (Order a) Key
forall a. Field (Order a) Key
key Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
i ST (PrimState m) (Key -> Ordering)
-> ST (PrimState m) Key -> ST (PrimState m) Ordering
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field (Order a) Key
-> Order a (PrimState (ST (PrimState m))) -> ST (PrimState m) Key
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (Order a) Key
forall a. Field (Order a) Key
key Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
j
Ordering
x -> Ordering -> ST (PrimState m) Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
x
{-# INLINE compareM #-}
insertAfter :: PrimMonad m => Order a (PrimState m) -> a -> m (Order a (PrimState m))
insertAfter :: Order a (PrimState m) -> a -> m (Order a (PrimState m))
insertAfter Order a (PrimState m)
n0 a
a1 = ST (PrimState m) (Order a (PrimState m))
-> m (Order a (PrimState m))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) (Order a (PrimState m))
-> m (Order a (PrimState m)))
-> ST (PrimState m) (Order a (PrimState m))
-> m (Order a (PrimState m))
forall a b. (a -> b) -> a -> b
$ do
Bool -> ST (PrimState m) () -> ST (PrimState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Order a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil Order a (PrimState m)
n0) (ST (PrimState m) () -> ST (PrimState m) ())
-> ST (PrimState m) () -> ST (PrimState m) ()
forall a b. (a -> b) -> a -> b
$ NullPointerException -> ST (PrimState m) ()
forall a e. Exception e => e -> a
throw NullPointerException
NullPointerException
Label (PrimState m)
mom <- Slot (Order a) Label
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Label (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n0
Key
k0 <- Field (Order a) Key
-> Order a (PrimState (ST (PrimState m))) -> ST (PrimState m) Key
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (Order a) Key
forall a. Field (Order a) Key
key Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n0
Order a (PrimState m)
n2 <- Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Order a (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
next Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n0
Key
k2 <- if Order a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil Order a (PrimState m)
n2 then Key -> ST (PrimState m) Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
forall a. Bounded a => a
maxBound else Field (Order a) Key
-> Order a (PrimState (ST (PrimState m))) -> ST (PrimState m) Key
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (Order a) Key
forall a. Field (Order a) Key
key Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n2
let !k1 :: Key
k1 = Key
k0 Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftR (Key
k2 Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
k0) Int
1
Order a (PrimState m)
n1 <- Label (PrimState (ST (PrimState m)))
-> Key
-> a
-> Order a (PrimState (ST (PrimState m)))
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Order a (PrimState (ST (PrimState m))))
forall (m :: * -> *) a.
PrimMonad m =>
Label (PrimState m)
-> Key
-> a
-> Order a (PrimState m)
-> Order a (PrimState m)
-> m (Order a (PrimState m))
makeOrder Label (PrimState m)
Label (PrimState (ST (PrimState m)))
mom Key
k1 a
a1 Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n0 Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n2
Bool -> ST (PrimState m) () -> ST (PrimState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Order a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil Order a (PrimState m)
n2) (ST (PrimState m) () -> ST (PrimState m) ())
-> ST (PrimState m) () -> ST (PrimState m) ()
forall a b. (a -> b) -> a -> b
$ Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
prev Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n2 Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n1
Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
next Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n0 Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n1
Bool -> ST (PrimState m) () -> ST (PrimState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key
k0 Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
1 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k2) (ST (PrimState m) () -> ST (PrimState m) ())
-> ST (PrimState m) () -> ST (PrimState m) ()
forall a b. (a -> b) -> a -> b
$ Label (PrimState m) -> Order a (PrimState m) -> ST (PrimState m) ()
forall s a. Label s -> Order a s -> ST s ()
rewind Label (PrimState m)
mom Order a (PrimState m)
n0
Order a (PrimState m) -> ST (PrimState m) (Order a (PrimState m))
forall (m :: * -> *) a. Monad m => a -> m a
return Order a (PrimState m)
n1
where
rewind :: Label s -> Order a s -> ST s ()
rewind :: Label s -> Order a s -> ST s ()
rewind Label s
mom Order a s
this = do
Order a s
p <- Slot (Order a) (Order a)
-> Order a (PrimState (ST s)) -> ST s (Order a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
prev Order a s
Order a (PrimState (ST s))
this
if Order a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil Order a s
p then Label s -> Label s -> Order a s -> Key -> Int -> ST s ()
forall s a.
Label s -> Label s -> Order a s -> Key -> Int -> ST s ()
rebalance Label s
mom Label s
mom Order a s
this Key
0 Int
64
else do
Label s
dad <- Slot (Order a) Label
-> Order a (PrimState (ST s)) -> ST s (Label (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a s
Order a (PrimState (ST s))
p
if Label s
mom Label s -> Label s -> Bool
forall a. Eq a => a -> a -> Bool
== Label s
dad then Label s -> Order a s -> ST s ()
forall s a. Label s -> Order a s -> ST s ()
rewind Label s
mom Order a s
p
else Label s -> Label s -> Order a s -> Key -> Int -> ST s ()
forall s a.
Label s -> Label s -> Order a s -> Key -> Int -> ST s ()
rebalance Label s
mom Label s
mom Order a s
p Key
0 Int
64
rebalance :: Label s -> Label s -> Order a s -> Word64 -> Int -> ST s ()
rebalance :: Label s -> Label s -> Order a s -> Key -> Int -> ST s ()
rebalance Label s
mom Label s
dad Order a s
this Key
k Int
j = Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Order a s -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil Order a s
this) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
Label s
guardian <- Slot (Order a) Label
-> Order a (PrimState (ST s)) -> ST s (Label (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a s
Order a (PrimState (ST s))
this
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Label s
mom Label s -> Label s -> Bool
forall a. Eq a => a -> a -> Bool
== Label s
guardian) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
Field (Order a) Key -> Order a (PrimState (ST s)) -> Key -> ST s ()
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> a -> m ()
setField Field (Order a) Key
forall a. Field (Order a) Key
key Order a s
Order a (PrimState (ST s))
this Key
k
Slot (Order a) Label
-> Order a (PrimState (ST s))
-> Label (PrimState (ST s))
-> ST s ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a s
Order a (PrimState (ST s))
this Label s
Label (PrimState (ST s))
dad
Order a s
n <- Slot (Order a) (Order a)
-> Order a (PrimState (ST s)) -> ST s (Order a (PrimState (ST s)))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
next Order a s
Order a (PrimState (ST s))
this
if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Label s -> Label s -> Order a s -> Key -> Int -> ST s ()
forall s a.
Label s -> Label s -> Order a s -> Key -> Int -> ST s ()
rebalance Label s
mom Label s
dad Order a s
n (Key
k Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
deltaU) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
else do
Label s
stepdad <- Label (PrimState (ST s)) -> ST s (Label (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Label (PrimState m) -> m (Label (PrimState m))
Label.insertAfter Label s
Label (PrimState (ST s))
dad
Label s -> Label s -> Order a s -> Key -> Int -> ST s ()
forall s a.
Label s -> Label s -> Order a s -> Key -> Int -> ST s ()
rebalance Label s
mom Label s
stepdad Order a s
n Key
deltaU Int
logU
delete :: PrimMonad m => Order a (PrimState m) -> m ()
delete :: Order a (PrimState m) -> m ()
delete Order a (PrimState m)
this = ST (PrimState m) () -> m ()
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) () -> m ()) -> ST (PrimState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> ST (PrimState m) () -> ST (PrimState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Order a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil Order a (PrimState m)
this) (ST (PrimState m) () -> ST (PrimState m) ())
-> ST (PrimState m) () -> ST (PrimState m) ()
forall a b. (a -> b) -> a -> b
$ NullPointerException -> ST (PrimState m) ()
forall a e. Exception e => e -> a
throw NullPointerException
NullPointerException
Label (PrimState m)
mom <- Slot (Order a) Label
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Label (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this
Order a (PrimState m)
p <- Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Order a (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
prev Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this
Order a (PrimState m)
n <- Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Order a (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
next Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this
Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
prev Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this Order a (PrimState (ST (PrimState m)))
forall (t :: * -> *) s. Struct t => t s
Nil
Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
next Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this Order a (PrimState (ST (PrimState m)))
forall (t :: * -> *) s. Struct t => t s
Nil
Bool
x <- if Order a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil Order a (PrimState m)
p then Bool -> ST (PrimState m) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
next Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
p Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n
Label (PrimState m)
pmom <- Slot (Order a) Label
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Label (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
p
Bool -> ST (PrimState m) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Label (PrimState m)
mom Label (PrimState m) -> Label (PrimState m) -> Bool
forall a. Eq a => a -> a -> Bool
== Label (PrimState m)
pmom)
Bool
y <- if Order a (PrimState m) -> Bool
forall (t :: * -> *) s. Struct t => t s -> Bool
isNil Order a (PrimState m)
n then Bool -> ST (PrimState m) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
Slot (Order a) (Order a)
-> Order a (PrimState (ST (PrimState m)))
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) ()
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> y (PrimState m) -> m ()
set Slot (Order a) (Order a)
forall a. Slot (Order a) (Order a)
prev Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
p
Label (PrimState m)
nmom <- Slot (Order a) Label
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Label (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
n
Bool -> ST (PrimState m) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Label (PrimState m)
mom Label (PrimState m) -> Label (PrimState m) -> Bool
forall a. Eq a => a -> a -> Bool
== Label (PrimState m)
nmom)
Bool -> ST (PrimState m) () -> ST (PrimState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
x Bool -> Bool -> Bool
|| Bool
y) (ST (PrimState m) () -> ST (PrimState m) ())
-> ST (PrimState m) () -> ST (PrimState m) ()
forall a b. (a -> b) -> a -> b
$ Label (PrimState (ST (PrimState m))) -> ST (PrimState m) ()
forall (m :: * -> *). PrimMonad m => Label (PrimState m) -> m ()
Label.delete Label (PrimState m)
Label (PrimState (ST (PrimState m)))
mom
{-# INLINE delete #-}
logU :: Int
logU :: Int
logU = Int
64
loglogU :: Int
loglogU :: Int
loglogU = Int
6
deltaU :: Key
deltaU :: Key
deltaU = Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftR Key
forall a. Bounded a => a
maxBound Int
loglogU
new :: PrimMonad m => a -> m (Order a (PrimState m))
new :: a -> m (Order a (PrimState m))
new a
a = ST (PrimState m) (Order a (PrimState m))
-> m (Order a (PrimState m))
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) (Order a (PrimState m))
-> m (Order a (PrimState m)))
-> ST (PrimState m) (Order a (PrimState m))
-> m (Order a (PrimState m))
forall a b. (a -> b) -> a -> b
$ do
Label (PrimState m)
l <- ST (PrimState m) (Label (PrimState m))
forall (m :: * -> *). PrimMonad m => m (Label (PrimState m))
Label.new
Label (PrimState (ST (PrimState m)))
-> Key
-> a
-> Order a (PrimState (ST (PrimState m)))
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Order a (PrimState (ST (PrimState m))))
forall (m :: * -> *) a.
PrimMonad m =>
Label (PrimState m)
-> Key
-> a
-> Order a (PrimState m)
-> Order a (PrimState m)
-> m (Order a (PrimState m))
makeOrder Label (PrimState m)
Label (PrimState (ST (PrimState m)))
l (Key -> Int -> Key
forall a. Bits a => a -> Int -> a
unsafeShiftR Key
forall a. Bounded a => a
maxBound Int
1) a
a Order a (PrimState (ST (PrimState m)))
forall (t :: * -> *) s. Struct t => t s
Nil Order a (PrimState (ST (PrimState m)))
forall (t :: * -> *) s. Struct t => t s
Nil
{-# INLINE new #-}
keys :: PrimMonad m => Order a (PrimState m) -> m (Key, Key)
keys :: Order a (PrimState m) -> m (Key, Key)
keys Order a (PrimState m)
this = ST (PrimState m) (Key, Key) -> m (Key, Key)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
st (ST (PrimState m) (Key, Key) -> m (Key, Key))
-> ST (PrimState m) (Key, Key) -> m (Key, Key)
forall a b. (a -> b) -> a -> b
$ do
Label (PrimState m)
mom <- Slot (Order a) Label
-> Order a (PrimState (ST (PrimState m)))
-> ST (PrimState m) (Label (PrimState (ST (PrimState m))))
forall (m :: * -> *) (x :: * -> *) (y :: * -> *).
(PrimMonad m, Struct x, Struct y) =>
Slot x y -> x (PrimState m) -> m (y (PrimState m))
get Slot (Order a) Label
forall a. Slot (Order a) Label
parent Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this
(,) (Key -> Key -> (Key, Key))
-> ST (PrimState m) Key -> ST (PrimState m) (Key -> (Key, Key))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field Label Key
-> Label (PrimState (ST (PrimState m))) -> ST (PrimState m) Key
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field Label Key
Label.key Label (PrimState m)
Label (PrimState (ST (PrimState m)))
mom ST (PrimState m) (Key -> (Key, Key))
-> ST (PrimState m) Key -> ST (PrimState m) (Key, Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Field (Order a) Key
-> Order a (PrimState (ST (PrimState m))) -> ST (PrimState m) Key
forall (m :: * -> *) (x :: * -> *) a.
(PrimMonad m, Struct x) =>
Field x a -> x (PrimState m) -> m a
getField Field (Order a) Key
forall a. Field (Order a) Key
key Order a (PrimState m)
Order a (PrimState (ST (PrimState m)))
this
{-# INLINE keys #-}