-- |
-- Copyright   :  (c) Adrian Hey 2004,2005
-- License     :  BSD3
--
{-# OPTIONS_HADDOCK hide #-}
module Data.Tree.AVL.Push
(-- * \"Pushing\" new elements into AVL trees
 -- | \"Pushing\" is another word for insertion. (c.f \"Popping\".)

 -- ** Pushing on extreme left or right
 pushL,pushR,

 -- ** Pushing on /sorted/ AVL trees
 push,push',pushMaybe,pushMaybe',
) where

import Data.COrdering
import Data.Tree.AVL.Internals.Types(AVL(..))
import Data.Tree.AVL.BinPath(BinPath(..),openPathWith,writePath,insertPath)

{------------------------------------------------------------------------------------------------------------------------------
 -------------------------------------- Notes about Insertion and Rebalancing -------------------------------------------------
 ------------------------------------------------------------------------------------------------------------------------------
   If we forget about tree rebalancing, and consider what changes in BF tell us about changes in H
   under ordinary circumstances, we can make the following observations:

   (1) Insertion can never reduce the height of a (sub)tree.
   (2) Insertion can only change the height of a (sub)tree by +1 at most. Therefore the BF of the
       root can change by +/- 1 most.
   (2) If insertion changes the BF from 0 -> +/- 1, then this must be because either the left or
       right subtrees has grown in height by 1. Since they were equal before (BF=0), the overall
       height of the root must also have grown by 1.
   (3) If insertion changes the BF from +/-1 -> 0, then this must be because one either the left
       or right subtree has grown by 1 so that it is now equal in height to the opposing subtree.
       Since height of the root is determined by the maximum height of the subtrees, it is left
       unchanged.
   (4) If insertion leaves the BF unchanged, then this must be because the height of neither
       subtree has changed. Therefore the height of the root is left unchanged.
   (5) It follows from (2) and (3), that changes in height, and hence BF can (and will) propogate
       up the tree (along the insertion path) as far as the first node with non-zero BF, and no further.
   (6) If insertion changes the BF from +/-1 -> +/-2 then we have a problem. This is dealt with by
       one of four possible rebalancing 'rotations' (there are two possiblities for each of the left
       and right subtrees). However, it's appropriate to mention an important property of the rotations
       now. The net effect of unbalancing and rebalancing is to give the root BF=0 and leave the height
       unchanged. So the combined effect of the unbalance-rebalance operation appears like a special
       case of (3). Another important property of rebalancing is that it /preserves/ the tree sorting.
   (7) It follows from (6) and (5) any single insertion will cause most one unbalance-rebalance operation.

   So in summary we have a set of rules to enable us to infer changes in height of a subtree (if any) from
   changes in the BF of the subtree, and hence the changes (if any) in the BF of the root. The rules are:
      BF    0 -> +/-1, height increased by 1
      BF +/-1 ->    0, height unchanged.
      BF unchanged   , height unchanged.
      BF +/-1 -> -/+1, NEVER OCCURS

   It should also be observed that these observations and rules apply to INSERTION only (not deletion).

Rebalancing: CASE RR
--------------------
   Consider inserting into the right subtree of the right subtree (RR subtree). From the obsevations above we can
   say this is only going to unbalance the root if:
           The height of the RR subtree is increased by 1 (we determine this from looking at changes in it's BF)
   ..and.. The right subtree has BF=0 prior to insertion (observation 5)
   ..and.. THe root has BF=-1 prior to insertion (observation 2)

   In pictures..

             -----                                       -----                                            -----
            |  B  |                                     |  B  |                                          |  D  |
            |H=h+2|                                     |H=h+3|                                          |H=h+2| <- Note
            |BF=-1|                                     |BF=-2| <-- Unbalanced!                          |BF= 0| <- Note
            /-----\                                     /-----\                                          /-----\
           /       \                                   /       \                                        /       \
          /         \                                 /         \                                      /         \
    -----/           \-----                     -----/           \-----                          -----/           \-----
   |  A  |           |  D  |       E grows     |  A  |           |  D  |        Rebalance       |  B  |           |  E  |
   | H=h |           |H=h+1|       by 1        | H=h |           |H=h+2|        -------->       |H=h+1|           |H=h+1|
   |     |           |BF= 0|       ------>     |     |           |BF=-1|                        |BF= 0|           |     |
    -----            /-----\       h -> h+1     -----            /-----\                        /-----\            -----
                    /       \                                   /       \                      /       \
                   /         \                                 /         \                    /         \
             -----/           \-----                     -----/           \-----        -----/           \-----
            |  C  |           |  E  |                   |  C  |           |  E  |      |  A  |           |  C  |
            | H=h |           | H=h |                   | H=h |           |H=h+1|      | H=h |           | H=h |
            |     |           |     |                   |     |           |     |      |     |           |     |
             -----             -----                     -----             -----        -----             -----

  Unfortunately, if you try this for insertion into the right left subtree (C) it doesn't work. To deal with
  this case we need a more complicated re-balancing rotation involving 3 nodes. There are 2 distinct cases, which
  both use the same rotation, but details re. BF and H are different.

Rebalancing: CASE RL(1)
-----------------------

             -----                                       -----                                         -----
            |  B  |                                     |  B  |                                       |  D  |
            |H=h+3|                                     |H=h+4|                                       |H=h+3| <- Note
            |BF=-1|                                     |BF=-2| <-- Unbalanced!                       |BF= 0| <- Note
            /-----\                                     /-----\                                       /-----\
           /       \                                   /       \                                     /       \
          /         \                                 /         \                                   /         \
    -----/           \-----                     -----/           \-----                            /           \
   |  A  |           |  F  |       E grows     |  A  |           |  F  |       Rebalance     -----/             \-----
   |H=h+1|           |H=h+2|       by 1        |H=h+1|           |H=h+3|       -------->    |  B  |             |  F  |
   |     |           |BF= 0|       ------>     |     |           |BF=+1|                    |H=h+2|             |H=h+2|
    -----            /-----\       h -> h+1     -----            /-----\                    |BF=+1|             |BF= 0|
                    /       \                                   /       \              -----/-----\-----   -----/-----\-----
                   /         \                                 /         \            |  A  |     |  C  | |  E  |     |  G  |
             -----/           \-----                     -----/           \-----      |H=h+1|     | H=h | |H=h+1|     |H=h+1|
            |  D  |           |  G  |                   |  D  |           |  G  |     |     |     |     | |     |     |     |
            |H=h+1|           |H=h+1|                   |H=h+2|           |H=h+1|      -----       -----   -----       -----
            |BF= 0|           |     |                   |BF=-1|           |     |
            /-----\            -----                    /-----\            -----
           /       \                                   /       \
          /         \                                 /         \
    -----/           \-----                     -----/           \-----
   |  C  |           |  E  |                   |  C  |           |  E  |
   | H=h |           | H=h |                   | H=h |           |H=h+1|
   |     |           |     |                   |     |           |     |
    -----             -----                     -----             -----

Rebalancing: CASE RL(2)
-----------------------

             -----                                       -----                                         -----
            |  B  |                                     |  B  |                                       |  D  |
            |H=h+3|                                     |H=h+4|                                       |H=h+3| <- Note
            |BF=-1|                                     |BF=-2| <-- Unbalanced!                       |BF= 0| <- Note
            /-----\                                     /-----\                                       /-----\
           /       \                                   /       \                                     /       \
          /         \                                 /         \                                   /         \
    -----/           \-----                     -----/           \-----                            /           \
   |  A  |           |  F  |       C grows     |  A  |           |  F  |       Rebalance     -----/             \-----
   |H=h+1|           |H=h+2|       by 1        |H=h+1|           |H=h+3|       -------->    |  B  |             |  F  |
   |     |           |BF= 0|       ------>     |     |           |BF=+1|                    |H=h+2|             |H=h+2|
    -----            /-----\       h -> h+1     -----            /-----\                    |BF= 0|             |BF=-1|
                    /       \                                   /       \              -----/-----\-----   -----/-----\-----
                   /         \                                 /         \            |  A  |     |  C  | |  E  |     |  G  |
             -----/           \-----                     -----/           \-----      |H=h+1|     |H=h+1| | H=h |     |H=h+1|
            |  D  |           |  G  |                   |  D  |           |  G  |     |     |     |     | |     |     |     |
            |H=h+1|           |H=h+1|                   |H=h+2|           |H=h+1|      -----       -----   -----       -----
            |BF= 0|           |     |                   |BF=+1|           |     |
            /-----\            -----                    /-----\            -----
           /       \                                   /       \
          /         \                                 /         \
    -----/           \-----                     -----/           \-----
   |  C  |           |  E  |                   |  C  |           |  E  |
   | H=h |           | H=h |                   |H=h+1|           | H=h |
   |     |           |     |                   |     |           |     |
    -----             -----                     -----             -----
-}

-- | General push. This function searches the AVL tree using the supplied selector. If a matching element
-- is found it's replaced by the value (@e@) returned in the @('Data.COrdering.Eq' e)@ constructor returned by the selector.
-- If no match is found then the default element value is added at in the appropriate position in the tree.
--
-- Note that for this to work properly requires that the selector behave as if it were comparing the
-- (potentially) new default element with existing tree elements, even if it isn't.
--
-- Note also that this function is /non-strict/ in it\'s second argument (the default value which
-- is inserted if the search fails or is discarded if the search succeeds). If you want
-- to force evaluation, but only if it\'s actually incorprated in the tree, then use 'push''
--
-- Complexity: O(log n)
push :: (e -> COrdering e) -> e -> AVL e -> AVL e
push :: forall e. (e -> COrdering e) -> e -> AVL e -> AVL e
push e -> COrdering e
c e
e0 = AVL e -> AVL e
put where -- there now follows a huge collection of functions requiring
                         -- pattern matching from hell in which c and e0 are free variables
-- This may look longwinded, it's been done this way to..
--  * Avoid doing case analysis on the same node more than once.
--  * Minimise heap burn rate (by avoiding explicit rebalancing operations).
 ----------------------------- LEVEL 0 ---------------------------------
 --                              put                                  --
 -----------------------------------------------------------------------
 put :: AVL e -> AVL e
put  AVL e
E        = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z    AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E
 put (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putN AVL e
l e
e  AVL e
r
 put (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putZ AVL e
l e
e  AVL e
r
 put (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putP AVL e
l e
e  AVL e
r

 ----------------------------- LEVEL 1 ---------------------------------
 --                       putN, putZ, putP                            --
 -----------------------------------------------------------------------

 -- Put in (N l e r), BF=-1  , (never returns P)
 putN :: AVL e -> e -> AVL e -> AVL e
putN AVL e
l e
e AVL e
r = case e -> COrdering e
c e
e of
              COrdering e
Lt    -> AVL e -> e -> AVL e -> AVL e
putNL AVL e
l e
e  AVL e
r  -- <e, so put in L subtree
              Eq e
e' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N     AVL e
l e
e' AVL e
r  -- =e, so update existing
              COrdering e
Gt    -> AVL e -> e -> AVL e -> AVL e
putNR AVL e
l e
e  AVL e
r  -- >e, so put in R subtree

 -- Put in (Z l e r), BF= 0
 putZ :: AVL e -> e -> AVL e -> AVL e
putZ AVL e
l e
e AVL e
r = case e -> COrdering e
c e
e of
              COrdering e
Lt    -> AVL e -> e -> AVL e -> AVL e
putZL AVL e
l e
e  AVL e
r  -- <e, so put in L subtree
              Eq e
e' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z     AVL e
l e
e' AVL e
r  -- =e, so update existing
              COrdering e
Gt    -> AVL e -> e -> AVL e -> AVL e
putZR AVL e
l e
e  AVL e
r  -- >e, so put in R subtree

 -- Put in (P l e r), BF=+1 , (never returns N)
 putP :: AVL e -> e -> AVL e -> AVL e
putP AVL e
l e
e AVL e
r = case e -> COrdering e
c e
e of
              COrdering e
Lt    -> AVL e -> e -> AVL e -> AVL e
putPL AVL e
l e
e  AVL e
r  -- <e, so put in L subtree
              Eq e
e' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P     AVL e
l e
e' AVL e
r  -- =e, so update existing
              COrdering e
Gt    -> AVL e -> e -> AVL e -> AVL e
putPR AVL e
l e
e  AVL e
r  -- >e, so put in R subtree

 ----------------------------- LEVEL 2 ---------------------------------
 --                      putNL, putZL, putPL                          --
 --                      putNR, putZR, putPR                          --
 -----------------------------------------------------------------------

 -- (putNL l e r): Put in L subtree of (N l e r), BF=-1 (Never requires rebalancing) , (never returns P)
 {-# INLINE putNL #-}
 putNL :: AVL e -> e -> AVL e -> AVL e
putNL  AVL e
E           e
e AVL e
r = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z    AVL e
forall e. AVL e
E  e
e0 AVL e
forall e. AVL e
E ) e
e AVL e
r       -- L subtree empty, H:0->1, parent BF:-1-> 0
 putNL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putN AVL e
ll e
le AVL e
lr      -- L subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r
 putNL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putP AVL e
ll e
le AVL e
lr      -- L subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r
 putNL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
ll e
le AVL e
lr      -- L subtree BF= 0, so need to look for changes
                          in case AVL e
l' of
                          AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push: Bug0" -- impossible
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r         -- L subtree BF:0-> 0, H:h->h  , parent BF:-1->-1
                          AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r         -- L subtree BF:0->+/-1, H:h->h+1, parent BF:-1-> 0

 -- (putZL l e r): Put in L subtree of (Z l e r), BF= 0  (Never requires rebalancing) , (never returns N)
 {-# INLINE putZL #-}
 putZL :: AVL e -> e -> AVL e -> AVL e
putZL  AVL e
E           e
e AVL e
r = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z    AVL e
forall e. AVL e
E  e
e0 AVL e
forall e. AVL e
E ) e
e AVL e
r       -- L subtree        H:0->1, parent BF: 0->+1
 putZL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putN AVL e
ll e
le AVL e
lr      -- L subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r
 putZL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putP AVL e
ll e
le AVL e
lr      -- L subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r
 putZL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
ll e
le AVL e
lr      -- L subtree BF= 0, so need to look for changes
                          in case AVL e
l' of
                          AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push: Bug1" -- impossible
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r         -- L subtree BF: 0-> 0, H:h->h  , parent BF: 0-> 0
                          AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r         -- L subtree BF: 0->+/-1, H:h->h+1, parent BF: 0->+1

 -- (putZR l e r): Put in R subtree of (Z l e r), BF= 0 (Never requires rebalancing) , (never returns P)
 {-# INLINE putZR #-}
 putZR :: AVL e -> e -> AVL e -> AVL e
putZR AVL e
l e
e AVL e
E            = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z    AVL e
forall e. AVL e
E  e
e0 AVL e
forall e. AVL e
E )       -- R subtree        H:0->1, parent BF: 0->-1
 putZR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putN AVL e
rl e
re AVL e
rr      -- R subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'
 putZR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putP AVL e
rl e
re AVL e
rr      -- R subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'
 putZR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
rl e
re AVL e
rr      -- R subtree BF= 0, so need to look for changes
                          in case AVL e
r' of
                          AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push: Bug2" -- impossible
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'         -- R subtree BF: 0-> 0, H:h->h  , parent BF: 0-> 0
                          AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'         -- R subtree BF: 0->+/-1, H:h->h+1, parent BF: 0->-1

 -- (putPR l e r): Put in R subtree of (P l e r), BF=+1 (Never requires rebalancing) , (never returns N)
 {-# INLINE putPR #-}
 putPR :: AVL e -> e -> AVL e -> AVL e
putPR AVL e
l e
e  AVL e
E           = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z    AVL e
forall e. AVL e
E  e
e0 AVL e
forall e. AVL e
E )       -- R subtree empty, H:0->1,     parent BF:+1-> 0
 putPR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putN AVL e
rl e
re AVL e
rr      -- R subtree BF<>0, H:h->h,     parent BF:+1->+1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'
 putPR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putP AVL e
rl e
re AVL e
rr      -- R subtree BF<>0, H:h->h,     parent BF:+1->+1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'
 putPR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
rl e
re AVL e
rr      -- R subtree BF= 0, so need to look for changes
                          in case AVL e
r' of
                          AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push: Bug3" -- impossible
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'         -- R subtree BF:0-> 0, H:h->h  , parent BF:+1->+1
                          AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'         -- R subtree BF:0->+/-1, H:h->h+1, parent BF:+1-> 0

      -------- These 2 cases (NR and PL) may need rebalancing if they go to LEVEL 3 ---------

 -- (putNR l e r): Put in R subtree of (N l e r), BF=-1 , (never returns P)
 {-# INLINE putNR #-}
 putNR :: AVL e -> e -> AVL e -> AVL e
putNR AVL e
_ e
_ AVL e
E            = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push: Bug4"               -- impossible if BF=-1
 putNR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putN AVL e
rl e
re AVL e
rr              -- R subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'
 putNR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putP AVL e
rl e
re AVL e
rr              -- R subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'
 putNR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = case e -> COrdering e
c e
re of                        -- determine if RR or RL
                          COrdering e
Lt     -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRL AVL e
l e
e    AVL e
rl e
re  AVL e
rr   -- RL (never returns P)
                          Eq e
re' ->    AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N   AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re' AVL e
rr)  -- new re
                          COrdering e
Gt     -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRR AVL e
l e
e    AVL e
rl e
re  AVL e
rr   -- RR (never returns P)

 -- (putPL l e r): Put in L subtree of (P l e r), BF=+1 , (never returns N)
 {-# INLINE putPL #-}
 putPL :: AVL e -> e -> AVL e -> AVL e
putPL  AVL e
E           e
_ AVL e
_ = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push: Bug5"               -- impossible if BF=+1
 putPL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putN AVL e
ll e
le AVL e
lr              -- L subtree BF<>0, H:h->h, parent BF:+1->+1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r
 putPL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putP AVL e
ll e
le AVL e
lr              -- L subtree BF<>0, H:h->h, parent BF:+1->+1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r
 putPL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering e
c e
le of                        -- determine if LL or LR
                          COrdering e
Lt     -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLL  AVL e
ll e
le  AVL e
lr  e
e AVL e
r    -- LL (never returns N)
                          Eq e
le' ->    AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le' AVL e
lr) e
e AVL e
r    -- new le
                          COrdering e
Gt     -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLR  AVL e
ll e
le  AVL e
lr  e
e AVL e
r    -- LR (never returns N)

 ----------------------------- LEVEL 3 ---------------------------------
 --                        putNRR, putPLL                             --
 --                        putNRL, putPLR                             --
 -----------------------------------------------------------------------

 -- (putNRR l e rl re rr): Put in RR subtree of (N l e (Z rl re rr)) , (never returns P)
 {-# INLINE putNRR #-}
 putNRR :: AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRR AVL e
l e
e AVL e
rl e
re  AVL e
E              = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
rl) e
re (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E)         -- l and rl must also be E, special CASE RR!!
 putNRR AVL e
l e
e AVL e
rl e
re (N AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = AVL e -> e -> AVL e -> AVL e
putN AVL e
rrl e
rre AVL e
rrr         -- RR subtree BF<>0, H:h->h, so no change
                                    in AVL e
rr' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re AVL e
rr')
 putNRR AVL e
l e
e AVL e
rl e
re (P AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = AVL e -> e -> AVL e -> AVL e
putP AVL e
rrl e
rre AVL e
rrr         -- RR subtree BF<>0, H:h->h, so no change
                                    in AVL e
rr' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re AVL e
rr')
 putNRR AVL e
l e
e AVL e
rl e
re (Z AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
rrl e
rre AVL e
rrr         -- RR subtree BF= 0, so need to look for changes
                                    in case AVL e
rr' of
                                    AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push: Bug6"   -- impossible
                                    Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re AVL e
rr')     -- RR subtree BF: 0-> 0, H:h->h, so no change
                                    AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
rl) e
re AVL e
rr'     -- RR subtree BF: 0->+/-1, H:h->h+1, parent BF:-1->-2, CASE RR !!

 -- (putPLL ll le lr e r): Put in LL subtree of (P (Z ll le lr) e r) , (never returns N)
 {-# INLINE putPLL #-}
 putPLL :: AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLL  AVL e
E e
le AVL e
lr e
e AVL e
r              = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E) e
le (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
lr e
e AVL e
r)         -- r and lr must also be E, special CASE LL!!
 putPLL (N AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = AVL e -> e -> AVL e -> AVL e
putN AVL e
lll e
lle AVL e
llr         -- LL subtree BF<>0, H:h->h, so no change
                                    in AVL e
ll' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le AVL e
lr) e
e AVL e
r
 putPLL (P AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = AVL e -> e -> AVL e -> AVL e
putP AVL e
lll e
lle AVL e
llr         -- LL subtree BF<>0, H:h->h, so no change
                                    in AVL e
ll' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le AVL e
lr) e
e AVL e
r
 putPLL (Z AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
lll e
lle AVL e
llr         -- LL subtree BF= 0, so need to look for changes
                                    in case AVL e
ll' of
                                    AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push: Bug7"   -- impossible
                                    Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le AVL e
lr) e
e AVL e
r -- LL subtree BF: 0-> 0, H:h->h, so no change
                                    AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
lr e
e AVL e
r) -- LL subtree BF: 0->+/-1, H:h->h+1, parent BF:-1->-2, CASE LL !!

 -- (putNRL l e rl re rr): Put in RL subtree of (N l e (Z rl re rr)) , (never returns P)
 {-# INLINE putNRL #-}
 putNRL :: AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRL AVL e
l e
e  AVL e
E              e
re AVL e
rr = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
forall e. AVL e
E) e
e0 (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
re AVL e
rr)         -- l and rr must also be E, special CASE LR !!
 putNRL AVL e
l e
e (N AVL e
rll e
rle AVL e
rlr) e
re AVL e
rr = let rl' :: AVL e
rl' = AVL e -> e -> AVL e -> AVL e
putN AVL e
rll e
rle AVL e
rlr         -- RL subtree BF<>0, H:h->h, so no change
                                    in AVL e
rl' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl' e
re AVL e
rr)
 putNRL AVL e
l e
e (P AVL e
rll e
rle AVL e
rlr) e
re AVL e
rr = let rl' :: AVL e
rl' = AVL e -> e -> AVL e -> AVL e
putP AVL e
rll e
rle AVL e
rlr         -- RL subtree BF<>0, H:h->h, so no change
                                    in AVL e
rl' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl' e
re AVL e
rr)
 putNRL AVL e
l e
e (Z AVL e
rll e
rle AVL e
rlr) e
re AVL e
rr = let rl' :: AVL e
rl' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
rll e
rle AVL e
rlr         -- RL subtree BF= 0, so need to look for changes
                                    in case AVL e
rl' of
                                    AVL e
E                -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push: Bug8" -- impossible
                                    Z AVL e
_    e
_    AVL e
_    -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl' e
re AVL e
rr)                -- RL subtree BF: 0-> 0, H:h->h, so no change
                                    N AVL e
rll' e
rle' AVL e
rlr' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
rll') e
rle' (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rlr' e
re AVL e
rr) -- RL subtree BF: 0->-1, SO.. CASE RL(1) !!
                                    P AVL e
rll' e
rle' AVL e
rlr' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
rll') e
rle' (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
rlr' e
re AVL e
rr) -- RL subtree BF: 0->+1, SO.. CASE RL(2) !!

 -- (putPLR ll le lr e r): Put in LR subtree of (P (Z ll le lr) e r) , (never returns N)
 {-# INLINE putPLR #-}
 putPLR :: AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLR AVL e
ll e
le  AVL e
E              e
e AVL e
r = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le AVL e
forall e. AVL e
E) e
e0 (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e AVL e
r)         -- r and ll must also be E, special CASE LR !!
 putPLR AVL e
