-- |
-- Copyright   :  (c) Adrian Hey 2004,2005
-- License     :  BSD3
--
{-# OPTIONS_HADDOCK hide #-}
module Data.Tree.AVL.Delete
(-- * Deleting elements from AVL trees

 -- ** Deleting from extreme left or right
 delL,delR,assertDelL,assertDelR,tryDelL,tryDelR,

 -- ** Deleting from /sorted/ trees
 delete,deleteFast,deleteIf,deleteMaybe,

 -- * \"Popping\" elements from AVL trees
 -- | \"Popping\" means reading and deleting a tree element in a single operation.

 -- ** Popping from extreme left or right
 assertPopL,assertPopR,tryPopL,tryPopR,

 -- ** Popping from /sorted/ trees
 assertPop,tryPop,assertPopMaybe,tryPopMaybe,assertPopIf,tryPopIf,
) where

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

import Data.Tree.AVL.Internals.DelUtils
         (-- Deleting Utilities
          delRN,delRZ,delRP,delLN,delLZ,delLP,
          -- Popping Utilities.
          popRN,popRZ,popRP,popLN,popLZ,popLP,
          -- Balancing Utilities
          chkLN,chkLZ,chkLP,chkRN,chkRZ,chkRP,
          chkLN',chkLZ',chkLP',chkRN',chkRZ',chkRP',
          -- Node substitution utilities.
          subN,subZR,subZL,subP,
          -- BinPath related
          deletePath
         )

#include "ghcdefs.h"

-- | Delete the left-most element of an AVL tree. If the tree is sorted this will be the
-- least element. This function returns an empty tree if it's argument is an empty tree.
--
-- Complexity: O(log n)
delL :: AVL e -> AVL e
delL :: forall e. AVL e -> AVL e
delL  AVL e
E        = AVL e
forall e. AVL e
E
delL (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delLN AVL e
l e
e AVL e
r
delL (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delLZ AVL e
l e
e AVL e
r
delL (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delLP AVL e
l e
e AVL e
r

-- | Delete the left-most element of a /non-empty/ AVL tree. If the tree is sorted this will be the
-- least element. This function raises an error if it's argument is an empty tree.
--
-- Complexity: O(log n)
assertDelL :: AVL e -> AVL e
assertDelL :: forall e. AVL e -> AVL e
assertDelL  AVL e
E        = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertDelL: Empty tree."
assertDelL (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delLN AVL e
l e
e AVL e
r
assertDelL (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delLZ AVL e
l e
e AVL e
r
assertDelL (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delLP AVL e
l e
e AVL e
r

-- | Try to delete the left-most element of a /non-empty/ AVL tree. If the tree is sorted this will be the
-- least element. This function returns 'Nothing' if it's argument is an empty tree.
--
-- Complexity: O(log n)
tryDelL :: AVL e -> Maybe (AVL e)
tryDelL :: forall e. AVL e -> Maybe (AVL e)
tryDelL  AVL e
E        = Maybe (AVL e)
forall a. Maybe a
Nothing
tryDelL (N AVL e
l e
e AVL e
r) = AVL e -> Maybe (AVL e)
forall a. a -> Maybe a
Just (AVL e -> Maybe (AVL e)) -> AVL e -> Maybe (AVL e)
forall a b. (a -> b) -> a -> b
$! AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delLN AVL e
l e
e AVL e
r
tryDelL (Z AVL e
l e
e AVL e
r) = AVL e -> Maybe (AVL e)
forall a. a -> Maybe a
Just (AVL e -> Maybe (AVL e)) -> AVL e -> Maybe (AVL e)
forall a b. (a -> b) -> a -> b
$! AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delLZ AVL e
l e
e AVL e
r
tryDelL (P AVL e
l e
e AVL e
r) = AVL e -> Maybe (AVL e)
forall a. a -> Maybe a
Just (AVL e -> Maybe (AVL e)) -> AVL e -> Maybe (AVL e)
forall a b. (a -> b) -> a -> b
$! AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delLP AVL e
l e
e AVL e
r

-- | Delete the right-most element of an AVL tree. If the tree is sorted this will be the
-- greatest element. This function returns an empty tree if it's argument is an empty tree.
--
-- Complexity: O(log n)
delR :: AVL e -> AVL e
delR :: forall e. AVL e -> AVL e
delR  AVL e
E        = AVL e
forall e. AVL e
E
delR (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delRN AVL e
l e
e AVL e
r
delR (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delRZ AVL e
l e
e AVL e
r
delR (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delRP AVL e
l e
e AVL e
r

-- | Delete the right-most element of a /non-empty/ AVL tree. If the tree is sorted this will be the
-- greatest element. This function raises an error if it's argument is an empty tree.
--
-- Complexity: O(log n)
assertDelR :: AVL e -> AVL e
assertDelR :: forall e. AVL e -> AVL e
assertDelR  AVL e
E        = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"assertDelR: Empty tree."
assertDelR (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delRN AVL e
l e
e AVL e
r
assertDelR (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delRZ AVL e
l e
e AVL e
r
assertDelR (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delRP AVL e
l e
e AVL e
r

-- | Try to delete the right-most element of a /non-empty/ AVL tree. If the tree is sorted this will be the
-- greatest element. This function returns 'Nothing' if it's argument is an empty tree.
--
-- Complexity: O(log n)
tryDelR :: AVL e -> Maybe (AVL e)
tryDelR :: forall e. AVL e -> Maybe (AVL e)
tryDelR  AVL e
E        = Maybe (AVL e)
forall a. Maybe a
Nothing
tryDelR (N AVL e
l e
e AVL e
r) = AVL e -> Maybe (AVL e)
forall a. a -> Maybe a
Just (AVL e -> Maybe (AVL e)) -> AVL e -> Maybe (AVL e)
forall a b. (a -> b) -> a -> b
$! AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delRN AVL e
l e
e AVL e
r
tryDelR (Z AVL e
l e
e AVL e
r) = AVL e -> Maybe (AVL e)
forall a. a -> Maybe a
Just (AVL e -> Maybe (AVL e)) -> AVL e -> Maybe (AVL e)
forall a b. (a -> b) -> a -> b
$! AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delRZ AVL e
l e
e AVL e
r
tryDelR (P AVL e
l e
e AVL e
r) = AVL e -> Maybe (AVL e)
forall a. a -> Maybe a
Just (AVL e -> Maybe (AVL e)) -> AVL e -> Maybe (AVL e)
forall a b. (a -> b) -> a -> b
$! AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
delRP AVL e
l e
e AVL e
r

-- | Pop the left-most element from a non-empty AVL tree, returning the popped element and the
-- modified AVL tree. If the tree is sorted this will be the least element.
-- This function raises an error if it's argument is an empty tree.
--
-- Complexity: O(log n)
assertPopL :: AVL e -> (e,AVL e)
assertPopL :: forall e. AVL e -> (e, AVL e)
assertPopL  AVL e
E        = [Char] -> (e, AVL e)
forall a. HasCallStack => [Char] -> a
error [Char]
"assertPopL: Empty tree."
assertPopL (N AVL e
l e
e AVL e
r) = case AVL e -> e -> AVL e -> (# e, AVL e #)
forall e. AVL e -> e -> AVL e -> (# e, AVL e #)
popLN AVL e
l e
e AVL e
r of UBT2(AVL e
v,t) -> (e
v,AVL e
t)
assertPopL (Z AVL e
l e
e AVL e
r) = case AVL e -> e -> AVL e -> (# e, AVL e #)
forall e. AVL e -> e -> AVL e -> (# e, AVL e #)
popLZ AVL e
l e
e AVL e
r of UBT2(AVL e
v,t) -> (e
v,AVL e
t)
assertPopL (P AVL e
l e
e AVL e
r) = case AVL e -> e -> AVL e -> (# e, AVL e #)
forall e. AVL e -> e -> AVL e -> (# e, AVL e #)
popLP AVL e
l e
e AVL e
r of UBT2(AVL e
v,t) -> (e
v,AVL e
t)

-- | Same as 'assertPopL', except this version returns 'Nothing' if it's argument is an empty tree.
--
-- Complexity: O(log n)
tryPopL :: AVL e -> Maybe (e,AVL e)
tryPopL :: forall e. AVL e -> Maybe (e, AVL e)
tryPopL  AVL e
E        = Maybe (e, AVL e)
forall a. Maybe a
Nothing
tryPopL (N AVL e
l e
e AVL e
r) = (e, AVL e) -> Maybe (e, AVL e)
forall a. a -> Maybe a
Just ((e, AVL e) -> Maybe (e, AVL e)) -> (e, AVL e) -> Maybe (e, AVL 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
l e
e AVL e
r of UBT2(AVL e
v,t) -> (e
v,AVL e
t)
tryPopL (Z AVL e
l e
e AVL e
r) = (e, AVL e) -> Maybe (e, AVL e)
forall a. a -> Maybe a
Just ((e, AVL e) -> Maybe (e, AVL e)) -> (e, AVL e) -> Maybe (e, AVL 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
l e
e AVL e
r of UBT2(AVL e
v,t) -> (e
v,AVL e
t)
tryPopL (P AVL e
l e
e AVL e
r) = (e, AVL e) -> Maybe (e, AVL e)
forall a. a -> Maybe a
Just ((e, AVL e) -> Maybe (e, AVL e)) -> (e, AVL e) -> Maybe (e, AVL 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
l e
e AVL e
r of UBT2(AVL e
v,t) -> (e
v,AVL e
t)


-- | Pop the right-most element from a non-empty AVL tree, returning the popped element and the
-- modified AVL tree. If the tree is sorted this will be the greatest element.
-- This function raises an error if it's argument is an empty tree.
--
-- Complexity: O(log n)
assertPopR :: AVL e -> (AVL e,e)
assertPopR :: forall e. AVL e -> (AVL e, e)
assertPopR  AVL e
E        = [Char] -> (AVL e, e)
forall a. HasCallStack => [Char] -> a
error [Char]
"assertPopR: Empty tree."
assertPopR (N AVL e
l e
e AVL e
r) = case AVL e -> e -> AVL e -> (# AVL e, e #)
forall e. AVL e -> e -> AVL e -> (# AVL e, e #)
popRN AVL e
l e
e AVL e
r of UBT2(e
t,v) -> (AVL e
t,e
v)
assertPopR (Z AVL e
l e
e AVL e
r) = case AVL e -> e -> AVL e -> (# AVL e, e #)
forall e. AVL e -> e -> AVL e -> (# AVL e, e #)
popRZ AVL e
l e
e AVL e
r of UBT2(e
t,v) -> (AVL e
t,e
v)
assertPopR (P AVL e
l e
e AVL e
r) = case AVL e -> e -> AVL e -> (# AVL e, e #)
forall e. AVL e -> e -> AVL e -> (# AVL e, e #)
popRP AVL e
l e
e AVL e
r of UBT2(e
t,v) -> (AVL e
t,e
v)

-- | Same as 'assertPopR', except this version returns 'Nothing' if it's argument is an empty tree.
--
-- Complexity: O(log n)
tryPopR :: AVL e -> Maybe (AVL e,e)
tryPopR :: forall e. AVL e -> Maybe (AVL e, e)
tryPopR  AVL e
E        = Maybe (AVL e, e)
forall a. Maybe a
Nothing
tryPopR (N AVL e
l e
e AVL e
r) = (AVL e, e) -> Maybe (AVL e, e)
forall a. a -> Maybe a
Just ((AVL e, e) -> Maybe (AVL e, e)) -> (AVL e, e) -> Maybe (AVL e, 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
l e
e AVL e
r of UBT2(e
t,v) -> (AVL e
t,e
v)
tryPopR (Z AVL e
l e
e AVL e
r) = (AVL e, e) -> Maybe (AVL e, e)
forall a. a -> Maybe a
Just ((AVL e, e) -> Maybe (AVL e, e)) -> (AVL e, e) -> Maybe (AVL e, 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
l e
e AVL e
r of UBT2(e
t,v) -> (AVL e
t,e
v)
tryPopR (P AVL e
l e
e AVL e
r) = (AVL e, e) -> Maybe (AVL e, e)
forall a. a -> Maybe a
Just ((AVL e, e) -> Maybe (AVL e, e)) -> (AVL e, e) -> Maybe (AVL e, 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
l e
e AVL e
r of UBT2(e
t,v) -> (AVL e
t,e
v)

-- | General purpose function for deletion of elements from a sorted AVL tree.
-- If a matching element is not found then this function returns the original tree.
--
-- Complexity: O(log n)
delete :: (e -> Ordering) -> AVL e -> AVL e
delete :: forall e. (e -> Ordering) -> AVL e -> AVL e
delete e -> Ordering
c AVL e
t = case (e -> Ordering) -> AVL e -> Int#
forall e. (e -> Ordering) -> AVL e -> Int#
findFullPath e -> Ordering
c AVL e
t of
             L(-1) -> t                -- Not found, p<0
             Int#
p     -> Int# -> AVL e -> AVL e
forall e. Int# -> AVL e -> AVL e
deletePath Int#
p AVL e
t   -- Found, so delete

-- | This version only deletes the element if the supplied selector returns @('Data.COrdering.Eq' 'True')@.
-- If it returns @('Data.COrdering.Eq' 'False')@ or if no matching element is found then this function returns
-- the original tree.
--
-- Complexity: O(log n)
deleteIf :: (e -> COrdering Bool) -> AVL e -> AVL e
deleteIf :: forall e. (e -> COrdering Bool) -> AVL e -> AVL e
deleteIf e -> COrdering Bool
c AVL e
t = case (e -> COrdering Bool) -> AVL e -> BinPath Bool
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering Bool
c AVL e
t of
               FullBP Int#
p Bool
True -> Int# -> AVL e -> AVL e
forall e. Int# -> AVL e -> AVL e
deletePath Int#
p AVL e
t
               BinPath Bool
_             -> AVL e
t

-- | This version only deletes the element if the supplied selector returns @('Data.COrdering.Eq' 'Nothing')@.
-- If it returns @('Data.COrdering.Eq' ('Just' e))@  then the matching element is replaced by e.
-- If no matching element is found then this function returns the original tree.
--
-- Complexity: O(log n)
deleteMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL e
deleteMaybe :: forall e. (e -> COrdering (Maybe e)) -> AVL e -> AVL e
deleteMaybe e -> COrdering (Maybe e)
c AVL e
t = case (e -> COrdering (Maybe e)) -> AVL e -> BinPath (Maybe e)
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering (Maybe e)
c AVL e
t of
                  FullBP Int#
p Maybe e
Nothing  -> Int# -> AVL e -> AVL e
forall e. Int# -> AVL e -> AVL e
deletePath Int#
p AVL e
t
                  FullBP Int#
p (Just e
e) -> Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
writePath Int#
p e
e AVL e
t
                  BinPath (Maybe e)
_                 -> AVL e
t

-- | Functionally identical to 'delete', but returns an identical tree (one with all the nodes on
-- the path duplicated) if the search fails. This should probably only be used if you know the
-- search will succeed.
--
-- Complexity: O(log n)
deleteFast :: (e -> Ordering) -> AVL e -> AVL e
-- This was the old delete so it's been tested OK, but as a different name.
deleteFast :: forall e. (e -> Ordering) -> AVL e -> AVL e
deleteFast e -> Ordering
c = AVL e -> AVL e
delete' where
 delete' :: AVL e -> AVL e
delete'  AVL e
E        = AVL e
forall e. AVL e
E
 delete' (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
delN AVL e
l e
e AVL e
r
 delete' (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
delZ AVL e
l e
e AVL e
r
 delete' (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> AVL e
delP AVL e
l e
e AVL e
r

 ----------------------------- LEVEL 1 ---------------------------------
 --                       delN, delZ, delP                            --
 -----------------------------------------------------------------------

 -- Delete from (N l e r)
 delN :: AVL e -> e -> AVL e -> AVL e
delN AVL e
l e
e AVL e
r = case e -> Ordering
c e
e of
              Ordering
LT -> AVL e -> e -> AVL e -> AVL e
delNL AVL e
l e
e AVL e
r
              Ordering
EQ -> AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN AVL e
l AVL e
r
              Ordering
GT -> AVL e -> e -> AVL e -> AVL e
delNR AVL e
l e
e AVL e
r

 -- Delete from (Z l e r)
 delZ :: AVL e -> e -> AVL e -> AVL e
delZ AVL e
l e
e AVL e
r = case e -> Ordering
c e
e of
              Ordering
LT -> AVL e -> e -> AVL e -> AVL e
delZL AVL e
l e
e AVL e
r
              Ordering
EQ -> AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZR AVL e
l AVL e
r
              Ordering
GT -> AVL e -> e -> AVL e -> AVL e
delZR AVL e
l e
e AVL e
r

 -- Delete from (P l e r)
 delP :: AVL e -> e -> AVL e -> AVL e
delP AVL e
l e
e AVL e
r = case e -> Ordering
c e
e of
              Ordering
LT -> AVL e -> e -> AVL e -> AVL e
delPL AVL e
l e
e AVL e
r
              Ordering
EQ -> AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP AVL e
l AVL e
r
              Ordering
GT -> AVL e -> e -> AVL e -> AVL e
delPR AVL e
l e
e AVL e
r

 ----------------------------- LEVEL 2 ---------------------------------
 --                      delNL, delZL, delPL                          --
 --                      delNR, delZR, delPR                          --
 -----------------------------------------------------------------------

 -- Delete from the left subtree of (N l e r)
 delNL :: AVL e -> e -> AVL e -> AVL e
delNL  AVL e
E           e
e AVL e
r = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
forall e. AVL e
E e
e AVL e
r                            -- Left sub-tree is empty
 delNL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> Ordering
c e
le of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN  (AVL e -> e -> AVL e -> AVL e
delNL AVL e
ll e
le AVL e
lr) e
e AVL e
r
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN  (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN  AVL e
ll    AVL e
lr) e
e AVL e
r
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN  (AVL e -> e -> AVL e -> AVL e
delNR AVL e
ll e
le AVL e
lr) e
e AVL e
r
 delNL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> Ordering
c e
le of
                          Ordering
LT -> let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
delZL AVL e
ll e
le AVL e
lr in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r  -- height can't change
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN' (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZR AVL e
ll    AVL e
lr) e
e AVL e
r                    -- << But it can here
                          Ordering
GT -> let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
delZR AVL e
ll e
le AVL e
lr in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l' e
e AVL e
r  -- height can't change
 delNL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> Ordering
c e
le of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN  (AVL e -> e -> AVL e -> AVL e
delPL AVL e
ll e
le AVL e
lr) e
e AVL e
r
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN  (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP  AVL e
ll    AVL e
lr) e
e AVL e
r
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN  (AVL e -> e -> AVL e -> AVL e
delPR AVL e
ll e
le AVL e
lr) e
e AVL e
r

 -- Delete from the right subtree of (N l e r)
 delNR :: AVL e -> e -> AVL e -> AVL e
delNR AVL e
_ e
_  AVL e
E           = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"delNR: Bug0"             -- Impossible
 delNR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = case e -> Ordering
c e
re of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delNL AVL e
rl e
re AVL e
rr)
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN  AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN  AVL e
rl    AVL e
rr)
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delNR AVL e
rl e
re AVL e
rr)
 delNR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = case e -> Ordering
c e
re of
                          Ordering
LT -> let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
delZL AVL e
rl e
re AVL e
rr in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'   -- height can't change
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN' AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZL AVL e
rl    AVL e
rr)                    -- << But it can here
                          Ordering
GT -> let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
delZR AVL e
rl e
re AVL e
rr in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
e AVL e
r'   -- height can't change
 delNR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = case e -> Ordering
c e
re of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delPL AVL e
rl e
re AVL e
rr)
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN  AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP  AVL e
rl    AVL e
rr)
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delPR AVL e
rl e
re AVL e
rr)

 -- Delete from the left subtree of (Z l e r)
 delZL :: AVL e -> e -> AVL e -> AVL e
delZL  AVL e
E           e
e AVL e
r = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
forall e. AVL e
E e
e AVL e
r                            -- Left sub-tree is empty
 delZL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> Ordering
c e
le of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ  (AVL e -> e -> AVL e -> AVL e
delNL AVL e
ll e
le AVL e
lr) e
e AVL e
r
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ  (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN  AVL e
ll    AVL e
lr) e
e AVL e
r
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ  (AVL e -> e -> AVL e -> AVL e
delNR AVL e
ll e
le AVL e
lr) e
e AVL e
r
 delZL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> Ordering
c e
le of
                          Ordering
LT -> let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
delZL AVL e
ll e
le AVL e
lr in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r  -- height can't change
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ'  (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZR AVL e
ll    AVL e
lr) e
e AVL e
r                  -- << But it can here
                          Ordering
GT -> let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
delZR AVL e
ll e
le AVL e
lr in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l' e
e AVL e
r  -- height can't change
 delZL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> Ordering
c e
le of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ  (AVL e -> e -> AVL e -> AVL e
delPL AVL e
ll e
le AVL e
lr) e
e AVL e
r
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ  (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP  AVL e
ll    AVL e
lr) e
e AVL e
r
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ  (AVL e -> e -> AVL e -> AVL e
delPR AVL e
ll e
le AVL e
lr) e
e AVL e
r

 -- Delete from the right subtree of (Z l e r)
 delZR :: AVL e -> e -> AVL e -> AVL e
delZR AVL e
l e
e  AVL e
E           = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
forall e. AVL e
E                            -- Right sub-tree is empty
 delZR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = case e -> Ordering
c e
re of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delNL AVL e
rl e
re AVL e
rr)
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ  AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN  AVL e
rl    AVL e
rr)
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delNR AVL e
rl e
re AVL e
rr)
 delZR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = case e -> Ordering
c e
re of
                          Ordering
LT -> let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
delZL AVL e
rl e
re AVL e
rr in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'  -- height can't change
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ' AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZL AVL e
rl    AVL e
rr)                   -- << But it can here
                          Ordering
GT -> let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
delZR AVL e
rl e
re AVL e
rr in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
e AVL e
r'  -- height can't change
 delZR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = case e -> Ordering
c e
re of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delPL AVL e
rl e
re AVL e
rr)
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ  AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP  AVL e
rl    AVL e
rr)
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delPR AVL e
rl e
re AVL e
rr)

 -- Delete from the left subtree of (P l e r)
 delPL :: AVL e -> e -> AVL e -> AVL e
delPL  AVL e
E           e
_ AVL e
_ = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"delPL: Bug0"             -- Impossible
 delPL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> Ordering
c e
le of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP  (AVL e -> e -> AVL e -> AVL e
delNL AVL e
ll e
le AVL e
lr) e
e AVL e
r
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP  (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN  AVL e
ll    AVL e
lr) e
e AVL e
r
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP  (AVL e -> e -> AVL e -> AVL e
delNR AVL e
ll e
le AVL e
lr) e
e AVL e
r
 delPL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> Ordering
c e
le of
                          Ordering
LT -> let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
delZL AVL e
ll e
le AVL e
lr in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r  -- height can't change
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP' (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZR AVL e
ll    AVL e
lr) e
e AVL e
r                   -- << But it can here
                          Ordering
GT -> let l' :: AVL e
l' = AVL e -> e -> AVL e -> AVL e
delZR AVL e
ll e
le AVL e
lr in AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l' e
e AVL e
r  -- height can't change
 delPL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> Ordering
c e
le of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP  (AVL e -> e -> AVL e -> AVL e
delPL AVL e
ll e
le AVL e
lr) e
e AVL e
r
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP  (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP  AVL e
ll    AVL e
lr) e
e AVL e
r
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP  (AVL e -> e -> AVL e -> AVL e
delPR AVL e
ll e
le AVL e
lr) e
e AVL e
r

 -- Delete from the right subtree of (P l e r)
 delPR :: AVL e -> e -> AVL e -> AVL e
delPR AVL e
l e
e  AVL e
E           = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
forall e. AVL e
E                            -- Right sub-tree is empty
 delPR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = case e -> Ordering
c e
re of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delNL AVL e
rl e
re AVL e
rr)
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP  AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN  AVL e
rl    AVL e
rr)
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delNR AVL e
rl e
re AVL e
rr)
 delPR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = case e -> Ordering
c e
re of
                          Ordering
LT -> let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
delZL AVL e
rl e
re AVL e
rr in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'  -- height can't change
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP' AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZL AVL e
rl    AVL e
rr)                   -- << But it can here
                          Ordering
GT -> let r' :: AVL e
r' = AVL e -> e -> AVL e -> AVL e
delZR AVL e
rl e
re AVL e
rr in AVL e
r' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
e AVL e
r'  -- height can't change
 delPR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = case e -> Ordering
c e
re of
                          Ordering
LT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delPL AVL e
rl e
re AVL e
rr)
                          Ordering
EQ -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP  AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP  AVL e
rl    AVL e
rr)
                          Ordering
GT -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP  AVL e
l e
e (AVL e -> e -> AVL e -> AVL e
delPR AVL e
rl e
re AVL e
rr)

-- | General purpose function for popping elements from a sorted AVL tree.
-- An error is raised if a matching element is not found. The pair returned
-- by this function consists of the popped value and the modified tree.
--
-- Complexity: O(log n)
assertPop :: (e -> COrdering a) -> AVL e -> (a,AVL e)
assertPop :: forall e a. (e -> COrdering a) -> AVL e -> (a, AVL e)
assertPop e -> COrdering a
c = AVL e -> (a, AVL e)
genPop_ where
 genPop_ :: AVL e -> (a, AVL e)
genPop_  AVL e
E        = [Char] -> (a, AVL e)
forall a. HasCallStack => [Char] -> a
error [Char]
"assertPop: element not found."
 genPop_ (N AVL e
l e
e AVL e
r) = case AVL e -> e -> AVL e -> (# a, AVL e #)
popN AVL e
l e
e AVL e
r of UBT2(AVL e
v,t) -> (a
v,AVL e
t)
 genPop_ (Z AVL e
l e
e AVL e
r) = case AVL e -> e -> AVL e -> (# a, AVL e #)
popZ AVL e
l e
e AVL e
r of UBT2(AVL e
v,t) -> (a
v,AVL e
t)
 genPop_ (P AVL e
l e
e AVL e
r) = case AVL e -> e -> AVL e -> (# a, AVL e #)
popP AVL e
l e
e AVL e
r of UBT2(AVL e
v,t) -> (a
v,AVL e
t)

 ----------------------------- LEVEL 1 ---------------------------------
 --                       popN, popZ, popP                            --
 -----------------------------------------------------------------------

 -- Pop from (N l e r)
 popN :: AVL e -> e -> AVL e -> (# a, AVL e #)
popN AVL e
l e
e AVL e
r = case e -> COrdering a
c e
e of
              COrdering a
Lt   -> AVL e -> e -> AVL e -> (# a, AVL e #)
popNL AVL e
l e
e AVL e
r
              Eq a
a -> let t :: AVL e
t = AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN AVL e
l AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
              COrdering a
Gt   -> AVL e -> e -> AVL e -> (# a, AVL e #)
popNR AVL e
l e
e AVL e
r

 -- Pop from (Z l e r)
 popZ :: AVL e -> e -> AVL e -> (# a, AVL e #)
popZ AVL e
l e
e AVL e
r = case e -> COrdering a
c e
e of
              COrdering a
Lt   -> AVL e -> e -> AVL e -> (# a, AVL e #)
popZL AVL e
l e
e AVL e
r
              Eq a
a -> let t :: AVL e
t = AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZR AVL e
l AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
              COrdering a
Gt   -> AVL e -> e -> AVL e -> (# a, AVL e #)
popZR AVL e
l e
e AVL e
r

 -- Pop from (P l e r)
 popP :: AVL e -> e -> AVL e -> (# a, AVL e #)
popP AVL e
l e
e AVL e
r = case e -> COrdering a
c e
e of
              COrdering a
Lt   -> AVL e -> e -> AVL e -> (# a, AVL e #)
popPL AVL e
l e
e AVL e
r
              Eq a
a -> let t :: AVL e
t = AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP AVL e
l AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
              COrdering a
Gt   -> AVL e -> e -> AVL e -> (# a, AVL e #)
popPR AVL e
l e
e AVL e
r

 ----------------------------- LEVEL 2 ---------------------------------
 --                      popNL, popZL, popPL                          --
 --                      popNR, popZR, popPR                          --
 -----------------------------------------------------------------------

 -- Pop from the left subtree of (N l e r)
 popNL :: AVL e -> e -> AVL e -> (# a, AVL e #)
popNL  AVL e
E           e
_ AVL e
_ = [Char] -> (# a, AVL e #)
forall a. HasCallStack => [Char] -> a
error [Char]
"assertPop: element not found."     -- Left sub-tree is empty
 popNL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering a
c e
le of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNL AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN AVL e
ll AVL e
lr) e
e AVL e
r     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNR AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
 popNL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering a
c e
le of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZL AVL e
ll e
le AVL e
lr of UBT2(a,l_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, N l_ AVL e
e r)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN' (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZR AVL e
ll AVL e
lr) e
e AVL e
r
                                                                     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZR AVL e
ll e
le AVL e
lr of UBT2(a,l_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, N l_ AVL e
e r)
 popNL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering a
c e
le of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPL AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP AVL e
ll AVL e
lr) e
e AVL e
r     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPR AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLN AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)

 -- Pop from the right subtree of (N l e r)
 popNR :: AVL e -> e -> AVL e -> (# a, AVL e #)
popNR AVL e
_ e
_  AVL e
E           = [Char] -> (# a, AVL e #)
forall a. HasCallStack => [Char] -> a
error [Char]
"genPop.popNR: Bug!"             -- Impossible
 popNR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = case e -> COrdering a
c e
re of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNL AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN AVL e
rl AVL e
rr)     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNR AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
 popNR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = case e -> COrdering a
c e
re of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZL AVL e
rl e
re AVL e
rr of UBT2(a,r_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, AVL e
N e
l e r_)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN' AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZL AVL e
rl AVL e
rr)
                                                                     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZR AVL e
rl e
re AVL e
rr of UBT2(a,r_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, AVL e
N e
l e r_)
 popNR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = case e -> COrdering a
c e
re of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPL AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP AVL e
rl AVL e
rr)     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPR AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRN AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)

 -- Pop from the left subtree of (Z l e r)
 popZL :: AVL e -> e -> AVL e -> (# a, AVL e #)
popZL  AVL e
E           e
_ AVL e
_ = [Char] -> (# a, AVL e #)
forall a. HasCallStack => [Char] -> a
error [Char]
"assertPop: element not found."  -- Left sub-tree is empty
 popZL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering a
c e
le of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNL AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN AVL e
ll AVL e
lr) e
e AVL e
r     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNR AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
 popZL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering a
c e
le of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZL AVL e
ll e
le AVL e
lr of UBT2(a,l_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, Z l_ AVL e
e r)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ' (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZR AVL e
ll AVL e
lr) e
e AVL e
r
                                                                     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZR AVL e
ll e
le AVL e
lr of UBT2(a,l_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, Z l_ AVL e
e r)
 popZL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering a
c e
le of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPL AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP AVL e
ll AVL e
lr) e
e AVL e
r     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPR AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLZ AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)

 -- Pop from the right subtree of (Z l e r)
 popZR :: AVL e -> e -> AVL e -> (# a, AVL e #)
popZR AVL e
_ e
_  AVL e
E           = [Char] -> (# a, AVL e #)
forall a. HasCallStack => [Char] -> a
error [Char]
"assertPop: element not found."    -- Right sub-tree is empty
 popZR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = case e -> COrdering a
c e
re of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNL AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN AVL e
rl AVL e
rr)     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNR AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
 popZR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = case e -> COrdering a
c e
re of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZL AVL e
rl e
re AVL e
rr of UBT2(a,r_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, AVL e
Z e
l e r_)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ' AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZL AVL e
rl AVL e
rr)
                                                                     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZR AVL e
rl e
re AVL e
rr of UBT2(a,r_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, AVL e
Z e
l e r_)
 popZR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = case e -> COrdering a
c e
re of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPL AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP AVL e
rl AVL e
rr)     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPR AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRZ AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)

 -- Pop from the left subtree of (P l e r)
 popPL :: AVL e -> e -> AVL e -> (# a, AVL e #)
popPL  AVL e
E           e
_ AVL e
_ = [Char] -> (# a, AVL e #)
forall a. HasCallStack => [Char] -> a
error [Char]
"genPop.popPL: Bug!"             -- Impossible
 popPL (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering a
c e
le of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNL AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN AVL e
ll AVL e
lr) e
e AVL e
r     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNR AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
 popPL (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering a
c e
le of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZL AVL e
ll e
le AVL e
lr of UBT2(a,l_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, P l_ AVL e
e r)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP' (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZR AVL e
ll AVL e
lr) e
e AVL e
r
                                                                     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZR AVL e
ll e
le AVL e
lr of UBT2(a,l_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, P l_ AVL e
e r)
 popPL (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = case e -> COrdering a
c e
le of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPL AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP AVL e
ll AVL e
lr) e
e AVL e
r     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPR AVL e
ll e
le AVL e
lr of
                                  UBT2(a,l_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkLP AVL e
l_ e
e AVL e
r in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)

 -- Pop from the right subtree of (P l e r)
 popPR :: AVL e -> e -> AVL e -> (# a, AVL e #)
popPR AVL e
_ e
_  AVL e
E           = [Char] -> (# a, AVL e #)
forall a. HasCallStack => [Char] -> a
error [Char]
"assertPop: element not found."                  -- Right sub-tree is empty
 popPR AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = case e -> COrdering a
c e
re of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNL AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subN AVL e
rl AVL e
rr)     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popNR AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
 popPR AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = case e -> COrdering a
c e
re of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZL AVL e
rl e
re AVL e
rr of UBT2(a,r_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, AVL e
P e
l e r_)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP' AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subZL AVL e
rl AVL e
rr)
                                                                     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popZR AVL e
rl e
re AVL e
rr of UBT2(a,r_) -> UBT2(aAVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
, AVL e
P e
l e r_)
 popPR AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = case e -> COrdering a
c e
re of
                          COrdering a
Lt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPL AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          Eq a
a -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP AVL e
l e
e (AVL e -> AVL e -> AVL e
forall e. AVL e -> AVL e -> AVL e
subP AVL e
rl AVL e
rr)     in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)
                          COrdering a
Gt   -> case AVL e -> e -> AVL e -> (# a, AVL e #)
popPR AVL e
rl e
re AVL e
rr of
                                  UBT2(a,r_) -> let t :: AVL e
t = AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
chkRP AVL e
l e
e AVL e
r_ in AVL e
t AVL e -> (# a, AVL e #) -> (# a, AVL e #)
forall a b. a -> b -> b
`seq` UBT2(AVL e
a,t)

-- | Similar to 'assertPop', but this function returns 'Nothing' if the search fails.
--
-- Complexity: O(log n)
tryPop :: (e -> COrdering a) -> AVL e -> Maybe (a,AVL e)
tryPop :: forall e a. (e -> COrdering a) -> AVL e -> Maybe (a, AVL e)
tryPop e -> COrdering a
c AVL e
t = case (e -> COrdering a) -> AVL e -> BinPath a
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering a
c AVL e
t of
                FullBP Int#
pth a
a -> let t' :: AVL e
t' = Int# -> AVL e -> AVL e
forall e. Int# -> AVL e -> AVL e
deletePath Int#
pth AVL e
t in AVL e
t' AVL e -> Maybe (a, AVL e) -> Maybe (a, AVL e)
forall a b. a -> b -> b
`seq` (a, AVL e) -> Maybe (a, AVL e)
forall a. a -> Maybe a
Just (a
a,AVL e
t')
                BinPath a
_            -> Maybe (a, AVL e)
forall a. Maybe a
Nothing

-- | In this case the selector returns two values if a search succeeds.
-- If the second is @('Just' e)@ then the new value (@e@) is substituted in the same place in the tree.
-- If the second is 'Nothing' then the corresponding tree element is deleted.
-- This function raises an error if the search fails.
--
-- Complexity: O(log n)
assertPopMaybe :: (e -> COrdering (a,Maybe e)) -> AVL e -> (a,AVL e)
assertPopMaybe :: forall e a. (e -> COrdering (a, Maybe e)) -> AVL e -> (a, AVL e)
assertPopMaybe e -> COrdering (a, Maybe e)
c AVL e
t = case (e -> COrdering (a, Maybe e)) -> AVL e -> BinPath (a, Maybe e)
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering (a, Maybe e)
c AVL e
t of
                      FullBP Int#
pth (a
a,Just e
e ) -> let t' :: AVL e
t' = Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
writePath  Int#
pth e
e AVL e
t in AVL e
t' AVL e -> (a, AVL e) -> (a, AVL e)
forall a b. a -> b -> b
`seq` (a
a,AVL e
t')
                      FullBP Int#
pth (a
a,Maybe e
Nothing) -> let t' :: AVL e
t' = Int# -> AVL e -> AVL e
forall e. Int# -> AVL e -> AVL e
deletePath Int#
pth   AVL e
t in AVL e
t' AVL e -> (a, AVL e) -> (a, AVL e)
forall a b. a -> b -> b
`seq` (a
a,AVL e
t')
                      BinPath (a, Maybe e)
_                      -> [Char] -> (a, AVL e)
forall a. HasCallStack => [Char] -> a
error [Char]
"assertPopMaybe: element not found."

-- | Similar to 'assertPopMaybe', but returns 'Nothing' if the search fails.
--
-- Complexity: O(log n)
tryPopMaybe :: (e -> COrdering (a,Maybe e)) -> AVL e -> Maybe (a,AVL e)
tryPopMaybe :: forall e a.
(e -> COrdering (a, Maybe e)) -> AVL e -> Maybe (a, AVL e)
tryPopMaybe e -> COrdering (a, Maybe e)
c AVL e
t = case (e -> COrdering (a, Maybe e)) -> AVL e -> BinPath (a, Maybe e)
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering (a, Maybe e)
c AVL e
t of
                     FullBP Int#
pth (a
a,Just e
e ) -> let t' :: AVL e
t' = Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
writePath  Int#
pth e
e AVL e
t in AVL e
t' AVL e -> Maybe (a, AVL e) -> Maybe (a, AVL e)
forall a b. a -> b -> b
`seq` (a, AVL e) -> Maybe (a, AVL e)
forall a. a -> Maybe a
Just (a
a,AVL e
t')
                     FullBP Int#
pth (a
a,Maybe e
Nothing) -> let t' :: AVL e
t' = Int# -> AVL e -> AVL e
forall e. Int# -> AVL e -> AVL e
deletePath Int#
pth   AVL e
t in AVL e
t' AVL e -> Maybe (a, AVL e) -> Maybe (a, AVL e)
forall a b. a -> b -> b
`seq` (a, AVL e) -> Maybe (a, AVL e)
forall a. a -> Maybe a
Just (a
a,AVL e
t')
                     BinPath (a, Maybe e)
_                      -> Maybe (a, AVL e)
forall a. Maybe a
Nothing


-- | A simpler version of 'assertPopMaybe'. The corresponding element is deleted if the second value
-- returned by the selector is 'True'. If it\'s 'False', the original tree is returned.
-- This function raises an error if the search fails.
--
-- Complexity: O(log n)
assertPopIf :: (e -> COrdering (a,Bool)) -> AVL e -> (a,AVL e)
assertPopIf :: forall e a. (e -> COrdering (a, Bool)) -> AVL e -> (a, AVL e)
assertPopIf e -> COrdering (a, Bool)
c AVL e
t = case (e -> COrdering (a, Bool)) -> AVL e -> BinPath (a, Bool)
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering (a, Bool)
c AVL e
t of
                     FullBP Int#
_   (a
a,Bool
False) -> (a
a,AVL e
t)
                     FullBP Int#
pth (a
a,Bool
True ) -> let t' :: AVL e
t' = Int# -> AVL e -> AVL e
forall e. Int# -> AVL e -> AVL e
deletePath Int#
pth AVL e
t in AVL e
t' AVL e -> (a, AVL e) -> (a, AVL e)
forall a b. a -> b -> b
`seq` (a
a,AVL e
t')
                     BinPath (a, Bool)
_                    -> [Char] -> (a, AVL e)
forall a. HasCallStack => [Char] -> a
error [Char]
"assertPopIf: element not found."

-- | Similar to 'assertPopIf', but returns 'Nothing' if the search fails.
--
-- Complexity: O(log n)
tryPopIf :: (e -> COrdering (a,Bool)) -> AVL e -> Maybe (a,AVL e)
tryPopIf :: forall e a. (e -> COrdering (a, Bool)) -> AVL e -> Maybe (a, AVL e)
tryPopIf e -> COrdering (a, Bool)
c AVL e
t = case (e -> COrdering (a, Bool)) -> AVL e -> BinPath (a, Bool)
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering (a, Bool)
c AVL e
t of
                  FullBP Int#
_   (a
a,Bool
False) -> (a, AVL e) -> Maybe (a, AVL e)
forall a. a -> Maybe a
Just (a
a,AVL e
t)
                  FullBP Int#
pth (a
a,Bool
True ) -> let t' :: AVL e
t' = Int# -> AVL e -> AVL e
forall e. Int# -> AVL e -> AVL e
deletePath Int#
pth AVL e
t in AVL e
t' AVL e -> Maybe (a, AVL e) -> Maybe (a, AVL e)
forall a b. a -> b -> b
`seq` (a, AVL e) -> Maybe (a, AVL e)
forall a. a -> Maybe a
Just (a
a,AVL e
t')
                  BinPath (a, Bool)
_                    -> Maybe (a, AVL e)
forall a. Maybe a
Nothing