{-# OPTIONS_GHC -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Tree.AVL.Zipper
-- Copyright   :  (c) Adrian Hey 2004,2005
-- License     :  BSD3
--
-- Maintainer  :  http://homepages.nildram.co.uk/~ahey/em.png
-- Stability   :  stable
-- Portability :  portable
--
-- An implementation of \"The Zipper\" for AVL trees. This can be used like
-- a functional pointer to a serial data structure which can be navigated
-- and modified, without having to worry about all those tricky tree balancing
-- issues. See JFP Vol.7 part 5 or ..
--
-- <http://haskell.org/hawiki/TheZipper>
--
-- Notes about efficiency:
--
-- The functions defined here provide a useful way to achieve those awkward
-- operations which may not be covered by the rest of this package. They're
-- reasonably efficient (mostly O(log n) or better), but zipper flexibility
-- is bought at the expense of keeping path information explicitly as a heap
-- data structure rather than implicitly on the stack. Since heap storage
-- probably costs more, zipper operations will are likely to incur higher
-- constant factors than equivalent non-zipper operations (if available).
--
-- Some of the functions provided here may appear to be weird combinations of
-- functions from a more logical set of primitives. They are provided because
-- they are not really simple combinations of the corresponding primitives.
-- They are more efficient, so you should use them if possible (e.g combining
-- deleting with Zipper closing).
--
-- Also, consider using the 'BAVL' as a cheaper alternative if you don't actually
-- need to navigate the tree.
-----------------------------------------------------------------------------
module Data.Tree.AVL.Zipper
        (-- * Types.
         ZAVL,PAVL,

         -- * Opening.
         assertOpenL,assertOpenR,
         tryOpenL,tryOpenR,
         genAssertOpen,genTryOpen,
         genTryOpenGE,genTryOpenLE,
         genOpenEither,

         -- * Closing.
         close,fillClose,

         -- * Manipulating the current element.
         getCurrent,putCurrent,applyCurrent,applyCurrent',

         -- * Moving.
         assertMoveL,assertMoveR,tryMoveL,tryMoveR,

         -- * Inserting elements.
         insertL,insertR,insertMoveL,insertMoveR,fill,

         -- * Deleting elements.
         delClose,
         assertDelMoveL,assertDelMoveR,tryDelMoveR,tryDelMoveL,
         delAllL,delAllR,
         delAllCloseL,delAllCloseR,
         delAllIncCloseL,delAllIncCloseR,

         -- * Inserting AVL trees.
         insertTreeL,insertTreeR,

         -- * Current element status.
         isLeftmost,isRightmost,
         sizeL,sizeR,

         -- * Operations on whole zippers.
         sizeZAVL,

         -- * A cheaper option is to use BAVL
         -- | These are a cheaper but more restrictive alternative to using the full Zipper.
         -- They use \"Binary Paths\" (Ints) to point to a particular element of an 'AVL' tree.
         -- Use these when you don't need to navigate the tree, you just want to look at a
         -- particular element (and perhaps modify or delete it). The advantage of these is
         -- that they don't create the usual Zipper heap structure, so they will be faster
         -- (and reduce heap burn rate too).
         -- 
         -- If you subsequently decide you need a Zipper rather than a BAVL then some conversion
         -- utilities are provided.

         -- ** Types.
         BAVL,

         -- ** Opening and closing.
         genOpenBAVL,closeBAVL,

         -- ** Inspecting status.
         fullBAVL,emptyBAVL,tryReadBAVL,readFullBAVL,

         -- ** Modifying the tree.
         pushBAVL,deleteBAVL,

         -- ** Converting to BAVL to Zipper.
         -- | These are O(log n) operations but with low constant factors because no comparisons
         -- are required (and the tree nodes on the path will most likely still be in cache as
         -- a result of opening the BAVL in the first place).
         fullBAVLtoZAVL,emptyBAVLtoPAVL,anyBAVLtoEither,

        ) where 

import Prelude -- so haddock finds the symbols there

import Data.Tree.AVL.Types(AVL(..))
import Data.Tree.AVL.Size(size,addSize)
import Data.Tree.AVL.Internals.DelUtils(deletePath,popRN,popRZ,popRP,popLN,popLZ,popLP)
import Data.Tree.AVL.Internals.HeightUtils(height,addHeight)
import Data.Tree.AVL.Internals.HJoin(spliceH,joinH)
import Data.Tree.AVL.Internals.HPush(pushHL,pushHR)
import Data.Tree.AVL.Internals.BinPath(BinPath(..),genOpenPath,writePath,insertPath,sel,goL,goR)

#ifdef __GLASGOW_HASKELL__
import GHC.Base
#include "ghcdefs.h"
#else
#include "h98defs.h"
#endif

-- N.B. Zippers are always opened using relative heights for efficiency reasons. On the
-- whole this causes no problems, except when inserting entire AVL trees or substituting
-- the empty tree. (These cases have some minor height computation overhead).

-- | Abstract data type for a successfully opened AVL tree. All ZAVL\'s are non-empty!
-- A ZAVL can be tought of as a functional pointer to an AVL tree element.
data ZAVL e = ZAVL (Path e) (AVL e) !UINT e (AVL e) !UINT 

-- | Abstract data type for an unsuccessfully opened AVL tree.
-- A PAVL can be tought of as a functional pointer to the gap
-- where the expected element should be (but isn't). You can fill this gap using
-- the 'fill' function, or fill and close at the same time using the 'fillClose' function.
data PAVL e = PAVL (Path e) !UINT

data Path e = EP                          -- Empty Path
            | LP (Path e) e (AVL e) !UINT -- Left subtree was taken
            | RP (Path e) e (AVL e) !UINT -- Right subtree was taken

-- Local Closing Utility
close_ :: Path e -> AVL e -> UINT -> AVL e
close_  EP        t _ = t
close_ (LP p e r hr) l hl = case spliceH l hl e r hr of UBT2(t,ht) -> close_ p t ht
close_ (RP p e l hl) r hr = case spliceH l hl e r hr of UBT2(t,ht) -> close_ p t ht

-- Local Utility to remove all left paths from a path
noLP :: Path e -> Path e
noLP  EP           = EP
noLP (LP p _ _ _ ) = noLP p
noLP (RP p e l hl) = let p_ = noLP p in p_ `seq` RP p_ e l hl

-- Local Utility to remove all right paths from a path
noRP :: Path e -> Path e
noRP  EP           = EP
noRP (LP p e r hr) = let p_ = noRP p in p_ `seq` LP p_ e r hr
noRP (RP p _ _ _ ) = noRP p

-- Local Closing Utility which ignores all left paths
closeNoLP :: Path e -> AVL e -> UINT -> AVL e
closeNoLP  EP           t _  = t
closeNoLP (LP p _ _ _ ) l hl = closeNoLP p l hl
closeNoLP (RP p e l hl) r hr = case spliceH l hl e r hr of UBT2(t,ht) -> closeNoLP p t ht

-- Local Closing Utility which ignores all right paths
closeNoRP :: Path e -> AVL e -> UINT -> AVL e
closeNoRP  EP           t _  = t
closeNoRP (LP p e r hr) l hl = case spliceH l hl e r hr of UBT2(t,ht) -> closeNoRP p t ht
closeNoRP (RP p _ _ _ ) r hr = closeNoRP p r hr

-- Add size of all path elements. 
addSizeP :: Int -> Path e -> Int
addSizeP n  EP          = n
addSizeP n (LP p _ r _) = addSizeP (addSize (n+1) r) p
addSizeP n (RP p _ l _) = addSizeP (addSize (n+1) l) p

-- Add size of all RP path elements. 
addSizeRP :: Int -> Path e -> Int
addSizeRP n  EP          = n
addSizeRP n (LP p _ _ _) = addSizeRP n p
addSizeRP n (RP p _ l _) = addSizeRP (addSize (n+1) l) p

-- Add size of all LP path elements. 
addSizeLP :: Int -> Path e -> Int
addSizeLP n  EP          = n
addSizeLP n (LP p _ r _) = addSizeLP (addSize (n+1) r) p
addSizeLP n (RP p _ _ _) = addSizeLP n p

-- | Opens a sorted AVL tree at the element given by the supplied selector. This function
-- raises an error if the tree does not contain such an element.
--
-- Complexity: O(log n) 
genAssertOpen :: (e -> Ordering) -> AVL e -> ZAVL e
genAssertOpen c t = op EP L(0) t where -- Relative heights !!
 -- op :: (Path e) -> UINT -> AVL e -> ZAVL e
 op _ _  E        = error "genAssertOpen: No matching element."
 op p h (N l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT2(h) l
                    EQ -> ZAVL p l DECINT2(h) e r DECINT1(h)
                    GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` op p_ DECINT1(h) r
 op p h (Z l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT1(h) l
                    EQ -> ZAVL p l DECINT1(h) e r DECINT1(h)
                    GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT1(h) r
 op p h (P l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` op p_ DECINT1(h) l
                    EQ -> ZAVL p l DECINT1(h) e r DECINT2(h)
                    GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT2(h) r

-- | Attempts to open a sorted AVL tree at the element given by the supplied selector.
-- This function returns 'Nothing' if there is no such element.
--
-- Note that this operation will still create a zipper path structure on the heap (which
-- is promptly discarded) if the search fails, and so is potentially inefficient if failure
-- is likely. In cases like this it may be better to use 'genOpenBAVL', test for \"fullness\"
-- using 'fullBAVL' and then convert to a 'ZAVL' using 'fullBAVLtoZAVL'.
--
-- Complexity: O(log n) 
genTryOpen :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
genTryOpen c t = op EP L(0) t where -- Relative heights !!
 -- op :: (Path e) -> UINT -> AVL e -> Maybe (ZAVL e)
 op _ _  E        = Nothing
 op p h (N l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT2(h) l
                    EQ -> Just $! ZAVL p l DECINT2(h) e r DECINT1(h)
                    GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` op p_ DECINT1(h) r
 op p h (Z l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT1(h) l
                    EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT1(h)
                    GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT1(h) r
 op p h (P l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` op p_ DECINT1(h) l
                    EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT2(h)
                    GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT2(h) r

-- | Attempts to open a sorted AVL tree at the least element which is greater than or equal, according to
-- the supplied selector. This function returns 'Nothing' if the tree does not contain such an element.
--
-- Complexity: O(log n) 
genTryOpenGE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
genTryOpenGE c t = op EP L(0) t where -- Relative heights !!
 -- op :: (Path e) -> UINT -> AVL e -> ZAVL e
 op p h  E        = backupR p E h where
                     backupR  EP            _ _  = Nothing
                     backupR (LP p_ e r hr) l hl = Just $! ZAVL p_ l hl e r hr
                     backupR (RP p_ e l hl) r hr = case spliceH l hl e r hr of UBT2(t_,ht_) -> backupR p_ t_ ht_
 op p h (N l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT2(h) l
                    EQ -> Just $! ZAVL p l DECINT2(h) e r DECINT1(h)
                    GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` op p_ DECINT1(h) r
 op p h (Z l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT1(h) l
                    EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT1(h)
                    GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT1(h) r
 op p h (P l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` op p_ DECINT1(h) l
                    EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT2(h)
                    GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT2(h) r

-- | Attempts to open a sorted AVL tree at the greatest element which is less than or equal, according to
-- the supplied selector. This function returns _Nothing_ if the tree does not contain such an element.
--
-- Complexity: O(log n) 
genTryOpenLE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
genTryOpenLE c t = op EP L(0) t where -- Relative heights !!
 -- op :: (Path e) -> UINT -> AVL e -> ZAVL e
 op p h  E        = backupL p E h where
                     backupL  EP            _ _  = Nothing
                     backupL (LP p_ e r hr) l hl = case spliceH l hl e r hr of UBT2(t_,ht_) -> backupL p_ t_ ht_
                     backupL (RP p_ e l hl) r hr = Just $! ZAVL p_ l hl e r hr
 op p h (N l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT2(h) l
                    EQ -> Just $! ZAVL p l DECINT2(h) e r DECINT1(h)
                    GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` op p_ DECINT1(h) r
 op p h (Z l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT1(h) l
                    EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT1(h)
                    GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT1(h) r
 op p h (P l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` op p_ DECINT1(h) l
                    EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT2(h)
                    GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT2(h) r

-- | Opens a non-empty AVL tree at the leftmost element.
-- This function raises an error if the tree is empty.
--
-- Complexity: O(log n) 
assertOpenL :: AVL e -> ZAVL e
assertOpenL  E        = error "assertOpenL: Empty tree."
assertOpenL (N l e r) = openLN EP L(0) l e r            -- Relative heights !!  
assertOpenL (Z l e r) = openLZ EP L(0) l e r            -- Relative heights !! 
assertOpenL (P l e r) = openL_ (LP EP e r L(0)) L(1) l  -- Relative heights !!

-- | Attempts to open a non-empty AVL tree at the leftmost element.
-- This function returns 'Nothing' if the tree is empty.
--
-- Complexity: O(log n) 
tryOpenL :: AVL e -> Maybe (ZAVL e)
tryOpenL  E        = Nothing
tryOpenL (N l e r) = Just $! openLN EP L(0) l e r             -- Relative heights !!  
tryOpenL (Z l e r) = Just $! openLZ EP L(0) l e r             -- Relative heights !!
tryOpenL (P l e r) = Just $! openL_ (LP EP e r L(0)) L(1) l   -- Relative heights !!

-- Local utility for opening at the leftmost element, using current path and height.
openL_ :: (Path e) -> UINT -> AVL e -> ZAVL e
openL_ _ _  E        = error "openL_: Bug0"
openL_ p h (N l e r) = openLN p h l e r                                                      
openL_ p h (Z l e r) = openLZ p h l e r                                                      
openL_ p h (P l e r) = let p_ = LP p e r DECINT2(h) in p_ `seq` openL_ p_ DECINT1(h) l
                        
-- Open leftmost of (N l e r), where l may be E
openLN :: (Path e) -> UINT -> AVL e -> e -> AVL e -> ZAVL e
openLN p h  E           e r = ZAVL p E DECINT2(h) e r DECINT1(h) 
openLN p h (N ll le lr) e r = let p_  = LP p e r DECINT1(h) in p_ `seq` openLN p_ DECINT2(h) ll le lr 
openLN p h (Z ll le lr) e r = let p_  = LP p e r DECINT1(h) in p_ `seq` openLZ p_ DECINT2(h) ll le lr 
openLN p h (P ll le lr) e r = let p_  = LP p e r DECINT1(h)
                                  p__ = p_ `seq` LP p_ le lr DECINT4(h)                   
                              in p__ `seq` openL_ p__ DECINT3(h) ll 
-- Open leftmost of (Z l e r), where l may be E
openLZ :: (Path e) -> UINT -> AVL e -> e -> AVL e -> ZAVL e
openLZ p h  E           e r = ZAVL p E DECINT1(h) e r DECINT1(h) 
openLZ p h (N ll le lr) e r = let p_  = LP p e r DECINT1(h) in p_ `seq` openLN p_ DECINT1(h) ll le lr 
openLZ p h (Z ll le lr) e r = let p_  = LP p e r DECINT1(h) in p_ `seq` openLZ p_ DECINT1(h) ll le lr 
openLZ p h (P ll le lr) e r = let p_  = LP p e r DECINT1(h)
                                  p__ = p_ `seq` LP p_ le lr DECINT3(h)                     
                              in p__ `seq` openL_ p__ DECINT2(h) ll 

-- | Opens a non-empty AVL tree at the rightmost element.
-- This function raises an error if the tree is empty.
--
-- Complexity: O(log n) 
assertOpenR :: AVL e -> ZAVL e
assertOpenR  E        = error "assertOpenR: Empty tree."
assertOpenR (N l e r) = openR_ (RP EP e l L(0)) L(1) r  -- Relative heights !!
assertOpenR (Z l e r) = openRZ EP L(0) l e r            -- Relative heights !!
assertOpenR (P l e r) = openRP EP L(0) l e r            -- Relative heights !! 

-- | Attempts to open a non-empty AVL tree at the rightmost element.
-- This function returns 'Nothing' if the tree is empty.
--
-- Complexity: O(log n) 
tryOpenR :: AVL e -> Maybe (ZAVL e)
tryOpenR  E        = Nothing
tryOpenR (N l e r) = Just $! openR_ (RP EP e l L(0)) L(1) r  -- Relative heights !!
tryOpenR (Z l e r) = Just $! openRZ EP L(0) l e r            -- Relative heights !!
tryOpenR (P l e r) = Just $! openRP EP L(0) l e r            -- Relative heights !!  

-- Local utility for opening at the rightmost element, using current path and height.
openR_ :: (Path e) -> UINT -> AVL e -> ZAVL e
openR_ _ _  E        = error "openR_: Bug0"
openR_ p h (N l e r) = let p_ = RP p e l DECINT2(h) in p_ `seq` openR_ p_ DECINT1(h) r 
openR_ p h (Z l e r) = openRZ p h l e r                                 
openR_ p h (P l e r) = openRP p h l e r                                 
-- Open rightmost of (P l e r), where r may be E
openRP :: (Path e) -> UINT -> AVL e -> e -> AVL e -> ZAVL e
openRP p h l e  E           = ZAVL p l DECINT1(h) e E DECINT2(h)  
openRP p h l e (N rl re rr) = let p_  = RP p e l DECINT1(h)
                                  p__ = p_ `seq` RP p_ re rl DECINT4(h)                    
                              in p__ `seq` openR_ p__ DECINT3(h) rr 
openRP p h l e (Z rl re rr) = let p_ = RP p e l DECINT1(h) in p_ `seq` openRZ p_ DECINT2(h) rl re rr 
openRP p h l e (P rl re rr) = let p_ = RP p e l DECINT1(h) in p_ `seq` openRP p_ DECINT2(h) rl re rr 
-- Open rightmost of (Z l e r), where r may be E
openRZ :: (Path e) -> UINT -> AVL e -> e -> AVL e -> ZAVL e
openRZ p h l e  E           = ZAVL p l DECINT1(h) e E DECINT1(h)  
openRZ p h l e (N rl re rr) = let p_  = RP p e l DECINT1(h)
                                  p__ = p_ `seq` RP p_ re rl DECINT3(h)                    
                              in p__ `seq` openR_ p__ DECINT2(h) rr
openRZ p h l e (Z rl re rr) = let p_ = RP p e l DECINT1(h) in p_ `seq` openRZ p_ DECINT1(h) rl re rr
openRZ p h l e (P rl re rr) = let p_ = RP p e l DECINT1(h) in p_ `seq` openRP p_ DECINT1(h) rl re rr

-- | Returns @('Right' zavl)@ if the expected element was found, @('Left' pavl)@ if the
-- expected element was not found. It's OK to use this function on empty trees.
--
-- Complexity: O(log n)
genOpenEither :: (e -> Ordering) -> AVL e -> Either (PAVL e) (ZAVL e)
genOpenEither c t = op EP L(0) t where -- Relative heights !!
 -- op :: (Path e) -> UINT -> AVL e -> Either (PAVL e) (ZAVL e)
 op p h  E        = Left $! PAVL p h
 op p h (N l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT2(h) l
                    EQ -> Right $! ZAVL p l DECINT2(h) e r DECINT1(h)
                    GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` op p_ DECINT1(h) r
 op p h (Z l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT1(h) l
                    EQ -> Right $! ZAVL p l DECINT1(h) e r DECINT1(h)
                    GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT1(h) r
 op p h (P l e r) = case c e of
                    LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` op p_ DECINT1(h) l
                    EQ -> Right $! ZAVL p l DECINT1(h) e r DECINT2(h)
                    GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT2(h) r

-- | Fill the gap pointed to by a 'PAVL' with the supplied element, which becomes
-- the current element of the resulting 'ZAVL'. The supplied filling element should
-- be \"equal\" to the value used in the search which created the 'PAVL'.
--
-- Complexity: O(1)
fill :: e -> PAVL e -> ZAVL e
fill e (PAVL p h) = ZAVL p E h e E h

-- | Essentially the same operation as 'fill', but the resulting 'ZAVL' is closed
-- immediately.
--
-- Complexity: O(log n)
fillClose :: e -> PAVL e -> AVL e
fillClose e (PAVL p h) = close_ p (Z E e E) INCINT1(h)

-- | Closes a Zipper.
--
-- Complexity: O(log n)
close :: ZAVL e -> AVL e
close (ZAVL p l hl e r hr) = case spliceH l hl e r hr of UBT2(t,ht) -> close_ p t ht

-- | Deletes the current element and then closes the Zipper.
--
-- Complexity: O(log n)
delClose :: ZAVL e -> AVL e
delClose (ZAVL p l hl _ r hr) = case joinH l hl r hr of UBT2(t,ht) -> close_ p t ht

-- | Gets the current element of a Zipper.
--
-- Complexity: O(1)
getCurrent :: ZAVL e -> e
getCurrent (ZAVL _ _ _ e _ _) = e

-- | Overwrites the current element of a Zipper.
--
-- Complexity: O(1)
putCurrent :: e -> ZAVL e -> ZAVL e
putCurrent e (ZAVL p l hl _ r hr) = ZAVL p l hl e r hr

-- | Applies a function to the current element of a Zipper (lazily).
-- See also 'applyCurrent'' for a strict version of this function.
--
-- Complexity: O(1)
applyCurrent :: (e -> e) -> ZAVL e -> ZAVL e
applyCurrent f (ZAVL p l hl e r hr) = ZAVL p l hl (f e) r hr

-- | Applies a function to the current element of a Zipper strictly.
-- See also 'applyCurrent' for a non-strict version of this function.
--
-- Complexity: O(1)
applyCurrent' :: (e -> e) -> ZAVL e -> ZAVL e
applyCurrent' f (ZAVL p l hl e r hr) = let e_ = f e in e_ `seq` ZAVL p l hl e_ r hr

-- | Moves one step left.
-- This function raises an error if the current element is already the leftmost element.
--
-- Complexity: O(1) average, O(log n) worst case.
assertMoveL :: ZAVL e -> ZAVL e
assertMoveL (ZAVL p E           _   e r hr) = case pushHL e r hr of UBT2(t,ht) -> cR p t ht
 where cR  EP               _  _   = error "assertMoveL: Can't move left."
       cR (LP p_ e_ r_ hr_) l_ hl_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> cR p_ t ht    
       cR (RP p_ e_ l_ hl_) r_ hr_ = ZAVL p_ l_ hl_ e_ r_ hr_
assertMoveL (ZAVL p (N ll le lr) hl e r hr) = let p_ = RP (LP p e r hr) le ll DECINT2(hl)
                                              in p_ `seq` openR_ p_ DECINT1(hl) lr
assertMoveL (ZAVL p (Z ll le lr) hl e r hr) = openRZ (LP p e r hr) hl ll le lr
assertMoveL (ZAVL p (P ll le lr) hl e r hr) = openRP (LP p e r hr) hl ll le lr

-- | Attempts to move one step left.
-- This function returns 'Nothing' if the current element is already the leftmost element.
--
-- Complexity: O(1) average, O(log n) worst case.
tryMoveL :: ZAVL e -> Maybe (ZAVL e)
tryMoveL (ZAVL p E            _  e r hr) = case pushHL e r hr of UBT2(t,ht) -> cR p t ht
 where cR  EP               _  _      = Nothing
       cR (LP p_ e_ r_ hr_) l_ hl_    = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> cR p_ t ht    
       cR (RP p_ e_ l_ hl_) r_ hr_    = Just $! ZAVL p_ l_ hl_ e_ r_ hr_
tryMoveL (ZAVL p (N ll le lr) hl e r hr) = Just $! let p_ = RP (LP p e r hr) le ll DECINT2(hl)
                                                   in p_ `seq` openR_ p_ DECINT1(hl) lr
tryMoveL (ZAVL p (Z ll le lr) hl e r hr) = Just $! openRZ (LP p e r hr) hl ll le lr
tryMoveL (ZAVL p (P ll le lr) hl e r hr) = Just $! openRP (LP p e r hr) hl ll le lr

-- | Moves one step right.
-- This function raises an error if the current element is already the rightmost element.
--
-- Complexity: O(1) average, O(log n) worst case.
assertMoveR :: ZAVL e -> ZAVL e
assertMoveR (ZAVL p l hl e  E           _ ) = case pushHR l hl e of UBT2(t,ht) -> cL p t ht
 where cL  EP               _  _   = error "assertMoveR: Can't move right."
       cL (RP p_ e_ l_ hl_) r_ hr_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> cL p_ t ht
       cL (LP p_ e_ r_ hr_) l_ hl_ = ZAVL p_ l_ hl_ e_ r_ hr_    
assertMoveR (ZAVL p l hl e (N rl re rr) hr) = openLN (RP p e l hl) hr rl re rr
assertMoveR (ZAVL p l hl e (Z rl re rr) hr) = openLZ (RP p e l hl) hr rl re rr
assertMoveR (ZAVL p l hl e (P rl re rr) hr) = let p_ = LP (RP p e l hl) re rr DECINT2(hr)
                                              in p_ `seq` openL_ p_ DECINT1(hr) rl

-- | Attempts to move one step right.
-- This function returns 'Nothing' if the current element is already the rightmost element.
--
-- Complexity: O(1) average, O(log n) worst case.
tryMoveR :: ZAVL e -> Maybe (ZAVL e)
tryMoveR (ZAVL p l hl e  E           _ ) = case pushHR l hl e of UBT2(t,ht) -> cL p t ht
 where cL  EP               _  _   = Nothing
       cL (RP p_ e_ l_ hl_) r_ hr_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> cL p_ t ht
       cL (LP p_ e_ r_ hr_) l_ hl_ = Just $! ZAVL p_ l_ hl_ e_ r_ hr_    
tryMoveR (ZAVL p l hl e (N rl re rr) hr) = Just $! openLN (RP p e l hl) hr rl re rr
tryMoveR (ZAVL p l hl e (Z rl re rr) hr) = Just $! openLZ (RP p e l hl) hr rl re rr
tryMoveR (ZAVL p l hl e (P rl re rr) hr) = Just $! let p_ = LP (RP p e l hl) re rr DECINT2(hr)
                                                   in p_ `seq` openL_ p_ DECINT1(hr) rl

-- | Returns 'True' if the current element is the leftmost element.
--
-- Complexity: O(1) average, O(log n) worst case.
isLeftmost :: ZAVL e -> Bool
isLeftmost (ZAVL p E _ _ _ _) = iL p
 where iL  EP           = True
       iL (LP p_ _ _ _) = iL p_
       iL (RP _  _ _ _) = False    
isLeftmost (ZAVL _ _ _ _ _ _) = False

-- | Returns 'True' if the current element is the rightmost element.
--
-- Complexity: O(1) average, O(log n) worst case.
isRightmost :: ZAVL e -> Bool
isRightmost (ZAVL p _ _ _ E _) = iR p
 where iR  EP           = True
       iR (RP p_ _ _ _) = iR p_
       iR (LP _  _ _ _) = False    
isRightmost (ZAVL _ _ _ _ _ _) = False

-- | Inserts a new element to the immediate left of the current element.
--
-- Complexity: O(1) average, O(log n) worst case.
insertL :: e -> ZAVL e -> ZAVL e
insertL e0 (ZAVL p l hl e1 r hr) = case pushHR l hl e0 of UBT2(l_,hl_) -> ZAVL p l_ hl_ e1 r hr

-- | Inserts a new element to the immediate left of the current element and then
-- moves one step left (so the newly inserted element becomes the current element). 
--
-- Complexity: O(1) average, O(log n) worst case.
insertMoveL :: e -> ZAVL e -> ZAVL e
insertMoveL e0 (ZAVL p l hl e1 r hr) = case pushHL e1 r hr of UBT2(r_,hr_) -> ZAVL p l hl e0 r_ hr_

-- | Inserts a new element to the immediate right of the current element.
--
-- Complexity: O(1) average, O(log n) worst case.
insertR :: ZAVL e -> e -> ZAVL e
insertR (ZAVL p l hl e0 r hr) e1  = case pushHL e1 r hr of UBT2(r_,hr_) -> ZAVL p l hl e0 r_ hr_

-- | Inserts a new element to the immediate right of the current element and then
-- moves one step right (so the newly inserted element becomes the current element). 
--
-- Complexity: O(1) average, O(log n) worst case.
insertMoveR :: ZAVL e -> e -> ZAVL e
insertMoveR (ZAVL p l hl e0 r hr) e1  = case pushHR l hl e0 of UBT2(l_,hl_) -> ZAVL p l_ hl_ e1 r hr

-- | Inserts a new AVL tree to the immediate left of the current element.
--
-- Complexity: O(log n), where n is the size of the inserted tree.
insertTreeL :: AVL e -> ZAVL e -> ZAVL e
insertTreeL E           zavl = zavl
insertTreeL t@(N l _ _) zavl = insertLH t (addHeight L(2) l) zavl -- Absolute height required!!
insertTreeL t@(Z l _ _) zavl = insertLH t (addHeight L(1) l) zavl -- Absolute height required!!
insertTreeL t@(P _ _ r) zavl = insertLH t (addHeight L(2) r) zavl -- Absolute height required!!


-- Local utility to insert an AVL to the immediate left of the current element.
-- This operation carries a minor overhead in that we must convert the absolute
-- AVL height into a relative height with the same offset as the rest of the ZAVL.
-- This requires calculation of the absolute height at the current position, but
-- this should be relatively cheap because the overwhelming majority of elements will
-- be close to the bottom of any tree. 
insertLH :: AVL e -> UINT -> ZAVL e -> ZAVL e
insertLH t ht (ZAVL p l hl e r hr) =
 let offset = case COMPAREUINT hl hr of -- chose smaller sub-tree to calculate absolute height 
              LT -> SUBINT(hl,height l)
              EQ -> SUBINT(hl,height l)
              GT -> SUBINT(hr,height r)
 in case joinH l hl t ADDINT(ht,offset) of UBT2(l_,hl_) -> ZAVL p l_ hl_ e r hr

-- | Inserts a new AVL tree to the immediate right of the current element.
--
-- Complexity: O(log n), where n is the size of the inserted tree.
insertTreeR :: ZAVL e -> AVL e -> ZAVL e
insertTreeR zavl E           = zavl
insertTreeR zavl t@(N l _ _) = insertRH t (addHeight L(2) l) zavl -- Absolute height required!!
insertTreeR zavl t@(Z l _ _) = insertRH t (addHeight L(1) l) zavl -- Absolute height required!!
insertTreeR zavl t@(P _ _ r) = insertRH t (addHeight L(2) r) zavl -- Absolute height required!!

-- Local utility to insert an AVL to the immediate right of the current element.
-- This operation carries a minor overhead in that we must convert the absolute
-- AVL height into a relative height with the same offset as the rest of the ZAVL.
-- This requires calculation of the absolute height at the current position, but
-- this should be relatively cheap because the overwhelming majority of elements will
-- be close to the bottom of any tree. 
insertRH :: AVL e -> UINT -> ZAVL e -> ZAVL e
insertRH t ht (ZAVL p l hl e r hr) =
 let offset = case COMPAREUINT hl hr of -- chose smaller sub-tree to calculate absolute height 
              LT -> SUBINT(hl,height l)
              EQ -> SUBINT(hr,height r)
              GT -> SUBINT(hr,height r)
 in case joinH t ADDINT(ht,offset) r hr of UBT2(r_,hr_) -> ZAVL p l hl e r_ hr_


-- | Deletes the current element and moves one step left.
-- This function raises an error if the current element is already the leftmost element.
--
-- Complexity: O(1) average, O(log n) worst case.
assertDelMoveL :: ZAVL e -> ZAVL e
assertDelMoveL (ZAVL p  E            _ _ r hr) = dR p r hr
 where dR  EP               _  _   = error "assertDelMoveL: Can't move left."
       dR (LP p_ e_ r_ hr_) l_ hl_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> dR p_ t ht    
       dR (RP p_ e_ l_ hl_) r_ hr_ = ZAVL p_ l_ hl_ e_ r_ hr_
assertDelMoveL (ZAVL p (N ll le lr) hl _ r hr) = case popRN ll le lr of
                                                 UBT2(l,e) -> case l of
                                                              Z _ _ _ -> ZAVL p l DECINT1(hl) e r hr
                                                              N _ _ _ -> ZAVL p l         hl  e r hr
                                                              _       -> error "assertDelMoveL: Bug0" -- impossible
assertDelMoveL (ZAVL p (Z ll le lr) hl _ r hr) = case popRZ ll le lr of
                                                 UBT2(l,e) -> case l of
                                                              E       -> ZAVL p l DECINT1(hl) e r hr -- Don't use E!!
                                                              N _ _ _ -> error "assertDelMoveL: Bug1"      -- impossible
                                                              _       -> ZAVL p l         hl  e r hr
assertDelMoveL (ZAVL p (P ll le lr) hl _ r hr) = case popRP ll le lr of
                                                 UBT2(l,e) -> case l of
                                                        E       -> error "assertDelMoveL: Bug2" -- impossible
                                                        Z _ _ _ -> ZAVL p l DECINT1(hl) e r hr
                                                        _       -> ZAVL p l         hl  e r hr


-- | Attempts to delete the current element and move one step left.
-- This function returns 'Nothing' if the current element is already the leftmost element.
--
-- Complexity: O(1) average, O(log n) worst case.
tryDelMoveL :: ZAVL e -> Maybe (ZAVL e)
tryDelMoveL (ZAVL p  E            _ _ r hr) = dR p r hr
 where dR  EP               _  _   = Nothing
       dR (LP p_ e_ r_ hr_) l_ hl_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> dR p_ t ht    
       dR (RP p_ e_ l_ hl_) r_ hr_ = Just $! ZAVL p_ l_ hl_ e_ r_ hr_
tryDelMoveL (ZAVL p (N ll le lr) hl _ r hr) = Just $! case popRN ll le lr of
                                              UBT2(l,e) -> case l of
                                                           Z _ _ _ -> ZAVL p l DECINT1(hl) e r hr
                                                           N _ _ _ -> ZAVL p l         hl  e r hr
                                                           _       -> error "tryDelMoveL: Bug0" -- impossible
tryDelMoveL (ZAVL p (Z ll le lr) hl _ r hr) = Just $! case popRZ ll le lr of
                                              UBT2(l,e) -> case l of
                                                           E       -> ZAVL p l DECINT1(hl) e r hr -- Don't use E!!
                                                           N _ _ _ -> error "tryDelMoveL: Bug1"   -- impossible
                                                           _       -> ZAVL p l         hl  e r hr
tryDelMoveL (ZAVL p (P ll le lr) hl _ r hr) = Just $! case popRP ll le lr of
                                              UBT2(l,e) -> case l of
                                                           E       -> error "tryDelMoveL: Bug2" -- impossible
                                                           Z _ _ _ -> ZAVL p l DECINT1(hl) e r hr
                                                           _       -> ZAVL p l         hl  e r hr


-- | Deletes the current element and moves one step right.
-- This function raises an error if the current element is already the rightmost element.
--
-- Complexity: O(1) average, O(log n) worst case.
assertDelMoveR :: ZAVL e -> ZAVL e
assertDelMoveR (ZAVL p l hl _ E            _ ) = dL p l hl
 where dL  EP               _  _   = error "delMoveR: Can't move right."
       dL (LP p_ e_ r_ hr_) l_ hl_ = ZAVL p_ l_ hl_ e_ r_ hr_    
       dL (RP p_ e_ l_ hl_) r_ hr_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> dL p_ t ht
assertDelMoveR (ZAVL p l hl _ (N rl re rr) hr) = case popLN rl re rr of
                                                 UBT2(e,r) -> case r of
                                                              E       -> error "delMoveR: Bug0" -- impossible
                                                              Z _ _ _ -> ZAVL p l hl e r DECINT1(hr)
                                                              _       -> ZAVL p l hl e r         hr 
assertDelMoveR (ZAVL p l hl _ (Z rl re rr) hr) = case popLZ rl re rr of
                                                 UBT2(e,r) -> case r of
                                                              E       -> ZAVL p l hl e r DECINT1(hr) -- Don't use E!!
                                                              P _ _ _ -> error "delMoveR: Bug1" -- impossible
                                                              _       -> ZAVL p l hl e r         hr
assertDelMoveR (ZAVL p l hl _ (P rl re rr) hr) = case popLP rl re rr of
                                                 UBT2(e,r) -> case r of
                                                              Z _ _ _ -> ZAVL p l hl e r DECINT1(hr)
                                                              P _ _ _ -> ZAVL p l hl e r         hr 
                                                              _       -> error "delMoveR: Bug2" -- impossible


-- | Attempts to delete the current element and move one step right.
-- This function returns 'Nothing' if the current element is already the rightmost element.
--
-- Complexity: O(1) average, O(log n) worst case.
tryDelMoveR :: ZAVL e -> Maybe (ZAVL e)
tryDelMoveR (ZAVL p l hl _ E            _ ) = dL p l hl
 where dL  EP               _  _   = Nothing
       dL (LP p_ e_ r_ hr_) l_ hl_ = Just $! ZAVL p_ l_ hl_ e_ r_ hr_    
       dL (RP p_ e_ l_ hl_) r_ hr_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> dL p_ t ht
tryDelMoveR (ZAVL p l hl _ (N rl re rr) hr) = Just $! case popLN rl re rr of
                                              UBT2(e,r) -> case r of
                                                           E       -> error "tryDelMoveR: Bug0" -- impossible
                                                           Z _ _ _ -> ZAVL p l hl e r DECINT1(hr)
                                                           _       -> ZAVL p l hl e r         hr 
tryDelMoveR (ZAVL p l hl _ (Z rl re rr) hr) = Just $! case popLZ rl re rr of
                                              UBT2(e,r) -> case r of
                                                           E       -> ZAVL p l hl e r DECINT1(hr) -- Don't use E!!
                                                           P _ _ _ -> error "tryDelMoveR: Bug1" -- impossible
                                                           _       -> ZAVL p l hl e r         hr
tryDelMoveR (ZAVL p l hl _ (P rl re rr) hr) = Just $! case popLP rl re rr of
                                              UBT2(e,r) -> case r of
                                                           Z _ _ _ -> ZAVL p l hl e r DECINT1(hr)
                                                           P _ _ _ -> ZAVL p l hl e r         hr 
                                                           _       -> error "tryDelMoveR: Bug2" -- impossible


-- | Delete all elements to the left of the current element.
--
-- Complexity: O(log n)
delAllL :: ZAVL e -> ZAVL e
delAllL (ZAVL p l hl e r hr) = 
 let hE = case COMPAREUINT hl hr of -- Calculate relative offset and use this as height of empty tree
          LT -> SUBINT(hl,height l)
          EQ -> SUBINT(hr,height r)
          GT -> SUBINT(hr,height r)
     p_ = noRP p -- remove right paths (current element becomes leftmost)
 in p_ `seq` ZAVL p_ E hE e r hr

-- | Delete all elements to the right of the current element.
--
-- Complexity: O(log n)
delAllR :: ZAVL e -> ZAVL e
delAllR (ZAVL p l hl e r hr) = 
 let hE = case COMPAREUINT hl hr of -- Calculate relative offset and use this as height of empty tree
          LT -> SUBINT(hl,height l)
          EQ -> SUBINT(hl,height l)
          GT -> SUBINT(hr,height r)
     p_ = noLP p -- remove left paths (current element becomes rightmost)
 in p_ `seq` ZAVL p_ l hl e E hE

-- | Similar to 'delAllL', in that all elements to the left of the current element are deleted,
-- but this function also closes the tree in the process.
--
-- Complexity: O(log n)
delAllCloseL :: ZAVL e -> AVL e
delAllCloseL (ZAVL p _ _ e r hr) = case pushHL e r hr of UBT2(t,ht) -> closeNoRP p t ht

-- | Similar to 'delAllR', in that all elements to the right of the current element are deleted,
-- but this function also closes the tree in the process.
--
-- Complexity: O(log n)
delAllCloseR :: ZAVL e -> AVL e
delAllCloseR (ZAVL p l hl e _ _) = case pushHR l hl e of UBT2(t,ht) -> closeNoLP p t ht

-- | Similar to 'delAllCloseL', but in this case the current element and all
-- those to the left of the current element are deleted.
--
-- Complexity: O(log n)
delAllIncCloseL :: ZAVL e -> AVL e
delAllIncCloseL (ZAVL p _ _ _ r hr) = closeNoRP p r hr

-- | Similar to 'delAllCloseR', but in this case the current element and all
-- those to the right of the current element are deleted.
--
-- Complexity: O(log n)
delAllIncCloseR :: ZAVL e -> AVL e
delAllIncCloseR (ZAVL p l hl _ _ _) = closeNoLP p l hl

-- | Counts the number of elements to the left of the current element
-- (this does not include the current element).
--
-- Complexity: O(n), where n is the count result.
sizeL :: ZAVL e -> Int
sizeL (ZAVL p l _ _ _ _) = addSizeRP (size l) p

-- | Counts the number of elements to the right of the current element
-- (this does not include the current element).
--
-- Complexity: O(n), where n is the count result.
sizeR :: ZAVL e -> Int
sizeR (ZAVL p _ _ _ r _) = addSizeLP (size r) p

-- | Counts the total number of elements in a ZAVL.
--
-- Complexity: O(n)
sizeZAVL :: ZAVL e -> Int
sizeZAVL (ZAVL p l _ _ r _) = addSizeP (addSize (addSize 1 l) r) p


{-------------------- BAVL stuff below ----------------------------------}

-- | A 'BAVL' is like a pointer reference to somewhere inside an 'AVL' tree. It may be either \"full\"
-- (meaning it points to an actual tree node containing an element), or \"empty\" (meaning it
-- points to the position in a tree where an element was expected but wasn\'t found).
data BAVL e = BAVL (AVL e) (BinPath e) 

-- | Search for an element in a /sorted/ 'AVL' tree using the supplied selector.
-- Returns a \"full\" 'BAVL' if a matching element was found, otherwise returns an \"empty\" 'BAVL'.
--
-- Complexity: O(log n) 
genOpenBAVL :: (e -> Ordering) -> AVL e -> BAVL e
{-# INLINE genOpenBAVL #-}
genOpenBAVL c t = bp `seq` BAVL t bp
 where bp = genOpenPath c t

-- | Returns the original tree, extracted from the 'BAVL'. Typically you will not need this, as
-- the original tree will still be in scope in most cases.
--
-- Complexity: O(1)
closeBAVL :: BAVL e -> AVL e
{-# INLINE closeBAVL #-}
closeBAVL (BAVL t _) = t 

-- | Returns 'True' if the 'BAVL' is \"full\" (a corresponding element was found).
--
-- Complexity: O(1)
fullBAVL :: BAVL e -> Bool
{-# INLINE fullBAVL #-}
fullBAVL (BAVL _ (FullBP  _ _)) = True
fullBAVL (BAVL _ (EmptyBP _  )) = False

-- | Returns 'True' if the 'BAVL' is \"empty\" (no corresponding element was found).
--
-- Complexity: O(1)
emptyBAVL :: BAVL e -> Bool
{-# INLINE emptyBAVL #-}
emptyBAVL (BAVL _ (FullBP  _ _)) = False
emptyBAVL (BAVL _ (EmptyBP _  )) = True

-- | Read the element value from a \"full\" 'BAVL'. 
-- This function returns 'Nothing' if applied to an \"empty\" 'BAVL'.
--
-- Complexity: O(1)
tryReadBAVL :: BAVL e -> Maybe e
{-# INLINE tryReadBAVL #-}
tryReadBAVL (BAVL _ (FullBP  _ e)) = Just e
tryReadBAVL (BAVL _ (EmptyBP _  )) = Nothing

-- | Read the element value from a \"full\" 'BAVL'.
-- This function raises an error if applied to an \"empty\" 'BAVL'.
--
-- Complexity: O(1)
readFullBAVL :: BAVL e -> e
{-# INLINE readFullBAVL #-}
readFullBAVL (BAVL _ (FullBP  _ e)) = e
readFullBAVL (BAVL _ (EmptyBP _  )) = error "readFullBAVL: Empty BAVL."

-- | If the 'BAVL' is \"full\", this function returns the original tree with the corresponding
-- element replaced by the new element (first argument). If it\'s \"empty\" the original tree is returned
-- with the new element inserted.
--
-- Complexity: O(log n)
pushBAVL :: e -> BAVL e -> AVL e
{-# INLINE pushBAVL #-}
pushBAVL e (BAVL t (FullBP  p _)) = writePath  p e t
pushBAVL e (BAVL t (EmptyBP p  )) = insertPath p e t

-- | If the 'BAVL' is \"full\", this function returns the original tree with the corresponding
-- element deleted. If it\'s \"empty\" the original tree is returned unmodified.
--
-- Complexity: O(log n) (or O(1) for an empty 'BAVL')
deleteBAVL :: BAVL e -> AVL e
{-# INLINE deleteBAVL #-}
deleteBAVL (BAVL t (FullBP  p _)) = deletePath p t
deleteBAVL (BAVL t (EmptyBP _  )) = t

-- | Converts a \"full\" 'BAVL' as a 'ZAVL'. Raises an error if applied to an \"empty\" 'BAVL'.
--
-- Complexity: O(log n)
fullBAVLtoZAVL :: BAVL e -> ZAVL e
fullBAVLtoZAVL (BAVL t (FullBP  i _)) = openFull i EP L(0) t -- Relative heights !!
fullBAVLtoZAVL (BAVL _ (EmptyBP _  )) = error "fullBAVLtoZAVL: Empty BAVL."
-- Local Utility
openFull :: UINT -> (Path e) -> UINT -> AVL e -> ZAVL e
openFull _ _ _  E        = error "openFull: Bug0."
openFull i p h (N l e r) = case sel i of
                           LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` openFull (goL i) p_ DECINT2(h) l
                           EQ -> ZAVL p l DECINT2(h) e r DECINT1(h)
                           GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` openFull (goR i) p_ DECINT1(h) r
openFull i p h (Z l e r) = case sel i of
                           LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` openFull (goL i) p_ DECINT1(h) l
                           EQ -> ZAVL p l DECINT1(h) e r DECINT1(h)
                           GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` openFull (goR i) p_ DECINT1(h) r
openFull i p h (P l e r) = case sel i of
                           LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` openFull (goL i) p_ DECINT1(h) l
                           EQ -> ZAVL p l DECINT1(h) e r DECINT2(h)
                           GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` openFull (goR i) p_ DECINT2(h) r

-- | Converts an \"empty\" 'BAVL' as a 'PAVL'. Raises an error if applied to a \"full\" 'BAVL'.
--
-- Complexity: O(log n)
emptyBAVLtoPAVL :: BAVL e -> PAVL e
emptyBAVLtoPAVL (BAVL _ (FullBP  _ _)) = error "emptyBAVLtoPAVL: Full BAVL."
emptyBAVLtoPAVL (BAVL t (EmptyBP i  )) = openEmpty i EP L(0) t -- Relative heights !!
-- Local Utility
openEmpty :: UINT -> (Path e) -> UINT -> AVL e -> PAVL e
openEmpty _ p h  E        = PAVL p h -- Test for i==0 ??
openEmpty i p h (N l e r) = case sel i of
                            LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` openEmpty (goL i) p_ DECINT2(h) l
                            EQ -> error "openEmpty: Bug0"
                            GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` openEmpty (goR i) p_ DECINT1(h) r
openEmpty i p h (Z l e r) = case sel i of
                            LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` openEmpty (goL i) p_ DECINT1(h) l
                            EQ -> error "openEmpty: Bug1"
                            GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` openEmpty (goR i) p_ DECINT1(h) r
openEmpty i p h (P l e r) = case sel i of
                            LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` openEmpty (goL i) p_ DECINT1(h) l
                            EQ -> error "openEmpty: Bug2"
                            GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` openEmpty (goR i) p_ DECINT2(h) r


-- | Converts a 'BAVL' to either a 'PAVL' or 'ZAVL' (depending on whether it is \"empty\" or \"full\").
--
-- Complexity: O(log n)
anyBAVLtoEither :: BAVL e -> Either (PAVL e) (ZAVL e)
anyBAVLtoEither (BAVL t (FullBP  i _)) = Right (openFull  i EP L(0) t) -- Relative heights !!
anyBAVLtoEither (BAVL t (EmptyBP i  )) = Left  (openEmpty i EP L(0) t) -- Relative heights !!