ll e
le (N AVL e
lrl e
lre AVL e
lrr) e
e AVL e
r = let lr' :: AVL e
lr' = AVL e -> e -> AVL e -> AVL e
putN AVL e
lrl e
lre AVL e
lrr         -- LR subtree BF<>0, H:h->h, so no change
                                    in AVL e
lr' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le AVL e
lr') e
e AVL e
r
 putPLR AVL e
ll e
le (P AVL e
lrl e
lre AVL e
lrr) e
e AVL e
r = let lr' :: AVL e
lr' = AVL e -> e -> AVL e -> AVL e
putP AVL e
lrl e
lre AVL e
lrr         -- LR subtree BF<>0, H:h->h, so no change
                                    in AVL e
lr' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le AVL e
lr') e
e AVL e
r
 putPLR AVL e
ll e
le (Z AVL e
lrl e
lre AVL e
lrr) e
e AVL e
r = let lr' :: AVL e
lr' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
lrl e
lre AVL e
lrr         -- LR subtree BF= 0, so need to look for changes
                                    in case AVL e
lr' of
                                    AVL e
E                -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push: Bug9" -- impossible
                                    Z AVL e
_    e
_    AVL e
_    -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le AVL e
lr') e
e AVL e
r                -- LR subtree BF: 0-> 0, H:h->h, so no change
                                    N AVL e
