module Data.Tree.AVL.Delete
(
delL,delR,assertDelL,assertDelR,tryDelL,tryDelR,
genDel,genDelFast,genDelIf,genDelMaybe,
assertPopL,assertPopR,tryPopL,tryPopR,
genAssertPop,genTryPop,genAssertPopMaybe,genTryPopMaybe,genAssertPopIf,genTryPopIf,
) where
import Prelude
import Data.COrdering
import Data.Tree.AVL.Types(AVL(..))
import Data.Tree.AVL.BinPath(BinPath(..),genFindPath,genOpenPathWith,writePath)
import Data.Tree.AVL.Internals.DelUtils
(
delRN,delRZ,delRP,delLN,delLZ,delLP,
popRN,popRZ,popRP,popLN,popLZ,popLP,
chkLN,chkLZ,chkLP,chkRN,chkRZ,chkRP,
chkLN',chkLZ',chkLP',chkRN',chkRZ',chkRP',
subN,subZR,subZL,subP,
deletePath
)
#ifdef __GLASGOW_HASKELL__
import GHC.Base
#include "ghcdefs.h"
#else
#include "h98defs.h"
#endif
delL :: AVL e -> AVL e
delL E = E
delL (N l e r) = delLN l e r
delL (Z l e r) = delLZ l e r
delL (P l e r) = delLP l e r
assertDelL :: AVL e -> AVL e
assertDelL E = error "assertDelL: Empty tree."
assertDelL (N l e r) = delLN l e r
assertDelL (Z l e r) = delLZ l e r
assertDelL (P l e r) = delLP l e r
tryDelL :: AVL e -> Maybe (AVL e)
tryDelL E = Nothing
tryDelL (N l e r) = Just $! delLN l e r
tryDelL (Z l e r) = Just $! delLZ l e r
tryDelL (P l e r) = Just $! delLP l e r
delR :: AVL e -> AVL e
delR E = E
delR (N l e r) = delRN l e r
delR (Z l e r) = delRZ l e r
delR (P l e r) = delRP l e r
assertDelR :: AVL e -> AVL e
assertDelR E = error "assertDelR: Empty tree."
assertDelR (N l e r) = delRN l e r
assertDelR (Z l e r) = delRZ l e r
assertDelR (P l e r) = delRP l e r
tryDelR :: AVL e -> Maybe (AVL e)
tryDelR E = Nothing
tryDelR (N l e r) = Just $! delRN l e r
tryDelR (Z l e r) = Just $! delRZ l e r
tryDelR (P l e r) = Just $! delRP l e r
assertPopL :: AVL e -> (e,AVL e)
assertPopL E = error "assertPopL: Empty tree."
assertPopL (N l e r) = case popLN l e r of UBT2(v,t) -> (v,t)
assertPopL (Z l e r) = case popLZ l e r of UBT2(v,t) -> (v,t)
assertPopL (P l e r) = case popLP l e r of UBT2(v,t) -> (v,t)
tryPopL :: AVL e -> Maybe (e,AVL e)
tryPopL E = Nothing
tryPopL (N l e r) = Just $! case popLN l e r of UBT2(v,t) -> (v,t)
tryPopL (Z l e r) = Just $! case popLZ l e r of UBT2(v,t) -> (v,t)
tryPopL (P l e r) = Just $! case popLP l e r of UBT2(v,t) -> (v,t)
assertPopR :: AVL e -> (AVL e,e)
assertPopR E = error "assertPopR: Empty tree."
assertPopR (N l e r) = case popRN l e r of UBT2(t,v) -> (t,v)
assertPopR (Z l e r) = case popRZ l e r of UBT2(t,v) -> (t,v)
assertPopR (P l e r) = case popRP l e r of UBT2(t,v) -> (t,v)
tryPopR :: AVL e -> Maybe (AVL e,e)
tryPopR E = Nothing
tryPopR (N l e r) = Just $! case popRN l e r of UBT2(t,v) -> (t,v)
tryPopR (Z l e r) = Just $! case popRZ l e r of UBT2(t,v) -> (t,v)
tryPopR (P l e r) = Just $! case popRP l e r of UBT2(t,v) -> (t,v)
genDel :: (e -> Ordering) -> AVL e -> AVL e
genDel c t = let p = genFindPath c t
in case COMPAREUINT p L(0) of
LT -> t
_ -> deletePath p t
genDelIf :: (e -> COrdering Bool) -> AVL e -> AVL e
genDelIf c t = case genOpenPathWith c t of
FullBP p True -> deletePath p t
_ -> t
genDelMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL e
genDelMaybe c t = case genOpenPathWith c t of
FullBP p Nothing -> deletePath p t
FullBP p (Just e) -> writePath p e t
_ -> t
genDelFast :: (e -> Ordering) -> AVL e -> AVL e
genDelFast c = genDel' where
genDel' E = E
genDel' (N l e r) = delN l e r
genDel' (Z l e r) = delZ l e r
genDel' (P l e r) = delP l e r
delN l e r = case c e of
LT -> delNL l e r
EQ -> subN l r
GT -> delNR l e r
delZ l e r = case c e of
LT -> delZL l e r
EQ -> subZR l r
GT -> delZR l e r
delP l e r = case c e of
LT -> delPL l e r
EQ -> subP l r
GT -> delPR l e r
delNL E e r = N E e r
delNL (N ll le lr) e r = case c le of
LT -> chkLN (delNL ll le lr) e r
EQ -> chkLN (subN ll lr) e r
GT -> chkLN (delNR ll le lr) e r
delNL (Z ll le lr) e r = case c le of
LT -> let l' = delZL ll le lr in l' `seq` N l' e r
EQ -> chkLN' (subZR ll lr) e r
GT -> let l' = delZR ll le lr in l' `seq` N l' e r
delNL (P ll le lr) e r = case c le of
LT -> chkLN (delPL ll le lr) e r
EQ -> chkLN (subP ll lr) e r
GT -> chkLN (delPR ll le lr) e r
delNR _ _ E = error "delNR: Bug0"
delNR l e (N rl re rr) = case c re of
LT -> chkRN l e (delNL rl re rr)
EQ -> chkRN l e (subN rl rr)
GT -> chkRN l e (delNR rl re rr)
delNR l e (Z rl re rr) = case c re of
LT -> let r' = delZL rl re rr in r' `seq` N l e r'
EQ -> chkRN' l e (subZL rl rr)
GT -> let r' = delZR rl re rr in r' `seq` N l e r'
delNR l e (P rl re rr) = case c re of
LT -> chkRN l e (delPL rl re rr)
EQ -> chkRN l e (subP rl rr)
GT -> chkRN l e (delPR rl re rr)
delZL E e r = Z E e r
delZL (N ll le lr) e r = case c le of
LT -> chkLZ (delNL ll le lr) e r
EQ -> chkLZ (subN ll lr) e r
GT -> chkLZ (delNR ll le lr) e r
delZL (Z ll le lr) e r = case c le of
LT -> let l' = delZL ll le lr in l' `seq` Z l' e r
EQ -> chkLZ' (subZR ll lr) e r
GT -> let l' = delZR ll le lr in l' `seq` Z l' e r
delZL (P ll le lr) e r = case c le of
LT -> chkLZ (delPL ll le lr) e r
EQ -> chkLZ (subP ll lr) e r
GT -> chkLZ (delPR ll le lr) e r
delZR l e E = Z l e E
delZR l e (N rl re rr) = case c re of
LT -> chkRZ l e (delNL rl re rr)
EQ -> chkRZ l e (subN rl rr)
GT -> chkRZ l e (delNR rl re rr)
delZR l e (Z rl re rr) = case c re of
LT -> let r' = delZL rl re rr in r' `seq` Z l e r'
EQ -> chkRZ' l e (subZL rl rr)
GT -> let r' = delZR rl re rr in r' `seq` Z l e r'
delZR l e (P rl re rr) = case c re of
LT -> chkRZ l e (delPL rl re rr)
EQ -> chkRZ l e (subP rl rr)
GT -> chkRZ l e (delPR rl re rr)
delPL E _ _ = error "delPL: Bug0"
delPL (N ll le lr) e r = case c le of
LT -> chkLP (delNL ll le lr) e r
EQ -> chkLP (subN ll lr) e r
GT -> chkLP (delNR ll le lr) e r
delPL (Z ll le lr) e r = case c le of
LT -> let l' = delZL ll le lr in l' `seq` P l' e r
EQ -> chkLP' (subZR ll lr) e r
GT -> let l' = delZR ll le lr in l' `seq` P l' e r
delPL (P ll le lr) e r = case c le of
LT -> chkLP (delPL ll le lr) e r
EQ -> chkLP (subP ll lr) e r
GT -> chkLP (delPR ll le lr) e r
delPR l e E = P l e E
delPR l e (N rl re rr) = case c re of
LT -> chkRP l e (delNL rl re rr)
EQ -> chkRP l e (subN rl rr)
GT -> chkRP l e (delNR rl re rr)
delPR l e (Z rl re rr) = case c re of
LT -> let r' = delZL rl re rr in r' `seq` P l e r'
EQ -> chkRP' l e (subZL rl rr)
GT -> let r' = delZR rl re rr in r' `seq` P l e r'
delPR l e (P rl re rr) = case c re of
LT -> chkRP l e (delPL rl re rr)
EQ -> chkRP l e (subP rl rr)
GT -> chkRP l e (delPR rl re rr)
genAssertPop :: (e -> COrdering a) -> AVL e -> (a,AVL e)
genAssertPop c = genPop_ where
genPop_ E = error "genAssertPop: element not found."
genPop_ (N l e r) = case popN l e r of UBT2(v,t) -> (v,t)
genPop_ (Z l e r) = case popZ l e r of UBT2(v,t) -> (v,t)
genPop_ (P l e r) = case popP l e r of UBT2(v,t) -> (v,t)
popN l e r = case c e of
Lt -> popNL l e r
Eq a -> let t = subN l r in t `seq` UBT2(a,t)
Gt -> popNR l e r
popZ l e r = case c e of
Lt -> popZL l e r
Eq a -> let t = subZR l r in t `seq` UBT2(a,t)
Gt -> popZR l e r
popP l e r = case c e of
Lt -> popPL l e r
Eq a -> let t = subP l r in t `seq` UBT2(a,t)
Gt -> popPR l e r
popNL E _ _ = error "genAssertPop: element not found."
popNL (N ll le lr) e r = case c le of
Lt -> case popNL ll le lr of
UBT2(a,l_) -> let t = chkLN l_ e r in t `seq` UBT2(a,t)
Eq a -> let t = chkLN (subN ll lr) e r in t `seq` UBT2(a,t)
Gt -> case popNR ll le lr of
UBT2(a,l_) -> let t = chkLN l_ e r in t `seq` UBT2(a,t)
popNL (Z ll le lr) e r = case c le of
Lt -> case popZL ll le lr of UBT2(a,l_) -> UBT2(a, N l_ e r)
Eq a -> let t = chkLN' (subZR ll lr) e r
in t `seq` UBT2(a,t)
Gt -> case popZR ll le lr of UBT2(a,l_) -> UBT2(a, N l_ e r)
popNL (P ll le lr) e r = case c le of
Lt -> case popPL ll le lr of
UBT2(a,l_) -> let t = chkLN l_ e r in t `seq` UBT2(a,t)
Eq a -> let t = chkLN (subP ll lr) e r in t `seq` UBT2(a,t)
Gt -> case popPR ll le lr of
UBT2(a,l_) -> let t = chkLN l_ e r in t `seq` UBT2(a,t)
popNR _ _ E = error "genPop.popNR: Bug!"
popNR l e (N rl re rr) = case c re of
Lt -> case popNL rl re rr of
UBT2(a,r_) -> let t = chkRN l e r_ in t `seq` UBT2(a,t)
Eq a -> let t = chkRN l e (subN rl rr) in t `seq` UBT2(a,t)
Gt -> case popNR rl re rr of
UBT2(a,r_) -> let t = chkRN l e r_ in t `seq` UBT2(a,t)
popNR l e (Z rl re rr) = case c re of
Lt -> case popZL rl re rr of UBT2(a,r_) -> UBT2(a, N l e r_)
Eq a -> let t = chkRN' l e (subZL rl rr)
in t `seq` UBT2(a,t)
Gt -> case popZR rl re rr of UBT2(a,r_) -> UBT2(a, N l e r_)
popNR l e (P rl re rr) = case c re of
Lt -> case popPL rl re rr of
UBT2(a,r_) -> let t = chkRN l e r_ in t `seq` UBT2(a,t)
Eq a -> let t = chkRN l e (subP rl rr) in t `seq` UBT2(a,t)
Gt -> case popPR rl re rr of
UBT2(a,r_) -> let t = chkRN l e r_ in t `seq` UBT2(a,t)
popZL E _ _ = error "genAssertPop: element not found."
popZL (N ll le lr) e r = case c le of
Lt -> case popNL ll le lr of
UBT2(a,l_) -> let t = chkLZ l_ e r in t `seq` UBT2(a,t)
Eq a -> let t = chkLZ (subN ll lr) e r in t `seq` UBT2(a,t)
Gt -> case popNR ll le lr of
UBT2(a,l_) -> let t = chkLZ l_ e r in t `seq` UBT2(a,t)
popZL (Z ll le lr) e r = case c le of
Lt -> case popZL ll le lr of UBT2(a,l_) -> UBT2(a, Z l_ e r)
Eq a -> let t = chkLZ' (subZR ll lr) e r
in t `seq` UBT2(a,t)
Gt -> case popZR ll le lr of UBT2(a,l_) -> UBT2(a, Z l_ e r)
popZL (P ll le lr) e r = case c le of
Lt -> case popPL ll le lr of
UBT2(a,l_) -> let t = chkLZ l_ e r in t `seq` UBT2(a,t)
Eq a -> let t = chkLZ (subP ll lr) e r in t `seq` UBT2(a,t)
Gt -> case popPR ll le lr of
UBT2(a,l_) -> let t = chkLZ l_ e r in t `seq` UBT2(a,t)
popZR _ _ E = error "genAssertPop: element not found."
popZR l e (N rl re rr) = case c re of
Lt -> case popNL rl re rr of
UBT2(a,r_) -> let t = chkRZ l e r_ in t `seq` UBT2(a,t)
Eq a -> let t = chkRZ l e (subN rl rr) in t `seq` UBT2(a,t)
Gt -> case popNR rl re rr of
UBT2(a,r_) -> let t = chkRZ l e r_ in t `seq` UBT2(a,t)
popZR l e (Z rl re rr) = case c re of
Lt -> case popZL rl re rr of UBT2(a,r_) -> UBT2(a, Z l e r_)
Eq a -> let t = chkRZ' l e (subZL rl rr)
in t `seq` UBT2(a,t)
Gt -> case popZR rl re rr of UBT2(a,r_) -> UBT2(a, Z l e r_)
popZR l e (P rl re rr) = case c re of
Lt -> case popPL rl re rr of
UBT2(a,r_) -> let t = chkRZ l e r_ in t `seq` UBT2(a,t)
Eq a -> let t = chkRZ l e (subP rl rr) in t `seq` UBT2(a,t)
Gt -> case popPR rl re rr of
UBT2(a,r_) -> let t = chkRZ l e r_ in t `seq` UBT2(a,t)
popPL E _ _ = error "genPop.popPL: Bug!"
popPL (N ll le lr) e r = case c le of
Lt -> case popNL ll le lr of
UBT2(a,l_) -> let t = chkLP l_ e r in t `seq` UBT2(a,t)
Eq a -> let t = chkLP (subN ll lr) e r in t `seq` UBT2(a,t)
Gt -> case popNR ll le lr of
UBT2(a,l_) -> let t = chkLP l_ e r in t `seq` UBT2(a,t)
popPL (Z ll le lr) e r = case c le of
Lt -> case popZL ll le lr of UBT2(a,l_) -> UBT2(a, P l_ e r)
Eq a -> let t = chkLP' (subZR ll lr) e r
in t `seq` UBT2(a,t)
Gt -> case popZR ll le lr of UBT2(a,l_) -> UBT2(a, P l_ e r)
popPL (P ll le lr) e r = case c le of
Lt -> case popPL ll le lr of
UBT2(a,l_) -> let t = chkLP l_ e r in t `seq` UBT2(a,t)
Eq a -> let t = chkLP (subP ll lr) e r in t `seq` UBT2(a,t)
Gt -> case popPR ll le lr of
UBT2(a,l_) -> let t = chkLP l_ e r in t `seq` UBT2(a,t)
popPR _ _ E = error "genAssertPop: element not found."
popPR l e (N rl re rr) = case c re of
Lt -> case popNL rl re rr of
UBT2(a,r_) -> let t = chkRP l e r_ in t `seq` UBT2(a,t)
Eq a -> let t = chkRP l e (subN rl rr) in t `seq` UBT2(a,t)
Gt -> case popNR rl re rr of
UBT2(a,r_) -> let t = chkRP l e r_ in t `seq` UBT2(a,t)
popPR l e (Z rl re rr) = case c re of
Lt -> case popZL rl re rr of UBT2(a,r_) -> UBT2(a, P l e r_)
Eq a -> let t = chkRP' l e (subZL rl rr)
in t `seq` UBT2(a,t)
Gt -> case popZR rl re rr of UBT2(a,r_) -> UBT2(a, P l e r_)
popPR l e (P rl re rr) = case c re of
Lt -> case popPL rl re rr of
UBT2(a,r_) -> let t = chkRP l e r_ in t `seq` UBT2(a,t)
Eq a -> let t = chkRP l e (subP rl rr) in t `seq` UBT2(a,t)
Gt -> case popPR rl re rr of
UBT2(a,r_) -> let t = chkRP l e r_ in t `seq` UBT2(a,t)
genTryPop :: (e -> COrdering a) -> AVL e -> Maybe (a,AVL e)
genTryPop c t = case genOpenPathWith c t of
FullBP pth a -> let t' = deletePath pth t in t' `seq` Just (a,t')
_ -> Nothing
genAssertPopMaybe :: (e -> COrdering (a,Maybe e)) -> AVL e -> (a,AVL e)
genAssertPopMaybe c t = case genOpenPathWith c t of
FullBP pth (a,Just e ) -> let t' = writePath pth e t in t' `seq` (a,t')
FullBP pth (a,Nothing) -> let t' = deletePath pth t in t' `seq` (a,t')
_ -> error "genAssertPopMaybe: element not found."
genTryPopMaybe :: (e -> COrdering (a,Maybe e)) -> AVL e -> Maybe (a,AVL e)
genTryPopMaybe c t = case genOpenPathWith c t of
FullBP pth (a,Just e ) -> let t' = writePath pth e t in t' `seq` Just (a,t')
FullBP pth (a,Nothing) -> let t' = deletePath pth t in t' `seq` Just (a,t')
_ -> Nothing
genAssertPopIf :: (e -> COrdering (a,Bool)) -> AVL e -> (a,AVL e)
genAssertPopIf c t = case genOpenPathWith c t of
FullBP _ (a,False) -> (a,t)
FullBP pth (a,True ) -> let t' = deletePath pth t in t' `seq` (a,t')
_ -> error "genAssertPopIf: element not found."
genTryPopIf :: (e -> COrdering (a,Bool)) -> AVL e -> Maybe (a,AVL e)
genTryPopIf c t = case genOpenPathWith c t of
FullBP _ (a,False) -> Just (a,t)
FullBP pth (a,True ) -> let t' = deletePath pth t in t' `seq` Just (a,t')
_ -> Nothing