-- |
-- Copyright   :  (c) Adrian Hey 2004,2005
-- License     :  BSD3
--
{-# OPTIONS_HADDOCK hide #-}
module Data.Tree.AVL.Zipper
(-- * The AVL Zipper
 -- | 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/haskellwiki/Zipper>.
 --
 -- 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 t'BAVL' as a cheaper alternative if you don't
 -- need to navigate the tree.

 -- ** Types
 ZAVL,PAVL,

 -- ** Opening
 assertOpenL,assertOpenR,
 tryOpenL,tryOpenR,
 assertOpen,tryOpen,
 tryOpenGE,tryOpenLE,
 openEither,

 -- ** 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
 openBAVL,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.Internals.Types(AVL(..))
import Data.Tree.AVL.Size(size,addSize)
import Data.Tree.AVL.Height(height,addHeight)
import Data.Tree.AVL.Internals.DelUtils(deletePath,popRN,popRZ,popRP,popLN,popLZ,popLP)
import Data.Tree.AVL.Internals.HJoin(spliceH,joinH)
import Data.Tree.AVL.Internals.HPush(pushHL,pushHR)
import Data.Tree.AVL.BinPath(BinPath(..),openPath,writePath,insertPath,sel,goL,goR)

import GHC.Base
#include "ghcdefs.h"

-- 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 thought 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_ :: forall e. Path e -> AVL e -> Int# -> AVL e
close_  Path e
EP        AVL e
t Int#
_ = AVL e
t
close_ (LP Path e
p e
e AVL e
r Int#
hr) AVL e
l Int#
hl = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l Int#
hl e
e AVL e
r Int#
hr of UBT2(t,ht) -> Path e -> AVL e -> Int# -> AVL e
forall e. Path e -> AVL e -> Int# -> AVL e
close_ Path e
p AVL e
t Int#
ht
close_ (RP Path e
p e
e AVL e
l Int#
hl) AVL e
r Int#
hr = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l Int#
hl e
e AVL e
r Int#
hr of UBT2(t,ht) -> Path e -> AVL e -> Int# -> AVL e
forall e. Path e -> AVL e -> Int# -> AVL e
close_ Path e
p AVL e
t Int#
ht

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

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

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

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

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

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

-- Add size of all LP path elements.
addSizeLP :: Int -> Path e -> Int
addSizeLP :: forall e. Int -> Path e -> Int
addSizeLP Int
n  Path e
EP          = Int
n
addSizeLP Int
n (LP Path e
p e
_ AVL e
r Int#
_) = Int -> Path e -> Int
forall e. Int -> Path e -> Int
addSizeLP (Int -> AVL e -> Int
forall e. Int -> AVL e -> Int
addSize (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) AVL e
r) Path e
p
addSizeLP Int
n (RP Path e
p e
_ AVL e
_ Int#
_) = Int -> Path e -> Int
forall e. Int -> Path e -> Int
addSizeLP Int
n Path e
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)
assertOpen :: (e -> Ordering) -> AVL e -> ZAVL e
assertOpen :: forall e. (e -> Ordering) -> AVL e -> ZAVL e
assertOpen e -> Ordering
c AVL e
t = Path e -> Int# -> AVL e -> ZAVL e
op Path e
forall e. Path e
EP L(0AVL e
) t where -- Relative heights !!
 -- op :: (Path e) -> UINT -> AVL e -> ZAVL e
 op :: Path e -> Int# -> AVL e -> ZAVL e
op Path e
_ Int#
_  AVL e
E        = [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertOpen: No matching element."
 op Path e
p Int#
h (N AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` op p_ DECINT2(hAVL e
) l
                    Ordering
EQ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT2(h) e r DECINT1(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT2(h) in p_ `seq` op p_ DECINT1(hAVL e
) r
 op Path e
p Int#
h (Z AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` op p_ DECINT1(hAVL e
) l
                    Ordering
EQ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e r DECINT1(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` op p_ DECINT1(hAVL e
) r
 op Path e
p Int#
h (P AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT2(h) in p_ `seq` op p_ DECINT1(hAVL e
) l
                    Ordering
EQ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e r DECINT2(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` op p_ DECINT2(hAVL e
) 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 'openBAVL', test for \"fullness\"
-- using 'fullBAVL' and then convert to a t'ZAVL' using 'fullBAVLtoZAVL'.
--
-- Complexity: O(log n)
tryOpen :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
tryOpen :: forall e. (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
tryOpen e -> Ordering
c AVL e
t = Path e -> Int# -> AVL e -> Maybe (ZAVL e)
op Path e
forall e. Path e
EP L(0AVL e
) t where -- Relative heights !!
 -- op :: (Path e) -> UINT -> AVL e -> Maybe (ZAVL e)
 op :: Path e -> Int# -> AVL e -> Maybe (ZAVL e)
op Path e
_ Int#
_  AVL e
E        = Maybe (ZAVL e)
forall a. Maybe a
Nothing
 op Path e
p Int#
h (N AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` op p_ DECINT2(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT2(h) e r DECINT1(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT2(h) in p_ `seq` op p_ DECINT1(hAVL e
) r
 op Path e
p Int#
h (Z AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` op p_ DECINT1(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e r DECINT1(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` op p_ DECINT1(hAVL e
) r
 op Path e
p Int#
h (P AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT2(h) in p_ `seq` op p_ DECINT1(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e r DECINT2(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` op p_ DECINT2(hAVL e
) 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)
tryOpenGE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
tryOpenGE :: forall e. (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
tryOpenGE e -> Ordering
c AVL e
t = Path e -> Int# -> AVL e -> Maybe (ZAVL e)
op Path e
forall e. Path e
EP L(0AVL e
) t where -- Relative heights !!
 -- op :: (Path e) -> UINT -> AVL e -> ZAVL e
 op :: Path e -> Int# -> AVL e -> Maybe (ZAVL e)
op Path e
p Int#
h  AVL e
E        = Path e -> AVL e -> Int# -> Maybe (ZAVL e)
forall {e}. Path e -> AVL e -> Int# -> Maybe (ZAVL e)
backupR Path e
p AVL e
forall e. AVL e
E Int#
h where
                     backupR :: Path e -> AVL e -> Int# -> Maybe (ZAVL e)
backupR  Path e
EP            AVL e
_ Int#
_  = Maybe (ZAVL e)
forall a. Maybe a
Nothing
                     backupR (LP Path e
p_ e
e AVL e
r Int#
hr) AVL e
l Int#
hl = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l Int#
hl e
e AVL e
r Int#
hr
                     backupR (RP Path e
p_ e
e AVL e
l Int#
hl) AVL e
r Int#
hr = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l Int#
hl e
e AVL e
r Int#
hr of UBT2(t_,ht_) -> Path e -> AVL e -> Int# -> Maybe (ZAVL e)
backupR Path e
p_ AVL e
t_ Int#
ht_
 op Path e
p Int#
h (N AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` op p_ DECINT2(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT2(h) e r DECINT1(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT2(h) in p_ `seq` op p_ DECINT1(hAVL e
) r
 op Path e
p Int#
h (Z AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` op p_ DECINT1(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e r DECINT1(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` op p_ DECINT1(hAVL e
) r
 op Path e
p Int#
h (P AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT2(h) in p_ `seq` op p_ DECINT1(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e r DECINT2(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` op p_ DECINT2(hAVL e
) 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)
tryOpenLE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
tryOpenLE :: forall e. (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
tryOpenLE e -> Ordering
c AVL e
t = Path e -> Int# -> AVL e -> Maybe (ZAVL e)
op Path e
forall e. Path e
EP L(0AVL e
) t where -- Relative heights !!
 -- op :: (Path e) -> UINT -> AVL e -> ZAVL e
 op :: Path e -> Int# -> AVL e -> Maybe (ZAVL e)
op Path e
p Int#
h  AVL e
E        = Path e -> AVL e -> Int# -> Maybe (ZAVL e)
forall {e}. Path e -> AVL e -> Int# -> Maybe (ZAVL e)
backupL Path e
p AVL e
forall e. AVL e
E Int#
h where
                     backupL :: Path e -> AVL e -> Int# -> Maybe (ZAVL e)
backupL  Path e
EP            AVL e
_ Int#
_  = Maybe (ZAVL e)
forall a. Maybe a
Nothing
                     backupL (LP Path e
p_ e
e AVL e
r Int#
hr) AVL e
l Int#
hl = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l Int#
hl e
e AVL e
r Int#
hr of UBT2(t_,ht_) -> Path e -> AVL e -> Int# -> Maybe (ZAVL e)
backupL Path e
p_ AVL e
t_ Int#
ht_
                     backupL (RP Path e
p_ e
e AVL e
l Int#
hl) AVL e
r Int#
hr = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l Int#
hl e
e AVL e
r Int#
hr
 op Path e
p Int#
h (N AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` op p_ DECINT2(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT2(h) e r DECINT1(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT2(h) in p_ `seq` op p_ DECINT1(hAVL e
) r
 op Path e
p Int#
h (Z AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` op p_ DECINT1(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e r DECINT1(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` op p_ DECINT1(hAVL e
) r
 op Path e
p Int#
h (P AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT2(h) in p_ `seq` op p_ DECINT1(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e r DECINT2(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` op p_ DECINT2(hAVL e
) 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 :: forall e. AVL e -> ZAVL e
assertOpenL  AVL e
E        = [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertOpenL: Empty tree."
assertOpenL (N AVL e
l e
e AVL e
r) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLN Path e
forall e. Path e
EP L(0AVL e
) e
l AVL e
e r            -- Relative heights !!
assertOpenL (Z AVL e
l e
e AVL e
r) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLZ Path e
forall e. Path e
EP L(0AVL e
) e
l AVL e
e r            -- Relative heights !!
assertOpenL (P AVL e
l e
e AVL e
r) = Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openL_ (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
forall e. Path e
EP e
e AVL e
r L(0)) LAVL e
(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 :: forall e. AVL e -> Maybe (ZAVL e)
tryOpenL  AVL e
E        = Maybe (ZAVL e)
forall a. Maybe a
Nothing
tryOpenL (N AVL e
l e
e AVL e
r) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLN Path e
forall e. Path e
EP L(0AVL e
) e
l AVL e
e r             -- Relative heights !!
tryOpenL (Z AVL e
l e
e AVL e
r) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLZ Path e
forall e. Path e
EP L(0AVL e
) e
l AVL e
e r             -- Relative heights !!
tryOpenL (P AVL e
l e
e AVL e
r) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openL_ (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
forall e. Path e
EP e
e AVL e
r L(0)) LAVL e
(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_ :: forall e. Path e -> Int# -> AVL e -> ZAVL e
openL_ Path e
_ Int#
_  AVL e
E        = [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"openL_: Bug0"
openL_ Path e
p Int#
h (N AVL e
l e
e AVL e
r) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLN Path e
p Int#
h AVL e
l e
e AVL e
r
openL_ Path e
p Int#
h (Z AVL e
l e
e AVL e
r) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLZ Path e
p Int#
h AVL e
l e
e AVL e
r
openL_ Path e
p Int#
h (P AVL e
l e
e AVL e
r) = let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT2(h) in p_ `seq` openL_ p_ DECINT1(hAVL e
) 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 :: forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLN Path e
p Int#
h  AVL e
E           e
e AVL e
r = Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
forall e. AVL e
E DECINT2(h) e r DECINT1(h)
openLN Path e
p Int#
h (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let p_ :: Path e
p_  = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` openLN p_ DECINT2(h) ll le lr
openLN Path e
p Int#
h (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let p_ :: Path e
p_  = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` openLZ p_ DECINT2(h) ll le lr
openLN Path e
p Int#
h (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let p_ :: Path e
p_  = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h)
                                  p__ :: Path e
p__ = Path e
p_ Path e -> Path e -> Path e
forall a b. a -> b -> b
`seq` Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p_ e
le AVL e
lr DECINT4(h)
                              in Path e
p__ Path e -> ZAVL e -> ZAVL e
forall a b. a -> b -> b
`seq` Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openL_ Path e
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 :: forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLZ Path e
p Int#
h  AVL e
E           e
e AVL e
r = Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
forall e. AVL e
E DECINT1(h) e r DECINT1(h)
openLZ Path e
p Int#
h (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let p_ :: Path e
p_  = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` openLN p_ DECINT1(h) ll le lr
openLZ Path e
p Int#
h (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let p_ :: Path e
p_  = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` openLZ p_ DECINT1(h) ll le lr
openLZ Path e
p Int#
h (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let p_ :: Path e
p_  = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h)
                                  p__ :: Path e
p__ = Path e
p_ Path e -> Path e -> Path e
forall a b. a -> b -> b
`seq` Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p_ e
le AVL e
lr DECINT3(h)
                              in Path e
p__ Path e -> ZAVL e -> ZAVL e
forall a b. a -> b -> b
`seq` Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openL_ Path e
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 :: forall e. AVL e -> ZAVL e
assertOpenR  AVL e
E        = [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertOpenR: Empty tree."
assertOpenR (N AVL e
l e
e AVL e
r) = Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openR_ (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
forall e. Path e
EP e
e AVL e
l L(0)) LAVL e
(1) r  -- Relative heights !!
assertOpenR (Z AVL e
l e
e AVL e
r) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRZ Path e
forall e. Path e
EP L(0AVL e
) e
l AVL e
e r            -- Relative heights !!
assertOpenR (P AVL e
l e
e AVL e
r) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRP Path e
forall e. Path e
EP L(0AVL e
) e
l AVL e
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 :: forall e. AVL e -> Maybe (ZAVL e)
tryOpenR  AVL e
E        = Maybe (ZAVL e)
forall a. Maybe a
Nothing
tryOpenR (N AVL e
l e
e AVL e
r) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openR_ (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
forall e. Path e
EP e
e AVL e
l L(0)) LAVL e
(1) r  -- Relative heights !!
tryOpenR (Z AVL e
l e
e AVL e
r) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRZ Path e
forall e. Path e
EP L(0AVL e
) e
l AVL e
e r            -- Relative heights !!
tryOpenR (P AVL e
l e
e AVL e
r) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRP Path e
forall e. Path e
EP L(0AVL e
) e
l AVL e
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_ :: forall e. Path e -> Int# -> AVL e -> ZAVL e
openR_ Path e
_ Int#
_  AVL e
E        = [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"openR_: Bug0"
openR_ Path e
p Int#
h (N AVL e
l e
e AVL e
r) = let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT2(h) in p_ `seq` openR_ p_ DECINT1(hAVL e
) r
openR_ Path e
p Int#
h (Z AVL e
l e
e AVL e
r) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRZ Path e
p Int#
h AVL e
l e
e AVL e
r
openR_ Path e
p Int#
h (P AVL e
l e
e AVL e
r) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRP Path e
p Int#
h AVL e
l e
e AVL 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 :: forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRP Path e
p Int#
h AVL e
l e
e  AVL e
E           = Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e E DECINT2(h)
openRP Path e
p Int#
h AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let p_ :: Path e
p_  = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h)
                                  p__ :: Path e
p__ = Path e
p_ Path e -> Path e -> Path e
forall a b. a -> b -> b
`seq` Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p_ e
re AVL e
rl DECINT4(h)
                              in Path e
p__ Path e -> ZAVL e -> ZAVL e
forall a b. a -> b -> b
`seq` Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openR_ Path e
p__ DECINT3(h) rr
openRP Path e
p Int#
h AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` openRZ p_ DECINT2(h) rl re rr
openRP Path e
p Int#
h AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL 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 :: forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRZ Path e
p Int#
h AVL e
l e
e  AVL e
E           = Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e E DECINT1(h)
openRZ Path e
p Int#
h AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let p_ :: Path e
p_  = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h)
                                  p__ :: Path e
p__ = Path e
p_ Path e -> Path e -> Path e
forall a b. a -> b -> b
`seq` Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p_ e
re AVL e
rl DECINT3(h)
                              in Path e
p__ Path e -> ZAVL e -> ZAVL e
forall a b. a -> b -> b
`seq` Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openR_ Path e
p__ DECINT2(h) rr
openRZ Path e
p Int#
h AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` openRZ p_ DECINT1(h) rl re rr
openRZ Path e
p Int#
h AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL 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)
openEither :: (e -> Ordering) -> AVL e -> Either (PAVL e) (ZAVL e)
openEither :: forall e. (e -> Ordering) -> AVL e -> Either (PAVL e) (ZAVL e)
openEither e -> Ordering
c AVL e
t = Path e -> Int# -> AVL e -> Either (PAVL e) (ZAVL e)
op Path e
forall e. Path e
EP L(0AVL e
) t where -- Relative heights !!
 -- op :: (Path e) -> UINT -> AVL e -> Either (PAVL e) (ZAVL e)
 op :: Path e -> Int# -> AVL e -> Either (PAVL e) (ZAVL e)
op Path e
p Int#
h  AVL e
E        = PAVL e -> Either (PAVL e) (ZAVL e)
forall a b. a -> Either a b
Left (PAVL e -> Either (PAVL e) (ZAVL e))
-> PAVL e -> Either (PAVL e) (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> PAVL e
forall e. Path e -> Int# -> PAVL e
PAVL Path e
p Int#
h
 op Path e
p Int#
h (N AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` op p_ DECINT2(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Either (PAVL e) (ZAVL e)
forall a b. b -> Either a b
Right (ZAVL e -> Either (PAVL e) (ZAVL e))
-> ZAVL e -> Either (PAVL e) (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT2(h) e r DECINT1(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT2(h) in p_ `seq` op p_ DECINT1(hAVL e
) r
 op Path e
p Int#
h (Z AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT1(h) in p_ `seq` op p_ DECINT1(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Either (PAVL e) (ZAVL e)
forall a b. b -> Either a b
Right (ZAVL e -> Either (PAVL e) (ZAVL e))
-> ZAVL e -> Either (PAVL e) (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e r DECINT1(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` op p_ DECINT1(hAVL e
) r
 op Path e
p Int#
h (P AVL e
l e
e AVL e
r) = case e -> Ordering
c e
e of
                    Ordering
LT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r DECINT2(h) in p_ `seq` op p_ DECINT1(hAVL e
) l
                    Ordering
EQ -> ZAVL e -> Either (PAVL e) (ZAVL e)
forall a b. b -> Either a b
Right (ZAVL e -> Either (PAVL e) (ZAVL e))
-> ZAVL e -> Either (PAVL e) (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(h) e r DECINT2(h)
                    Ordering
GT -> let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l DECINT1(h) in p_ `seq` op p_ DECINT2(hAVL e
) r

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

-- | Essentially the same operation as 'fill', but the resulting t'ZAVL' is closed
-- immediately.
--
-- Complexity: O(log n)
fillClose :: e -> PAVL e -> AVL e
fillClose :: forall e. e -> PAVL e -> AVL e
fillClose e
e (PAVL Path e
p Int#
h) = Path e -> AVL e -> Int# -> AVL e
forall e. Path e -> AVL e -> Int# -> AVL e
close_ Path 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
e AVL e
forall e. AVL e
E) INCINT1(h)

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

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

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

-- | Overwrites the current element of a Zipper.
--
-- Complexity: O(1)
putCurrent :: e -> ZAVL e -> ZAVL e
putCurrent :: forall e. e -> ZAVL e -> ZAVL e
putCurrent e
e (ZAVL Path e
p AVL e
l Int#
hl e
_ AVL e
r Int#
hr) = Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r Int#
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 :: forall e. (e -> e) -> ZAVL e -> ZAVL e
applyCurrent e -> e
f (ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r Int#
hr) = Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl (e -> e
f e
e) AVL e
r Int#
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' :: forall e. (e -> e) -> ZAVL e -> ZAVL e
applyCurrent' e -> e
f (ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r Int#
hr) = let e_ :: e
e_ = e -> e
f e
e in e
e_ e -> ZAVL e -> ZAVL e
forall a b. a -> b -> b
`seq` Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e_ AVL e
r Int#
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 :: forall e. ZAVL e -> ZAVL e
assertMoveL (ZAVL Path e
p AVL e
E           Int#
_   e
e AVL e
r Int#
hr) = case e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. e -> AVL e -> Int# -> (# AVL e, Int# #)
pushHL e
e AVL e
r Int#
hr of UBT2(t,ht) -> Path e -> AVL e -> Int# -> ZAVL e
forall {e}. Path e -> AVL e -> Int# -> ZAVL e
cR Path e
p AVL e
t Int#
ht
 where cR :: Path e -> AVL e -> Int# -> ZAVL e
cR  Path e
EP               AVL e
_  Int#
_   = [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertMoveL: Can't move left."
       cR (LP Path e
p_ e
e_ AVL e
r_ Int#
hr_) AVL e
l_ Int#
hl_ = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_ of UBT2(t,ht) -> Path e -> AVL e -> Int# -> ZAVL e
cR Path e
p_ AVL e
t Int#
ht
       cR (RP Path e
p_ e
e_ AVL e
l_ Int#
hl_) AVL e
r_ Int#
hr_ = Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_
assertMoveL (ZAVL Path e
p (N AVL e
ll e
le AVL e
lr) Int#
hl e
e AVL e
r Int#
hr) = let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r Int#
hr) e
le AVL e
ll DECINT2(hl)
                                              in Path e
p_ Path e -> ZAVL e -> ZAVL e
forall a b. a -> b -> b
`seq` Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openR_ Path e
p_ DECINT1(hl) lr
assertMoveL (ZAVL Path e
p (Z AVL e
ll e
le AVL e
lr) Int#
hl e
e AVL e
r Int#
hr) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRZ (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r Int#
hr) Int#
hl AVL e
ll e
le AVL e
lr
assertMoveL (ZAVL Path e
p (P AVL e
ll e
le AVL e
lr) Int#
hl e
e AVL e
r Int#
hr) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRP (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r Int#
hr) Int#
hl AVL e
ll e
le AVL e
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 :: forall e. ZAVL e -> Maybe (ZAVL e)
tryMoveL (ZAVL Path e
p AVL e
E            Int#
_  e
e AVL e
r Int#
hr) = case e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. e -> AVL e -> Int# -> (# AVL e, Int# #)
pushHL e
e AVL e
r Int#
hr of UBT2(t,ht) -> Path e -> AVL e -> Int# -> Maybe (ZAVL e)
forall {e}. Path e -> AVL e -> Int# -> Maybe (ZAVL e)
cR Path e
p AVL e
t Int#
ht
 where cR :: Path e -> AVL e -> Int# -> Maybe (ZAVL e)
cR  Path e
EP               AVL e
_  Int#
_      = Maybe (ZAVL e)
forall a. Maybe a
Nothing
       cR (LP Path e
p_ e
e_ AVL e
r_ Int#
hr_) AVL e
l_ Int#
hl_    = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_ of UBT2(t,ht) -> Path e -> AVL e -> Int# -> Maybe (ZAVL e)
cR Path e
p_ AVL e
t Int#
ht
       cR (RP Path e
p_ e
e_ AVL e
l_ Int#
hl_) AVL e
r_ Int#
hr_    = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_
tryMoveL (ZAVL Path e
p (N AVL e
ll e
le AVL e
lr) Int#
hl e
e AVL e
r Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r Int#
hr) e
le AVL e
ll DECINT2(hl)
                                                   in Path e
p_ Path e -> ZAVL e -> ZAVL e
forall a b. a -> b -> b
`seq` Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openR_ Path e
p_ DECINT1(hl) lr
tryMoveL (ZAVL Path e
p (Z AVL e
ll e
le AVL e
lr) Int#
hl e
e AVL e
r Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRZ (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r Int#
hr) Int#
hl AVL e
ll e
le AVL e
lr
tryMoveL (ZAVL Path e
p (P AVL e
ll e
le AVL e
lr) Int#
hl e
e AVL e
r Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openRP (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP Path e
p e
e AVL e
r Int#
hr) Int#
hl AVL e
ll e
le AVL e
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 :: forall e. ZAVL e -> ZAVL e
assertMoveR (ZAVL Path e
p AVL e
l Int#
hl e
e  AVL e
E           Int#
_ ) = case AVL e -> Int# -> e -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> (# AVL e, Int# #)
pushHR AVL e
l Int#
hl e
e of UBT2(t,ht) -> Path e -> AVL e -> Int# -> ZAVL e
forall {e}. Path e -> AVL e -> Int# -> ZAVL e
cL Path e
p AVL e
t Int#
ht
 where cL :: Path e -> AVL e -> Int# -> ZAVL e
cL  Path e
EP               AVL e
_  Int#
_   = [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertMoveR: Can't move right."
       cL (RP Path e
p_ e
e_ AVL e
l_ Int#
hl_) AVL e
r_ Int#
hr_ = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_ of UBT2(t,ht) -> Path e -> AVL e -> Int# -> ZAVL e
cL Path e
p_ AVL e
t Int#
ht
       cL (LP Path e
p_ e
e_ AVL e
r_ Int#
hr_) AVL e
l_ Int#
hl_ = Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_
assertMoveR (ZAVL Path e
p AVL e
l Int#
hl e
e (N AVL e
rl e
re AVL e
rr) Int#
hr) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLN (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l Int#
hl) Int#
hr AVL e
rl e
re AVL e
rr
assertMoveR (ZAVL Path e
p AVL e
l Int#
hl e
e (Z AVL e
rl e
re AVL e
rr) Int#
hr) = Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLZ (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l Int#
hl) Int#
hr AVL e
rl e
re AVL e
rr
assertMoveR (ZAVL Path e
p AVL e
l Int#
hl e
e (P AVL e
rl e
re AVL e
rr) Int#
hr) = let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l Int#
hl) e
re AVL e
rr DECINT2(hr)
                                              in Path e
p_ Path e -> ZAVL e -> ZAVL e
forall a b. a -> b -> b
`seq` Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openL_ Path e
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 :: forall e. ZAVL e -> Maybe (ZAVL e)
tryMoveR (ZAVL Path e
p AVL e
l Int#
hl e
e  AVL e
E           Int#
_ ) = case AVL e -> Int# -> e -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> (# AVL e, Int# #)
pushHR AVL e
l Int#
hl e
e of UBT2(t,ht) -> Path e -> AVL e -> Int# -> Maybe (ZAVL e)
forall {e}. Path e -> AVL e -> Int# -> Maybe (ZAVL e)
cL Path e
p AVL e
t Int#
ht
 where cL :: Path e -> AVL e -> Int# -> Maybe (ZAVL e)
cL  Path e
EP               AVL e
_  Int#
_   = Maybe (ZAVL e)
forall a. Maybe a
Nothing
       cL (RP Path e
p_ e
e_ AVL e
l_ Int#
hl_) AVL e
r_ Int#
hr_ = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_ of UBT2(t,ht) -> Path e -> AVL e -> Int# -> Maybe (ZAVL e)
cL Path e
p_ AVL e
t Int#
ht
       cL (LP Path e
p_ e
e_ AVL e
r_ Int#
hr_) AVL e
l_ Int#
hl_ = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_
tryMoveR (ZAVL Path e
p AVL e
l Int#
hl e
e (N AVL e
rl e
re AVL e
rr) Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLN (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l Int#
hl) Int#
hr AVL e
rl e
re AVL e
rr
tryMoveR (ZAVL Path e
p AVL e
l Int#
hl e
e (Z AVL e
rl e
re AVL e
rr) Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> e -> AVL e -> ZAVL e
openLZ (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l Int#
hl) Int#
hr AVL e
rl e
re AVL e
rr
tryMoveR (ZAVL Path e
p AVL e
l Int#
hl e
e (P AVL e
rl e
re AVL e
rr) Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! let p_ :: Path e
p_ = Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
LP (Path e -> e -> AVL e -> Int# -> Path e
forall e. Path e -> e -> AVL e -> Int# -> Path e
RP Path e
p e
e AVL e
l Int#
hl) e
re AVL e
rr DECINT2(hr)
                                                   in Path e
p_ Path e -> ZAVL e -> ZAVL e
forall a b. a -> b -> b
`seq` Path e -> Int# -> AVL e -> ZAVL e
forall e. Path e -> Int# -> AVL e -> ZAVL e
openL_ Path e
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 :: forall e. ZAVL e -> Bool
isLeftmost (ZAVL Path e
p AVL e
E Int#
_ e
_ AVL e
_ Int#
_) = Path e -> Bool
forall {e}. Path e -> Bool
iL Path e
p
 where iL :: Path e -> Bool
iL  Path e
EP           = Bool
True
       iL (LP Path e
p_ e
_ AVL e
_ Int#
_) = Path e -> Bool
iL Path e
p_
       iL (RP Path e
_  e
_ AVL e
_ Int#
_) = Bool
False
isLeftmost (ZAVL Path e
_ AVL e
_ Int#
_ e
_ AVL e
_ Int#
_) = Bool
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 :: forall e. ZAVL e -> Bool
isRightmost (ZAVL Path e
p AVL e
_ Int#
_ e
_ AVL e
E Int#
_) = Path e -> Bool
forall {e}. Path e -> Bool
iR Path e
p
 where iR :: Path e -> Bool
iR  Path e
EP           = Bool
True
       iR (RP Path e
p_ e
_ AVL e
_ Int#
_) = Path e -> Bool
iR Path e
p_
       iR (LP Path e
_  e
_ AVL e
_ Int#
_) = Bool
False
isRightmost (ZAVL Path e
_ AVL e
_ Int#
_ e
_ AVL e
_ Int#
_) = Bool
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 :: forall e. e -> ZAVL e -> ZAVL e
insertL e
e0 (ZAVL Path e
p AVL e
l Int#
hl e
e1 AVL e
r Int#
hr) = case AVL e -> Int# -> e -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> (# AVL e, Int# #)
pushHR AVL e
l Int#
hl e
e0 of UBT2(l_,hl_) -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l_ Int#
hl_ e
e1 AVL e
r Int#
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 :: forall e. e -> ZAVL e -> ZAVL e
insertMoveL e
e0 (ZAVL Path e
p AVL e
l Int#
hl e
e1 AVL e
r Int#
hr) = case e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. e -> AVL e -> Int# -> (# AVL e, Int# #)
pushHL e
e1 AVL e
r Int#
hr of UBT2(r_,hr_) -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e0 AVL e
r_ Int#
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 :: forall e. ZAVL e -> e -> ZAVL e
insertR (ZAVL Path e
p AVL e
l Int#
hl e
e0 AVL e
r Int#
hr) e
e1  = case e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. e -> AVL e -> Int# -> (# AVL e, Int# #)
pushHL e
e1 AVL e
r Int#
hr of UBT2(r_,hr_) -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e0 AVL e
r_ Int#
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 :: forall e. ZAVL e -> e -> ZAVL e
insertMoveR (ZAVL Path e
p AVL e
l Int#
hl e
e0 AVL e
r Int#
hr) e
e1  = case AVL e -> Int# -> e -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> (# AVL e, Int# #)
pushHR AVL e
l Int#
hl e
e0 of UBT2(l_,hl_) -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l_ Int#
hl_ e
e1 AVL e
r Int#
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 :: forall e. AVL e -> ZAVL e -> ZAVL e
insertTreeL AVL e
E           ZAVL e
zavl = ZAVL e
zavl
insertTreeL t :: AVL e
t@(N AVL e
l e
_ AVL e
_) ZAVL e
zavl = AVL e -> Int# -> ZAVL e -> ZAVL e
forall e. AVL e -> Int# -> ZAVL e -> ZAVL e
insertLH AVL e
t (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2AVL e
) l) zavl -- Absolute height required!!
insertTreeL t :: AVL e
t@(Z AVL e
l e
_ AVL e
_) ZAVL e
zavl = AVL e -> Int# -> ZAVL e -> ZAVL e
forall e. AVL e -> Int# -> ZAVL e -> ZAVL e
insertLH AVL e
t (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1AVL e
) l) zavl -- Absolute height required!!
insertTreeL t :: AVL e
t@(P AVL e
_ e
_ AVL e
r) ZAVL e
zavl = AVL e -> Int# -> ZAVL e -> ZAVL e
forall e. AVL e -> Int# -> ZAVL e -> ZAVL e
insertLH AVL e
t (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2AVL e
) 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 :: forall e. AVL e -> Int# -> ZAVL e -> ZAVL e
insertLH AVL e
t Int#
ht (ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r Int#
hr) =
 let offset :: Int#
offset = case Int# -> Int# -> Ordering
COMPAREUINT Int#
hl Int#
hr of -- chose smaller sub-tree to calculate absolute height
              Ordering
LT -> SUBINT(hl,height l)
              Ordering
EQ -> SUBINT(hl,height l)
              Ordering
GT -> SUBINT(hr,height r)
 in case AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
joinH AVL e
l Int#
hl AVL e
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 :: forall e. ZAVL e -> AVL e -> ZAVL e
insertTreeR ZAVL e
zavl AVL e
E           = ZAVL e
zavl
insertTreeR ZAVL e
zavl t :: AVL e
t@(N AVL e
l e
_ AVL e
_) = AVL e -> Int# -> ZAVL e -> ZAVL e
forall e. AVL e -> Int# -> ZAVL e -> ZAVL e
insertRH AVL e
t (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2AVL e
) l) zavl -- Absolute height required!!
insertTreeR ZAVL e
zavl t :: AVL e
t@(Z AVL e
l e
_ AVL e
_) = AVL e -> Int# -> ZAVL e -> ZAVL e
forall e. AVL e -> Int# -> ZAVL e -> ZAVL e
insertRH AVL e
t (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1AVL e
) l) zavl -- Absolute height required!!
insertTreeR ZAVL e
zavl t :: AVL e
t@(P AVL e
_ e
_ AVL e
r) = AVL e -> Int# -> ZAVL e -> ZAVL e
forall e. AVL e -> Int# -> ZAVL e -> ZAVL e
insertRH AVL e
t (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2AVL e
) 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 :: forall e. AVL e -> Int# -> ZAVL e -> ZAVL e
insertRH AVL e
t Int#
ht (ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r Int#
hr) =
 let offset :: Int#
offset = case Int# -> Int# -> Ordering
COMPAREUINT Int#
hl Int#
hr of -- chose smaller sub-tree to calculate absolute height
              Ordering
LT -> SUBINT(hl,height l)
              Ordering
EQ -> SUBINT(hr,height r)
              Ordering
GT -> SUBINT(hr,height r)
 in case AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
joinH AVL e
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 :: forall e. ZAVL e -> ZAVL e
assertDelMoveL (ZAVL Path e
p  AVL e
E            Int#
_ e
_ AVL e
r Int#
hr) = Path e -> AVL e -> Int# -> ZAVL e
forall {e}. Path e -> AVL e -> Int# -> ZAVL e
dR Path e
p AVL e
r Int#
hr
 where dR :: Path e -> AVL e -> Int# -> ZAVL e
dR  Path e
EP               AVL e
_  Int#
_   = [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertDelMoveL: Can't move left."
       dR (LP Path e
p_ e
e_ AVL e
r_ Int#
hr_) AVL e
l_ Int#
hl_ = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_ of UBT2(t,ht) -> Path e -> AVL e -> Int# -> ZAVL e
dR Path e
p_ AVL e
t Int#
ht
       dR (RP Path e
p_ e
e_ AVL e
l_ Int#
hl_) AVL e
r_ Int#
hr_ = Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_
assertDelMoveL (ZAVL Path e
p (N AVL e
ll e
le AVL e
lr) Int#
hl e
_ AVL e
r Int#
hr) = case AVL e -> e -> AVL e -> (# AVL e, e #)
forall e. AVL e -> e -> AVL e -> (# AVL e, e #)
popRN AVL e
ll e
le AVL e
lr of
                                                 UBT2(e
l,e) -> case AVL e
l of
                                                              Z AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(hl) e r hr
                                                              N AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l         Int#
hl  e
e AVL e
r Int#
hr
                                                              AVL e
_       -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertDelMoveL: Bug0" -- impossible
assertDelMoveL (ZAVL Path e
p (Z AVL e
ll e
le AVL e
lr) Int#
hl e
_ AVL e
r Int#
hr) = case AVL e -> e -> AVL e -> (# AVL e, e #)
forall e. AVL e -> e -> AVL e -> (# AVL e, e #)
popRZ AVL e
ll e
le AVL e
lr of
                                                 UBT2(e
l,e) -> case AVL e
l of
                                                              AVL e
E       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(hl) e r hr -- Don't use E!!
                                                              N AVL e
_ e
_ AVL e
_ -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertDelMoveL: Bug1"      -- impossible
                                                              AVL e
_       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l         Int#
hl  e
e AVL e
r Int#
hr
assertDelMoveL (ZAVL Path e
p (P AVL e
ll e
le AVL e
lr) Int#
hl e
_ AVL e
r Int#
hr) = case AVL e -> e -> AVL e -> (# AVL e, e #)
forall e. AVL e -> e -> AVL e -> (# AVL e, e #)
popRP AVL e
ll e
le AVL e
lr of
                                                 UBT2(e
l,e) -> case AVL e
l of
                                                        AVL e
E       -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertDelMoveL: Bug2" -- impossible
                                                        Z AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(hl) e r hr
                                                        AVL e
_       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l         Int#
hl  e
e AVL e
r Int#
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 :: forall e. ZAVL e -> Maybe (ZAVL e)
tryDelMoveL (ZAVL Path e
p  AVL e
E            Int#
_ e
_ AVL e
r Int#
hr) = Path e -> AVL e -> Int# -> Maybe (ZAVL e)
forall {e}. Path e -> AVL e -> Int# -> Maybe (ZAVL e)
dR Path e
p AVL e
r Int#
hr
 where dR :: Path e -> AVL e -> Int# -> Maybe (ZAVL e)
dR  Path e
EP               AVL e
_  Int#
_   = Maybe (ZAVL e)
forall a. Maybe a
Nothing
       dR (LP Path e
p_ e
e_ AVL e
r_ Int#
hr_) AVL e
l_ Int#
hl_ = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_ of UBT2(t,ht) -> Path e -> AVL e -> Int# -> Maybe (ZAVL e)
dR Path e
p_ AVL e
t Int#
ht
       dR (RP Path e
p_ e
e_ AVL e
l_ Int#
hl_) AVL e
r_ Int#
hr_ = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_
tryDelMoveL (ZAVL Path e
p (N AVL e
ll e
le AVL e
lr) Int#
hl e
_ AVL e
r Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! case AVL e -> e -> AVL e -> (# AVL e, e #)
forall e. AVL e -> e -> AVL e -> (# AVL e, e #)
popRN AVL e
ll e
le AVL e
lr of
                                              UBT2(e
l,e) -> case AVL e
l of
                                                           Z AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(hl) e r hr
                                                           N AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l         Int#
hl  e
e AVL e
r Int#
hr
                                                           AVL e
_       -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"tryDelMoveL: Bug0" -- impossible
tryDelMoveL (ZAVL Path e
p (Z AVL e
ll e
le AVL e
lr) Int#
hl e
_ AVL e
r Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! case AVL e -> e -> AVL e -> (# AVL e, e #)
forall e. AVL e -> e -> AVL e -> (# AVL e, e #)
popRZ AVL e
ll e
le AVL e
lr of
                                              UBT2(e
l,e) -> case AVL e
l of
                                                           AVL e
E       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(hl) e r hr -- Don't use E!!
                                                           N AVL e
_ e
_ AVL e
_ -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"tryDelMoveL: Bug1"   -- impossible
                                                           AVL e
_       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l         Int#
hl  e
e AVL e
r Int#
hr
tryDelMoveL (ZAVL Path e
p (P AVL e
ll e
le AVL e
lr) Int#
hl e
_ AVL e
r Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! case AVL e -> e -> AVL e -> (# AVL e, e #)
forall e. AVL e -> e -> AVL e -> (# AVL e, e #)
popRP AVL e
ll e
le AVL e
lr of
                                              UBT2(e
l,e) -> case AVL e
l of
                                                           AVL e
E       -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"tryDelMoveL: Bug2" -- impossible
                                                           Z AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l DECINT1(hl) e r hr
                                                           AVL e
_       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l         Int#
hl  e
e AVL e
r Int#
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 :: forall e. ZAVL e -> ZAVL e
assertDelMoveR (ZAVL Path e
p AVL e
l Int#
hl e
_ AVL e
E            Int#
_ ) = Path e -> AVL e -> Int# -> ZAVL e
forall {e}. Path e -> AVL e -> Int# -> ZAVL e
dL Path e
p AVL e
l Int#
hl
 where dL :: Path e -> AVL e -> Int# -> ZAVL e
dL  Path e
EP               AVL e
_  Int#
_   = [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"delMoveR: Can't move right."
       dL (LP Path e
p_ e
e_ AVL e
r_ Int#
hr_) AVL e
l_ Int#
hl_ = Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_
       dL (RP Path e
p_ e
e_ AVL e
l_ Int#
hl_) AVL e
r_ Int#
hr_ = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_ of UBT2(t,ht) -> Path e -> AVL e -> Int# -> ZAVL e
dL Path e
p_ AVL e
t Int#
ht
assertDelMoveR (ZAVL Path e
p AVL e
l Int#
hl e
_ (N AVL e
rl e
re AVL e
rr) Int#
hr) = case AVL e -> e -> AVL e -> (# e, AVL e #)
forall e. AVL e -> e -> AVL e -> (# e, AVL e #)
popLN AVL e
rl e
re AVL e
rr of
                                                 UBT2(AVL e
e,r) -> case AVL e
r of
                                                              AVL e
E       -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"delMoveR: Bug0" -- impossible
                                                              Z AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r DECINT1(hr)
                                                              AVL e
_       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r         Int#
hr
assertDelMoveR (ZAVL Path e
p AVL e
l Int#
hl e
_ (Z AVL e
rl e
re AVL e
rr) Int#
hr) = case AVL e -> e -> AVL e -> (# e, AVL e #)
forall e. AVL e -> e -> AVL e -> (# e, AVL e #)
popLZ AVL e
rl e
re AVL e
rr of
                                                 UBT2(AVL e
e,r) -> case AVL e
r of
                                                              AVL e
E       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r DECINT1(hr) -- Don't use E!!
                                                              P AVL e
_ e
_ AVL e
_ -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"delMoveR: Bug1" -- impossible
                                                              AVL e
_       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r         Int#
hr
assertDelMoveR (ZAVL Path e
p AVL e
l Int#
hl e
_ (P AVL e
rl e
re AVL e
rr) Int#
hr) = case AVL e -> e -> AVL e -> (# e, AVL e #)
forall e. AVL e -> e -> AVL e -> (# e, AVL e #)
popLP AVL e
rl e
re AVL e
rr of
                                                 UBT2(AVL e
e,r) -> case AVL e
r of
                                                              Z AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r DECINT1(hr)
                                                              P AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r         Int#
hr
                                                              AVL e
_       -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall e. ZAVL e -> Maybe (ZAVL e)
tryDelMoveR (ZAVL Path e
p AVL e
l Int#
hl e
_ AVL e
E            Int#
_ ) = Path e -> AVL e -> Int# -> Maybe (ZAVL e)
forall {e}. Path e -> AVL e -> Int# -> Maybe (ZAVL e)
dL Path e
p AVL e
l Int#
hl
 where dL :: Path e -> AVL e -> Int# -> Maybe (ZAVL e)
dL  Path e
EP               AVL e
_  Int#
_   = Maybe (ZAVL e)
forall a. Maybe a
Nothing
       dL (LP Path e
p_ e
e_ AVL e
r_ Int#
hr_) AVL e
l_ Int#
hl_ = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_
       dL (RP Path e
p_ e
e_ AVL e
l_ Int#
hl_) AVL e
r_ Int#
hr_ = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l_ Int#
hl_ e
e_ AVL e
r_ Int#
hr_ of UBT2(t,ht) -> Path e -> AVL e -> Int# -> Maybe (ZAVL e)
dL Path e
p_ AVL e
t Int#
ht
tryDelMoveR (ZAVL Path e
p AVL e
l Int#
hl e
_ (N AVL e
rl e
re AVL e
rr) Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! case AVL e -> e -> AVL e -> (# e, AVL e #)
forall e. AVL e -> e -> AVL e -> (# e, AVL e #)
popLN AVL e
rl e
re AVL e
rr of
                                              UBT2(AVL e
e,r) -> case AVL e
r of
                                                           AVL e
E       -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"tryDelMoveR: Bug0" -- impossible
                                                           Z AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r DECINT1(hr)
                                                           AVL e
_       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r         Int#
hr
tryDelMoveR (ZAVL Path e
p AVL e
l Int#
hl e
_ (Z AVL e
rl e
re AVL e
rr) Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! case AVL e -> e -> AVL e -> (# e, AVL e #)
forall e. AVL e -> e -> AVL e -> (# e, AVL e #)
popLZ AVL e
rl e
re AVL e
rr of
                                              UBT2(AVL e
e,r) -> case AVL e
r of
                                                           AVL e
E       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r DECINT1(hr) -- Don't use E!!
                                                           P AVL e
_ e
_ AVL e
_ -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"tryDelMoveR: Bug1" -- impossible
                                                           AVL e
_       -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r         Int#
hr
tryDelMoveR (ZAVL Path e
p AVL e
l Int#
hl e
_ (P AVL e
rl e
re AVL e
rr) Int#
hr) = ZAVL e -> Maybe (ZAVL e)
forall a. a -> Maybe a
Just (ZAVL e -> Maybe (ZAVL e)) -> ZAVL e -> Maybe (ZAVL e)
forall a b. (a -> b) -> a -> b
$! case AVL e -> e -> AVL e -> (# e, AVL e #)
forall e. AVL e -> e -> AVL e -> (# e, AVL e #)
popLP AVL e
rl e
re AVL e
rr of
                                              UBT2(AVL e
e,r) -> case AVL e
r of
                                                           Z AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r DECINT1(hr)
                                                           P AVL e
_ e
_ AVL e
_ -> Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r         Int#
hr
                                                           AVL e
_       -> [Char] -> ZAVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"tryDelMoveR: Bug2" -- impossible


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

-- | Delete all elements to the right of the current element.
--
-- Complexity: O(log n)
delAllR :: ZAVL e -> ZAVL e
delAllR :: forall e. ZAVL e -> ZAVL e
delAllR (ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
r Int#
hr) =
 let hE :: Int#
hE = case Int# -> Int# -> Ordering
COMPAREUINT Int#
hl Int#
hr of -- Calculate relative offset and use this as height of empty tree
          Ordering
LT -> SUBINT(hl,height l)
          Ordering
EQ -> SUBINT(hl,height l)
          Ordering
GT -> SUBINT(hr,height r)
     p_ :: Path e
p_ = Path e -> Path e
forall e. Path e -> Path e
noLP Path e
p -- remove left paths (current element becomes rightmost)
 in Path e
p_ Path e -> ZAVL e -> ZAVL e
forall a b. a -> b -> b
`seq` Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
forall e. Path e -> AVL e -> Int# -> e -> AVL e -> Int# -> ZAVL e
ZAVL Path e
p_ AVL e
l Int#
hl e
e AVL e
forall e. AVL e
E Int#
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 :: forall e. ZAVL e -> AVL e
delAllCloseL (ZAVL Path e
p AVL e
_ Int#
_ e
e AVL e
r Int#
hr) = case e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. e -> AVL e -> Int# -> (# AVL e, Int# #)
pushHL e
e AVL e
r Int#
hr of UBT2(t,ht) -> Path e -> AVL e -> Int# -> AVL e
forall e. Path e -> AVL e -> Int# -> AVL e
closeNoRP Path e
p AVL e
t Int#
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 :: forall e. ZAVL e -> AVL e
delAllCloseR (ZAVL Path e
p AVL e
l Int#
hl e
e AVL e
_ Int#
_) = case AVL e -> Int# -> e -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> (# AVL e, Int# #)
pushHR AVL e
l Int#
hl e
e of UBT2(t,ht) -> Path e -> AVL e -> Int# -> AVL e
forall e. Path e -> AVL e -> Int# -> AVL e
closeNoLP Path e
p AVL e
t Int#
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 :: forall e. ZAVL e -> AVL e
delAllIncCloseL (ZAVL Path e
p AVL e
_ Int#
_ e
_ AVL e
r Int#
hr) = Path e -> AVL e -> Int# -> AVL e
forall e. Path e -> AVL e -> Int# -> AVL e
closeNoRP Path e
p AVL e
r Int#
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 :: forall e. ZAVL e -> AVL e
delAllIncCloseR (ZAVL Path e
p AVL e
l Int#
hl e
_ AVL e
_ Int#
_) = Path e -> AVL e -> Int# -> AVL e
forall e. Path e -> AVL e -> Int# -> AVL e
closeNoLP Path e
p AVL e
l Int#
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 :: forall e. ZAVL e -> Int
sizeL (ZAVL Path e
p AVL e
l Int#
_ e
_ AVL e
_ Int#
_) = Int -> Path e -> Int
forall e. Int -> Path e -> Int
addSizeRP (AVL e -> Int
forall e. AVL e -> Int
size AVL e
l) Path e
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 :: forall e. ZAVL e -> Int
sizeR (ZAVL Path e
p AVL e
_ Int#
_ e
_ AVL e
r Int#
_) = Int -> Path e -> Int
forall e. Int -> Path e -> Int
addSizeLP (AVL e -> Int
forall e. AVL e -> Int
size AVL e
r) Path e
p

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


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

-- | A t'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\" t'BAVL' if a matching element was found,
-- otherwise returns an \"empty\" t'BAVL'.
--
-- Complexity: O(log n)
openBAVL :: (e -> Ordering) -> AVL e -> BAVL e
{-# INLINE openBAVL #-}
openBAVL :: forall e. (e -> Ordering) -> AVL e -> BAVL e
openBAVL e -> Ordering
c AVL e
t = BinPath e
bp BinPath e -> BAVL e -> BAVL e
forall a b. a -> b -> b
`seq` AVL e -> BinPath e -> BAVL e
forall e. AVL e -> BinPath e -> BAVL e
BAVL AVL e
t BinPath e
bp
 where bp :: BinPath e
bp = (e -> Ordering) -> AVL e -> BinPath e
forall e. (e -> Ordering) -> AVL e -> BinPath e
openPath e -> Ordering
c AVL e
t

-- | Returns the original tree, extracted from the t'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 :: forall e. BAVL e -> AVL e
closeBAVL (BAVL AVL e
t BinPath e
_) = AVL e
t

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

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

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

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

-- | If the t'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 :: forall e. e -> BAVL e -> AVL e
pushBAVL e
e (BAVL AVL e
t (FullBP  Int#
p e
_)) = Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
writePath  Int#
p e
e AVL e
t
pushBAVL e
e (BAVL 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

-- | If the t'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 t'BAVL')
deleteBAVL :: BAVL e -> AVL e
{-# INLINE deleteBAVL #-}
deleteBAVL :: forall e. BAVL e -> AVL e
deleteBAVL (BAVL AVL e
t (FullBP  Int#
p e
_)) = Int# -> AVL e -> AVL e
forall e. Int# -> AVL e -> AVL e
deletePath Int#
p AVL e
t
deleteBAVL (BAVL AVL e
t (EmptyBP Int#
_  )) = AVL e
t

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

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


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