lrl' e
lre' AVL e
lrr' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
ll e
le AVL e
lrl') e
lre' (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
lrr' e
e AVL e
r) -- LR subtree BF: 0->-1, SO.. CASE LR(2) !!
                                    P AVL e
lrl' e
lre' AVL e
lrr' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le AVL e
lrl') e
lre' (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
lrr' e
e AVL e
r) -- LR subtree BF: 0->+1, SO.. CASE LR(1) !!

-- | Almost identical to 'push', but this version forces evaluation of the default new element
-- (second argument) if no matching element is found. Note that it does /not/ do this if
-- a matching element is found, because in this case the default new element is discarded
-- anyway. Note also that it does not force evaluation of any replacement value provided by the
-- selector (if it returns Eq). (You have to do that yourself if that\'s what you want.)
--
-- Complexity: O(log n)
push' :: (e -> COrdering e) -> e -> AVL e -> AVL e
push' :: forall e. (e -> COrdering e) -> e -> AVL e -> AVL e
push' e -> COrdering e
c e
e0 = AVL e -> AVL e
put where
 ----------------------------- LEVEL 0 ---------------------------------
 --                              put                                  --
 -----------------------------------------------------------------------
 put :: AVL e -> AVL e
put  AVL e
E        = e
e0 e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E
 put (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putN AVL e
l e
e  AVL e
r
 put (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putZ AVL e
l e
e  AVL e
r
 put (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putP AVL e
l e
e  AVL e
r

 ----------------------------- LEVEL 1 ---------------------------------
 --                       putN, putZ, putP                            --
 -----------------------------------------------------------------------

 -- Put in (N l e r), BF=-1  , (never returns P)
 putN :: AVL e -> e -> AVL e -> AVL e
putN AVL e
l e
e AVL e
r = case e -> COrdering e
c e
e of
              COrdering e
Lt    -> AVL e -> e -> AVL e -> AVL e
putNL AVL e
l e
e  AVL e
r  -- <e, so put in L subtree
              Eq e
e' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N     AVL e
l e
e' AVL e
r  -- =e, so update existing
              COrdering e
Gt    -> AVL e -> e -> AVL e -> AVL e
putNR AVL e
l e
e  AVL e
r  -- >e, so put in R subtree

 -- Put in (Z l e r), BF= 0
 putZ :: AVL e -> e -> AVL e -> AVL e
putZ AVL e
l e
e AVL e
r = case e -> COrdering e
c e
e of
              COrdering e
Lt    -> AVL e -> e -> AVL e -> AVL e
putZL AVL e
l e
e  AVL e
r  -- <e, so put in L subtree
              Eq e
e' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z     AVL e
l e
e' AVL e
r  -- =e, so update existing
              COrdering e
Gt    -> AVL e -> e -> AVL e -> AVL e
putZR AVL e
l e
e  AVL e
r  -- >e, so put in R subtree

 -- Put in (P l e r), BF=+1 , (never returns N)
 putP :: AVL e -> e -> AVL e -> AVL e
putP AVL e
l e
e AVL e
r = case e -> COrdering e
c e
e of
              COrdering e
Lt    -> AVL e -> e -> AVL e -> AVL e
putPL AVL e
l e
e  AVL e
r  -- <e, so put in L subtree
              Eq e
e' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P     AVL e
l e
e' AVL e
r  -- =e, so update existing
              COrdering e
Gt    -> AVL e -> e -> AVL e -> AVL e
putPR AVL e
l e
e  AVL e
r  -- >e, so put in R subtree

 ----------------------------- LEVEL 2 ---------------------------------
 --                      putNL, putZL, putPL                          --
 --                      putNR, putZR, putPR                          --
 -----------------------------------------------------------------------

 -- (putNL l e r): Put in L subtree of (N l e r), BF=-1 (Never requires rebalancing) , (never returns P)
 {-# INLINE putNL #-}
 putNL :: AVL e -> e -> AVL e -> AVL e
putNL  AVL e
E           e
e AVL e
r = e
e0 e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E ) e
e AVL e
r  -- L subtree empty, H:0->1, parent BF:-1-> 0
 putNL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putN AVL e
ll e
le AVL e
lr      -- L subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r
 putNL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putP AVL e
ll e
le AVL e
lr      -- L subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r
 putNL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
ll e
le AVL e
lr      -- L subtree BF= 0, so need to look for changes
                          in case AVL e
l' of
                          AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push': Bug0" -- impossible
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r         -- L subtree BF:0-> 0, H:h->h  , parent BF:-1->-1
                          AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r         -- L subtree BF:0->+/-1, H:h->h+1, parent BF:-1-> 0

 -- (putZL l e r): Put in L subtree of (Z l e r), BF= 0  (Never requires rebalancing) , (never returns N)
 {-# INLINE putZL #-}
 putZL :: AVL e -> e -> AVL e -> AVL e
putZL  AVL e
E           e
e AVL e
r = e
e0 e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E ) e
e AVL e
r  -- L subtree        H:0->1, parent BF: 0->+1
 putZL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putN AVL e
ll e
le AVL e
lr      -- L subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r
 putZL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putP AVL e
ll e
le AVL e
lr      -- L subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r
 putZL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
ll e
le AVL e
lr      -- L subtree BF= 0, so need to look for changes
                          in case AVL e
l' of
                          AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push': Bug1" -- impossible
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r         -- L subtree BF: 0-> 0, H:h->h  , parent BF: 0-> 0
                          AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r         -- L subtree BF: 0->+/-1, H:h->h+1, parent BF: 0->+1

 -- (putZR l e r): Put in R subtree of (Z l e r), BF= 0 (Never requires rebalancing) , (never returns P)
 {-# INLINE putZR #-}
 putZR :: AVL e -> e -> AVL e -> AVL e
putZR AVL e
l e
e AVL e
E            = e
e0 e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E)   -- R subtree        H:0->1, parent BF: 0->-1
 putZR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putN AVL e
rl e
re AVL e
rr      -- R subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'
 putZR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putP AVL e
rl e
re AVL e
rr      -- R subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'
 putZR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
rl e
re AVL e
rr      -- R subtree BF= 0, so need to look for changes
                          in case AVL e
r' of
                          AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push': Bug2" -- impossible
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'         -- R subtree BF: 0-> 0, H:h->h  , parent BF: 0-> 0
                          AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'         -- R subtree BF: 0->+/-1, H:h->h+1, parent BF: 0->-1

 -- (putPR l e r): Put in R subtree of (P l e r), BF=+1 (Never requires rebalancing) , (never returns N)
 {-# INLINE putPR #-}
 putPR :: AVL e -> e -> AVL e -> AVL e
putPR AVL e
l e
e  AVL e
E           = e
e0 e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E)   -- R subtree empty, H:0->1,     parent BF:+1-> 0
 putPR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putN AVL e
rl e
re AVL e
rr      -- R subtree BF<>0, H:h->h,     parent BF:+1->+1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'
 putPR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putP AVL e
rl e
re AVL e
rr      -- R subtree BF<>0, H:h->h,     parent BF:+1->+1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'
 putPR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
rl e
re AVL e
rr      -- R subtree BF= 0, so need to look for changes
                          in case AVL e
r' of
                          AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push': Bug3" -- impossible
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'         -- R subtree BF:0-> 0, H:h->h  , parent BF:+1->+1
                          AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'         -- R subtree BF:0->+/-1, H:h->h+1, parent BF:+1-> 0

      -------- These 2 cases (NR and PL) may need rebalancing if they go to LEVEL 3 ---------

 -- (putNR l e r): Put in R subtree of (N l e r), BF=-1 , (never returns P)
 {-# INLINE putNR #-}
 putNR :: AVL e -> e -> AVL e -> AVL e
putNR AVL e
_ e
_ AVL e
E            = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push': Bug4"              -- impossible if BF=-1
 putNR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putN AVL e
rl e
re AVL e
rr              -- R subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'
 putNR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putP AVL e
rl e
re AVL e
rr              -- R subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'
 putNR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = case e -> COrdering e
c e
re of                        -- determine if RR or RL
                          COrdering e
Lt     -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRL AVL e
l e
e    AVL e
rl e
re  AVL e
rr   -- RL (never returns P)
                          Eq e
re' ->    AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N   AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re' AVL e
rr)  -- new re
                          COrdering e
Gt     -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRR AVL e
l e
e    AVL e
rl e
re  AVL e
rr   -- RR (never returns P)

 -- (putPL l e r): Put in L subtree of (P l e r), BF=+1 , (never returns N)
 {-# INLINE putPL #-}
 putPL :: AVL e -> e -> AVL e -> AVL e
putPL  AVL e
E           e
_ AVL e
_ = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push': Bug5"              -- impossible if BF=+1
 putPL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putN AVL e
ll e
le AVL e
lr              -- L subtree BF<>0, H:h->h, parent BF:+1->+1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r
 putPL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putP AVL e
ll e
le AVL e
lr              -- L subtree BF<>0, H:h->h, parent BF:+1->+1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r
 putPL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering e
c e
le of                        -- determine if LL or LR
                          COrdering e
Lt     -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLL  AVL e
ll e
le  AVL e
lr  e
e AVL e
r    -- LL (never returns N)
                          Eq e
le' ->    AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le' AVL e
lr) e
e AVL e
r    -- new le
                          COrdering e
Gt     -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLR  AVL e
ll e
le  AVL e
lr  e
e AVL e
r    -- LR (never returns N)

 ----------------------------- LEVEL 3 ---------------------------------
 --                        putNRR, putPLL                             --
 --                        putNRL, putPLR                             --
 -----------------------------------------------------------------------

 -- (putNRR l e rl re rr): Put in RR subtree of (N l e (Z rl re rr)) , (never returns P)
 {-# INLINE putNRR #-}
 putNRR :: AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRR AVL e
l e
e AVL e
rl e
re  AVL e
E              = e
e0 e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
rl) e
re (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E) -- l and rl must also be E, special CASE RR!!
 putNRR AVL e
l e
e AVL e
rl e
re (N AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = AVL e -> e -> AVL e -> AVL e
putN AVL e
rrl e
rre AVL e
rrr          -- RR subtree BF<>0, H:h->h, so no change
                                    in AVL e
rr' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re AVL e
rr')
 putNRR AVL e
l e
e AVL e
rl e
re (P AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = AVL e -> e -> AVL e -> AVL e
putP AVL e
rrl e
rre AVL e
rrr          -- RR subtree BF<>0, H:h->h, so no change
                                    in AVL e
rr' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re AVL e
rr')
 putNRR AVL e
l e
e AVL e
rl e
re (Z AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
rrl e
rre AVL e
rrr          -- RR subtree BF= 0, so need to look for changes
                                    in case AVL e
rr' of
                                    AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push': Bug6"   -- impossible
                                    Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re AVL e
rr')      -- RR subtree BF: 0-> 0, H:h->h, so no change
                                    AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
rl) e
re AVL e
rr'      -- RR subtree BF: 0->+/-1, H:h->h+1, parent BF:-1->-2, CASE RR !!

 -- (putPLL ll le lr e r): Put in LL subtree of (P (Z ll le lr) e r) , (never returns N)
 {-# INLINE putPLL #-}
 putPLL :: AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLL  AVL e
E e
le AVL e
lr e
e AVL e
r              = e
e0 e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E) e
le (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
lr e
e AVL e
r) -- r and lr must also be E, special CASE LL!!
 putPLL (N AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = AVL e -> e -> AVL e -> AVL e
putN AVL e
lll e
lle AVL e
llr          -- LL subtree BF<>0, H:h->h, so no change
                                    in AVL e
ll' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le AVL e
lr) e
e AVL e
r
 putPLL (P AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = AVL e -> e -> AVL e -> AVL e
putP AVL e
lll e
lle AVL e
llr          -- LL subtree BF<>0, H:h->h, so no change
                                    in AVL e
ll' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le AVL e
lr) e
e AVL e
r
 putPLL (Z AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
lll e
lle AVL e
llr          -- LL subtree BF= 0, so need to look for changes
                                    in case AVL e
ll' of
                                    AVL e
E       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push': Bug7"   -- impossible
                                    Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le AVL e
lr) e
e AVL e
r      -- LL subtree BF: 0-> 0, H:h->h, so no change
                                    AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
lr e
e AVL e
r)      -- LL subtree BF: 0->+/-1, H:h->h+1, parent BF:-1->-2, CASE LL !!

 -- (putNRL l e rl re rr): Put in RL subtree of (N l e (Z rl re rr)) , (never returns P)
 {-# INLINE putNRL #-}
 putNRL :: AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRL AVL e
l e
e  AVL e
E              e
re AVL e
rr = e
e0 e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
forall e. AVL e
E) e
e0 (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
re AVL e
rr) -- l and rr must also be E, special CASE LR !!
 putNRL AVL e
l e
e (N AVL e
rll e
rle AVL e
rlr) e
re AVL e
rr = let rl' :: AVL e
rl' = AVL e -> e -> AVL e -> AVL e
putN AVL e
rll e
rle AVL e
rlr          -- RL subtree BF<>0, H:h->h, so no change
                                    in AVL e
rl' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl' e
re AVL e
rr)
 putNRL AVL e
l e
e (P AVL e
rll e
rle AVL e
rlr) e
re AVL e
rr = let rl' :: AVL e
rl' = AVL e -> e -> AVL e -> AVL e
putP AVL e
rll e
rle AVL e
rlr          -- RL subtree BF<>0, H:h->h, so no change
                                    in AVL e
rl' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl' e
re AVL e
rr)
 putNRL AVL e
l e
e (Z AVL e
rll e
rle AVL e
rlr) e
re AVL e
rr = let rl' :: AVL e
rl' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
rll e
rle AVL e
rlr          -- RL subtree BF= 0, so need to look for changes
                                    in case AVL e
rl' of
                                    AVL e
E                -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push': Bug8" -- impossible
                                    Z AVL e
_    e
_    AVL e
_    -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl' e
re AVL e
rr)                -- RL subtree BF: 0-> 0, H:h->h, so no change
                                    N AVL e
rll' e
rle' AVL e
rlr' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
rll') e
rle' (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rlr' e
re AVL e
rr) -- RL subtree BF: 0->-1, SO.. CASE RL(1) !!
                                    P AVL e
rll' e
rle' AVL e
rlr' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
rll') e
rle' (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
rlr' e
re AVL e
rr) -- RL subtree BF: 0->+1, SO.. CASE RL(2) !!

 -- (putPLR ll le lr e r): Put in LR subtree of (P (Z ll le lr) e r) , (never returns N)
 {-# INLINE putPLR #-}
 putPLR :: AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLR AVL e
ll e
le  AVL e
E              e
e AVL e
r = e
e0 e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le AVL e
forall e. AVL e
E) e
e0 (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e AVL e
r) -- r and ll must also be E, special CASE LR !!
 putPLR AVL e
