module Data.Tree.AVL.Split
(
splitAtL,splitAtR,takeL,takeR,dropL,dropR,
rotateL,rotateR,popRotateL,popRotateR,rotateByL,rotateByR,
spanL,spanR,takeWhileL,dropWhileL,takeWhileR,dropWhileR,
genForkL,genForkR,genFork,
genTakeLE,genDropGT,
genTakeLT,genDropGE,
genTakeGT,genDropLE,
genTakeGE,genDropLT,
) where
import Prelude
import Data.COrdering(COrdering(..))
import Data.Tree.AVL.Types(AVL(..))
import Data.Tree.AVL.Push(pushL,pushR)
import Data.Tree.AVL.Internals.DelUtils(popRN,popRZ,popRP,popLN,popLZ,popLP)
import Data.Tree.AVL.Internals.HAVL(HAVL(HAVL),spliceHAVL,pushLHAVL,pushRHAVL)
import Data.Tree.AVL.Internals.HJoin(joinH')
#ifdef __GLASGOW_HASKELL__
import GHC.Base
#include "ghcdefs.h"
#else
#include "h98defs.h"
#endif
data SplitResult e = All (HAVL e) (HAVL e)
| More !UINT
splitAtL :: Int -> AVL e -> Either Int (AVL e, AVL e)
splitAtL n _ | n < 0 = error "splitAtL: Negative argument."
splitAtL 0 E = Left 0
splitAtL 0 t = Right (E,t)
splitAtL ASINT(n) t = case splitL n t L(0) of
More n_ -> Left ASINT(SUBINT(n,n_))
All (HAVL l _) (HAVL r _) -> Right (l,r)
splitL :: UINT -> AVL e -> UINT -> SplitResult e
splitL n E _ = More n
splitL n (N l e r) h = splitL_ n l DECINT2(h) e r DECINT1(h)
splitL n (Z l e r) h = splitL_ n l DECINT1(h) e r DECINT1(h)
splitL n (P l e r) h = splitL_ n l DECINT1(h) e r DECINT2(h)
splitL_ :: UINT -> AVL e -> UINT -> e -> AVL e -> UINT -> SplitResult e
splitL_ n l hl e r hr =
case splitL n l hl of
More L(0) -> let rhavl = pushLHAVL e (HAVL r hr); lhavl = HAVL l hl
in lhavl `seq` rhavl `seq` All lhavl rhavl
More L(1) -> case r of
E -> More L(0)
_ -> let lhavl = pushRHAVL (HAVL l hl) e
rhavl = HAVL r hr
in lhavl `seq` rhavl `seq` All lhavl rhavl
More n_ -> let sr = splitL DECINT1(n_) r hr
in case sr of
More _ -> sr
All havl0 havl1 -> let havl0' = spliceHAVL (HAVL l hl) e havl0
in havl0' `seq` All havl0' havl1
All havl0 havl1 -> let havl1' = spliceHAVL havl1 e (HAVL r hr)
in havl1' `seq` All havl0 havl1'
splitAtR :: Int -> AVL e -> Either Int (AVL e, AVL e)
splitAtR n _ | n < 0 = error "splitAtR: Negative argument."
splitAtR 0 E = Left 0
splitAtR 0 t = Right (t,E)
splitAtR ASINT(n) t = case splitR n t L(0) of
More n_ -> Left ASINT(SUBINT(n,n_))
All (HAVL l _) (HAVL r _) -> Right (l,r)
splitR :: UINT -> AVL e -> UINT -> SplitResult e
splitR n E _ = More n
splitR n (N l e r) h = splitR_ n l DECINT2(h) e r DECINT1(h)
splitR n (Z l e r) h = splitR_ n l DECINT1(h) e r DECINT1(h)
splitR n (P l e r) h = splitR_ n l DECINT1(h) e r DECINT2(h)
splitR_ :: UINT -> AVL e -> UINT -> e -> AVL e -> UINT -> SplitResult e
splitR_ n l hl e r hr =
case splitR n r hr of
More L(0) -> let lhavl = pushRHAVL (HAVL l hl) e; rhavl = HAVL r hr
in lhavl `seq` rhavl `seq` All lhavl rhavl
More L(1) -> case l of
E -> More L(0)
_ -> let rhavl = pushLHAVL e (HAVL r hr)
lhavl = HAVL l hl
in lhavl `seq` rhavl `seq` All lhavl rhavl
More n_ -> let sr = splitR DECINT1(n_) l hl
in case sr of
More _ -> sr
All havl0 havl1 -> let havl1' = spliceHAVL havl1 e (HAVL r hr)
in havl1' `seq` All havl0 havl1'
All havl0 havl1 -> let havlO' = spliceHAVL (HAVL l hl) e havl0
in havlO' `seq` All havlO' havl1
data TakeResult e = AllTR (HAVL e)
| MoreTR !UINT
takeL :: Int -> AVL e -> Either Int (AVL e)
takeL n _ | n < 0 = error "takeL: Negative argument."
takeL 0 E = Left 0
takeL 0 _ = Right E
takeL ASINT(n) t = case takeL_ n t L(0) of
MoreTR n_ -> Left ASINT(SUBINT(n,n_))
AllTR (HAVL t' _) -> Right t'
takeL_ :: UINT -> AVL e -> UINT -> TakeResult e
takeL_ n E _ = MoreTR n
takeL_ n (N l e r) h = takeL__ n l DECINT2(h) e r DECINT1(h)
takeL_ n (Z l e r) h = takeL__ n l DECINT1(h) e r DECINT1(h)
takeL_ n (P l e r) h = takeL__ n l DECINT1(h) e r DECINT2(h)
takeL__ :: UINT -> AVL e -> UINT -> e -> AVL e -> UINT -> TakeResult e
takeL__ n l hl e r hr =
let takel = takeL_ n l hl
in case takel of
MoreTR L(0) -> let lhavl = HAVL l hl
in lhavl `seq` AllTR lhavl
MoreTR L(1) -> case r of
E -> MoreTR L(0)
_ -> let lhavl = pushRHAVL (HAVL l hl) e
in lhavl `seq` AllTR lhavl
MoreTR n_ -> let taker = takeL_ DECINT1(n_) r hr
in case taker of
AllTR havl0 -> let havl0' = spliceHAVL (HAVL l hl) e havl0
in havl0' `seq` AllTR havl0'
_ -> taker
_ -> takel
takeR :: Int -> AVL e -> Either Int (AVL e)
takeR n _ | n < 0 = error "takeR: Negative argument."
takeR 0 E = Left 0
takeR 0 _ = Right E
takeR ASINT(n) t = case takeR_ n t L(0) of
MoreTR n_ -> Left ASINT(SUBINT(n,n_))
AllTR (HAVL t' _) -> Right t'
takeR_ :: UINT -> AVL e -> UINT -> TakeResult e
takeR_ n E _ = MoreTR n
takeR_ n (N l e r) h = takeR__ n l DECINT2(h) e r DECINT1(h)
takeR_ n (Z l e r) h = takeR__ n l DECINT1(h) e r DECINT1(h)
takeR_ n (P l e r) h = takeR__ n l DECINT1(h) e r DECINT2(h)
takeR__ :: UINT -> AVL e -> UINT -> e -> AVL e -> UINT -> TakeResult e
takeR__ n l hl e r hr =
let taker = takeR_ n r hr
in case taker of
MoreTR L(0) -> let rhavl = HAVL r hr
in rhavl `seq` AllTR rhavl
MoreTR L(1) -> case l of
E -> MoreTR L(0)
_ -> let rhavl = pushLHAVL e (HAVL r hr)
in rhavl `seq` AllTR rhavl
MoreTR n_ -> let takel = takeR_ DECINT1(n_) l hl
in case takel of
AllTR havl0 -> let havl0' = spliceHAVL havl0 e (HAVL r hr)
in havl0' `seq` AllTR havl0'
_ -> takel
_ -> taker
dropL :: Int -> AVL e -> Either Int (AVL e)
dropL n _ | n < 0 = error "dropL: Negative argument."
dropL 0 E = Left 0
dropL 0 t = Right t
dropL ASINT(n) t = case dropL_ n t L(0) of
MoreTR n_ -> Left ASINT(SUBINT(n,n_))
AllTR (HAVL r _) -> Right r
dropL_ :: UINT -> AVL e -> UINT -> TakeResult e
dropL_ n E _ = MoreTR n
dropL_ n (N l e r) h = dropL__ n l DECINT2(h) e r DECINT1(h)
dropL_ n (Z l e r) h = dropL__ n l DECINT1(h) e r DECINT1(h)
dropL_ n (P l e r) h = dropL__ n l DECINT1(h) e r DECINT2(h)
dropL__ :: UINT -> AVL e -> UINT -> e -> AVL e -> UINT -> TakeResult e
dropL__ n l hl e r hr =
case dropL_ n l hl of
MoreTR L(0) -> let rhavl = pushLHAVL e (HAVL r hr)
in rhavl `seq` AllTR rhavl
MoreTR L(1) -> case r of
E -> MoreTR L(0)
_ -> let rhavl = HAVL r hr in rhavl `seq` AllTR rhavl
MoreTR n_ -> dropL_ DECINT1(n_) r hr
AllTR havl1 -> let havl1' = spliceHAVL havl1 e (HAVL r hr)
in havl1' `seq` AllTR havl1'
dropR :: Int -> AVL e -> Either Int (AVL e)
dropR n _ | n < 0 = error "dropL: Negative argument."
dropR 0 E = Left 0
dropR 0 t = Right t
dropR ASINT(n) t = case dropR_ n t L(0) of
MoreTR n_ -> Left ASINT(SUBINT(n,n_))
AllTR (HAVL l _) -> Right l
dropR_ :: UINT -> AVL e -> UINT -> TakeResult e
dropR_ n E _ = MoreTR n
dropR_ n (N l e r) h = dropR__ n l DECINT2(h) e r DECINT1(h)
dropR_ n (Z l e r) h = dropR__ n l DECINT1(h) e r DECINT1(h)
dropR_ n (P l e r) h = dropR__ n l DECINT1(h) e r DECINT2(h)
dropR__ :: UINT -> AVL e -> UINT -> e -> AVL e -> UINT -> TakeResult e
dropR__ n l hl e r hr =
case dropR_ n r hr of
MoreTR L(0) -> let lhavl = pushRHAVL (HAVL l hl) e
in lhavl `seq` AllTR lhavl
MoreTR L(1) -> case l of
E -> MoreTR L(0)
_ -> let lhavl = HAVL l hl in lhavl `seq` AllTR lhavl
MoreTR n_ -> dropR_ DECINT1(n_) l hl
AllTR havl0 -> let havl0' = spliceHAVL (HAVL l hl) e havl0
in havl0' `seq` AllTR havl0'
data SpanResult e = Some (HAVL e) (HAVL e)
| TheLot
spanL :: (e -> Bool) -> AVL e -> (AVL e, AVL e)
spanL p t = case spanIt t L(0) of
TheLot -> (t, E)
Some (HAVL l _) (HAVL r _) -> (l, r)
where
spanIt E _ = TheLot
spanIt (N l e r) h = spanIt_ l DECINT2(h) e r DECINT1(h)
spanIt (Z l e r) h = spanIt_ l DECINT1(h) e r DECINT1(h)
spanIt (P l e r) h = spanIt_ l DECINT1(h) e r DECINT2(h)
spanIt_ l hl e r hr =
case spanIt l hl of
Some havl0 havl1 -> let havl1_ = spliceHAVL havl1 e (HAVL r hr)
in havl1_ `seq` Some havl0 havl1_
TheLot -> if p e
then let spanItr = spanIt r hr
in case spanItr of
Some havl0 havl1 -> let havl0_ = spliceHAVL (HAVL l hl) e havl0
in havl0_ `seq` Some havl0_ havl1
_ -> spanItr
else let rhavl = pushLHAVL e (HAVL r hr)
lhavl = HAVL l hl
in lhavl `seq` rhavl `seq` Some lhavl rhavl
spanR :: (e -> Bool) -> AVL e -> (AVL e, AVL e)
spanR p t = case spanIt t L(0) of
TheLot -> (E, t)
Some (HAVL l _) (HAVL r _) -> (l, r)
where
spanIt E _ = TheLot
spanIt (N l e r) h = spanIt_ l DECINT2(h) e r DECINT1(h)
spanIt (Z l e r) h = spanIt_ l DECINT1(h) e r DECINT1(h)
spanIt (P l e r) h = spanIt_ l DECINT1(h) e r DECINT2(h)
spanIt_ l hl e r hr =
case spanIt r hr of
Some havl0 havl1 -> let havl0_ = spliceHAVL (HAVL l hl) e havl0
in havl0_ `seq` Some havl0_ havl1
TheLot -> if p e
then let spanItl = spanIt l hl
in case spanItl of
Some havl0 havl1 -> let havl1_ = spliceHAVL havl1 e (HAVL r hr)
in havl1_ `seq` Some havl0 havl1_
_ -> spanItl
else let lhavl = pushRHAVL (HAVL l hl) e
rhavl = HAVL r hr
in lhavl `seq` rhavl `seq` Some lhavl rhavl
data TakeWhileResult e = SomeTW (HAVL e)
| TheLotTW
takeWhileL :: (e -> Bool) -> AVL e -> AVL e
takeWhileL p t = case spanIt t L(0) of
TheLotTW -> t
SomeTW (HAVL l _) -> l
where
spanIt E _ = TheLotTW
spanIt (N l e r) h = spanIt_ l DECINT2(h) e r DECINT1(h)
spanIt (Z l e r) h = spanIt_ l DECINT1(h) e r DECINT1(h)
spanIt (P l e r) h = spanIt_ l DECINT1(h) e r DECINT2(h)
spanIt_ l hl e r hr =
let twl = spanIt l hl
in case twl of
TheLotTW -> if p e
then let twr = spanIt r hr
in case twr of
SomeTW havl0 -> let havl0_ = spliceHAVL (HAVL l hl) e havl0
in havl0_ `seq` SomeTW havl0_
_ -> twr
else let lhavl = HAVL l hl in lhavl `seq` SomeTW lhavl
_ -> twl
takeWhileR :: (e -> Bool) -> AVL e -> AVL e
takeWhileR p t = case spanIt t L(0) of
TheLotTW -> t
SomeTW (HAVL r _) -> r
where
spanIt E _ = TheLotTW
spanIt (N l e r) h = spanIt_ l DECINT2(h) e r DECINT1(h)
spanIt (Z l e r) h = spanIt_ l DECINT1(h) e r DECINT1(h)
spanIt (P l e r) h = spanIt_ l DECINT1(h) e r DECINT2(h)
spanIt_ l hl e r hr =
let twr = spanIt r hr
in case twr of
TheLotTW -> if p e
then let twl = spanIt l hl
in case twl of
SomeTW havl1 -> let havl1_ = spliceHAVL havl1 e (HAVL r hr)
in havl1_ `seq` SomeTW havl1_
_ -> twl
else let rhavl = HAVL r hr in rhavl `seq` SomeTW rhavl
_ -> twr
dropWhileL :: (e -> Bool) -> AVL e -> AVL e
dropWhileL p t = case spanIt t L(0) of
TheLotTW -> E
SomeTW (HAVL r _) -> r
where
spanIt E _ = TheLotTW
spanIt (N l e r) h = spanIt_ l DECINT2(h) e r DECINT1(h)
spanIt (Z l e r) h = spanIt_ l DECINT1(h) e r DECINT1(h)
spanIt (P l e r) h = spanIt_ l DECINT1(h) e r DECINT2(h)
spanIt_ l hl e r hr =
case spanIt l hl of
SomeTW havl1 -> let havl1_ = spliceHAVL havl1 e (HAVL r hr)
in havl1_ `seq` SomeTW havl1_
TheLotTW -> if p e
then spanIt r hr
else let rhavl = pushLHAVL e (HAVL r hr)
in rhavl `seq` SomeTW rhavl
dropWhileR :: (e -> Bool) -> AVL e -> AVL e
dropWhileR p t = case spanIt t L(0) of
TheLotTW -> E
SomeTW (HAVL l _) -> l
where
spanIt E _ = TheLotTW
spanIt (N l e r) h = spanIt_ l DECINT2(h) e r DECINT1(h)
spanIt (Z l e r) h = spanIt_ l DECINT1(h) e r DECINT1(h)
spanIt (P l e r) h = spanIt_ l DECINT1(h) e r DECINT2(h)
spanIt_ l hl e r hr =
case spanIt r hr of
SomeTW havl0 -> let havl0_ = spliceHAVL (HAVL l hl) e havl0
in havl0_ `seq` SomeTW havl0_
TheLotTW -> if p e
then spanIt l hl
else let lhavl = pushRHAVL (HAVL l hl) e
in lhavl `seq` SomeTW lhavl
rotateL :: AVL e -> AVL e
rotateL E = E
rotateL (N l e r) = case popLN l e r of UBT2(e_,t) -> pushR t e_
rotateL (Z l e r) = case popLZ l e r of UBT2(e_,t) -> pushR t e_
rotateL (P l e r) = case popLP l e r of UBT2(e_,t) -> pushR t e_
rotateR :: AVL e -> AVL e
rotateR E = E
rotateR (N l e r) = case popRN l e r of UBT2(t,e_) -> pushL e_ t
rotateR (Z l e r) = case popRZ l e r of UBT2(t,e_) -> pushL e_ t
rotateR (P l e r) = case popRP l e r of UBT2(t,e_) -> pushL e_ t
popRotateL :: AVL e -> (e, AVL e)
popRotateL E = error "popRotateL: Empty tree."
popRotateL (N l e r) = case popLN l e r of UBT2(e_,t) -> popRotateL' e_ t
popRotateL (Z l e r) = case popLZ l e r of UBT2(e_,t) -> popRotateL' e_ t
popRotateL (P l e r) = case popLP l e r of UBT2(e_,t) -> popRotateL' e_ t
popRotateL' :: e -> AVL e -> (e, AVL e)
popRotateL' e t = let t' = pushR t e in t' `seq` (e,t')
popRotateR :: AVL e -> (AVL e, e)
popRotateR E = error "popRotateR: Empty tree."
popRotateR (N l e r) = case popRN l e r of UBT2(t,e_) -> popRotateR' t e_
popRotateR (Z l e r) = case popRZ l e r of UBT2(t,e_) -> popRotateR' t e_
popRotateR (P l e r) = case popRP l e r of UBT2(t,e_) -> popRotateR' t e_
popRotateR' :: AVL e -> e -> (AVL e, e)
popRotateR' t e = let t' = pushL e t in t' `seq` (t',e)
rotateByL :: AVL e -> Int -> AVL e
rotateByL t ASINT(n) = case COMPAREUINT n L(0) of
LT -> rotateByR__ t NEGATE(n)
EQ -> t
GT -> rotateByL__ t n
rotateByL_ :: AVL e -> UINT -> AVL e
rotateByL_ t L(0) = t
rotateByL_ t n = rotateByL__ t n
rotateByL__ :: AVL e -> UINT -> AVL e
rotateByL__ E _ = E
rotateByL__ t n = case splitL n t L(0) of
More L(0) -> t
More m -> let s = SUBINT(n,m)
n_ = _MODULO_(n,s)
in if ADDINT(n_,n_) LEQ s
then rotateByL_ t n_
else rotateByR__ t SUBINT(s,n_)
All (HAVL l hl) (HAVL r hr) -> joinH' r hr l hl
rotateByR :: AVL e -> Int -> AVL e
rotateByR t ASINT(n) = case COMPAREUINT n L(0) of
LT -> rotateByL__ t NEGATE(n)
EQ -> t
GT -> rotateByR__ t n
rotateByR_ :: AVL e -> UINT -> AVL e
rotateByR_ t L(0) = t
rotateByR_ t n = rotateByR__ t n
rotateByR__ :: AVL e -> UINT -> AVL e
rotateByR__ E _ = E
rotateByR__ t n = case splitR n t L(0) of
More L(0) -> t
More m -> let s = SUBINT(n,m)
n_ = _MODULO_(n,s)
in if ADDINT(n_,n_) LEQ s
then rotateByR_ t n_
else rotateByL__ t SUBINT(s,n_)
All (HAVL l hl) (HAVL r hr) -> joinH' r hr l hl
genForkL :: (e -> Ordering) -> AVL e -> (AVL e, AVL e)
genForkL c avl = let (HAVL l _,HAVL r _) = genForkL_ L(0) avl
in (l,r)
where
genForkL_ h E = (HAVL E h, HAVL E h)
genForkL_ h (N l e r) = genForkL__ l DECINT2(h) e r DECINT1(h)
genForkL_ h (Z l e r) = genForkL__ l DECINT1(h) e r DECINT1(h)
genForkL_ h (P l e r) = genForkL__ l DECINT1(h) e r DECINT2(h)
genForkL__ l hl e r hr = case c e of
LT -> let (havl0,havl1) = genForkL_ hl l
havl1_ = spliceHAVL havl1 e (HAVL r hr)
in havl1_ `seq` (havl0, havl1_)
EQ -> let lhavl = pushRHAVL (HAVL l hl) e
rhavl = HAVL r hr
in lhavl `seq` rhavl `seq` (lhavl,rhavl)
GT -> let (havl0,havl1) = genForkL_ hr r
havl0_ = spliceHAVL (HAVL l hl) e havl0
in havl0_ `seq` (havl0_, havl1)
genForkR :: (e -> Ordering) -> AVL e -> (AVL e, AVL e)
genForkR c avl = let (HAVL l _,HAVL r _) = genForkR_ L(0) avl
in (l,r)
where
genForkR_ h E = (HAVL E h, HAVL E h)
genForkR_ h (N l e r) = genForkR__ l DECINT2(h) e r DECINT1(h)
genForkR_ h (Z l e r) = genForkR__ l DECINT1(h) e r DECINT1(h)
genForkR_ h (P l e r) = genForkR__ l DECINT1(h) e r DECINT2(h)
genForkR__ l hl e r hr = case c e of
LT -> let (havl0,havl1) = genForkR_ hl l
havl1_ = spliceHAVL havl1 e (HAVL r hr)
in havl1_ `seq` (havl0, havl1_)
EQ -> let rhavl = pushLHAVL e (HAVL r hr)
lhavl = HAVL l hl
in lhavl `seq` rhavl `seq` (lhavl, rhavl)
GT -> let (havl0,havl1) = genForkR_ hr r
havl0_ = spliceHAVL (HAVL l hl) e havl0
in havl0_ `seq` (havl0_, havl1)
genFork :: (e -> COrdering a) -> AVL e -> (AVL e, Maybe a, AVL e)
genFork c avl = let (HAVL l _, mba, HAVL r _) = genFork_ L(0) avl
in (l,mba,r)
where
genFork_ h E = (HAVL E h, Nothing, HAVL E h)
genFork_ h (N l e r) = genFork__ l DECINT2(h) e r DECINT1(h)
genFork_ h (Z l e r) = genFork__ l DECINT1(h) e r DECINT1(h)
genFork_ h (P l e r) = genFork__ l DECINT1(h) e r DECINT2(h)
genFork__ l hl e r hr = case c e of
Lt -> let (havl0,mba,havl1) = genFork_ hl l
havl1_ = spliceHAVL havl1 e (HAVL r hr)
in havl1_ `seq` (havl0, mba, havl1_)
Eq a -> let lhavl = HAVL l hl
rhavl = HAVL r hr
in lhavl `seq` rhavl `seq` (lhavl, Just a, rhavl)
Gt -> let (havl0,mba,havl1) = genFork_ hr r
havl0_ = spliceHAVL (HAVL l hl) e havl0
in havl0_ `seq` (havl0_, mba, havl1)
genTakeLE :: (e -> Ordering) -> AVL e -> AVL e
genTakeLE c avl = let HAVL l _ = genForkL_ L(0) avl
in l
where
genForkL_ h E = HAVL E h
genForkL_ h (N l e r) = genForkL__ l DECINT2(h) e r DECINT1(h)
genForkL_ h (Z l e r) = genForkL__ l DECINT1(h) e r DECINT1(h)
genForkL_ h (P l e r) = genForkL__ l DECINT1(h) e r DECINT2(h)
genForkL__ l hl e r hr = case c e of
LT -> genForkL_ hl l
EQ -> pushRHAVL (HAVL l hl) e
GT -> let havl0 = genForkL_ hr r
in spliceHAVL (HAVL l hl) e havl0
genDropGT :: (e -> Ordering) -> AVL e -> AVL e
genDropGT = genTakeLE
genTakeGT :: (e -> Ordering) -> AVL e -> AVL e
genTakeGT c avl = let HAVL r _ = genForkL_ L(0) avl
in r
where
genForkL_ h E = HAVL E h
genForkL_ h (N l e r) = genForkL__ l DECINT2(h) e r DECINT1(h)
genForkL_ h (Z l e r) = genForkL__ l DECINT1(h) e r DECINT1(h)
genForkL_ h (P l e r) = genForkL__ l DECINT1(h) e r DECINT2(h)
genForkL__ l hl e r hr = case c e of
LT -> let havl1 = genForkL_ hl l
in spliceHAVL havl1 e (HAVL r hr)
EQ -> HAVL r hr
GT -> genForkL_ hr r
genDropLE :: (e -> Ordering) -> AVL e -> AVL e
genDropLE = genTakeGT
genTakeLT :: (e -> Ordering) -> AVL e -> AVL e
genTakeLT c avl = let HAVL l _ = genForkL_ L(0) avl
in l
where
genForkL_ h E = HAVL E h
genForkL_ h (N l e r) = genForkL__ l DECINT2(h) e r DECINT1(h)
genForkL_ h (Z l e r) = genForkL__ l DECINT1(h) e r DECINT1(h)
genForkL_ h (P l e r) = genForkL__ l DECINT1(h) e r DECINT2(h)
genForkL__ l hl e r hr = case c e of
LT -> genForkL_ hl l
EQ -> HAVL l hl
GT -> let havl0 = genForkL_ hr r
in spliceHAVL (HAVL l hl) e havl0
genDropGE :: (e -> Ordering) -> AVL e -> AVL e
genDropGE = genTakeLT
genTakeGE :: (e -> Ordering) -> AVL e -> AVL e
genTakeGE c avl = let HAVL r _ = genForkL_ L(0) avl
in r
where
genForkL_ h E = HAVL E h
genForkL_ h (N l e r) = genForkL__ l DECINT2(h) e r DECINT1(h)
genForkL_ h (Z l e r) = genForkL__ l DECINT1(h) e r DECINT1(h)
genForkL_ h (P l e r) = genForkL__ l DECINT1(h) e r DECINT2(h)
genForkL__ l hl e r hr = case c e of
LT -> let havl1 = genForkL_ hl l
in spliceHAVL havl1 e (HAVL r hr)
EQ -> pushLHAVL e (HAVL r hr)
GT -> genForkL_ hr r
genDropLT :: (e -> Ordering) -> AVL e -> AVL e
genDropLT = genTakeGE