{-# LANGUAGE CPP #-}

-- Code from this implementation was cribbed from `psqueues`, whose license is copied below.
--
-- The Glasgow Haskell Compiler License
--
-- Copyright 2004, The University Court of the University of Glasgow.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
-- - Redistributions of source code must retain the above copyright notice,
-- this list of conditions and the following disclaimer.
--
-- - Redistributions in binary form must reproduce the above copyright notice,
-- this list of conditions and the following disclaimer in the documentation
-- and/or other materials provided with the distribution.
--
-- - Neither name of the University nor the names of its contributors may be
-- used to endorse or promote products derived from this software without
-- specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
-- GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
-- INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-- FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-- UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-- OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
-- DAMAGE.

module TimerWheel.Internal.Bucket
  ( Bucket,
    empty,

    -- * Queries
    isEmpty,
    partition,

    -- * Modifications
    insert,
    Pop (..),
    pop,
    deleteExpectingHit,

    -- * Strict pair
    Pair (..),
  )
where

import Data.Bits
import TimerWheel.Internal.Prelude
import TimerWheel.Internal.Timestamp (Timestamp)

#include "MachDeps.h"

data Bucket a
  = -- Invariants on `Bin k p v m l r`:
    --   1. `l` and `r` can't both be Nil
    --   2. `p` is <= all `p` in `l` and `r`
    --   3. `k` is not an element of `l` nor `r`
    --   4. `m` has one 1-bit, which is (usually) the highest bit position at which any two keys in `k`+`l`+`r` differ
    --      (henceforth referred to as the diffbit). It can get out-of-date by deletions and pops. Thus, `m` represents
    --      a left-bound on the diffbit, that is, the true diffbit can be no left-er than `m`.
    --   5. No key in `l` has the `m` bit set
    --   6. All keys in `r` have the `m` bit set
    Bin {-# UNPACK #-} !AlarmId {-# UNPACK #-} !Timestamp !a {-# UNPACK #-} !Mask !(Bucket a) !(Bucket a)
  | Tip {-# UNPACK #-} !AlarmId {-# UNPACK #-} !Timestamp !a
  | Nil

type Mask = Word64

type AlarmId = Int

-- | An empty bucket.
empty :: Bucket a
empty :: forall a. Bucket a
empty =
  Bucket a
forall a. Bucket a
Nil

isEmpty :: Bucket a -> Bool
isEmpty :: forall a. Bucket a -> Bool
isEmpty = \case
  Bucket a
Nil -> Bool
True
  Bucket a
_ -> Bool
False

-- | Partition a bucket by timestamp (less-than-or-equal-to, greater-than).
partition :: forall a. Timestamp -> Bucket a -> Pair (Bucket a) (Bucket a)
partition :: forall a. Timestamp -> Bucket a -> Pair (Bucket a) (Bucket a)
partition Timestamp
q =
  Bucket a -> Bucket a -> Pair (Bucket a) (Bucket a)
go Bucket a
forall a. Bucket a
empty
  where
    go :: Bucket a -> Bucket a -> Pair (Bucket a) (Bucket a)
    go :: Bucket a -> Bucket a -> Pair (Bucket a) (Bucket a)
go Bucket a
acc Bucket a
t =
      case Bucket a
t of
        Bucket a
Nil -> Bucket a -> Bucket a -> Pair (Bucket a) (Bucket a)
forall a b. a -> b -> Pair a b
Pair Bucket a
acc Bucket a
t
        Tip AlarmId
i Timestamp
p a
x
          | Timestamp
p Timestamp -> Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
> Timestamp
q -> Bucket a -> Bucket a -> Pair (Bucket a) (Bucket a)
forall a b. a -> b -> Pair a b
Pair Bucket a
acc Bucket a
t
          | Bool
otherwise -> Bucket a -> Bucket a -> Pair (Bucket a) (Bucket a)
forall a b. a -> b -> Pair a b
Pair (AlarmId -> Timestamp -> a -> Bucket a -> Bucket a
forall a. AlarmId -> Timestamp -> a -> Bucket a -> Bucket a
insert AlarmId
i Timestamp
p a
x Bucket a
acc) Bucket a
forall a. Bucket a
Nil
        Bin AlarmId
i Timestamp
p a
x Word64
m Bucket a
l Bucket a
r
          | Timestamp
p Timestamp -> Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
> Timestamp
q -> Bucket a -> Bucket a -> Pair (Bucket a) (Bucket a)
forall a b. a -> b -> Pair a b
Pair Bucket a
acc Bucket a
t
          | Bool
otherwise ->
              case Bucket a -> Bucket a -> Pair (Bucket a) (Bucket a)
go Bucket a
acc Bucket a
l of
                Pair Bucket a
acc1 Bucket a
l1 ->
                  case Bucket a -> Bucket a -> Pair (Bucket a) (Bucket a)
go Bucket a
acc1 Bucket a
r of
                    Pair Bucket a
acc2 Bucket a
r1 -> Bucket a -> Bucket a -> Pair (Bucket a) (Bucket a)
forall a b. a -> b -> Pair a b
Pair (AlarmId -> Timestamp -> a -> Bucket a -> Bucket a
forall a. AlarmId -> Timestamp -> a -> Bucket a -> Bucket a
insert AlarmId
i Timestamp
p a
x Bucket a
acc2) (Word64 -> Bucket a -> Bucket a -> Bucket a
forall v. Word64 -> Bucket v -> Bucket v -> Bucket v
merge Word64
m Bucket a
l1 Bucket a
r1)

-- | Insert a new timer into a bucket.
--
-- If a timer with the given id is already in the bucket, behavior is undefined.
insert :: forall a. AlarmId -> Timestamp -> a -> Bucket a -> Bucket a
insert :: forall a. AlarmId -> Timestamp -> a -> Bucket a -> Bucket a
insert AlarmId
i Timestamp
p a
x Bucket a
bucket =
  case Bucket a
bucket of
    Bucket a
Nil -> AlarmId -> Timestamp -> a -> Bucket a
forall a. AlarmId -> Timestamp -> a -> Bucket a
Tip AlarmId
i Timestamp
p a
x
    Tip AlarmId
j Timestamp
q a
y
      | Bool
betteri -> AlarmId -> Bucket a -> Bucket a -> Bucket a
linki AlarmId
j Bucket a
bucket Bucket a
forall a. Bucket a
Nil
      | Bool
otherwise -> AlarmId -> Bucket a -> Bucket a -> Bucket a
linkj AlarmId
i (AlarmId -> Timestamp -> a -> Bucket a
forall a. AlarmId -> Timestamp -> a -> Bucket a
Tip AlarmId
i Timestamp
p a
x) Bucket a
forall a. Bucket a
Nil
      where
        betteri :: Bool
betteri = (Timestamp
p, AlarmId
i) (Timestamp, AlarmId) -> (Timestamp, AlarmId) -> Bool
forall a. Ord a => a -> a -> Bool
< (Timestamp
q, AlarmId
j)
        linkj :: AlarmId -> Bucket a -> Bucket a -> Bucket a
linkj = AlarmId
-> Timestamp -> a -> AlarmId -> Bucket a -> Bucket a -> Bucket a
forall v.
AlarmId
-> Timestamp -> v -> AlarmId -> Bucket v -> Bucket v -> Bucket v
link AlarmId
j Timestamp
q a
y
    Bin AlarmId
j Timestamp
q a
y Word64
m Bucket a
l Bucket a
r
      | Bool
betteri ->
          if
            | Bool
outsider -> AlarmId -> Bucket a -> Bucket a -> Bucket a
linki AlarmId
j Bucket a
bucket Bucket a
forall a. Bucket a
Nil
            | AlarmId -> Word64 -> Bool
goleft AlarmId
j Word64
m -> Bucket a -> Bucket a -> Bucket a
bini (Bucket a -> Bucket a
insertj Bucket a
l) Bucket a
r
            | Bool
otherwise -> Bucket a -> Bucket a -> Bucket a
bini Bucket a
l (Bucket a -> Bucket a
insertj Bucket a
r)
      | Bool
outsider -> AlarmId -> Bucket a -> Bucket a -> Bucket a
linkj AlarmId
i (AlarmId -> Timestamp -> a -> Bucket a
forall a. AlarmId -> Timestamp -> a -> Bucket a
Tip AlarmId
i Timestamp
p a
x) (Word64 -> Bucket a -> Bucket a -> Bucket a
forall v. Word64 -> Bucket v -> Bucket v -> Bucket v
merge Word64
m Bucket a
l Bucket a
r)
      | AlarmId -> Word64 -> Bool
goleft AlarmId
i Word64
m -> Bucket a -> Bucket a -> Bucket a
binj (Bucket a -> Bucket a
inserti Bucket a
l) Bucket a
r
      | Bool
otherwise -> Bucket a -> Bucket a -> Bucket a
binj Bucket a
l (Bucket a -> Bucket a
inserti Bucket a
r)
      where
        outsider :: Bool
outsider = Word64 -> AlarmId -> AlarmId -> Bool
prefixNotEqual Word64
m AlarmId
i AlarmId
j
        betteri :: Bool
betteri = (Timestamp
p, AlarmId
i) (Timestamp, AlarmId) -> (Timestamp, AlarmId) -> Bool
forall a. Ord a => a -> a -> Bool
< (Timestamp
q, AlarmId
j)
        bini :: Bucket a -> Bucket a -> Bucket a
bini = AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
i Timestamp
p a
x Word64
m
        binj :: Bucket a -> Bucket a -> Bucket a
binj = AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
j Timestamp
q a
y Word64
m
        inserti :: Bucket a -> Bucket a
inserti = AlarmId -> Timestamp -> a -> Bucket a -> Bucket a
forall a. AlarmId -> Timestamp -> a -> Bucket a -> Bucket a
insert AlarmId
i Timestamp
p a
x
        insertj :: Bucket a -> Bucket a
insertj = AlarmId -> Timestamp -> a -> Bucket a -> Bucket a
forall a. AlarmId -> Timestamp -> a -> Bucket a -> Bucket a
insert AlarmId
j Timestamp
q a
y
        linkj :: AlarmId -> Bucket a -> Bucket a -> Bucket a
linkj = AlarmId
-> Timestamp -> a -> AlarmId -> Bucket a -> Bucket a -> Bucket a
forall v.
AlarmId
-> Timestamp -> v -> AlarmId -> Bucket v -> Bucket v -> Bucket v
link AlarmId
j Timestamp
q a
y
  where
    linki :: AlarmId -> Bucket a -> Bucket a -> Bucket a
linki = AlarmId
-> Timestamp -> a -> AlarmId -> Bucket a -> Bucket a -> Bucket a
forall v.
AlarmId
-> Timestamp -> v -> AlarmId -> Bucket v -> Bucket v -> Bucket v
link AlarmId
i Timestamp
p a
x

data Pop a
  = PopAlgo {-# UNPACK #-} !AlarmId {-# UNPACK #-} !Timestamp !a !(Bucket a)
  | PopNada

pop :: Bucket a -> Pop a
pop :: forall a. Bucket a -> Pop a
pop = \case
  Bucket a
Nil -> Pop a
forall a. Pop a
PopNada
  Tip AlarmId
k Timestamp
p a
x -> AlarmId -> Timestamp -> a -> Bucket a -> Pop a
forall a. AlarmId -> Timestamp -> a -> Bucket a -> Pop a
PopAlgo AlarmId
k Timestamp
p a
x Bucket a
forall a. Bucket a
Nil
  Bin AlarmId
k Timestamp
p a
x Word64
m Bucket a
l Bucket a
r -> AlarmId -> Timestamp -> a -> Bucket a -> Pop a
forall a. AlarmId -> Timestamp -> a -> Bucket a -> Pop a
PopAlgo AlarmId
k Timestamp
p a
x (Word64 -> Bucket a -> Bucket a -> Bucket a
forall v. Word64 -> Bucket v -> Bucket v -> Bucket v
merge Word64
m Bucket a
l Bucket a
r)
{-# INLINE pop #-}

-- | Delete a timer from a bucket, expecting it to be there.
deleteExpectingHit :: AlarmId -> Bucket v -> Maybe (Bucket v)
deleteExpectingHit :: forall v. AlarmId -> Bucket v -> Maybe (Bucket v)
deleteExpectingHit AlarmId
i =
  Bucket v -> Maybe (Bucket v)
forall v. Bucket v -> Maybe (Bucket v)
go
  where
    go :: Bucket v -> Maybe (Bucket v)
    go :: forall v. Bucket v -> Maybe (Bucket v)
go = \case
      Bucket v
Nil -> Maybe (Bucket v)
forall a. Maybe a
Nothing
      Tip AlarmId
j Timestamp
_ v
_
        | AlarmId
i AlarmId -> AlarmId -> Bool
forall a. Eq a => a -> a -> Bool
== AlarmId
j -> Bucket v -> Maybe (Bucket v)
forall a. a -> Maybe a
Just Bucket v
forall a. Bucket a
Nil
        | Bool
otherwise -> Maybe (Bucket v)
forall a. Maybe a
Nothing
      Bin AlarmId
j Timestamp
p v
x Word64
m Bucket v
l Bucket v
r
        -- This commented out short-circuit is what makes this delete variant "expecting a hit"
        --   | prefixNotEqual m i j -> Nothing
        | AlarmId
i AlarmId -> AlarmId -> Bool
forall a. Eq a => a -> a -> Bool
== AlarmId
j -> Bucket v -> Maybe (Bucket v)
forall a. a -> Maybe a
Just (Bucket v -> Maybe (Bucket v)) -> Bucket v -> Maybe (Bucket v)
forall a b. (a -> b) -> a -> b
$! Word64 -> Bucket v -> Bucket v -> Bucket v
forall v. Word64 -> Bucket v -> Bucket v -> Bucket v
merge Word64
m Bucket v
l Bucket v
r
        | AlarmId -> Word64 -> Bool
goleft AlarmId
i Word64
m -> (\Bucket v
l1 -> AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
bin AlarmId
j Timestamp
p v
x Word64
m Bucket v
l1 Bucket v
r) (Bucket v -> Bucket v) -> Maybe (Bucket v) -> Maybe (Bucket v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bucket v -> Maybe (Bucket v)
forall v. Bucket v -> Maybe (Bucket v)
go Bucket v
l
        | Bool
otherwise -> AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
bin AlarmId
j Timestamp
p v
x Word64
m Bucket v
l (Bucket v -> Bucket v) -> Maybe (Bucket v) -> Maybe (Bucket v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bucket v -> Maybe (Bucket v)
forall v. Bucket v -> Maybe (Bucket v)
go Bucket v
r

-- | 'Bin' smart constructor, respecting the invariant that both children can't be 'Nil'.
bin :: AlarmId -> Timestamp -> v -> Mask -> Bucket v -> Bucket v -> Bucket v
bin :: forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
bin AlarmId
i Timestamp
p v
x Word64
_ Bucket v
Nil Bucket v
Nil = AlarmId -> Timestamp -> v -> Bucket v
forall a. AlarmId -> Timestamp -> a -> Bucket a
Tip AlarmId
i Timestamp
p v
x
bin AlarmId
i Timestamp
p v
x Word64
m Bucket v
l Bucket v
r = AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
i Timestamp
p v
x Word64
m Bucket v
l Bucket v
r
{-# INLINE bin #-}

link :: AlarmId -> Timestamp -> v -> AlarmId -> Bucket v -> Bucket v -> Bucket v
link :: forall v.
AlarmId
-> Timestamp -> v -> AlarmId -> Bucket v -> Bucket v -> Bucket v
link AlarmId
i Timestamp
p v
x AlarmId
j Bucket v
t Bucket v
u
  | AlarmId -> Word64 -> Bool
goleft AlarmId
j Word64
m = AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
i Timestamp
p v
x Word64
m Bucket v
t Bucket v
u
  | Bool
otherwise = AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
i Timestamp
p v
x Word64
m Bucket v
u Bucket v
t
  where
    m :: Word64
m = Word64 -> Word64
onlyHighestBit (AlarmId -> Word64
i2w AlarmId
i Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` AlarmId -> Word64
i2w AlarmId
j)
{-# INLINE link #-}

-- Merge two disjoint buckets that have the same mask.
merge :: Mask -> Bucket v -> Bucket v -> Bucket v
merge :: forall v. Word64 -> Bucket v -> Bucket v -> Bucket v
merge Word64
m Bucket v
l Bucket v
r =
  case (Bucket v
l, Bucket v
r) of
    (Bucket v
Nil, Bucket v
_) -> Bucket v
r
    (Bucket v
_, Bucket v
Nil) -> Bucket v
l
    --
    --    ip      jq
    --
    (Tip AlarmId
i Timestamp
p v
x, Tip AlarmId
j Timestamp
q v
y)
      --
      --       ip
      --      /  \
      --    nil  jq
      --
      | (Timestamp
p, AlarmId
i) (Timestamp, AlarmId) -> (Timestamp, AlarmId) -> Bool
forall a. Ord a => a -> a -> Bool
< (Timestamp
q, AlarmId
j) -> AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
i Timestamp
p v
x Word64
m Bucket v
forall a. Bucket a
Nil Bucket v
r
      --
      --       jq
      --      /  \
      --    ip   nil
      --
      | Bool
otherwise -> AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
j Timestamp
q v
y Word64
m Bucket v
l Bucket v
forall a. Bucket a
Nil
    --
    --    ip      jq
    --           /  \
    --         rl    rr
    --
    (Tip AlarmId
i Timestamp
p v
x, Bin AlarmId
j Timestamp
q v
y Word64
n Bucket v
rl Bucket v
rr)
      --
      --       ip
      --      /  \
      --    nil  jq
      --        /  \
      --      rl    rr
      --
      | (Timestamp
p, AlarmId
i) (Timestamp, AlarmId) -> (Timestamp, AlarmId) -> Bool
forall a. Ord a => a -> a -> Bool
< (Timestamp
q, AlarmId
j) -> AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
i Timestamp
p v
x Word64
m Bucket v
forall a. Bucket a
Nil Bucket v
r
      --
      --       jq
      --      /  \
      --    ip   rl+rr
      --
      | Bool
otherwise -> AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
j Timestamp
q v
y Word64
m Bucket v
l (Word64 -> Bucket v -> Bucket v -> Bucket v
forall v. Word64 -> Bucket v -> Bucket v -> Bucket v
merge Word64
n Bucket v
rl Bucket v
rr)
    --
    --       ip      jq
    --      /  \
    --    ll    lr
    --
    (Bin AlarmId
i Timestamp
p v
x Word64
n Bucket v
ll Bucket v
lr, Tip AlarmId
j Timestamp
q v
y)
      --
      --         ip
      --        /  \
      --    ll+lr   jq
      --
      | (Timestamp
p, AlarmId
i) (Timestamp, AlarmId) -> (Timestamp, AlarmId) -> Bool
forall a. Ord a => a -> a -> Bool
< (Timestamp
q, AlarmId
j) -> AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
i Timestamp
p v
x Word64
m (Word64 -> Bucket v -> Bucket v -> Bucket v
forall v. Word64 -> Bucket v -> Bucket v -> Bucket v
merge Word64
n Bucket v
ll Bucket v
lr) Bucket v
r
      --
      --          jq
      --         /  \
      --       ip   nil
      --      /  \
      --    ll    lr
      --
      | Bool
otherwise -> AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
j Timestamp
q v
y Word64
m Bucket v
l Bucket v
forall a. Bucket a
Nil
    --
    --       ip          jq
    --      /  \        /  \
    --    ll    lr    rl    rr
    --
    (Bin AlarmId
i Timestamp
p v
x Word64
n Bucket v
ll Bucket v
lr, Bin AlarmId
j Timestamp
q v
y Word64
o Bucket v
rl Bucket v
rr)
      --
      --         ip
      --        /  \
      --    ll+lr   jq
      --           /  \
      --         rl    rr
      --
      | (Timestamp
p, AlarmId
i) (Timestamp, AlarmId) -> (Timestamp, AlarmId) -> Bool
forall a. Ord a => a -> a -> Bool
< (Timestamp
q, AlarmId
j) -> AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
i Timestamp
p v
x Word64
m (Word64 -> Bucket v -> Bucket v -> Bucket v
forall v. Word64 -> Bucket v -> Bucket v -> Bucket v
merge Word64
n Bucket v
ll Bucket v
lr) Bucket v
r
      --
      --          jq
      --         /  \
      --       ip   rl+rr
      --      /  \
      --    ll    lr
      --
      | Bool
otherwise -> AlarmId
-> Timestamp -> v -> Word64 -> Bucket v -> Bucket v -> Bucket v
forall a.
AlarmId
-> Timestamp -> a -> Word64 -> Bucket a -> Bucket a -> Bucket a
Bin AlarmId
j Timestamp
q v
y Word64
m Bucket v
l (Word64 -> Bucket v -> Bucket v -> Bucket v
forall v. Word64 -> Bucket v -> Bucket v -> Bucket v
merge Word64
o Bucket v
rl Bucket v
rr)

------------------------------------------------------------------------------------------------------------------------
-- Bit fiddling

-- | Is (or should) this timer be stored on the left of this bin, given its mask?
goleft :: AlarmId -> Mask -> Bool
goleft :: AlarmId -> Word64 -> Bool
goleft AlarmId
i Word64
m =
  AlarmId -> Word64
i2w AlarmId
i Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
m Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
{-# INLINE goleft #-}

-- m = 00001000000000000000000
-- i = IIII???????????????????
-- j = JJJJ???????????????????
--
-- prefixNotEqual m i j answers, is IIII not equal to JJJJ?
prefixNotEqual :: Mask -> AlarmId -> AlarmId -> Bool
prefixNotEqual :: Word64 -> AlarmId -> AlarmId -> Bool
prefixNotEqual (Word64 -> Word64
prefixMask -> Word64
e) AlarmId
i AlarmId
j =
  AlarmId -> Word64
i2w AlarmId
i Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
e Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= AlarmId -> Word64
i2w AlarmId
j Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
e
{-# INLINE prefixNotEqual #-}

--            m = 0000000000100000
-- prefixMask m = 1111111111000000
prefixMask :: Word64 -> Word64
prefixMask :: Word64 -> Word64
prefixMask Word64
m = -Word64
m Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
m
{-# INLINE prefixMask #-}

onlyHighestBit :: Word64 -> Mask
onlyHighestBit :: Word64 -> Word64
onlyHighestBit Word64
w = Word64 -> AlarmId -> Word64
forall a. Bits a => a -> AlarmId -> a
unsafeShiftL Word64
1 (WORD_SIZE_IN_BITS - 1 - countLeadingZeros w)
{-# INLINE onlyHighestBit #-}

i2w :: AlarmId -> Word64
i2w :: AlarmId -> Word64
i2w = AlarmId -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE i2w #-}

------------------------------------------------------------------------------------------------------------------------
-- Strict pair

data Pair a b
  = Pair !a !b