ll e
le (N AVL e
lrl e
lre AVL e
lrr) e
e AVL e
r = let lr' :: AVL e
lr' = AVL e -> e -> AVL e -> AVL e
putN AVL e
lrl e
lre AVL e
lrr          -- LR subtree BF<>0, H:h->h, so no change
                                    in AVL e
lr' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le AVL e
lr') e
e AVL e
r
 putPLR AVL e
ll e
le (P AVL e
lrl e
lre AVL e
lrr) e
e AVL e
r = let lr' :: AVL e
lr' = AVL e -> e -> AVL e -> AVL e
putP AVL e
lrl e
lre AVL e
lrr          -- LR subtree BF<>0, H:h->h, so no change
                                    in AVL e
lr' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le AVL e
lr') e
e AVL e
r
 putPLR AVL e
ll e
le (Z AVL e
lrl e
lre AVL e
lrr) e
e AVL e
r = let lr' :: AVL e
lr' = AVL e -> e -> AVL e -> AVL e
putZ AVL e
lrl e
lre AVL e
lrr          -- LR subtree BF= 0, so need to look for changes
                                    in case AVL e
lr' of
                                    AVL e
E                -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"push': Bug9" -- impossible
                                    Z AVL e
_    e
_    AVL e
_    -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le AVL e
lr') e
e AVL e
r                -- LR subtree BF: 0-> 0, H:h->h, so no change
                                    N AVL e
