-- |
-- Copyright   :  (c) Adrian Hey 2005
-- License     :  BSD3
--
-- This module provides a cheap but extremely limited and dangerous alternative
-- to using the Zipper. A BinPath provides a way of finding a particular element
-- in an AVL tree again without doing any comparisons. But a BinPath is ONLY VALID
-- IF THE TREE SHAPE DOES NOT CHANGE.
--
-- See the BAVL type in Data.Tree.AVL.Zipper module for a safer wrapper round these
-- functions.
module Data.Tree.AVL.BinPath
        (BinPath(..),findFullPath,findEmptyPath,openPath,openPathWith,readPath,writePath,insertPath,
        --  These are used by deletePath, which currently resides in Data.Tree.AVL.Internals.DelUtils
        sel,goL,goR,
        ) where
-- N.B. The deletePath function should really be here too, but has been put
-- in Data.Tree.AVL.Internals.DelUtils instead because deletion is a tangled web of circular
-- depencency.

import Data.Tree.AVL.Internals.Types(AVL(..))
import Data.COrdering

import GHC.Base
#include "ghcdefs.h"

-- Test path LSB
bit0 :: Int# -> Bool
{-# INLINE bit0 #-}
bit0 :: Int# -> Bool
bit0 Int#
p = Int# -> Bool
isTrue# (Word# -> Int#
word2Int# (Word# -> Word# -> Word#
and# (Int# -> Word#
int2Word# Int#
p) (Int# -> Word#
int2Word# Int#
1#)) Int# -> Int# -> Int#
==# Int#
1#)

-- | A pseudo comparison.
-- N.B. If the path was bit reversed, this could be a straight comparison?..
sel :: Int# -> Ordering
{-# INLINE sel #-}
sel :: Int# -> Ordering
sel Int#
p = if Int# -> Bool
isTrue# (Int#
p Int# -> Int# -> Int#
==# Int#
0#) then Ordering
EQ
                    else if Int# -> Bool
bit0 Int#
p then Ordering
LT -- Left  if Bit 0 == 1
                                   else Ordering
GT -- Right if Bit 0 == 0


-- | Modify path for entering left subtree
goL :: Int# -> Int#
{-# INLINE goL #-}
goL :: Int# -> Int#
goL Int#
p = Int# -> Int# -> Int#
iShiftRL# Int#
p Int#
1#

-- | Modify path for entering right subtree
goR :: Int# -> Int#
{-# INLINE goR #-}
goR :: Int# -> Int#
goR Int#
p = Int# -> Int# -> Int#
iShiftRL# (Int#
p Int# -> Int# -> Int#
-# Int#
1#) Int#
1#

-- | A BinPath is full if the search succeeded, empty otherwise.
data BinPath a = FullBP   {-# UNPACK #-} !UINT a -- Found
               | EmptyBP  {-# UNPACK #-} !UINT   -- Not Found

{-------------------------------------------------------------------------------------------
                                        Notes:
--------------------------------------------------------------------------------------------
The Binary paths are based on an indexing scheme that:
 1- Uniquely identifies each tree node
 2- Provides a simple algorithm for path generation.
 3- Provides a simple algorithm to locate a node in the tree, given it's path.

Imagine an infinite Binary Tree, with nodes indexed as follows:

          _____00_____             <- d=1
         /            \
      _01_            _02_         <- d=2
     /    \          /    \
   03      05      04      06      <- d=4
  /  \    /  \    /  \    /  \
 07  11  09  13  08  12  10  14    <- d=8
 <-------- More Layers ------->

To generate the node index (path) as we move down the tree we..
 1- Initialise index (i) to 0, and a parameter (d) to 1
 2- If we've arrived where we want, output i.
 3- Either Move left:  i <- i+d,  d <- 2d, goto 2
    or     Move right: i <- i+2d, d <- 2d, goto 2

To find a node, given its index (path) i, we..
 1- If i=0 then stop, we've arrived.
 2- If i is odd then move left , i <- (i-1)>>1,  goto 1  -- (i-1)>>1 =  i>>1     if i is odd
                else move right, i <- (i-1)>>1,  goto 1  -- (i-1)>>1 = (i>>1)-1  if i is even
Examples:
 i=05: (left ,i<-2):(right,i<-0):(stop)
 i=12: (right,i<-5):(left ,i<-2):(right,i<-0):(stop)

See also: pathTree in Data.Tree.AVL.Test.Utils for recursive implementation of the indexing scheme.
--------------------------------------------------------------------------------------------}

-- | Find the path to a AVL tree element, returns -1 (invalid path) if element not found
--
-- Complexity: O(log n)
findFullPath :: (e -> Ordering) -> AVL e -> UINT
-- ?? What about strictness if UINT is boxed (i.e. non-ghc)?
findFullPath :: forall e. (e -> Ordering) -> AVL e -> Int#
findFullPath e -> Ordering
c AVL e
t = Int# -> Int# -> AVL e -> Int#
find L(1) LAVL e
(0) t where
 find :: Int# -> Int# -> AVL e -> Int#
find  Int#
_ Int#
_  AVL e
E        = L(-1)
 find  Int#
d Int#
i (N AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> Int#
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find  Int#
d Int#
i (Z AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> Int#
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find  Int#
d Int#
i (P AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> Int#
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find' :: Int# -> Int# -> AVL e -> e -> AVL e -> Int#
find' Int#
d Int#
i    AVL e
l e
e AVL e
r  = case e -> Ordering
c e
e of
                       Ordering
LT    -> let d_ :: Int#
d_ = ADDINT(d,d) in find d_ ADDINT(i,d AVL e
) l
                       Ordering
EQ    -> Int#
i
                       Ordering
GT    -> let d_ :: Int#
d_ = ADDINT(d,d) in find d_ ADDINT(i,d_AVL e
) r -- d_ = 2d

-- | Find the path to a non-existant AVL tree element, returns -1 (invalid path) if element is found
--
-- Complexity: O(log n)
findEmptyPath :: (e -> Ordering) -> AVL e -> UINT
-- ?? What about strictness if UINT is boxed (i.e. non-ghc)?
findEmptyPath :: forall e. (e -> Ordering) -> AVL e -> Int#
findEmptyPath e -> Ordering
c AVL e
t = Int# -> Int# -> AVL e -> Int#
find L(1) LAVL e
(0) t where
 find :: Int# -> Int# -> AVL e -> Int#
find  Int#
_ Int#
i  AVL e
E        = Int#
i
 find  Int#
d Int#
i (N AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> Int#
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find  Int#
d Int#
i (Z AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> Int#
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find  Int#
d Int#
i (P AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> Int#
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find' :: Int# -> Int# -> AVL e -> e -> AVL e -> Int#
find' Int#
d Int#
i    AVL e
l e
e AVL e
r  = case e -> Ordering
c e
e of
                       Ordering
LT    -> let d_ :: Int#
d_ = ADDINT(d,d) in find d_ ADDINT(i,d AVL e
) l
                       Ordering
EQ    -> L(-1)
                       Ordering
GT    -> let d_ :: Int#
d_ = ADDINT(d,d) in find d_ ADDINT(i,d_AVL e
) r -- d_ = 2d

-- | Get the BinPath of an element using the supplied selector.
--
-- Complexity: O(log n)
openPath :: (e -> Ordering) -> AVL e -> BinPath e
openPath :: forall e. (e -> Ordering) -> AVL e -> BinPath e
openPath e -> Ordering
c AVL e
t = Int# -> Int# -> AVL e -> BinPath e
find L(1) LAVL e
(0) t where
 find :: Int# -> Int# -> AVL e -> BinPath e
find  Int#
_ Int#
i  AVL e
E        = Int# -> BinPath e
forall a. Int# -> BinPath a
EmptyBP Int#
i
 find  Int#
d Int#
i (N AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> BinPath e
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find  Int#
d Int#
i (Z AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> BinPath e
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find  Int#
d Int#
i (P AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> BinPath e
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find' :: Int# -> Int# -> AVL e -> e -> AVL e -> BinPath e
find' Int#
d Int#
i    AVL e
l e
e AVL e
r  = case e -> Ordering
c e
e of
                       Ordering
LT    -> let d_ :: Int#
d_ = ADDINT(d,d) in find d_ ADDINT(i,d AVL e
) l
                       Ordering
EQ    -> Int# -> e -> BinPath e
forall a. Int# -> a -> BinPath a
FullBP Int#
i e
e
                       Ordering
GT    -> let d_ :: Int#
d_ = ADDINT(d,d) in find d_ ADDINT(i,d_AVL e
) r -- d_ = 2d

-- | Get the BinPath of an element using the supplied (combining) selector.
--
-- Complexity: O(log n)
openPathWith :: (e -> COrdering a) -> AVL e -> BinPath a
openPathWith :: forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering a
c AVL e
t = Int# -> Int# -> AVL e -> BinPath a
find L(1) LAVL e
(0) t where
 find :: Int# -> Int# -> AVL e -> BinPath a
find  Int#
_ Int#
i  AVL e
E        = Int# -> BinPath a
forall a. Int# -> BinPath a
EmptyBP Int#
i
 find  Int#
d Int#
i (N AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> BinPath a
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find  Int#
d Int#
i (Z AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> BinPath a
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find  Int#
d Int#
i (P AVL e
l e
e AVL e
r) = Int# -> Int# -> AVL e -> e -> AVL e -> BinPath a
find' Int#
d Int#
i AVL e
l e
e AVL e
r
 find' :: Int# -> Int# -> AVL e -> e -> AVL e -> BinPath a
find' Int#
d Int#
i    AVL e
l e
e AVL e
r  = case e -> COrdering a
c e
e of
                       COrdering a
Lt   -> let d_ :: Int#
d_ = ADDINT(d,d) in find d_ ADDINT(i,d AVL e
) l
                       Eq a
a -> Int# -> a -> BinPath a
forall a. Int# -> a -> BinPath a
FullBP Int#
i a
a
                       COrdering a
Gt   -> let d_ :: Int#
d_ = ADDINT(d,d) in find d_ ADDINT(i,d_AVL e
) r -- d_ = 2d

-- | Overwrite a tree element. Assumes the path bits were extracted from 'FullBP' constructor.
-- Raises an error if the path leads to an empty tree.
--
-- N.B This operation does not change tree shape (no insertion occurs).
--
-- Complexity: O(log n)
writePath :: UINT -> e -> AVL e -> AVL e
writePath :: forall e. Int# -> e -> AVL e -> AVL e
writePath Int#
i0 e
e' AVL e
t = Int# -> AVL e -> AVL e
wp Int#
i0 AVL e
t where
 wp :: Int# -> AVL e -> AVL e
wp L(0)  E        = error "writePath: Bug0" -- Needed to force strictness in path
 wp L(0) (AVL e
N e
l AVL e
_ r) AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
= AVL e
N l e' r
 wp L(0) (AVL e
Z e
l AVL e
_ r) AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
= AVL e
Z l e' r
 wp L(0) (AVL e
P e
l AVL e
_ r) AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
= AVL e
P l e' r
 wp Int#
_  AVL e
E        = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"writePath: Bug1"
 wp Int#
i (N AVL e
l e
e AVL e
r) = if Int# -> Bool
bit0 Int#
i then let l' :: AVL e
l' = Int# -> AVL e -> AVL e
wp (Int# -> Int#
goL Int#
i) AVL e
l 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
                            else let r' :: AVL e
r' = Int# -> AVL e -> AVL e
wp (Int# -> Int#
goR Int#
i) AVL e
r 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'
 wp Int#
i (Z AVL e
l e
e AVL e
r) = if Int# -> Bool
bit0 Int#
i then let l' :: AVL e
l' = Int# -> AVL e -> AVL e
wp (Int# -> Int#
goL Int#
i) AVL e
l 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
                            else let r' :: AVL e
r' = Int# -> AVL e -> AVL e
wp (Int# -> Int#
goR Int#
i) AVL e
r 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'
 wp Int#
i (P AVL e
l e
e AVL e
r) = if Int# -> Bool
bit0 Int#
i then let l' :: AVL e
l' = Int# -> AVL e -> AVL e
wp (Int# -> Int#
goL Int#
i) AVL e
l 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
                            else let r' :: AVL e
r' = Int# -> AVL e -> AVL e
wp (Int# -> Int#
goR Int#
i) AVL e
r 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'

-- | Read a tree element. Assumes the path bits were extracted from 'FullBP' constructor.
-- Raises an error if the path leads to an empty tree.
--
-- Complexity: O(log n)
readPath :: UINT -> AVL e -> e
readPath :: forall e. Int# -> AVL e -> e
readPath L(0)  E        = error "readPath: Bug0" -- Needed to force strictness in path
readPath L(0) (AVL e
N e
_ AVL e
e _) e
= e
readPath L(0) (AVL e
Z e
_ AVL e
e _) e
= e
readPath L(0) (AVL e
P e
_ AVL e
e _) e
= e
readPath Int#
_     AVL e
E        = [Char] -> e
forall a. HasCallStack => [Char] -> a
error [Char]
"readPath: Bug1"
readPath Int#
i    (N AVL e
l e
_ AVL e
r) = Int# -> AVL e -> AVL e -> e
forall e. Int# -> AVL e -> AVL e -> e
readPath_ Int#
i AVL e
l AVL e
r
readPath Int#
i    (Z AVL e
l e
_ AVL e
r) = Int# -> AVL e -> AVL e -> e
forall e. Int# -> AVL e -> AVL e -> e
readPath_ Int#
i AVL e
l AVL e
r
readPath Int#
i    (P AVL e
l e
_ AVL e
r) = Int# -> AVL e -> AVL e -> e
forall e. Int# -> AVL e -> AVL e -> e
readPath_ Int#
i AVL e
l AVL e
r
readPath_ :: UINT -> AVL e -> AVL e -> e
readPath_ :: forall e. Int# -> AVL e -> AVL e -> e
readPath_ Int#
i AVL e
l AVL e
r = if Int# -> Bool
bit0 Int#
i then Int# -> AVL e -> e
forall e. Int# -> AVL e -> e
readPath (Int# -> Int#
goL Int#
i) AVL e
l
                            else Int# -> AVL e -> e
forall e. Int# -> AVL e -> e
readPath (Int# -> Int#
goR Int#
i) AVL e
r

-- | Inserts a new tree element. Assumes the path bits were extracted from a 'EmptyBP' constructor.
-- This function replaces the first Empty node it encounters with the supplied value, regardless
-- of the current path bits (which are not checked). DO NOT USE THIS FOR REPLACING ELEMENTS ALREADY
-- PRESENT IN THE TREE (use 'writePath' for this).
--
-- Complexity: O(log n)
insertPath :: UINT -> e -> AVL e -> AVL e
insertPath :: forall e. Int# -> e -> AVL e -> AVL e
insertPath Int#
i0 e
e0 AVL e
t = Int# -> AVL e -> AVL e
put Int#
i0 AVL e
t where
 ----------------------------- LEVEL 0 ---------------------------------
 --                             put                                   --
 -----------------------------------------------------------------------
 put :: Int# -> AVL e -> AVL e
put Int#
_  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 Int#
i (N AVL e
l e
e AVL e
r) = Int# -> AVL e -> e -> AVL e -> AVL e
putN Int#
i AVL e
l e
e  AVL e
r
 put Int#
i (Z AVL e
l e
e AVL e
r) = Int# -> AVL e -> e -> AVL e -> AVL e
putZ Int#
i AVL e
l e
e  AVL e
r
 put Int#
i (P AVL e
l e
e AVL e
r) = Int# -> AVL e -> e -> AVL e -> AVL e
putP Int#
i 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 :: Int# -> AVL e -> e -> AVL e -> AVL e
putN Int#
i AVL e
l e
e AVL e
r = if Int# -> Bool
bit0 Int#
i then Int# -> AVL e -> e -> AVL e -> AVL e
putNL Int#
i AVL e
l e
e AVL e
r  -- put in L subtree
                          else Int# -> AVL e -> e -> AVL e -> AVL e
putNR Int#
i AVL e
l e
e AVL e
r  -- put in R subtree

 -- Put in (Z l e r), BF= 0
 putZ :: Int# -> AVL e -> e -> AVL e -> AVL e
putZ Int#
i AVL e
l e
e AVL e
r = if Int# -> Bool
bit0 Int#
i then Int# -> AVL e -> e -> AVL e -> AVL e
putZL Int#
i AVL e
l e
e AVL e
r  -- put in L subtree
                          else Int# -> AVL e -> e -> AVL e -> AVL e
putZR Int#
i AVL e
l e
e AVL e
r  -- put in R subtree

 -- Put in (P l e r), BF=+1 , (never returns N)
 putP :: Int# -> AVL e -> e -> AVL e -> AVL e
putP Int#
i AVL e
l e
e AVL e
r = if Int# -> Bool
bit0 Int#
i then Int# -> AVL e -> e -> AVL e -> AVL e
putPL Int#
i AVL e
l e
e AVL e
r  -- put in L subtree
                          else Int# -> AVL e -> e -> AVL e -> AVL e
putPR Int#
i AVL e
l e
e AVL e
r  -- 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 :: Int# -> AVL e -> e -> AVL e -> AVL e
putNL Int#
_ 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 Int#
i (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = Int# -> AVL e -> e -> AVL e -> AVL e
putN (Int# -> Int#
goL Int#
i) 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 Int#
i (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = Int# -> AVL e -> e -> AVL e -> AVL e
putP (Int# -> Int#
goL Int#
i) 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 Int#
i (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = Int# -> AVL e -> e -> AVL e -> AVL e
putZ (Int# -> Int#
goL Int#
i) 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]
"insertPath: 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 :: Int# -> AVL e -> e -> AVL e -> AVL e
putZL Int#
_  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 Int#
i (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = Int# -> AVL e -> e -> AVL e -> AVL e
putN (Int# -> Int#
goL Int#
i) 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 Int#
i (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = Int# -> AVL e -> e -> AVL e -> AVL e
putP (Int# -> Int#
goL Int#
i) 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 Int#
i (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = Int# -> AVL e -> e -> AVL e -> AVL e
putZ (Int# -> Int#
goL Int#
i) 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]
"insertPath: 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 :: Int# -> AVL e -> e -> AVL e -> AVL e
putZR Int#
_ 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 Int#
i AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = Int# -> AVL e -> e -> AVL e -> AVL e
putN (Int# -> Int#
goR Int#
i) 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 Int#
i AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = Int# -> AVL e -> e -> AVL e -> AVL e
putP (Int# -> Int#
goR Int#
i) 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 Int#
i AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = Int# -> AVL e -> e -> AVL e -> AVL e
putZ (Int# -> Int#
goR Int#
i) 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]
"insertPath: 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 :: Int# -> AVL e -> e -> AVL e -> AVL e
putPR Int#
_ 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 Int#
i AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = Int# -> AVL e -> e -> AVL e -> AVL e
putN (Int# -> Int#
goR Int#
i) 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 Int#
i AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = Int# -> AVL e -> e -> AVL e -> AVL e
putP (Int# -> Int#
goR Int#
i) 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 Int#
i AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = Int# -> AVL e -> e -> AVL e -> AVL e
putZ (Int# -> Int#
goR Int#
i) 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]
"insertPath: 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 :: Int# -> AVL e -> e -> AVL e -> AVL e
putNR Int#
_ AVL e
_ e
_ AVL e
E            = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"insertPath: Bug4"           -- impossible if BF=-1
 putNR Int#
i AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = Int# -> AVL e -> e -> AVL e -> AVL e
putN (Int# -> Int#
goR Int#
i) 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 Int#
i AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let r' :: AVL e
r' = Int# -> AVL e -> e -> AVL e -> AVL e
putP (Int# -> Int#
goR Int#
i) 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 Int#
i AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let i' :: Int#
i' = Int# -> Int#
goR Int#
i in if Int# -> Bool
bit0 Int#
i' then Int# -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRL Int#
i' AVL e
l e
e AVL e
rl e
re AVL e
rr -- RL (never returns P)
                                                         else Int# -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRR Int#
i' 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 :: Int# -> AVL e -> e -> AVL e -> AVL e
putPL Int#
_  AVL e
E           e
_ AVL e
_ = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"insertPath: Bug5"           -- impossible if BF=+1
 putPL Int#
i (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = Int# -> AVL e -> e -> AVL e -> AVL e
putN (Int# -> Int#
goL Int#
i) 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 Int#
i (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = Int# -> AVL e -> e -> AVL e -> AVL e
putP (Int# -> Int#
goL Int#
i) 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 Int#
i (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let i' :: Int#
i' = Int# -> Int#
goL Int#
i in if Int# -> Bool
bit0 Int#
i' then Int# -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLL Int#
i' AVL e
ll e
le AVL e
lr e
e AVL e
r -- LL (never returns N)
                                                         else Int# -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLR Int#
i' 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 :: Int# -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRR Int#
_ 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 Int#
i AVL e
l e
e AVL e
rl e
re (N AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = Int# -> AVL e -> e -> AVL e -> AVL e
putN (Int# -> Int#
goR Int#
i) 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 Int#
i AVL e
l e
e AVL e
rl e
re (P AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = Int# -> AVL e -> e -> AVL e -> AVL e
putP (Int# -> Int#
goR Int#
i) 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 Int#
i AVL e
l e
e AVL e
rl e
re (Z AVL e
rrl e
rre AVL e
rrr) = let rr' :: AVL e
rr' = Int# -> AVL e -> e -> AVL e -> AVL e
putZ (Int# -> Int#
goR Int#
i) 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]
"insertPath: 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 :: Int# -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLL Int#
_  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 Int#
i (N AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = Int# -> AVL e -> e -> AVL e -> AVL e
putN (Int# -> Int#
goL Int#
i) 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 Int#
i (P AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = Int# -> AVL e -> e -> AVL e -> AVL e
putP (Int# -> Int#
goL Int#
i) 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 Int#
i (Z AVL e
lll e
lle AVL e
llr) e
le AVL e
lr e
e AVL e
r = let ll' :: AVL e
ll' = Int# -> AVL e -> e -> AVL e -> AVL e
putZ (Int# -> Int#
goL Int#
i) 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]
"insertPath: 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 :: Int# -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putNRL Int#
_ 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 Int#
i AVL e
l e
e (N AVL e
rll e
rle AVL e
rlr) e
re AVL e
rr = let rl' :: AVL e
rl' = Int# -> AVL e -> e -> AVL e -> AVL e
putN (Int# -> Int#
goL Int#
i) 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 Int#
i AVL e
l e
e (P AVL e
rll e
rle AVL e
rlr) e
re AVL e
rr = let rl' :: AVL e
rl' = Int# -> AVL e -> e -> AVL e -> AVL e
putP (Int# -> Int#
goL Int#
i) 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 Int#
i AVL e
l e
e (Z AVL e
rll e
rle AVL e
rlr) e
re AVL e
rr = let rl' :: AVL e
rl' = Int# -> AVL e -> e -> AVL e -> AVL e
putZ (Int# -> Int#
goL Int#
i) 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]
"insertPath: 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 :: Int# -> AVL e -> e -> AVL e -> e -> AVL e -> AVL e
putPLR Int#
_ 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 Int#
i AVL e
ll e
le (N AVL e
lrl e
lre AVL e
lrr) e
e AVL e
r = let lr' :: AVL e
lr' = Int# -> AVL e -> e -> AVL e -> AVL e
putN (Int# -> Int#
goR Int#
i) 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 Int#
i AVL e
ll e
le (P AVL e
lrl e
lre AVL e
lrr) e
e AVL e
r = let lr' :: AVL e
lr' = Int# -> AVL e -> e -> AVL e -> AVL e
putP (Int# -> Int#
goR Int#
i) 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 Int#
i AVL e
ll e
le (Z AVL e
lrl e
lre AVL e
lrr) e
e AVL e
r = let lr' :: AVL e
lr' = Int# -> AVL e -> e -> AVL e -> AVL e
putZ (Int# -> Int#
goR Int#
i) 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]
"insertPath: 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) !!