radix-tree-1.0.0.0: src/Data/Patricia/Word/Strict/Internal.hs

{-# LANGUAGE BangPatterns
           , DeriveLift
           , GADTs
           , RankNTypes
           , ScopedTypeVariables
           , UnboxedTuples #-}

module Data.Patricia.Word.Strict.Internal
  ( StrictPatricia
  , Patricia (..)

  , Data.Patricia.Word.Strict.Internal.null
  , size

  , Data.Patricia.Word.Strict.Internal.map
  , map'
  , mapWithKey
  , mapWithKey'

  , Data.Patricia.Word.Strict.Internal.foldl
  , Data.Patricia.Word.Strict.Internal.foldl'
  , foldlWithKey
  , foldlWithKey'

  , Data.Patricia.Word.Strict.Internal.foldr
  , Data.Patricia.Word.Strict.Internal.foldr'
  , foldrWithKey
  , foldrWithKey'

  , Data.Patricia.Word.Strict.Internal.foldMap
  , foldMapWithKey

  , Data.Patricia.Word.Strict.Internal.traverse
  , traverseWithKey

  , union
  , unionL
  , unionWith'
  , unionWithKey'

  , difference
  , differenceWith
  , differenceWithKey

  , Data.Patricia.Word.Strict.Internal.compare

  , disjoint
  , intersection
  , intersectionL
  , intersectionWith'
  , intersectionWithKey'

  , merge

  , Data.Patricia.Word.Strict.Internal.lookup
  , Data.Patricia.Word.Strict.Internal.find
  , member
  , takeOne

  , dirtyLookup
  , dirtyFind
  , dirtyMember

  , insert
  , insertWith
  , insertWith'

  , adjust
  , adjust'

  , delete

  , update

  , alter

  , lookupL
  , lookupR

  , adjustL
  , adjustL'
  , adjustLWithKey
  , adjustLWithKey'

  , adjustR
  , adjustR'
  , adjustRWithKey
  , adjustRWithKey'

  , deleteL
  , deleteR

  , updateL
  , updateR
  , updateLWithKey
  , updateRWithKey

  , adjustRange
  , unsafeAdjustRange

  , adjustRange'
  , unsafeAdjustRange'

  , adjustRangeWithKey
  , unsafeAdjustRangeWithKey

  , adjustRangeWithKey'
  , unsafeAdjustRangeWithKey'

  , deleteRange
  , unsafeDeleteRange

  , updateRange
  , unsafeUpdateRange

  , updateRangeWithKey
  , unsafeUpdateRangeWithKey

  , takeRange
  , unsafeTakeRange

  , takeL
  , takeR

  , Split (..)
  , splitL
  , splitR

  , SplitLookup (..)
  , splitLookup

  , Data.Patricia.Word.Strict.Internal.filter
  , filterWithKey

  , mapMaybe
  , mapMaybeWithKey

  , partition
  , partitionWithKey

  , mapEither
  , mapEitherWithKey

  , lookupMin
  , lookupMinWithKey
  , lookupMax
  , lookupMaxWithKey

  , unsafeLookupMin
  , unsafeLookupMinWithKey
  , unsafeLookupMax
  , unsafeLookupMaxWithKey

  , deleteMin
  , deleteMax

  , adjustMin
  , adjustMin'
  , adjustMinWithKey
  , adjustMinWithKey'
  , adjustMax
  , adjustMax'
  , adjustMaxWithKey
  , adjustMaxWithKey'

  , updateMin
  , updateMinWithKey
  , updateMax
  , updateMaxWithKey

  , ViewL (..)
  , minView
  , unsafeMinView

  , ViewR (..)
  , maxView
  , unsafeMaxView
  ) where

import           Data.Patricia.Word.Common
import           Radix.Common
import           Radix.Exception
import           Radix.Word.Common
import           Radix.Word.Foundation

import           Control.Applicative
import           Control.DeepSeq
import           Control.Exception (throw)
import           Data.Bits
import           Data.Foldable
import           Data.Functor.Classes
import           Language.Haskell.TH.Syntax (Lift)
import           Text.Read
import           Text.Show



-- | Convenience synonym.
type StrictPatricia = Patricia

-- | Spine-strict PATRICIA tree.
data Patricia a = Bin
                    {-# UNPACK #-} !Prefix
                    !(Patricia a)          -- ^ Masked bit is @0@.
                    !(Patricia a)          -- ^ Masked bit is @1@.

                | Tip
                    {-# UNPACK #-} !Key
                    a

                | Nil -- ^ Invariant: only allowed as the root of the tree.
                  deriving Lift

instance Show a => Show (Patricia a) where
  showsPrec = liftShowsPrec showsPrec showList

instance Show1 Patricia where
  liftShowsPrec showsPrec_ showList_ _ t =
    showListWith (liftShowsPrec showsPrec_ showList_ 0) $
      foldrWithKey (\k a -> (:) (k, a)) [] t

instance Read a => Read (Patricia a) where
  readPrec = liftReadPrec readPrec readListPrec

instance Read1 Patricia where
  liftReadPrec readPrec_ readList_ =
    fmap (Data.Foldable.foldl' (\z (k, a) -> insert k a z) Nil)
      (liftReadListPrec readPrec_ readList_)


instance Eq a => Eq (Patricia a) where
  (==) = liftEq (==)

instance Eq1 Patricia where
  liftEq eq = go
    where
      go l r =
        case l of
          Bin p xl xr ->
            case r of
              Bin q yl yr -> p == q && go xl yl && go xr yr
              _           -> False

          Tip kA a ->
            case r of
              Tip kB b -> kA == kB && eq a b
              _        -> False

          Nil ->
            case r of
              Nil -> True
              _   -> False


-- | Uses 'Data.Patricia.Word.Strict.map'.
instance Functor Patricia where
  fmap = Data.Patricia.Word.Strict.Internal.map

instance Foldable Patricia where
  foldl = Data.Patricia.Word.Strict.Internal.foldl
  foldr = Data.Patricia.Word.Strict.Internal.foldr
  foldMap = Data.Patricia.Word.Strict.Internal.foldMap

  foldl' = Data.Patricia.Word.Strict.Internal.foldl'
  foldr' = Data.Patricia.Word.Strict.Internal.foldr'

  null = Data.Patricia.Word.Strict.Internal.null
  length = fromIntegral . size

instance Traversable Patricia where
  traverse = Data.Patricia.Word.Strict.Internal.traverse


instance NFData a => NFData (Patricia a) where
  rnf = liftRnf rnf

instance NFData1 Patricia where
  liftRnf nf = go
    where
      go t =
        case t of
          Bin _ l r -> go l `seq` go r
          Tip _ a   -> nf a
          Nil       -> ()



{-# INLINE join #-}
-- | Knowing that the prefices of two non-'Nil' trees disagree, construct a 'Bin'.
join :: Prefix -> Patricia a -> Prefix -> Patricia a -> Patricia a
join p0 t0 p1 t1 =
  let m = branchingBit p0 p1

      p = mask p0 m .|. m

  in if zeroBit p0 m
       then Bin p t0 t1
       else Bin p t1 t0

{-# INLINE safeJoin #-}
-- | Knowing that the prefices of two trees disagree, construct a 'Bin'.
safeJoin :: Prefix -> Patricia a -> Prefix -> Patricia a -> Patricia a
safeJoin _  Nil _  t1  = t1
safeJoin _  t0  _  Nil = t0
safeJoin p0 t0  p1 t1  = join p0 t0 p1 t1

{-# INLINE rebin #-}
-- | Reconstruct a 'Bin' knowing that either of the sides may now be a 'Nil'.
rebin :: Prefix -> Patricia a -> Patricia a -> Patricia a
rebin p l r =
  case l of
    Nil -> r
    _   ->
      case r of
        Nil -> l
        _   -> Bin p l r

{-# INLINE rebinL #-}
-- | Reconstruct a 'Bin' knowing that the left side may now be a 'Nil'.
rebinL :: Prefix -> Patricia a -> Patricia a -> Patricia a
rebinL p l r =
  case l of
    Nil -> r
    _   -> Bin p l r


{-# INLINE rebinR #-}
-- | Reconstruct a 'Bin' knowing that the right side may now be a 'Nil'.
rebinR :: Prefix -> Patricia a -> Patricia a -> Patricia a
rebinR p l r =
  case r of
    Nil -> l
    _   -> Bin p l r


{-# INLINE retip #-}
-- | Reconstruct a 'Tip' knowing that the value may not be there anymore.
retip :: Key -> Maybe a -> Patricia a
retip w (Just a) = Tip w a
retip _ Nothing  = Nil



-- | \(\mathcal{O}(1)\).
--   Check if the tree is empty.
null :: Patricia a -> Bool
null Nil = True
null _   = False

-- | \(\mathcal{O}(n)\).
--   Calculate the number of elements stored in the tree.
--   The returned number is guaranteed to be non-negative.
size :: Patricia a -> Int
size t =
  case t of
    Bin _ l r -> let !m = size l
                     !n = size r
                 in m + n

    Tip _ _   -> 1

    Nil       -> 0



-- | \(\mathcal{O}(n)\).
--   Apply a function to every value in the tree.
map :: (a -> b) -> Patricia a -> Patricia b
map f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p (go l) (go r)
        Tip k a   -> Tip k (f a)
        Nil       -> Nil

-- | \(\mathcal{O}(n)\).
--   Apply a function to every value in the tree.
--
--   New values are evaluated to WHNF.
map' :: (a -> b) -> Patricia a -> Patricia b
map' f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p (go l) (go r)
        Tip k a   -> Tip k $! f a
        Nil       -> Nil

-- | \(\mathcal{O}(n)\).
--   Apply a function to every value in the tree.
mapWithKey :: (Word -> a -> b) -> Patricia a -> Patricia b
mapWithKey f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p (go l) (go r)
        Tip k a   -> Tip k (f k a)
        Nil       -> Nil

-- | \(\mathcal{O}(n)\).
--   Apply a function to every value in the tree.
--
--   New values are evaluated to WHNF.
mapWithKey' :: (Word -> a -> b) -> Patricia a -> Patricia b
mapWithKey' f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p (go l) (go r)
        Tip k a   -> Tip k $! f k a
        Nil       -> Nil



-- | \(\mathcal{O}(n_R)\).
--   Fold the tree left-to-right.
foldl :: (b -> a -> b) -> b -> Patricia a -> b
foldl f = go
  where
    go z t =
      case t of
        Bin _ l r -> go (go z l) r
        Tip _ a   -> f z a
        Nil       -> z

-- | \(\mathcal{O}(n_R)\).
--   Fold the tree left-to-right.
foldlWithKey :: (b -> Word -> a -> b) -> b -> Patricia a -> b
foldlWithKey f = go
  where
    go z t =
      case t of
        Bin _ l r -> go (go z l) r
        Tip k a   -> f z k a
        Nil       -> z



-- | \(\mathcal{O}(n)\).
--   Fold the tree left-to-right with a strict accumulator.
foldl' :: (b -> a -> b) -> b -> Patricia a -> b
foldl' f = go
  where
    go !z t =
      case t of
        Bin _ l r -> let !z' = go z l
                     in go z' r
        Tip _ a   -> f z a
        Nil       -> z

-- | \(\mathcal{O}(n)\).
--   Fold the tree left-to-right with a strict accumulator.
foldlWithKey' :: (b -> Word -> a -> b) -> b -> Patricia a -> b
foldlWithKey' f = go
  where
    go !z t =
      case t of
        Bin _ l r -> let !z' = go z l
                     in go z' r
        Tip k a   -> f z k a
        Nil       -> z



-- | \(\mathcal{O}(n_L)\).
--   Fold the tree right-to-left.
foldr :: (a -> b -> b) -> b -> Patricia a -> b
foldr f = go
  where
    go z t =
      case t of
        Bin _ l r -> go (go z r) l
        Tip _ a   -> f a z
        Nil       -> z

-- | \(\mathcal{O}(n_L)\).
--   Fold the tree right-to-left.
foldrWithKey :: (Word -> a -> b -> b) -> b -> Patricia a -> b
foldrWithKey f = go
  where
    go z t =
      case t of
        Bin _ l r -> go (go z r) l
        Tip k a   -> f k a z
        Nil       -> z

-- | \(\mathcal{O}(n)\).
--   Fold the tree right-to-left with a strict accumulator.
foldr' :: (a -> b -> b) -> b -> Patricia a -> b
foldr' f = go
  where
    go !z t =
      case t of
        Bin _ l r -> let !z' = go z r
                     in go z' l
        Tip _ a   -> f a z
        Nil       -> z

-- | \(\mathcal{O}(n)\).
--   Fold the tree right-to-left with a strict accumulator.
foldrWithKey' :: (Word -> a -> b -> b) -> b -> Patricia a -> b
foldrWithKey' f = go
  where
    go !z t =
      case t of
        Bin _ l r -> let !z' = go z r
                     in go z' l
        Tip k a   -> f k a z
        Nil       -> z



-- | \(\mathcal{O}(n_M)\).
--   Map each element in the tree to a monoid and combine the results.
foldMap :: Monoid m => (a -> m) -> Patricia a -> m
foldMap f = go
  where
    go t =
      case t of
        Bin _ l r -> go l <> go r
        Tip _ a   -> f a
        Nil       -> mempty

-- | \(\mathcal{O}(n_M)\).
--   Map each element in the tree to a monoid and combine the results.
foldMapWithKey :: Monoid m => (Word -> a -> m) -> Patricia a -> m
foldMapWithKey f = go
  where
    go t =
      case t of
        Bin _ l r -> go l <> go r
        Tip k a   -> f k a
        Nil       -> mempty



-- | \(\mathcal{O}(n)\).
--   Map each element in the tree to an action, evaluate these actions
--   left-to-right and collect the results.
traverse :: Applicative f => (a -> f b) -> Patricia a -> f (Patricia b)
traverse f = go
  where
    go t =
      case t of
        Bin p l r -> liftA2 (Bin p) (go l) (go r)
        Tip k a   -> Tip k <$> f a
        Nil       -> pure Nil

-- | \(\mathcal{O}(n)\).
--   Map each element in the tree to an action, evaluate these actions
--   left-to-right and collect the results.
traverseWithKey :: Applicative f => (Word -> a -> f b) -> Patricia a -> f (Patricia b)
traverseWithKey f = go
  where
    go t =
      case t of
        Bin p l r -> liftA2 (Bin p) (go l) (go r)
        Tip k a   -> Tip k <$> f k a
        Nil       -> pure Nil



type UBin a = (# Prefix, Patricia a, Patricia a #)

type UTip a = (# Word, a #)



-- | \(\mathcal{O}(n_A + n_B)\).
--   Unbiased union of two trees.
union :: Patricia a -> Patricia a -> Patricia a
union = anyAny
  where
    anyAny tA tB =
      case tA of
        Bin pA lA rA -> binAny (# pA, lA, rA #) tA tB

        Tip kA _ -> tipAny kA tA tB

        Nil -> tB

    tipAny kA tA tB =
      case tB of
        Bin pB lB rB -> tipBin kA tA (# pB, lB, rB #) tB

        Tip kB _
          | kA == kB  -> tA
          | otherwise -> join kA tA kB tB

        Nil -> tA

    binAny uA tA tB =
      case tB of
        Bin pB lB rB -> binBin uA tA (# pB, lB, rB #) tB

        Tip kB _ -> tipBin kB tB uA tA

        Nil -> tA

    tipBin kA tA (# pB, lB, rB #) tB
      | beyond pB kA = join kA tA pB tB
      | kA < pB      = Bin pB (tipAny kA tA lB) rB
      | otherwise    = Bin pB lB (tipAny kA tA rB)

    binBin uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =
      let {-# NOINLINE no #-}
          no = join pA tA pB tB

      in case Prelude.compare pA pB of
           EQ                  -> Bin pA (anyAny lA lB) (anyAny rA rB)

           LT | pB <= upper pA -> Bin pA lA (binAny uB tB rA)
              | pA >= lower pB -> Bin pB (binAny uA tA lB) rB
              | otherwise      -> no

           GT | pA <= upper pB -> Bin pB lB (binAny uA tA rB)
              | pB >= lower pA -> Bin pA (binAny uB tB lA) rA
              | otherwise      -> no



-- | \(\mathcal{O}(n_A + n_B)\).
--   Left-biased union of two trees.
unionL :: Patricia a -> Patricia a -> Patricia a
unionL =
  union_ $ \s k a b ->
    let !(# c #) = case s of
                     L -> (# a #)
                     R -> (# b #)
    in Tip k c

-- | \(\mathcal{O}(n_A + n_B)\).
--   Union of two trees with a combining function.
--
--   New values are evaluated to WHNF.
unionWith'
  :: (a -> a -> a)
  -> Patricia a
  -> Patricia a
  -> Patricia a
unionWith' f =
  union_ $ \s k a b ->
    Tip k $! case s of
               L -> f a b
               R -> f b a

-- | \(\mathcal{O}(n_A + n_B)\).
--   Union of two trees with a combining function.
--
--   New values are evaluated to WHNF.
unionWithKey'
  :: (Word -> a -> a -> a)
  -> Patricia a
  -> Patricia a
  -> Patricia a
unionWithKey' f =
  union_ $ \s k a b ->
    Tip k $! case s of
               L -> f k a b
               R -> f k b a



{-# INLINE union_ #-}
union_
  :: (forall x y. S x y a a -> Key -> x -> y -> Patricia a)
  -> Patricia a
  -> Patricia a
  -> Patricia a
union_ f = anyAny L
  where
    anyAny s tA tB =
      case tA of
        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB

        Tip kA a -> tipAny s (# kA, a #) tA tB

        Nil -> tB

    tipAny s uA@(# kA, a #) tA tB =
      case tB of
        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #) tB

        Tip kB b
          | kA == kB  -> f s kA a b
          | otherwise -> join kA tA kB tB

        Nil -> tA

    binAny s uA tA tB =
      case tB of
        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB

        Tip kB b ->
          let !(# s' #) = other s
          in tipBin s' (# kB, b #) tB uA tA

        Nil -> tA

    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #) tB
      | beyond pB kA = join kA tA pB tB
      | kA < pB      = Bin pB (tipAny s uA tA lB) rB
      | otherwise    = Bin pB lB (tipAny s uA tA rB)

    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =
      let {-# NOINLINE no #-}
          no = join pA tA pB tB

      in case Prelude.compare pA pB of
           EQ                  -> Bin pA (anyAny s lA lB) (anyAny s rA rB)

           LT | pB <= upper pA -> let !(# s' #) = other s
                                  in Bin pA lA (binAny s' uB tB rA)
              | pA >= lower pB -> Bin pB (binAny s uA tA lB) rB
              | otherwise      -> no

           GT | pA <= upper pB -> Bin pB lB (binAny s uA tA rB)
              | pB >= lower pA -> let !(# s' #) = other s
                                  in Bin pA (binAny s' uB tB lA) rA
              | otherwise      -> no



-- | \(\mathcal{O}(n_A + n_B)\).
--   Difference of two trees.
difference :: Patricia a -> Patricia b -> Patricia a
difference =
  difference_ $ \_ _ _ _ ->
    Nil

-- | \(\mathcal{O}(n_A + n_B)\).
--   Difference of two trees with a combining function.
--
--   The 'Maybe' is evaluated to WHNF.
differenceWith
  :: (a -> b -> Maybe a)
  -> Patricia a
  -> Patricia b
  -> Patricia a
differenceWith f =
  difference_ $ \s k a b ->
    retip k $ case s of
                L -> f a b
                R -> f b a

-- | \(\mathcal{O}(n_A + n_B)\).
--   Difference of two trees with a combining function.
--
--   The 'Maybe' is evaluated to WHNF.
differenceWithKey
  :: (Word -> a -> b -> Maybe a)
  -> Patricia a
  -> Patricia b
  -> Patricia a
differenceWithKey f =
  difference_ $ \s k a b ->
    retip k $ case s of
                L -> f k a b
                R -> f k b a



{-# INLINE difference_ #-}
difference_
  :: (forall x y. S x y a b -> Key -> x -> y -> Patricia a)
  -> Patricia a
  -> Patricia b
  -> Patricia a
difference_ (f :: forall n o. S n o x y -> Key -> n -> o -> Patricia x) = anyAny L
  where
    anyAny
      :: forall a b. S a b x y -> Patricia a -> Patricia b -> Patricia x
    anyAny s tA tB =
      case tA of
        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB

        Tip kA a -> tipAny s (# kA, a #) tA tB

        Nil -> case s of
                 L -> tA
                 R -> tB

    tipAny
      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> Patricia x
    tipAny s uA@(# kA, a #) tA tB =
      case tB of
        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #) tB

        Tip kB b
          | kA == kB  -> f s kA a b
          | otherwise -> case s of
                           L -> tA
                           R -> tB

        Nil -> case s of
                 L -> tA
                 R -> tB

    binAny
      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> Patricia x
    binAny s uA tA tB =
      case tB of
        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB

        Tip kB b -> let !(# s' #) = other s
                    in tipBin s' (# kB, b #) tB uA tA

        Nil -> case s of
                 L -> tA
                 R -> tB

    tipBin
      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> Patricia b -> Patricia x
    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #) tB
      | beyond pB kA = case s of
                         L -> tA
                         R -> tB

      | kA < pB      = case s of
                         L -> tipAny s uA tA lB
                         R -> rebinL pB (tipAny s uA tA lB) rB

      | otherwise    = case s of
                         L -> tipAny s uA tA rB
                         R -> rebinR pB lB (tipAny s uA tA rB)

    binBin
      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> Patricia x
    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =
      let {-# NOINLINE no #-}
          no = case s of
                 L -> tA
                 R -> tB

      in case Prelude.compare pA pB of
           EQ                  -> rebin pA (anyAny s lA lB) (anyAny s rA rB)

           LT | pB <= upper pA -> case s of
                                    L -> rebinR pA lA (binAny R uB tB rA)
                                    R -> binAny L uB tB rA

              | pA >= lower pB -> case s of
                                    L -> binAny s uA tA lB
                                    R -> rebinL pB (binAny s uA tA lB) rB

              | otherwise      -> no

           GT | pA <= upper pB -> case s of
                                    L -> binAny s uA tA rB
                                    R -> rebinR pB lB (binAny s uA tA rB)

              | pB >= lower pA -> case s of
                                    L -> rebinL pA (binAny R uB tB lA) rA
                                    R -> binAny L uB tB lA

              | otherwise      -> no



-- | \(\mathcal{O}(n_A + n_B)\).
--   Compare two trees with respect to set inclusion,
--   using the given equality function for intersecting keys.
--   If any intersecting keys hold unequal values, the trees are 'Incomparable'.
compare :: (a -> b -> Bool) -> Patricia a -> Patricia b -> PartialOrdering
compare (f :: x -> y -> Bool) = anyAny L
  where
    anyAny
      :: forall a b. S a b x y -> Patricia a -> Patricia b -> PartialOrdering
    anyAny s tA tB =
      case tA of
        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB

        Tip kA a -> tipAny s (# kA, a #) tA tB

        Nil -> case tB of
                 Nil -> Equal
                 _   -> Subset

    tipAny
      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> PartialOrdering
    tipAny s uA@(# kA, a #) tA tB =
      case tB of
        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #)

        Tip kB b
          | kA == kB  -> let eq = case s of
                                    L -> f a b
                                    R -> f b a
                         in if eq
                              then Equal
                              else Incomparable

          | otherwise -> Incomparable

        Nil -> Superset

    binAny
      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> PartialOrdering
    binAny s uA tA tB =
      case tB of
        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB

        Tip kB b -> let !(# s' #) = other s
                    in tipBin s' (# kB, b #) tB uA

        Nil -> Superset

    tipBin
      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> PartialOrdering
    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #) =
      if beyond pB kA
        then Incomparable
        else limit s . tipAny s uA tA $ if kA < pB
                                           then lB
                                           else rB

    binBin
      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> PartialOrdering
    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =
      case Prelude.compare pA pB of
        EQ                  -> order (anyAny s lA lB) (anyAny s rA rB)

        LT | pB <= upper pA -> let !(# s' #) = other s
                               in limit s' $ binAny s' uB tB rA

           | pA >= lower pB -> limit s $ binAny s uA tA lB

           | otherwise      -> Incomparable

        GT | pA <= upper pB -> limit s $ binAny s uA tA rB

           | pB >= lower pA -> let !(# s' #) = other s

                               in limit s' $ binAny s' uB tB lA

           | otherwise      -> Incomparable



-- | \(\mathcal{O}(n_A + n_B)\).
--   Determine whether two trees' key sets are disjoint.
disjoint :: Patricia a -> Patricia b -> Bool
disjoint = anyAny
  where
    anyAny tA tB =
      case tA of
        Bin pA lA rA -> binAny (# pA, lA, rA #) tA tB

        Tip kA _ -> tipAny kA tA tB

        Nil -> True

    tipAny kA tA tB =
      case tB of
        Bin pB lB rB -> tipBin kA tA (# pB, lB, rB #)

        Tip kB _ -> kA /= kB

        Nil -> True

    binAny :: forall a b. UBin a -> Patricia a -> Patricia b -> Bool
    binAny uA tA tB =
      case tB of
        Bin pB lB rB -> binBin uA tA (# pB, lB, rB #) tB

        Tip kB _ -> tipBin kB tB uA

        Nil -> True

    tipBin kA tA (# pB, lB, rB #)
      | beyond pB kA = True
      | otherwise    = tipAny kA tA $ if kA < pB
                                        then lB
                                        else rB

    binBin uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =
      case Prelude.compare pA pB of
        EQ                  -> anyAny lA lB && anyAny rA rB

        LT | pB <= upper pA -> binAny uB tB rA
           | pA >= lower pB -> binAny uA tA lB
           | otherwise      -> True

        GT | pA <= upper pB -> binAny uA tA rB
           | pB >= lower pA -> binAny uB tB lA
           | otherwise      -> True



-- | \(\mathcal{O}(n_A + n_B)\).
--   Unbiased intersection of two trees.
intersection :: Patricia a -> Patricia a -> Patricia a
intersection = anyAny
  where
    anyAny tA tB =
      case tA of
        Bin pA lA rA -> binAny (# pA, lA, rA #) tA tB

        Tip kA _ -> tipAny kA tA tB

        Nil -> Nil

    tipAny kA tA tB =
      case tB of
        Bin pB lB rB -> tipBin kA tA (# pB, lB, rB #)

        Tip kB _
          | kA == kB  -> tA
          | otherwise -> Nil

        Nil -> Nil

    binAny uA tA tB =
      case tB of
        Bin pB lB rB -> binBin uA tA (# pB, lB, rB #) tB

        Tip kB _ -> tipBin kB tB uA

        Nil -> Nil

    tipBin kA tA (# pB, lB, rB #)
      | beyond pB kA = Nil
      | otherwise    = tipAny kA tA $ if kA < pB
                                        then lB
                                        else rB

    binBin uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =
      case Prelude.compare pA pB of
        EQ                  -> rebin pA (anyAny lA lB) (anyAny rA rB)

        LT | pB <= upper pA -> binAny uB tB rA
           | pA >= lower pB -> binAny uA tA lB
           | otherwise      -> Nil

        GT | pA <= upper pB -> binAny uA tA rB
           | pB >= lower pA -> binAny uB tB lA
           | otherwise      -> Nil



-- | \(\mathcal{O}(n_A + n_B)\).
--   Left-biased intersection of two trees.
intersectionL :: Patricia a -> Patricia b -> Patricia a
intersectionL =
  intersection_ $ \s k a b ->
    let !(# c #) = case s of
                     L -> (# a #)
                     R -> (# b #)
    in Tip k c

-- | \(\mathcal{O}(n_A + n_B)\).
--   Intersection of two trees with a combining function.
--
--   New values are evaluated to WHNF.
intersectionWith'
  :: (a -> b -> c)
  -> Patricia a
  -> Patricia b
  -> Patricia c
intersectionWith' f =
  intersection_ $ \s k a b ->
    Tip k $! case s of
               L -> f a b
               R -> f b a

-- | \(\mathcal{O}(n_A + n_B)\).
--   Intersection of two trees with a combining function.
--
--   New values are evaluated to WHNF.
intersectionWithKey'
  :: (Word -> a -> b -> c)
  -> Patricia a
  -> Patricia b
  -> Patricia c
intersectionWithKey' f =
  intersection_ $ \s k a b ->
    Tip k $! case s of
               L -> f k a b
               R -> f k b a



{-# INLINE intersection_ #-}
intersection_
  :: (forall x y. S x y a b -> Key -> x -> y -> Patricia c)
  -> Patricia a
  -> Patricia b
  -> Patricia c
intersection_ (f :: forall n o. S n o x y -> Word -> n -> o -> Patricia c) =
  anyAny L
  where
    anyAny
      :: forall a b. S a b x y -> Patricia a -> Patricia b -> Patricia c
    anyAny s tA tB =
      case tA of
        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB

        Tip kA a -> tipAny s (# kA, a #) tA tB

        Nil -> Nil

    tipAny
      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> Patricia c
    tipAny s uA@(# kA, a #) tA tB =
      case tB of
        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #)

        Tip kB b
          | kA == kB  -> f s kA a b
          | otherwise -> Nil

        Nil -> Nil

    binAny
      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> Patricia c
    binAny s uA tA tB =
      case tB of
        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB

        Tip kB b -> let !(# s' #) = other s
                    in tipBin s' (# kB, b #) tB uA

        Nil -> Nil

    tipBin
      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> Patricia c
    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #)
      | beyond pB kA = Nil
      | otherwise    = tipAny s uA tA $ if kA < pB
                                          then lB
                                          else rB

    binBin
      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> Patricia c
    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =
      case Prelude.compare pA pB of
        EQ                  -> rebin pA (anyAny s lA lB) (anyAny s rA rB)

        LT | pB <= upper pA -> let !(# s' #) = other s
                               in binAny s' uB tB rA
           | pA >= lower pB -> binAny s uA tA lB
           | otherwise      -> Nil

        GT | pA <= upper pB -> binAny s uA tA rB
           | pB >= lower pA -> let !(# s' #) = other s
                               in binAny s' uB tB lA
           | otherwise      -> Nil



{-# INLINE merge #-}
-- | \(\mathcal{O}(n_A + n_B)\).
--   General merge of two trees.
--
--   Collision and single value functions __must__ return either
--   'Tip' with the respective key, or 'Nil'.
--
--   Subtree argument functions may return any tree, however the shape of said tree
--   __must__ be compatible with the prefix passed to the function.
--
--   Resulting 'Patricia' trees in argument functions are evaluated to WHNF.
--
--   This functions inlines when all argument functions are provided.
merge
  :: (Key -> a -> b -> Patricia c)                      -- ^ Single value collision
  -> (Key -> a -> Patricia c)                           -- ^ Single left value
  -> (Prefix -> Patricia a -> Patricia a -> Patricia c) -- ^ Left subtree
  -> (Key -> b -> Patricia c)                           -- ^ Single right value
  -> (Prefix -> Patricia b -> Patricia b -> Patricia c) -- ^ Right subtree
  -> Patricia a
  -> Patricia b
  -> Patricia c
merge (f :: Key -> x -> y -> Patricia c) oneX treeX oneY treeY = anyAny L
  where
    {-# INLINE side #-}
    side one tree t =
      case t of
        Bin p l r -> tree p l r
        Tip k a   -> one k a
        Nil       -> Nil

    sideX = side oneX treeX

    sideY = side oneY treeY

    sideA :: forall a b. S a b x y -> Patricia a -> Patricia c
    sideA s tA = case s of
                   L -> sideX tA
                   R -> sideY tA

    sideB :: forall a b. S a b x y -> Patricia b -> Patricia c
    sideB s tB = case s of
                   L -> sideY tB
                   R -> sideX tB

    anyAny
      :: forall a b. S a b x y -> Patricia a -> Patricia b -> Patricia c
    anyAny s tA tB =
      case tA of
        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB

        Tip kA a     -> tipAny s (# kA, a #) tA tB

        Nil          -> sideB s tB

    tipAny
      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> Patricia c
    tipAny s uA@(# kA, a #) tA tB =
      case tB of
        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #)

        Tip kB b
          | kA == kB  -> case s of
                           L -> f kA a b
                           R -> f kA b a

          | otherwise -> case s of
                           L -> safeJoin kA (oneX kA a) kB (sideY tB)
                           R -> safeJoin kA (oneY kA a) kB (sideX tB)

        Nil          -> sideA s tA

    binAny
      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> Patricia c
    binAny s uA tA tB =
      case tB of
        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB

        Tip kB b     -> let !(# s' #) = other s
                        in tipBin s' (# kB, b #) tB uA

        Nil          -> sideA s tA

    tipBin
      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> Patricia c
    tipBin s uA@(# kA, a #) tA (# pB, lB, rB #)
      | beyond pB kA = case s of
                         L -> safeJoin kA (oneX kA a) pB (treeY pB lB rB)
                         R -> safeJoin kA (oneY kA a) pB (treeX pB lB rB)

      | kA < pB      = rebin pB (tipAny s uA tA lB) (sideB s rB)

      | otherwise    = rebin pB (sideB s lB) (tipAny s uA tA rB)

    binBin
      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> Patricia c
    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =
      let {-# NOINLINE no #-}
          no = case s of
                 L -> safeJoin pA (treeX pA lA rA) pB (treeY pB lB rB)
                 R -> safeJoin pA (treeY pA lA rA) pB (treeX pB lB rB)

      in case Prelude.compare pA pB of
           EQ                  -> rebin pA (anyAny s lA lB) (anyAny s rA rB)

           LT | pB <= upper pA -> let !(# s' #) = other s

                                  in rebin pA (sideA s lA) (binAny s' uB tB rA)

              | pA >= lower pB -> rebin pB (binAny s uA tA lB) (sideB s rB)

              | otherwise      -> no

           GT | pA <= upper pB -> rebin pB (sideB s lB) (binAny s uA tA rB)

              | pB >= lower pA -> let !(# s' #) = other s

                                  in rebin pA (binAny s' uB tB lA) (sideA s rA)

              | otherwise      -> no



-- | \(\mathcal{O}(\min(n,W))\).
--   Look up the value at a key in the tree.
lookup :: Word -> Patricia a -> Maybe a
lookup !w = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> Nothing
          | w < p      -> go l
          | otherwise  -> go r

        Tip k a
          | k == w    -> Just a
          | otherwise -> Nothing

        Nil -> Nothing

-- | \(\mathcal{O}(\min(n,W))\).
--   Look up the value at a key in the tree, falling back to the given default value
--   if it does not exist.
find :: a -> Word -> Patricia a -> a
find d !w = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> d
          | w < p      -> go l
          | otherwise  -> go r

        Tip k a
          | k == w    -> a
          | otherwise -> d

        Nil -> d

-- | \(\mathcal{O}(\min(n,W))\).
--   Check whether the value exists at a key in the tree.
member :: Word -> Patricia a -> Bool
member !w = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> False
          | w < p      -> go l
          | otherwise  -> go r

        Tip k _ -> k == w

        Nil -> False

-- 'lookup' that doesn't allocate a 'Maybe'.
takeOne :: Word -> Patricia a -> Patricia a
takeOne !w = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> Nil
          | w < p      -> go l
          | otherwise  -> go r

        Tip k _
          | k == w    -> t
          | otherwise -> Nil

        Nil -> Nil



-- | \(\mathcal{O}(\min(n,W))\).
--   Look up the value at a key in the tree.
dirtyLookup :: Word -> Patricia a -> Maybe a
dirtyLookup !w = go
  where
    go t =
      case t of
        Bin p l r
          | w < p     -> go l
          | otherwise -> go r

        Tip k a
          | k == w    -> Just a
          | otherwise -> Nothing

        Nil -> Nothing

-- | \(\mathcal{O}(\min(n,W))\).
--   Look up the value at a key in the tree, falling back to the default value
--   if it does not exist.
dirtyFind :: a -> Word -> Patricia a -> a
dirtyFind d !w = go
  where
    go t =
      case t of
        Bin p l r
          | w < p     -> go l
          | otherwise -> go r

        Tip k a
          | k == w    -> a
          | otherwise -> d

        Nil -> d

-- | \(\mathcal{O}(\min(n,W))\).
--   Check whether the value exists at a key in the tree.
dirtyMember :: Word -> Patricia a -> Bool
dirtyMember !w = go
  where
    go t =
      case t of
        Bin p l r
          | w < p     -> go l
          | otherwise -> go r

        Tip k _ -> k == w

        Nil -> False



-- | \(\mathcal{O}(\min(n,W))\).
--   Insert a new value in the tree at the given key.
--   If a value already exists at that key, it is replaced.
insert :: Word -> a -> Patricia a -> Patricia a
insert !w a = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> join w (Tip w a) p t
          | w < p      -> Bin p (go l) r
          | otherwise  -> Bin p l (go r)

        Tip k _
          | k == w    -> Tip k a
          | otherwise -> join w (Tip w a) k t

        Nil -> Tip w a



-- | \(\mathcal{O}(\min(n,W))\).
--   Insert a new value in the tree at the given key.
--   If a value already exists at that key, the function is used instead.
insertWith :: (a -> a) -> Word -> a -> Patricia a -> Patricia a
insertWith f !w b = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> join w (Tip w b) p t
          | w < p      -> Bin p (go l) r
          | otherwise  -> Bin p l (go r)

        Tip k a
          | k == w    -> Tip k (f a)
          | otherwise -> join w (Tip w b) k t

        Nil -> Tip w b

-- | \(\mathcal{O}(\min(n,W))\).
--   Insert a new value in the tree at the given key.
--   If a value already exists at that key, the function is used instead.
--
--   New value is evaluted to WHNF.
insertWith' :: (a -> a) -> Word -> a -> Patricia a -> Patricia a
insertWith' f !w b = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> join w (b `seq` Tip w b) p t
          | w < p      -> Bin p (go l) r
          | otherwise  -> Bin p l (go r)

        Tip k a
          | k == w    -> Tip k $! f a
          | otherwise -> join w (b `seq` Tip w b) k t

        Nil -> Tip w b



-- | \(\mathcal{O}(\min(n,W))\).
--   Apply a function to a value in the tree at the given key.
adjust :: (a -> a) -> Word -> Patricia a -> Patricia a
adjust f !w = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> t
          | w < p      -> Bin p (go l) r
          | otherwise  -> Bin p l (go r)

        Tip k a
          | k == w    -> Tip k (f a)
          | otherwise -> t

        Nil -> Nil

-- | \(\mathcal{O}(\min(n,W))\).
--   Apply a function to a value in the tree at the given key.
--
--   New value is evaluated to WHNF.
adjust' :: (a -> a) -> Word -> Patricia a -> Patricia a
adjust' f !w = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> t
          | w < p      -> Bin p (go l) r
          | otherwise  -> Bin p l (go r)

        Tip k a
          | k == w    -> Tip k $! f a
          | otherwise -> t

        Nil -> Nil



-- | \(\mathcal{O}(\min(n,W))\).
--   Delete a value in the tree at the given key.
delete :: Word -> Patricia a -> Patricia a
delete !w = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> t
          | w < p      -> rebinL p (go l) r
          | otherwise  -> rebinR p l (go r)

        Tip k _
          | k == w    -> Nil
          | otherwise -> t

        Nil -> Nil

-- | \(\mathcal{O}(\min(n,W))\).
--   Update or delete a value in the tree at the given key.
--
--   The 'Maybe' is evaluated to WHNF.
update :: (a -> Maybe a) -> Word -> Patricia a -> Patricia a
update f !w = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> t
          | w < p      -> rebinL p (go l) r
          | otherwise  -> rebinR p l (go r)

        Tip k a
          | k == w    -> retip k (f a)
          | otherwise -> t

        Nil -> Nil



-- | \(\mathcal{O}(\min(n,W))\).
--   Insert, update or delete a value in the tree at the given key.
--
--   The resulting 'Maybe' is evaluated to WHNF.
alter :: (Maybe a -> Maybe a) -> Word -> Patricia a -> Patricia a
alter f !w = go
  where
    go t =
      case t of
        Bin p l r
          | beyond p w -> case f Nothing of
                            Just b  -> join p t w (Tip w b)
                            Nothing -> t

          | w < p      -> rebinL p (go l) r
          | otherwise  -> rebinR p l (go r)

        Tip k a
          | k == w    -> case f (Just a) of
                           Just b  -> Tip k b
                           Nothing -> Nil

          | otherwise -> case f Nothing of
                           Just b  -> join k t w (Tip w b)
                           Nothing -> t

        Nil -> case f Nothing of
                 Just b  -> Tip w b
                 Nothing -> Nil



-- | \(\mathcal{O}(\min(n,W))\).
--   Look up a value at a largest key smaller than or equal to the given key.
lookupL :: Word -> Patricia a -> Maybe (Lookup a)
lookupL !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then go l
                   else Nothing

            else Just $! if w <= upper p
                           then case go r of
                                  Just x  -> x
                                  Nothing -> unsafeLookupMaxWithKey l

                           else unsafeLookupMaxWithKey r

        Tip k a
          | k <= w    -> Just $! Lookup k a
          | otherwise -> Nothing

        Nil -> Nothing

-- | \(\mathcal{O}(\min(n,W))\).
--   Look up a value at a smallest key greater than or equal to the given key.
lookupR :: Word -> Patricia a -> Maybe (Lookup a)
lookupR !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then Just $! if w >= lower p
                           then case go l of
                                  Just x  -> x
                                  Nothing -> unsafeLookupMinWithKey r

                           else unsafeLookupMinWithKey l

            else if w <= upper p
                   then go r
                   else Nothing

        Tip k a
          | k >= w    -> Just $! Lookup k a
          | otherwise -> Nothing

        Nil -> Nothing



-- | \(\mathcal{O}(\min(n,W) + n_L)\).
--   Apply a function to every value for which the key is smaller than
--   or equal to the given one.
adjustL :: (a -> a) -> Word -> Patricia a -> Patricia a
adjustL f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then Bin p (go l) r
                   else t

            else Bin p (Data.Patricia.Word.Strict.Internal.map f l) $
                   if w <= upper p
                     then go r
                     else Data.Patricia.Word.Strict.Internal.map f r

        Tip k a
          | k <= w    -> Tip k (f a)
          | otherwise -> t

        Nil         -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_L)\).
--   Apply a function to every value for which the key is smaller than
--   or equal to the given one.
--
--   New value is evaluated to WHNF.
adjustL' :: (a -> a) -> Word -> Patricia a -> Patricia a
adjustL' f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then Bin p (go l) r
                   else t

            else Bin p (map' f l) $
                   if w <= upper p
                     then go r
                     else map' f r

        Tip k a
          | k <= w    -> Tip k $! f a
          | otherwise -> t

        Nil         -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_L)\).
--   Apply a function to every value for which the key is smaller than
--   or equal to the given one.
adjustLWithKey :: (Word -> a -> a) -> Word -> Patricia a -> Patricia a
adjustLWithKey f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then Bin p (go l) r
                   else t

            else Bin p (mapWithKey f l) $
                   if w <= upper p
                     then go r
                     else mapWithKey f r

        Tip k a
          | k <= w    -> Tip k (f k a)
          | otherwise -> t

        Nil         -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_L)\).
--   Apply a function to every value for which the key is smaller than
--   or equal to the given one.
--
--   New value is evaluated to WHNF.
adjustLWithKey' :: (Word -> a -> a) -> Word -> Patricia a -> Patricia a
adjustLWithKey' f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then Bin p (go l) r
                   else t

            else Bin p (mapWithKey' f l) $
                   if w <= upper p
                     then go r
                     else mapWithKey' f r

        Tip k a
          | k <= w    -> Tip k $! f k a
          | otherwise -> t

        Nil         -> Nil


-- | \(\mathcal{O}(\min(n,W))\).
--   Delete values for which keys are smaller than or equal to the given one.
deleteL :: Word -> Patricia a -> Patricia a
deleteL !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then rebinL p (go l) r
                   else t

            else if w <= upper p
                   then go r
                   else Nil

        Tip k _
          | k <= w    -> Nil
          | otherwise -> t

        Nil         -> Nil


-- | \(\mathcal{O}(\min(n,W) + n_L)\).
--   Update every value for which the key is smaller than or equal to the given one.
--
--   The 'Maybe' is evaluated to WHNF.
updateL :: (a -> Maybe a) -> Word -> Patricia a -> Patricia a
updateL f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then rebinL p (go l) r
                   else t

            else rebin p (mapMaybe f l) $
                   if w <= upper p
                     then go r
                     else mapMaybe f r

        Tip k a
          | k <= w    -> retip k (f a)
          | otherwise -> t

        Nil         -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_L)\).
--   Update every value for which the key is smaller than or equal to the given one.
--
--   The 'Maybe' is evaluated to WHNF.
updateLWithKey :: (Word -> a -> Maybe a) -> Word -> Patricia a -> Patricia a
updateLWithKey f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then rebinL p (go l) r
                   else t

            else rebin p (mapMaybeWithKey f l) $
                   if w <= upper p
                     then go r
                     else mapMaybeWithKey f r

        Tip k a
          | k <= w    -> retip k (f k a)
          | otherwise -> t

        Nil         -> Nil


-- | \(\mathcal{O}(\min(n,W))\).
--   Take values for which keys are smaller than or equal to the given one.
takeL :: Word -> Patricia a -> Patricia a
takeL !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then go l
                   else Nil

            else if w <= upper p
                   then rebinR p l (go r)
                   else t

        Tip k _
          | k <= w    -> t
          | otherwise -> Nil

        Nil -> Nil



-- | \(\mathcal{O}(\min(n,W) + n_R)\).
--   Apply a function to every value for which the key is greater than
--   or equal to the given one.
adjustR :: (a -> a) -> Word -> Patricia a -> Patricia a
adjustR f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then let l' = if w >= lower p
                            then go l
                            else Data.Patricia.Word.Strict.Internal.map f l

                 in Bin p l' (Data.Patricia.Word.Strict.Internal.map f r)

            else if w <= upper p
                   then Bin p l (go r)
                   else t

        Tip k a
          | k >= w    -> Tip k (f a)
          | otherwise -> t

        Nil         -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_R)\).
--   Apply a function to every value for which the key is greater than
--   or equal to the given one.
--
--   New value is evaluated to WHNF.
adjustR' :: (a -> a) -> Word -> Patricia a -> Patricia a
adjustR' f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then let l' = if w >= lower p
                            then go l
                            else map' f l

                 in Bin p l' (map' f r)

            else if w <= upper p
                   then Bin p l (go r)
                   else t

        Tip k a
          | k >= w    -> Tip k $! f a
          | otherwise -> t

        Nil         -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_R)\).
--   Apply a function to every value for which the key is greater than
--   or equal to the given one.
adjustRWithKey :: (Word -> a -> a) -> Word -> Patricia a -> Patricia a
adjustRWithKey f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then let l' = if w >= lower p
                            then go l
                            else mapWithKey f l

                 in Bin p l' (mapWithKey f r)

            else if w <= upper p
                   then Bin p l (go r)
                   else t

        Tip k a
          | k >= w    -> Tip k (f k a)
          | otherwise -> t

        Nil         -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_R)\).
--   Apply a function to every value for which the key is greater than
--   or equal to the given one.
--
--   New value is evaluated to WHNF.
adjustRWithKey' :: (Word -> a -> a) -> Word -> Patricia a -> Patricia a
adjustRWithKey' f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then let l' = if w >= lower p
                            then go l
                            else mapWithKey' f l

                 in Bin p l' (mapWithKey' f r)

            else if w <= upper p
                   then Bin p l (go r)
                   else t

        Tip k a
          | k >= w    -> Tip k $! f k a
          | otherwise -> t

        Nil         -> Nil


-- | \(\mathcal{O}(\min(n,W))\).
--   Delete values for which keys are greater than or equal to the given one.
deleteR :: Word -> Patricia a -> Patricia a
deleteR !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then go l
                   else Nil

            else if w <= upper p
                   then rebinR p l (go r)
                   else t

        Tip k _
          | k >= w    -> Nil
          | otherwise -> t

        Nil         -> Nil


-- | \(\mathcal{O}(\min(n,W) + n_R)\).
--   Update every value for which the key is greater than or equal to the given one.
--
--   The 'Maybe' is evaluated to WHNF.
updateR :: (a -> Maybe a) -> Word -> Patricia a -> Patricia a
updateR f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then let l' = if w >= lower p
                            then go l
                            else mapMaybe f l

                 in rebin p l' (mapMaybe f r)

            else if w <= upper p
                   then rebinR p l (go r)
                   else t

        Tip k a
          | k >= w    -> retip k (f a)
          | otherwise -> t

        Nil         -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_R)\).
--   Update every value for which the key is greater than or equal to the given one.
--
--   The 'Maybe' is evaluated to WHNF.
updateRWithKey :: (Word -> a -> Maybe a) -> Word -> Patricia a -> Patricia a
updateRWithKey f !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then let l' = if w >= lower p
                            then go l
                            else mapMaybeWithKey f l

                 in rebin p l' (mapMaybeWithKey f r)

            else if w <= upper p
                   then rebinR p l (go r)
                   else t

        Tip k a
          | k >= w    -> retip k (f k a)
          | otherwise -> t

        Nil         -> Nil


-- | \(\mathcal{O}(\min(n,W))\).
--   Take values for which keys are greater than or equal to the given one.
takeR :: Word -> Patricia a -> Patricia a
takeR !w = go
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then rebinL p (go l) r
                   else t

            else if w <= upper p
                   then go r
                   else Nil

        Tip k _
          | k >= w    -> t
          | otherwise -> Nil

        Nil -> Nil



-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Apply a function to every value for which the key is in the given range.
adjustRange :: (a -> a) -> Range -> Patricia a -> Patricia a
adjustRange f (UnsafeRange kL kR)
  | kL == kR  = adjust f kL
  | otherwise = unsafeAdjustRange f kL kR

-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Apply a function to every value for which the key is in the given range.
--
--   \(k_R\) __must__ be greater than \(k_L\).
unsafeAdjustRange
  :: (a -> a)
  -> Word     -- ^ \(k_L\)
  -> Word     -- ^ \(k_R\)
  -> Patricia a
  -> Patricia a
unsafeAdjustRange f !wL !wR = go
  where
    !mM = branchingBit wL wR

    !pM = mask wL mM .|. mM

    go t =
      case t of
        Bin p l r ->
          case Prelude.compare p pM of
            EQ                 -> Bin p (adjustR f wL l) (adjustL f wR r)

            LT | pM <= upper p -> Bin p l (go r)
               | p >= lower pM -> if wL < p
                                    then Bin p
                                           (adjustR f wL l)
                                           (Data.Patricia.Word.Strict.Internal.map f r)

                                    else Bin p l (adjustR f wL r)

               | otherwise     -> t

            GT | p <= upper pM -> if wR >= p
                                    then Bin p
                                           (Data.Patricia.Word.Strict.Internal.map f l)
                                           (adjustL f wR r)

                                    else Bin p (adjustL f wR l) r

               | pM >= lower p -> Bin p (go l) r
               | otherwise     -> t

        Tip k a
          | k >= wL && k <= wR -> Tip k (f a)
          | otherwise          -> t

        Nil -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Apply a function to every value for which the key is in the given range.
--
--   New value is evaluated to WHNF.
adjustRange' :: (a -> a) -> Range -> Patricia a -> Patricia a
adjustRange' f (UnsafeRange kL kR)
  | kL == kR  = adjust' f kL
  | otherwise = unsafeAdjustRange' f kL kR

-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Apply a function to every value for which the key is in the given range.
--
--   New value is evaluated to WHNF.
--
--   \(k_R\) __must__ be greater than \(k_L\).
unsafeAdjustRange'
  :: (a -> a)
  -> Word     -- ^ \(k_L\)
  -> Word     -- ^ \(k_R\)
  -> Patricia a
  -> Patricia a
unsafeAdjustRange' f !wL !wR = go
  where
    !mM = branchingBit wL wR

    !pM = mask wL mM .|. mM

    go t =
      case t of
        Bin p l r ->
          case Prelude.compare p pM of
            EQ                 -> Bin p (adjustR' f wL l) (adjustL' f wR r)

            LT | pM <= upper p -> Bin p l (go r)
               | p >= lower pM -> if wL < p
                                    then Bin p (adjustR' f wL l) (map' f r)
                                    else Bin p l (adjustR' f wL r)

               | otherwise     -> t

            GT | p <= upper pM -> if wR >= p
                                    then Bin p (map' f l) (adjustL' f wR r)
                                    else Bin p (adjustL' f wR l) r

               | pM >= lower p -> Bin p (go l) r
               | otherwise     -> t

        Tip k a
          | k >= wL && k <= wR -> Tip k $! f a
          | otherwise          -> t

        Nil -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Apply a function to every value for which the key is in the given range.
adjustRangeWithKey :: (Word -> a -> a) -> Range -> Patricia a -> Patricia a
adjustRangeWithKey f (UnsafeRange kL kR)
  | kL == kR  = adjust (f kL) kL
  | otherwise = unsafeAdjustRangeWithKey f kL kR

-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Apply a function to every value for which the key is in the given range.
--
--   \(k_R\) __must__ be greater than \(k_L\).
unsafeAdjustRangeWithKey
  :: (Word -> a -> a)
  -> Word             -- ^ \(k_L\)
  -> Word             -- ^ \(k_R\)
  -> Patricia a
  -> Patricia a
unsafeAdjustRangeWithKey f !wL !wR = go
  where
    !mM = branchingBit wL wR

    !pM = mask wL mM .|. mM

    go t =
      case t of
        Bin p l r ->
          case Prelude.compare p pM of
            EQ                 -> Bin p (adjustRWithKey f wL l) (adjustLWithKey f wR r)

            LT | pM <= upper p -> Bin p l (go r)
               | p >= lower pM -> if wL < p
                                    then Bin p (adjustRWithKey f wL l) (mapWithKey f r)
                                    else Bin p l (adjustRWithKey f wL r)

               | otherwise     -> t

            GT | p <= upper pM -> if wR >= p
                                    then Bin p (mapWithKey f l) (adjustLWithKey f wR r)
                                    else Bin p (adjustLWithKey f wR l) r

               | pM >= lower p -> Bin p (go l) r
               | otherwise     -> t

        Tip k a
          | k >= wL && k <= wR -> Tip k (f k a)
          | otherwise          -> t

        Nil -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Apply a function to every value for which the key is in the given range.
--
--   New value is evaluated to WHNF.
adjustRangeWithKey' :: (Word -> a -> a) -> Range -> Patricia a -> Patricia a
adjustRangeWithKey' f (UnsafeRange kL kR)
  | kL == kR  = adjust' (f kL) kL
  | otherwise = unsafeAdjustRangeWithKey' f kL kR

-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Apply a function to every value for which the key is in the given range.
--
--   New value is evaluated to WHNF.
--
--   \(k_R\) __must__ be greater than \(k_L\).
unsafeAdjustRangeWithKey'
  :: (Word -> a -> a)
  -> Word             -- ^ \(k_L\)
  -> Word             -- ^ \(k_R\)
  -> Patricia a
  -> Patricia a
unsafeAdjustRangeWithKey' f !wL !wR = go
  where
    !mM = branchingBit wL wR

    !pM = mask wL mM .|. mM

    go t =
      case t of
        Bin p l r ->
          case Prelude.compare p pM of
            EQ                 -> Bin p (adjustRWithKey' f wL l) (adjustLWithKey' f wR r)

            LT | pM <= upper p -> Bin p l (go r)
               | p >= lower pM -> if wL < p
                                    then Bin p (adjustRWithKey' f wL l) (mapWithKey' f r)
                                    else Bin p l (adjustRWithKey' f wL r)

               | otherwise     -> t

            GT | p <= upper pM -> if wR >= p
                                    then Bin p (mapWithKey' f l) (adjustLWithKey' f wR r)
                                    else Bin p (adjustLWithKey' f wR l) r

               | pM >= lower p -> Bin p (go l) r
               | otherwise     -> t

        Tip k a
          | k >= wL && k <= wR -> Tip k $! f k a
          | otherwise          -> t

        Nil -> Nil


-- | \(\mathcal{O}(\min(n,W))\).
--   Delete values for which keys are in the given range.
deleteRange :: Range -> Patricia a -> Patricia a
deleteRange (UnsafeRange kL kR)
  | kL == kR  = delete kL
  | otherwise = unsafeDeleteRange kL kR

-- | \(\mathcal{O}(\min(n,W))\).
--   Delete values for which keys are in the given range.
--
--   \(k_R\) __must__ be greater than \(k_L\).
unsafeDeleteRange
  :: Word         -- ^ \(k_L\)
  -> Word         -- ^ \(k_R\)
  -> Patricia a
  -> Patricia a
unsafeDeleteRange !wL !wR = go
  where
    !mM = branchingBit wL wR

    !pM = mask wL mM .|. mM

    go t =
      case t of
        Bin p l r ->
          case Prelude.compare p pM of
            EQ                 -> rebin p (deleteR wL l) (deleteL wR r)

            LT | pM <= upper p -> rebinR p l (go r)
               | p >= lower pM -> if wL < p
                                    then deleteR wL l
                                    else rebinR p l (deleteR wL r)
               | otherwise     -> t

            GT | p <= upper pM -> if wR >= p
                                    then deleteL wR r
                                    else rebinL p (deleteL wR l) r

               | pM >= lower p -> rebinL p (go l) r
               | otherwise     -> t

        Tip k _
          | k >= wL && k <= wR -> Nil
          | otherwise          -> t

        Nil -> Nil


-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Update every value for which the key is in the given range.
--
--   The 'Maybe' is evaluated to WHNF.
updateRange :: (a -> Maybe a) -> Range -> Patricia a -> Patricia a
updateRange f (UnsafeRange kL kR)
  | kL == kR  = update f kL
  | otherwise = unsafeUpdateRange f kL kR

-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Update every value for which the key is in the given range.
--
--   The 'Maybe' is evaluated to WHNF.
--
--   \(k_R\) __must__ be greater than \(k_L\).
unsafeUpdateRange
  :: (a -> Maybe a)
  -> Word           -- ^ \(k_L\)
  -> Word           -- ^ \(k_R\)
  -> Patricia a
  -> Patricia a
unsafeUpdateRange f !wL !wR = go
  where
    !mM = branchingBit wL wR

    !pM = mask wL mM .|. mM

    go t =
      case t of
        Bin p l r ->
          case Prelude.compare p pM of
            EQ                 -> rebin p (updateR f wL l) (updateL f wR r)

            LT | pM <= upper p -> rebinR p l (go r)
               | p >= lower pM -> if wL < p
                                    then rebinL p (updateR f wL l) (mapMaybe f r)
                                    else rebinR p l (updateR f wL r)
               | otherwise     -> t

            GT | p <= upper pM -> if wR >= p
                                    then rebinR p (mapMaybe f l) (updateL f wR r)
                                    else rebinL p (updateL f wR l) r

               | pM >= lower p -> rebinL p (go l) r
               | otherwise     -> t

        Tip k a
          | k >= wL && k <= wR -> retip k (f a)
          | otherwise          -> t

        Nil -> Nil

-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Update every value for which the key is in the given range.
--
--   The 'Maybe' is evaluated to WHNF.
updateRangeWithKey :: (Word -> a -> Maybe a) -> Range -> Patricia a -> Patricia a
updateRangeWithKey f (UnsafeRange kL kR)
  | kL == kR  = update (f kL) kL
  | otherwise = unsafeUpdateRangeWithKey f kL kR

-- | \(\mathcal{O}(\min(n,W) + n_I)\).
--   Update every value for which the key is in the given range.
--
--   The 'Maybe' is evaluated to WHNF.
--
--   \(k_R\) __must__ be greater than \(k_L\).
unsafeUpdateRangeWithKey
  :: (Word -> a -> Maybe a)
  -> Word                   -- ^ \(k_L\)
  -> Word                   -- ^ \(k_R\)
  -> Patricia a
  -> Patricia a
unsafeUpdateRangeWithKey f !wL !wR = go
  where
    !mM = branchingBit wL wR

    !pM = mask wL mM .|. mM

    go t =
      case t of
        Bin p l r ->
          case Prelude.compare p pM of
            EQ                 -> rebin p (updateRWithKey f wL l) (updateLWithKey f wR r)

            LT | pM <= upper p -> rebinR p l (go r)
               | p >= lower pM -> if wL < p
                                    then rebinL p (updateRWithKey f wL l)
                                                  (mapMaybeWithKey f r)

                                    else rebinR p l (updateRWithKey f wL r)
               | otherwise     -> t

            GT | p <= upper pM -> if wR >= p
                                    then rebinR p (mapMaybeWithKey f l)
                                                  (updateLWithKey f wR r)

                                    else rebinL p (updateLWithKey f wR l) r

               | pM >= lower p -> rebinL p (go l) r
               | otherwise     -> t

        Tip k a
          | k >= wL && k <= wR -> retip k (f k a)
          | otherwise          -> t

        Nil -> Nil



-- | \(\mathcal{O}(\min(n,W))\).
--   Take values for which keys are in the given range.
takeRange :: Range -> Patricia a -> Patricia a
takeRange (UnsafeRange kL kR)
  | kL == kR  = takeOne kL
  | otherwise = unsafeTakeRange kL kR

-- | \(\mathcal{O}(\min(n,W))\).
--   Take values for which keys are in the given range.
--
--   \(k_R\) __must__ be greater than \(k_L\).
unsafeTakeRange
  :: Word       -- ^ \(k_L\)
  -> Word       -- ^ \(k_R\)
  -> Patricia a
  -> Patricia a
unsafeTakeRange !wL !wR = go
  where
    !mM = branchingBit wL wR

    !pM = mask wL mM .|. mM

    go t =
      case t of
        Bin p l r ->
          case Prelude.compare p pM of
            EQ                 -> rebin p (takeR wL l) (takeL wR r)

            LT | pM <= upper p -> go r
               | p >= lower pM -> if wL < p
                                    then rebinL p (takeR wL l) r
                                    else takeR wL r

               | otherwise     -> Nil

            GT | p <= upper pM -> if wR >= p
                                    then rebinR p l (takeL wR r)
                                    else takeL wR l

               | pM >= lower p -> go l
               | otherwise     -> Nil

        Tip k _
          | k >= wL && k <= wR -> t
          | otherwise          -> Nil

        Nil -> Nil



-- | Result of a tree split.
data Split l r = Split !(Patricia l) !(Patricia r)
                 deriving Show

-- | \(\mathcal{O}(\min(n,W))\).
--   Split the tree into two, such that
--   values with keys smaller than or equal to the given one are on the left,
--   and values with keys greater than the given one are on the right.
splitL :: Word -> Patricia a -> Split a a
splitL !w = \t ->
  case go t of
    (# !l, !r #) -> Split l r
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then let !(# !ll, !lr #) = go l
                        in (# ll, rebinL p lr r #)

                   else (# Nil, t #)

            else if w <= upper p
                   then let !(# !rl, !rr #) = go r
                        in (# rebinR p l rl, rr #)

                   else (# t, Nil #)

        Tip k _
          | w >= k    -> (# t, Nil #)
          | otherwise -> (# Nil, t #)

        Nil -> (# Nil, Nil #)

-- | \(\mathcal{O}(\min(n,W))\).
--   Split the tree into two, such that
--   values with keys smaller than the given one are on the left,
--   and values with keys greater than or equal to the given one are on the right.
splitR :: Word -> Patricia a -> Split a a
splitR !w = \t ->
  case go t of
    (# !l, !r #) -> Split l r
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then let !(# !ll, !lr #) = go l
                        in (# ll, rebinL p lr r #)

                   else (# Nil, t #)

            else if w <= upper p
                   then let !(# !rl, !rr #) = go r
                        in (# rebinR p l rl, rr #)

                   else (# t, Nil #)

        Tip k _
          | w > k     -> (# t, Nil #)
          | otherwise -> (# Nil, t #)

        Nil -> (# Nil, Nil #)



-- | Result of a tree split with a lookup.
data SplitLookup l x r = SplitLookup !(Patricia l) !(Maybe x) !(Patricia r)
                         deriving Show

-- | \(\mathcal{O}(\min(n,W))\).
--   Split the tree into two, such that
--   values with keys smaller than the given one are on the left,
--   values with keys greater than the given one are on the right,
--   and the value at the given key is returned separately.
splitLookup :: Word -> Patricia a -> SplitLookup a a a
splitLookup !w = \t ->
  case go t of
    (# !l, !mx, !r #) -> SplitLookup l mx r
  where
    go t =
      case t of
        Bin p l r ->
          if w < p
            then if w >= lower p
                   then let !(# !ll, !mx, !lr #) = go l
                        in (# ll, mx, rebinL p lr r #)

                   else (# Nil, Nothing, t #)

            else if w <= upper p
                   then let !(# !rl, !mx, !rr #) = go r
                        in (# rebinR p l rl, mx, rr #)

                   else (# t, Nothing, Nil #)

        Tip k a ->
          case w `Prelude.compare` k of
            EQ -> (# Nil, Just a , Nil #)
            GT -> (# t  , Nothing, Nil #)
            LT -> (# Nil, Nothing, t   #)

        Nil -> (# Nil, Nothing, Nil #)



-- | \(\mathcal{O}(n)\).
--   Filter values that satisfy the value predicate.
filter :: (a -> Bool) -> Patricia a -> Patricia a
filter f = go
  where
    go t =
      case t of
        Bin p l r -> rebin p (go l) (go r)

        Tip _ a
          | f a       -> t
          | otherwise -> Nil

        Nil -> Nil

-- | \(\mathcal{O}(n)\).
--   Filter values that satisfy the value predicate.
filterWithKey :: (Word -> a -> Bool) -> Patricia a -> Patricia a
filterWithKey f = go
  where
    go t =
      case t of
        Bin p l r -> rebin p (go l) (go r)

        Tip k a
          | f k a     -> t
          | otherwise -> Nil

        Nil -> Nil



-- | \(\mathcal{O}(n)\).
--   Apply a function to every value in the tree and create one out of 'Just' values.
--
--   The 'Maybe' is evaluated to WHNF.
mapMaybe :: (a -> Maybe b) -> Patricia a -> Patricia b
mapMaybe f = go
  where
    go t =
      case t of
        Bin p l r -> rebin p (go l) (go r)

        Tip k a ->
          case f a of
            Just b  -> Tip k b
            Nothing -> Nil

        Nil -> Nil

-- | \(\mathcal{O}(n)\).
--   Apply a function to every value in the tree
--   and create a tree out of 'Just' results.
--
--   The 'Maybe' is evaluated to WHNF.
mapMaybeWithKey :: (Word -> a -> Maybe b) -> Patricia a -> Patricia b
mapMaybeWithKey f = go
  where
    go t =
      case t of
        Bin p l r -> rebin p (go l) (go r)

        Tip k a ->
          case f k a of
            Just b  -> Tip k b
            Nothing -> Nil

        Nil -> Nil



-- | \(\mathcal{O}(n)\).
--   Split the tree into two, such that values that satisfy the predicate
--   are on the left and values that do not are on the right.
partition :: (a -> Bool) -> Patricia a -> Split a a
partition f = \t ->
  case go t of
    (# !l, !r #) -> Split l r
  where
    go t =
      case t of
        Bin p l r ->
          let !(# !ll, !lr #) = go l
              !(# !rl, !rr #) = go r

          in (# rebin p ll rl, rebin p lr rr #)

        Tip _ a
          | f a       -> (# t, Nil #)
          | otherwise -> (# Nil, t #)

        Nil -> (# Nil, Nil #)

-- | \(\mathcal{O}(n)\).
--   Split the tree into two, such that values that satisfy the predicate
--   are on the left and values that do not are on the right.
partitionWithKey :: (Word -> a -> Bool) -> Patricia a -> Split a a
partitionWithKey f = \t ->
  case go t of
    (# !l, !r #) -> Split l r
  where
    go t =
      case t of
        Bin p l r ->
          let !(# !ll, !lr #) = go l
              !(# !rl, !rr #) = go r

          in (# rebin p ll rl, rebin p lr rr #)

        Tip k a
          | f k a     -> (# t, Nil #)
          | otherwise -> (# Nil, t #)

        Nil -> (# Nil, Nil #)


-- | \(\mathcal{O}(n)\).
--   Apply a function to every value in the tree and create two trees,
--   one out of 'Left' results and one out of 'Right' ones.
--
--   The 'Either' is evaluated to WHNF.
mapEither :: (a -> Either b c) -> Patricia a -> Split b c
mapEither f = \t ->
  case go t of
    (# !l, !r #) -> Split l r
  where
    go t =
      case t of
        Bin p l r ->
          let !(# !ll, !lr #) = go l
              !(# !rl, !rr #) = go r

          in (# rebin p ll rl, rebin p lr rr #)

        Tip k a ->
          case f a of
            Left b  -> (# Tip k b, Nil #)
            Right c -> (# Nil, Tip k c #)

        Nil -> (# Nil, Nil #)

-- | \(\mathcal{O}(n)\).
--   Apply a function to every value in the tree and create two trees,
--   one out of 'Left' results and one out of 'Right' ones.
--
--   The 'Either' is evaluated to WHNF.
mapEitherWithKey :: (Word -> a -> Either b c) -> Patricia a -> Split b c
mapEitherWithKey f = \t ->
  case go t of
    (# !l, !r #) -> Split l r
  where
    go t =
      case t of
        Bin p l r ->
          let !(# !ll, !lr #) = go l
              !(# !rl, !rr #) = go r

          in (# rebin p ll rl, rebin p lr rr #)

        Tip k a ->
          case f k a of
            Left b  -> (# Tip k b, Nil #)
            Right c -> (# Nil, Tip k c #)

        Nil -> (# Nil, Nil #)



moduleLoc :: String
moduleLoc = "Patricia.Word.Strict"



-- | \(\mathcal{O}(\min(n,W))\).
--   Look up a value at the leftmost key in the tree.
lookupMin :: Patricia a -> Maybe a
lookupMin Nil = Nothing
lookupMin t   = let !(# a #) = unsafeLookupMin t
                in Just a

-- | \(\mathcal{O}(\min(n,W))\).
--   Look up a value at the leftmost key in the tree.
--
--   Throws 'MalformedTree' if the tree is empty.
unsafeLookupMin :: Patricia a -> (# a #)
unsafeLookupMin t =
  case t of
    Bin _ l _ -> unsafeLookupMin l
    Tip _ a   -> (# a #)
    Nil       -> throw $ MalformedTree moduleLoc "lookupMin"


-- | \(\mathcal{O}(\min(n,W))\).
--   Look up a value at the leftmost key in the tree.
lookupMinWithKey :: Patricia a -> Maybe (Lookup a)
lookupMinWithKey Nil = Nothing
lookupMinWithKey t   = Just $! unsafeLookupMinWithKey t

-- | \(\mathcal{O}(\min(n,W))\).
--   Look up a value at the leftmost key in the tree.
--
--   Throws 'MalformedTree' if the tree is empty.
unsafeLookupMinWithKey :: Patricia a -> Lookup a
unsafeLookupMinWithKey t =
  case t of
    Bin _ l _ -> unsafeLookupMinWithKey l
    Tip k a   -> Lookup k a
    Nil       -> throw $ MalformedTree moduleLoc "lookupMinWithKey"



-- | \(\mathcal{O}(\min(n,W))\).
--   Look up a value at the rightmost key in the tree.
lookupMax :: Patricia a -> Maybe a
lookupMax Nil = Nothing
lookupMax t   = let !(# a #) = unsafeLookupMax t
                in Just a

-- | \(\mathcal{O}(\min(n,W))\).
--   Look up a value at the rightmost key in the tree.
--
--   Throws 'MalformedTree' if the tree is empty.
unsafeLookupMax :: Patricia a -> (# a #)
unsafeLookupMax t =
  case t of
    Bin _ _ r -> unsafeLookupMax r
    Tip _ a   -> (# a #)
    Nil       -> throw $ MalformedTree moduleLoc "lookupMax"


-- | \(\mathcal{O}(\min(n,W))\).
--   Look up a value at the rightmost key in the tree.
lookupMaxWithKey :: Patricia a -> Maybe (Lookup a)
lookupMaxWithKey Nil = Nothing
lookupMaxWithKey t   = Just $! unsafeLookupMaxWithKey t

-- | \(\mathcal{O}(\min(n,W))\).
--   Look up a value at the rightmost key in the tree.
--
--   Throws 'MalformedTree' if the tree is empty.
unsafeLookupMaxWithKey :: Patricia a -> Lookup a
unsafeLookupMaxWithKey t =
  case t of
    Bin _ _ r -> unsafeLookupMaxWithKey r
    Tip k a   -> Lookup k a
    Nil       -> throw $ MalformedTree moduleLoc "lookupMaxWithKey"



-- | \(\mathcal{O}(\min(n,W))\).
--   Delete a value at the leftmost key in the tree.
deleteMin :: Patricia a -> Patricia a
deleteMin = go
  where
    go t =
      case t of
        Bin p l r -> rebinL p (go l) r
        _         -> Nil

-- | \(\mathcal{O}(\min(n,W))\).
--   Delete a value at the rightmost key in the tree.
deleteMax :: Patricia a -> Patricia a
deleteMax = go
  where
    go t =
      case t of
        Bin p l r -> rebinR p l (go r)
        _         -> Nil



-- | \(\mathcal{O}(\min(n,W))\).
--   Update a value at the leftmost key in the tree.
adjustMin :: (a -> a) -> Patricia a -> Patricia a
adjustMin f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p (go l) r
        Tip k a   -> Tip k (f a)
        Nil       -> Nil

-- | \(\mathcal{O}(\min(n,W))\).
--   Update a value at the leftmost key in the tree.
--
--   New value is evaluated to WHNF.
adjustMin' :: (a -> a) -> Patricia a -> Patricia a
adjustMin' f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p (go l) r
        Tip k a   -> Tip k $! f a
        Nil       -> Nil


-- | \(\mathcal{O}(\min(n,W))\).
--   Update a value at the leftmost key in the tree.
adjustMinWithKey :: (Word -> a -> a) -> Patricia a -> Patricia a
adjustMinWithKey f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p (go l) r
        Tip k a   -> Tip k (f k a)
        Nil       -> Nil

-- | \(\mathcal{O}(\min(n,W))\).
--   Update a value at the leftmost key in the tree.
--
--   New value is evaluated to WHNF.
adjustMinWithKey' :: (Word -> a -> a) -> Patricia a -> Patricia a
adjustMinWithKey' f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p (go l) r
        Tip k a   -> Tip k $! f k a
        Nil       -> Nil


-- | \(\mathcal{O}(\min(n,W))\).
--   Update a value at the rightmost key in the tree.
adjustMax :: (a -> a) -> Patricia a -> Patricia a
adjustMax f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p l (go r)
        Tip k a   -> Tip k (f a)
        Nil       -> Nil

-- | \(\mathcal{O}(\min(n,W))\).
--   Update a value at the rightmost key in the tree.
--
--   New value is evaluated to WHNF.
adjustMax' :: (a -> a) -> Patricia a -> Patricia a
adjustMax' f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p l (go r)
        Tip k a   -> Tip k $! f a
        Nil       -> Nil

-- | \(\mathcal{O}(\min(n,W))\).
--   Update a value at the rightmost key in the tree.
adjustMaxWithKey :: (Word -> a -> a) -> Patricia a -> Patricia a
adjustMaxWithKey f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p l (go r)
        Tip k a   -> Tip k (f k a)
        Nil       -> Nil

-- | \(\mathcal{O}(\min(n,W))\).
--   Update a value at the rightmost key in the tree.
--
--   New value is evaluated to WHNF.
adjustMaxWithKey' :: (Word -> a -> a) -> Patricia a -> Patricia a
adjustMaxWithKey' f = go
  where
    go t =
      case t of
        Bin p l r -> Bin p l (go r)
        Tip k a   -> Tip k $! f k a
        Nil       -> Nil



-- | \(\mathcal{O}(\min(n,W))\).
--   Update or delete a value at the leftmost key in the tree.
--
--   The 'Maybe' is evaluated to WHNF.
updateMin :: (a -> Maybe a) -> Patricia a -> Patricia a
updateMin f = go
  where
    go t =
      case t of
        Bin p l r -> rebinL p (go l) r
        Tip k a   -> retip k (f a)
        Nil       -> Nil

-- | \(\mathcal{O}(\min(n,W))\).
--   Update or delete a value at the leftmost key in the tree.
--
--   The 'Maybe' is evaluated to WHNF.
updateMinWithKey :: (Word -> a -> Maybe a) -> Patricia a -> Patricia a
updateMinWithKey f = go
  where
    go t =
      case t of
        Bin p l r -> rebinL p (go l) r
        Tip k a   -> retip k (f k a)
        Nil       -> Nil


-- | \(\mathcal{O}(\min(n,W))\).
--   Update or delete a value at the rightmost key in the tree.
--
--   The 'Maybe' is evaluated to WHNF.
updateMax :: (a -> Maybe a) -> Patricia a -> Patricia a
updateMax f = go
  where
    go t =
      case t of
        Bin p l r -> rebinR p l (go r)
        Tip k a   -> retip k (f a)
        Nil       -> Nil

-- | \(\mathcal{O}(\min(n,W))\).
--   Update or delete a value at the rightmost key in the tree.
--
--   The 'Maybe' is evaluated to WHNF.
updateMaxWithKey :: (Word -> a -> Maybe a) -> Patricia a -> Patricia a
updateMaxWithKey f = go
  where
    go t =
      case t of
        Bin p l r -> rebinR p l (go r)
        Tip k a   -> retip k (f k a)
        Nil       -> Nil



-- | \(\mathcal{O}(\min(n,W))\).
--   Look up the leftmost value and return it alongside the tree without it.
minView :: Patricia a -> Maybe (ViewL a)
minView Nil = Nothing
minView t   = Just $! unsafeMinView t

-- | The leftmost value with its key and the rest of the tree.
data ViewL a = ViewL {-# UNPACK #-} !(Lookup a) !(Patricia a)
               deriving Show

-- | \(\mathcal{O}(\min(n,W))\).
--   Look up the leftmost value and return it alongside the tree without it.
--
--   Throws 'MalformedTree' if the tree is empty.
unsafeMinView :: Patricia a -> ViewL a
unsafeMinView t =
  case t of
    Bin p l r ->
      let !(ViewL a l0) = unsafeMinView l
      in ViewL a (rebinL p l0 r)

    Tip k a -> ViewL (Lookup k a) Nil

    Nil -> throw $ MalformedTree moduleLoc "minView"



-- | \(\mathcal{O}(\min(n,W))\).
--   Look up the rightmost value and return it alongside the tree without it.
maxView :: Patricia a -> Maybe (ViewR a)
maxView Nil = Nothing
maxView t   = Just $! unsafeMaxView t

-- | The rightmost value with its key and the rest of the tree.
data ViewR a = ViewR !(Patricia a) {-# UNPACK #-} !(Lookup a)
               deriving Show

-- | \(\mathcal{O}(\min(n,W))\).
--   Look up the rightmost value and return it alongside the tree without it.
--
--   Throws 'MalformedTree' if the tree is empty.
unsafeMaxView :: Patricia a -> ViewR a
unsafeMaxView t =
  case t of
    Bin p l r ->
      let !(ViewR r0 a) = unsafeMaxView r
      in ViewR (rebinR p l r0) a

    Tip k a -> ViewR Nil (Lookup k a)

    Nil -> throw $ MalformedTree moduleLoc "maxView"