lrl' e
lre' AVL e
lrr' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
ll e
le AVL e
lrl') e
lre' (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
lrr' e
e AVL e
r) -- LR subtree BF: 0->-1, SO.. CASE LR(2) !!
                                    P AVL e
lrl' e
lre' AVL e
lrr' -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll e
le AVL e
lrl') e
lre' (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
lrr' e
e AVL e
r) -- LR subtree BF: 0->+1, SO.. CASE LR(1) !!

-- | Similar to 'push', but returns the original tree if the combining comparison returns
-- @('Data.COrdering.Eq' 'Nothing')@. So this function can be used reduce heap burn rate by avoiding duplication
-- of nodes on the insertion path. But it may also be marginally slower otherwise.
--
-- Note that this function is /non-strict/ in it\'s second argument (the default value which
-- is inserted in the search fails or is discarded if the search succeeds). If you want
-- to force evaluation, but only if it\'s actually incorprated in the tree, then use 'pushMaybe''
--
-- Complexity: O(log n)
pushMaybe :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL e
pushMaybe :: forall e. (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL e
pushMaybe e -> COrdering (Maybe e)
c e
e AVL e
t = case (e -> COrdering (Maybe e)) -> AVL e -> BinPath (Maybe e)
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering (Maybe e)
c AVL e
t of
                     FullBP  Int#
_ Maybe e
Nothing   -> AVL e
t
                     FullBP  Int#
p (Just e
e') -> Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
writePath  Int#
p e
e' AVL e
t
                     EmptyBP Int#
p           -> Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
insertPath Int#
p e
e  AVL e
t

-- | Almost identical to 'pushMaybe', but this version forces evaluation of the default new element
-- (second argument) if no matching element is found. Note that it does /not/ do this if
-- a matching element is found, because in this case the default new element is discarded
-- anyway.
--
-- Complexity: O(log n)
pushMaybe' :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL e
pushMaybe' :: forall e. (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL e
pushMaybe' e -> COrdering (Maybe e)
c e
e AVL e
t = case (e -> COrdering (Maybe e)) -> AVL e -> BinPath (Maybe e)
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering (Maybe e)
c AVL e
t of
                      FullBP  Int#
_ Maybe e
Nothing   -> AVL e
t
                      FullBP  Int#
p (Just e
e') -> Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
writePath  Int#
p e
e' AVL e
t
                      EmptyBP Int#
p           -> e
e e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
insertPath Int#
p e
e  AVL e
t

-- | Push a new element in the leftmost position of an AVL tree. No comparison or searching is involved.
--
-- Complexity: O(log n)
pushL :: e -> AVL e -> AVL e
pushL :: forall e. e -> AVL e -> AVL e
pushL e
e0 = AVL e -> AVL e
pushL' where  -- There now follows a cut down version of the more general put.
                         -- Insertion is always on the left subtree.
                         -- Re-Balancing cases RR,RL/LR(1/2) never occur. Only LL!
                         -- There are also more impossible cases (putZL never returns N)
 ----------------------------- LEVEL 0 ---------------------------------
 --                             pushL'                                --
 -----------------------------------------------------------------------
 pushL' :: AVL e -> AVL e
pushL'  AVL e
E        = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E
 pushL' (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putNL AVL e
l e
e AVL e
r
 pushL' (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putZL AVL e
l e
e AVL e
r
 pushL' (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putPL AVL e
l e
e AVL e
r

 ----------------------------- LEVEL 2 ---------------------------------
 --                      putNL, putZL, putPL                          --
 -----------------------------------------------------------------------

 -- (putNL l e r): Put in L subtree of (N l e r), BF=-1 (Never requires rebalancing) , (never returns P)
 putNL :: AVL e -> e -> AVL e -> AVL e
putNL  AVL e
E           e
e AVL e
r = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E) e
e AVL e
r            -- L subtree empty, H:0->1, parent BF:-1-> 0
 putNL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putNL AVL e
ll e
le AVL e
lr     -- L subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r
 putNL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putPL AVL e
ll e
le AVL e
lr     -- L subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r
 putNL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putZL AVL e
ll e
le AVL e
lr     -- L subtree BF= 0, so need to look for changes
                          in case AVL e
l' of
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r         -- L subtree BF:0-> 0, H:h->h  , parent BF:-1->-1
                          P AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r         -- L subtree BF:0->+1, H:h->h+1, parent BF:-1-> 0
                          AVL e
_       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"pushL: Bug0" -- impossible

 -- (putZL l e r): Put in L subtree of (Z l e r), BF= 0  (Never requires rebalancing) , (never returns N)
 putZL :: AVL e -> e -> AVL e -> AVL e
putZL  AVL e
E           e
e AVL e
r = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E) e
e AVL e
r            -- L subtree        H:0->1, parent BF: 0->+1
 putZL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putNL AVL e
ll e
le AVL e
lr     -- L subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r
 putZL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putPL AVL e
ll e
le AVL e
lr     -- L subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r
 putZL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putZL AVL e
ll e
le AVL e
lr     -- L subtree BF= 0, so need to look for changes
                          in case AVL e
l' of
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r         -- L subtree BF: 0-> 0, H:h->h  , parent BF: 0-> 0
                          N AVL e
_ e
_ AVL e
_ -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"pushL: Bug1" -- impossible
                          AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r         -- L subtree BF: 0->+1, H:h->h+1, parent BF: 0->+1

      -------- This case (PL) may need rebalancing if it goes to LEVEL 3 ---------

 -- (putPL l e r): Put in L subtree of (P l e r), BF=+1 , (never returns N)
 putPL :: AVL e -> e -> AVL e -> AVL e
putPL  AVL e
E           e
_ AVL e
_ = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"pushL: Bug2"         -- impossible if BF=+1
 putPL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putNL AVL e
ll e
le AVL e
lr     -- L subtree BF<>0, H:h->h, parent BF:+1->+1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r
 putPL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
putPL AVL e
ll e
le AVL e
lr     -- L subtree BF<>0, H:h->h, parent BF:+1->+1
                          in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r
 putPL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLL AVL e
ll e
le AVL e
lr e
e AVL e
r         -- LL (never returns N)

 ----------------------------- LEVEL 3 ---------------------------------
 --                            putPLL                                 --
 -----------------------------------------------------------------------

 -- (putPLL ll le lr e r): Put in LL subtree of (P (Z ll le lr) e r) , (never returns N)
 {-# INLINE putPLL #-}
 putPLL :: AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLL  AVL e
E e
le AVL e
lr e
e AVL e
r              = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E) e
le (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
lr e
e AVL e
r)          -- r and lr must also be E, special CASE LL!!
 putPLL (N AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = AVL e -> e -> AVL e -> AVL e
putNL AVL e
lll e
lle AVL e
llr         -- LL subtree BF<>0, H:h->h, so no change
                                    in AVL e
ll' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le AVL e
lr) e
e AVL e
r
 putPLL (P AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = AVL e -> e -> AVL e -> AVL e
putPL AVL e
lll e
lle AVL e
llr         -- LL subtree BF<>0, H:h->h, so no change
                                    in AVL e
ll' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le AVL e
lr) e
e AVL e
r
 putPLL (Z AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = AVL e -> e -> AVL e -> AVL e
putZL AVL e
lll e
lle AVL e
llr         -- LL subtree BF= 0, so need to look for changes
                                    in case AVL e
ll' of
                                    Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le AVL e
lr) e
e AVL e
r -- LL subtree BF: 0-> 0, H:h->h, so no change
                                    N AVL e
_ e
_ AVL e
_ -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"pushL: Bug3" -- impossible
                                    AVL e
_       -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
ll' e
le (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
lr e
e AVL e
r) -- LL subtree BF: 0->+1, H:h->h+1, parent BF:-1->-2, CASE LL !!

-- | Push a new element in the rightmost position of an AVL tree. No comparison or searching is involved.
--
-- Complexity: O(log n)
pushR :: AVL e -> e -> AVL e
pushR :: forall e. AVL e -> e -> AVL e
pushR AVL e
t e
e0 = AVL e -> AVL e
pushR' AVL e
t where  -- There now follows a cut down version of the more general put.
                             -- Insertion is always on the right subtree.
                             -- Re-Balancing cases LL,RL/LR(1/2) never occur. Only RR!
                             -- There are also more impossible cases (putZR never returns P)

 ----------------------------- LEVEL 0 ---------------------------------
 --                             pushR'                                --
 -----------------------------------------------------------------------
 pushR' :: AVL e -> AVL e
pushR'  AVL e
E        = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E
 pushR' (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putNR AVL e
l e
e AVL e
r
 pushR' (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putZR AVL e
l e
e AVL e
r
 pushR' (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
putPR AVL e
l e
e AVL e
r

 ----------------------------- LEVEL 2 ---------------------------------
 --                      putNR, putZR, putPR                          --
 -----------------------------------------------------------------------

 -- (putZR l e r): Put in R subtree of (Z l e r), BF= 0 (Never requires rebalancing) , (never returns P)
 putZR :: AVL e -> e -> AVL e -> AVL e
putZR AVL e
l e
e AVL e
E            = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E)            -- R subtree        H:0->1, parent BF: 0->-1
 putZR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putNR AVL e
rl e
re AVL e
rr     -- R subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'
 putZR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putPR AVL e
rl e
re AVL e
rr     -- R subtree BF<>0, H:h->h, parent BF: 0-> 0
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'
 putZR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putZR AVL e
rl e
re AVL e
rr     -- R subtree BF= 0, so need to look for changes
                          in case AVL e
r' of
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'         -- R subtree BF: 0-> 0, H:h->h  , parent BF: 0-> 0
                          N AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'         -- R subtree BF: 0->-1, H:h->h+1, parent BF: 0->-1
                          AVL e
_       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"pushR: Bug0" -- impossible

 -- (putPR l e r): Put in R subtree of (P l e r), BF=+1 (Never requires rebalancing) , (never returns N)
 putPR :: AVL e -> e -> AVL e -> AVL e
putPR AVL e
l e
e  AVL e
E           = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E)            -- R subtree empty, H:0->1,     parent BF:+1-> 0
 putPR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putNR AVL e
rl e
re AVL e
rr     -- R subtree BF<>0, H:h->h,     parent BF:+1->+1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'
 putPR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putPR AVL e
rl e
re AVL e
rr     -- R subtree BF<>0, H:h->h,     parent BF:+1->+1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'
 putPR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putZR AVL e
rl e
re AVL e
rr     -- R subtree BF= 0, so need to look for changes
                          in case AVL e
r' of
                          Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'         -- R subtree BF:0-> 0, H:h->h  , parent BF:+1->+1
                          N AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'         -- R subtree BF:0->-1, H:h->h+1, parent BF:+1-> 0
                          AVL e
_       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"pushR: Bug1" -- impossible

      -------- This case (NR) may need rebalancing if it goes to LEVEL 3 ---------

 -- (putNR l e r): Put in R subtree of (N l e r), BF=-1 , (never returns P)
 putNR :: AVL e -> e -> AVL e -> AVL e
putNR AVL e
_ e
_ AVL e
E            = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"pushR: Bug2"         -- impossible if BF=-1
 putNR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putNR AVL e
rl e
re AVL e
rr     -- R subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'
 putNR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
putPR AVL e
rl e
re AVL e
rr     -- R subtree BF<>0, H:h->h, parent BF:-1->-1
                          in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'
 putNR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRR AVL e
l e
e AVL e
rl e
re AVL e
rr         -- RR (never returns P)

 ----------------------------- LEVEL 3 ---------------------------------
 --                            putNRR                                 --
 -----------------------------------------------------------------------

 -- (putNRR l e rl re rr): Put in RR subtree of (N l e (Z rl re rr)) , (never returns P)
 {-# INLINE putNRR #-}
 putNRR :: AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRR AVL e
l e
e AVL e
rl e
re  AVL e
E              = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
rl) e
re (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e0 AVL e
forall e. AVL e
E)          -- l and rl must also be E, special CASE RR!!
 putNRR AVL e
l e
e AVL e
rl e
re (N AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = AVL e -> e -> AVL e -> AVL e
putNR AVL e
rrl e
rre AVL e
rrr         -- RR subtree BF<>0, H:h->h, so no change
                                    in AVL e
rr' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re AVL e
rr')
 putNRR AVL e
l e
e AVL e
rl e
re (P AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = AVL e -> e -> AVL e -> AVL e
putPR AVL e
rrl e
rre AVL e
rrr         -- RR subtree BF<>0, H:h->h, so no change
                                    in AVL e
rr' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re AVL e
rr')
 putNRR AVL e
l e
e AVL e
rl e
re (Z AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = AVL e -> e -> AVL e -> AVL e
putZR AVL e
rrl e
rre AVL e
rrr         -- RR subtree BF= 0, so need to look for changes
                                    in case AVL e
rr' of
                                    Z AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
rl e
re AVL e
rr')      -- RR subtree BF: 0-> 0, H:h->h, so no change
                                    N AVL e
_ e
_ AVL e
_ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
rl) e
re AVL e
rr'      -- RR subtree BF: 0->-1, H:h->h+1, parent BF:-1->-2, CASE RR !!
                                    AVL e
_       -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"pushR: Bug3"      -- impossible