module Data.Tree.AVL.Zipper
(
ZAVL,PAVL,
assertOpenL,assertOpenR,
tryOpenL,tryOpenR,
genAssertOpen,genTryOpen,
genTryOpenGE,genTryOpenLE,
genOpenEither,
close,fillClose,
getCurrent,putCurrent,applyCurrent,applyCurrent',
assertMoveL,assertMoveR,tryMoveL,tryMoveR,
insertL,insertR,insertMoveL,insertMoveR,fill,
delClose,
assertDelMoveL,assertDelMoveR,tryDelMoveR,tryDelMoveL,
delAllL,delAllR,
delAllCloseL,delAllCloseR,
delAllIncCloseL,delAllIncCloseR,
insertTreeL,insertTreeR,
isLeftmost,isRightmost,
sizeL,sizeR,
sizeZAVL,
BAVL,
genOpenBAVL,closeBAVL,
fullBAVL,emptyBAVL,tryReadBAVL,readFullBAVL,
pushBAVL,deleteBAVL,
fullBAVLtoZAVL,emptyBAVLtoPAVL,anyBAVLtoEither,
) where
import Prelude
import Data.Tree.AVL.Types(AVL(..))
import Data.Tree.AVL.Size(size,addSize)
import Data.Tree.AVL.Height(height,addHeight)
import Data.Tree.AVL.Internals.DelUtils(deletePath,popRN,popRZ,popRP,popLN,popLZ,popLP)
import Data.Tree.AVL.Internals.HJoin(spliceH,joinH)
import Data.Tree.AVL.Internals.HPush(pushHL,pushHR)
import Data.Tree.AVL.BinPath(BinPath(..),genOpenPath,writePath,insertPath,sel,goL,goR)
#ifdef __GLASGOW_HASKELL__
import GHC.Base
#include "ghcdefs.h"
#else
#include "h98defs.h"
#endif
data ZAVL e = ZAVL (Path e) (AVL e) !UINT e (AVL e) !UINT
data PAVL e = PAVL (Path e) !UINT
data Path e = EP
| LP (Path e) e (AVL e) !UINT
| RP (Path e) e (AVL e) !UINT
close_ :: Path e -> AVL e -> UINT -> AVL e
close_ EP t _ = t
close_ (LP p e r hr) l hl = case spliceH l hl e r hr of UBT2(t,ht) -> close_ p t ht
close_ (RP p e l hl) r hr = case spliceH l hl e r hr of UBT2(t,ht) -> close_ p t ht
noLP :: Path e -> Path e
noLP EP = EP
noLP (LP p _ _ _ ) = noLP p
noLP (RP p e l hl) = let p_ = noLP p in p_ `seq` RP p_ e l hl
noRP :: Path e -> Path e
noRP EP = EP
noRP (LP p e r hr) = let p_ = noRP p in p_ `seq` LP p_ e r hr
noRP (RP p _ _ _ ) = noRP p
closeNoLP :: Path e -> AVL e -> UINT -> AVL e
closeNoLP EP t _ = t
closeNoLP (LP p _ _ _ ) l hl = closeNoLP p l hl
closeNoLP (RP p e l hl) r hr = case spliceH l hl e r hr of UBT2(t,ht) -> closeNoLP p t ht
closeNoRP :: Path e -> AVL e -> UINT -> AVL e
closeNoRP EP t _ = t
closeNoRP (LP p e r hr) l hl = case spliceH l hl e r hr of UBT2(t,ht) -> closeNoRP p t ht
closeNoRP (RP p _ _ _ ) r hr = closeNoRP p r hr
addSizeP :: Int -> Path e -> Int
addSizeP n EP = n
addSizeP n (LP p _ r _) = addSizeP (addSize (n+1) r) p
addSizeP n (RP p _ l _) = addSizeP (addSize (n+1) l) p
addSizeRP :: Int -> Path e -> Int
addSizeRP n EP = n
addSizeRP n (LP p _ _ _) = addSizeRP n p
addSizeRP n (RP p _ l _) = addSizeRP (addSize (n+1) l) p
addSizeLP :: Int -> Path e -> Int
addSizeLP n EP = n
addSizeLP n (LP p _ r _) = addSizeLP (addSize (n+1) r) p
addSizeLP n (RP p _ _ _) = addSizeLP n p
genAssertOpen :: (e -> Ordering) -> AVL e -> ZAVL e
genAssertOpen c t = op EP L(0) t where
op _ _ E = error "genAssertOpen: No matching element."
op p h (N l e r) = case c e of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT2(h) l
EQ -> ZAVL p l DECINT2(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` op p_ DECINT1(h) r
op p h (Z l e r) = case c e of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT1(h) l
EQ -> ZAVL p l DECINT1(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT1(h) r
op p h (P l e r) = case c e of
LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` op p_ DECINT1(h) l
EQ -> ZAVL p l DECINT1(h) e r DECINT2(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT2(h) r
genTryOpen :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
genTryOpen c t = op EP L(0) t where
op _ _ E = Nothing
op p h (N l e r) = case c e of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT2(h) l
EQ -> Just $! ZAVL p l DECINT2(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` op p_ DECINT1(h) r
op p h (Z l e r) = case c e of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT1(h) l
EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT1(h) r
op p h (P l e r) = case c e of
LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` op p_ DECINT1(h) l
EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT2(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT2(h) r
genTryOpenGE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
genTryOpenGE c t = op EP L(0) t where
op p h E = backupR p E h where
backupR EP _ _ = Nothing
backupR (LP p_ e r hr) l hl = Just $! ZAVL p_ l hl e r hr
backupR (RP p_ e l hl) r hr = case spliceH l hl e r hr of UBT2(t_,ht_) -> backupR p_ t_ ht_
op p h (N l e r) = case c e of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT2(h) l
EQ -> Just $! ZAVL p l DECINT2(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` op p_ DECINT1(h) r
op p h (Z l e r) = case c e of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT1(h) l
EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT1(h) r
op p h (P l e r) = case c e of
LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` op p_ DECINT1(h) l
EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT2(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT2(h) r
genTryOpenLE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
genTryOpenLE c t = op EP L(0) t where
op p h E = backupL p E h where
backupL EP _ _ = Nothing
backupL (LP p_ e r hr) l hl = case spliceH l hl e r hr of UBT2(t_,ht_) -> backupL p_ t_ ht_
backupL (RP p_ e l hl) r hr = Just $! ZAVL p_ l hl e r hr
op p h (N l e r) = case c e of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT2(h) l
EQ -> Just $! ZAVL p l DECINT2(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` op p_ DECINT1(h) r
op p h (Z l e r) = case c e of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT1(h) l
EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT1(h) r
op p h (P l e r) = case c e of
LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` op p_ DECINT1(h) l
EQ -> Just $! ZAVL p l DECINT1(h) e r DECINT2(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT2(h) r
assertOpenL :: AVL e -> ZAVL e
assertOpenL E = error "assertOpenL: Empty tree."
assertOpenL (N l e r) = openLN EP L(0) l e r
assertOpenL (Z l e r) = openLZ EP L(0) l e r
assertOpenL (P l e r) = openL_ (LP EP e r L(0)) L(1) l
tryOpenL :: AVL e -> Maybe (ZAVL e)
tryOpenL E = Nothing
tryOpenL (N l e r) = Just $! openLN EP L(0) l e r
tryOpenL (Z l e r) = Just $! openLZ EP L(0) l e r
tryOpenL (P l e r) = Just $! openL_ (LP EP e r L(0)) L(1) l
openL_ :: (Path e) -> UINT -> AVL e -> ZAVL e
openL_ _ _ E = error "openL_: Bug0"
openL_ p h (N l e r) = openLN p h l e r
openL_ p h (Z l e r) = openLZ p h l e r
openL_ p h (P l e r) = let p_ = LP p e r DECINT2(h) in p_ `seq` openL_ p_ DECINT1(h) l
openLN :: (Path e) -> UINT -> AVL e -> e -> AVL e -> ZAVL e
openLN p h E e r = ZAVL p E DECINT2(h) e r DECINT1(h)
openLN p h (N ll le lr) e r = let p_ = LP p e r DECINT1(h) in p_ `seq` openLN p_ DECINT2(h) ll le lr
openLN p h (Z ll le lr) e r = let p_ = LP p e r DECINT1(h) in p_ `seq` openLZ p_ DECINT2(h) ll le lr
openLN p h (P ll le lr) e r = let p_ = LP p e r DECINT1(h)
p__ = p_ `seq` LP p_ le lr DECINT4(h)
in p__ `seq` openL_ p__ DECINT3(h) ll
openLZ :: (Path e) -> UINT -> AVL e -> e -> AVL e -> ZAVL e
openLZ p h E e r = ZAVL p E DECINT1(h) e r DECINT1(h)
openLZ p h (N ll le lr) e r = let p_ = LP p e r DECINT1(h) in p_ `seq` openLN p_ DECINT1(h) ll le lr
openLZ p h (Z ll le lr) e r = let p_ = LP p e r DECINT1(h) in p_ `seq` openLZ p_ DECINT1(h) ll le lr
openLZ p h (P ll le lr) e r = let p_ = LP p e r DECINT1(h)
p__ = p_ `seq` LP p_ le lr DECINT3(h)
in p__ `seq` openL_ p__ DECINT2(h) ll
assertOpenR :: AVL e -> ZAVL e
assertOpenR E = error "assertOpenR: Empty tree."
assertOpenR (N l e r) = openR_ (RP EP e l L(0)) L(1) r
assertOpenR (Z l e r) = openRZ EP L(0) l e r
assertOpenR (P l e r) = openRP EP L(0) l e r
tryOpenR :: AVL e -> Maybe (ZAVL e)
tryOpenR E = Nothing
tryOpenR (N l e r) = Just $! openR_ (RP EP e l L(0)) L(1) r
tryOpenR (Z l e r) = Just $! openRZ EP L(0) l e r
tryOpenR (P l e r) = Just $! openRP EP L(0) l e r
openR_ :: (Path e) -> UINT -> AVL e -> ZAVL e
openR_ _ _ E = error "openR_: Bug0"
openR_ p h (N l e r) = let p_ = RP p e l DECINT2(h) in p_ `seq` openR_ p_ DECINT1(h) r
openR_ p h (Z l e r) = openRZ p h l e r
openR_ p h (P l e r) = openRP p h l e r
openRP :: (Path e) -> UINT -> AVL e -> e -> AVL e -> ZAVL e
openRP p h l e E = ZAVL p l DECINT1(h) e E DECINT2(h)
openRP p h l e (N rl re rr) = let p_ = RP p e l DECINT1(h)
p__ = p_ `seq` RP p_ re rl DECINT4(h)
in p__ `seq` openR_ p__ DECINT3(h) rr
openRP p h l e (Z rl re rr) = let p_ = RP p e l DECINT1(h) in p_ `seq` openRZ p_ DECINT2(h) rl re rr
openRP p h l e (P rl re rr) = let p_ = RP p e l DECINT1(h) in p_ `seq` openRP p_ DECINT2(h) rl re rr
openRZ :: (Path e) -> UINT -> AVL e -> e -> AVL e -> ZAVL e
openRZ p h l e E = ZAVL p l DECINT1(h) e E DECINT1(h)
openRZ p h l e (N rl re rr) = let p_ = RP p e l DECINT1(h)
p__ = p_ `seq` RP p_ re rl DECINT3(h)
in p__ `seq` openR_ p__ DECINT2(h) rr
openRZ p h l e (Z rl re rr) = let p_ = RP p e l DECINT1(h) in p_ `seq` openRZ p_ DECINT1(h) rl re rr
openRZ p h l e (P rl re rr) = let p_ = RP p e l DECINT1(h) in p_ `seq` openRP p_ DECINT1(h) rl re rr
genOpenEither :: (e -> Ordering) -> AVL e -> Either (PAVL e) (ZAVL e)
genOpenEither c t = op EP L(0) t where
op p h E = Left $! PAVL p h
op p h (N l e r) = case c e of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT2(h) l
EQ -> Right $! ZAVL p l DECINT2(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` op p_ DECINT1(h) r
op p h (Z l e r) = case c e of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` op p_ DECINT1(h) l
EQ -> Right $! ZAVL p l DECINT1(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT1(h) r
op p h (P l e r) = case c e of
LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` op p_ DECINT1(h) l
EQ -> Right $! ZAVL p l DECINT1(h) e r DECINT2(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` op p_ DECINT2(h) r
fill :: e -> PAVL e -> ZAVL e
fill e (PAVL p h) = ZAVL p E h e E h
fillClose :: e -> PAVL e -> AVL e
fillClose e (PAVL p h) = close_ p (Z E e E) INCINT1(h)
close :: ZAVL e -> AVL e
close (ZAVL p l hl e r hr) = case spliceH l hl e r hr of UBT2(t,ht) -> close_ p t ht
delClose :: ZAVL e -> AVL e
delClose (ZAVL p l hl _ r hr) = case joinH l hl r hr of UBT2(t,ht) -> close_ p t ht
getCurrent :: ZAVL e -> e
getCurrent (ZAVL _ _ _ e _ _) = e
putCurrent :: e -> ZAVL e -> ZAVL e
putCurrent e (ZAVL p l hl _ r hr) = ZAVL p l hl e r hr
applyCurrent :: (e -> e) -> ZAVL e -> ZAVL e
applyCurrent f (ZAVL p l hl e r hr) = ZAVL p l hl (f e) r hr
applyCurrent' :: (e -> e) -> ZAVL e -> ZAVL e
applyCurrent' f (ZAVL p l hl e r hr) = let e_ = f e in e_ `seq` ZAVL p l hl e_ r hr
assertMoveL :: ZAVL e -> ZAVL e
assertMoveL (ZAVL p E _ e r hr) = case pushHL e r hr of UBT2(t,ht) -> cR p t ht
where cR EP _ _ = error "assertMoveL: Can't move left."
cR (LP p_ e_ r_ hr_) l_ hl_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> cR p_ t ht
cR (RP p_ e_ l_ hl_) r_ hr_ = ZAVL p_ l_ hl_ e_ r_ hr_
assertMoveL (ZAVL p (N ll le lr) hl e r hr) = let p_ = RP (LP p e r hr) le ll DECINT2(hl)
in p_ `seq` openR_ p_ DECINT1(hl) lr
assertMoveL (ZAVL p (Z ll le lr) hl e r hr) = openRZ (LP p e r hr) hl ll le lr
assertMoveL (ZAVL p (P ll le lr) hl e r hr) = openRP (LP p e r hr) hl ll le lr
tryMoveL :: ZAVL e -> Maybe (ZAVL e)
tryMoveL (ZAVL p E _ e r hr) = case pushHL e r hr of UBT2(t,ht) -> cR p t ht
where cR EP _ _ = Nothing
cR (LP p_ e_ r_ hr_) l_ hl_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> cR p_ t ht
cR (RP p_ e_ l_ hl_) r_ hr_ = Just $! ZAVL p_ l_ hl_ e_ r_ hr_
tryMoveL (ZAVL p (N ll le lr) hl e r hr) = Just $! let p_ = RP (LP p e r hr) le ll DECINT2(hl)
in p_ `seq` openR_ p_ DECINT1(hl) lr
tryMoveL (ZAVL p (Z ll le lr) hl e r hr) = Just $! openRZ (LP p e r hr) hl ll le lr
tryMoveL (ZAVL p (P ll le lr) hl e r hr) = Just $! openRP (LP p e r hr) hl ll le lr
assertMoveR :: ZAVL e -> ZAVL e
assertMoveR (ZAVL p l hl e E _ ) = case pushHR l hl e of UBT2(t,ht) -> cL p t ht
where cL EP _ _ = error "assertMoveR: Can't move right."
cL (RP p_ e_ l_ hl_) r_ hr_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> cL p_ t ht
cL (LP p_ e_ r_ hr_) l_ hl_ = ZAVL p_ l_ hl_ e_ r_ hr_
assertMoveR (ZAVL p l hl e (N rl re rr) hr) = openLN (RP p e l hl) hr rl re rr
assertMoveR (ZAVL p l hl e (Z rl re rr) hr) = openLZ (RP p e l hl) hr rl re rr
assertMoveR (ZAVL p l hl e (P rl re rr) hr) = let p_ = LP (RP p e l hl) re rr DECINT2(hr)
in p_ `seq` openL_ p_ DECINT1(hr) rl
tryMoveR :: ZAVL e -> Maybe (ZAVL e)
tryMoveR (ZAVL p l hl e E _ ) = case pushHR l hl e of UBT2(t,ht) -> cL p t ht
where cL EP _ _ = Nothing
cL (RP p_ e_ l_ hl_) r_ hr_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> cL p_ t ht
cL (LP p_ e_ r_ hr_) l_ hl_ = Just $! ZAVL p_ l_ hl_ e_ r_ hr_
tryMoveR (ZAVL p l hl e (N rl re rr) hr) = Just $! openLN (RP p e l hl) hr rl re rr
tryMoveR (ZAVL p l hl e (Z rl re rr) hr) = Just $! openLZ (RP p e l hl) hr rl re rr
tryMoveR (ZAVL p l hl e (P rl re rr) hr) = Just $! let p_ = LP (RP p e l hl) re rr DECINT2(hr)
in p_ `seq` openL_ p_ DECINT1(hr) rl
isLeftmost :: ZAVL e -> Bool
isLeftmost (ZAVL p E _ _ _ _) = iL p
where iL EP = True
iL (LP p_ _ _ _) = iL p_
iL (RP _ _ _ _) = False
isLeftmost (ZAVL _ _ _ _ _ _) = False
isRightmost :: ZAVL e -> Bool
isRightmost (ZAVL p _ _ _ E _) = iR p
where iR EP = True
iR (RP p_ _ _ _) = iR p_
iR (LP _ _ _ _) = False
isRightmost (ZAVL _ _ _ _ _ _) = False
insertL :: e -> ZAVL e -> ZAVL e
insertL e0 (ZAVL p l hl e1 r hr) = case pushHR l hl e0 of UBT2(l_,hl_) -> ZAVL p l_ hl_ e1 r hr
insertMoveL :: e -> ZAVL e -> ZAVL e
insertMoveL e0 (ZAVL p l hl e1 r hr) = case pushHL e1 r hr of UBT2(r_,hr_) -> ZAVL p l hl e0 r_ hr_
insertR :: ZAVL e -> e -> ZAVL e
insertR (ZAVL p l hl e0 r hr) e1 = case pushHL e1 r hr of UBT2(r_,hr_) -> ZAVL p l hl e0 r_ hr_
insertMoveR :: ZAVL e -> e -> ZAVL e
insertMoveR (ZAVL p l hl e0 r hr) e1 = case pushHR l hl e0 of UBT2(l_,hl_) -> ZAVL p l_ hl_ e1 r hr
insertTreeL :: AVL e -> ZAVL e -> ZAVL e
insertTreeL E zavl = zavl
insertTreeL t@(N l _ _) zavl = insertLH t (addHeight L(2) l) zavl
insertTreeL t@(Z l _ _) zavl = insertLH t (addHeight L(1) l) zavl
insertTreeL t@(P _ _ r) zavl = insertLH t (addHeight L(2) r) zavl
insertLH :: AVL e -> UINT -> ZAVL e -> ZAVL e
insertLH t ht (ZAVL p l hl e r hr) =
let offset = case COMPAREUINT hl hr of
LT -> SUBINT(hl,height l)
EQ -> SUBINT(hl,height l)
GT -> SUBINT(hr,height r)
in case joinH l hl t ADDINT(ht,offset) of UBT2(l_,hl_) -> ZAVL p l_ hl_ e r hr
insertTreeR :: ZAVL e -> AVL e -> ZAVL e
insertTreeR zavl E = zavl
insertTreeR zavl t@(N l _ _) = insertRH t (addHeight L(2) l) zavl
insertTreeR zavl t@(Z l _ _) = insertRH t (addHeight L(1) l) zavl
insertTreeR zavl t@(P _ _ r) = insertRH t (addHeight L(2) r) zavl
insertRH :: AVL e -> UINT -> ZAVL e -> ZAVL e
insertRH t ht (ZAVL p l hl e r hr) =
let offset = case COMPAREUINT hl hr of
LT -> SUBINT(hl,height l)
EQ -> SUBINT(hr,height r)
GT -> SUBINT(hr,height r)
in case joinH t ADDINT(ht,offset) r hr of UBT2(r_,hr_) -> ZAVL p l hl e r_ hr_
assertDelMoveL :: ZAVL e -> ZAVL e
assertDelMoveL (ZAVL p E _ _ r hr) = dR p r hr
where dR EP _ _ = error "assertDelMoveL: Can't move left."
dR (LP p_ e_ r_ hr_) l_ hl_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> dR p_ t ht
dR (RP p_ e_ l_ hl_) r_ hr_ = ZAVL p_ l_ hl_ e_ r_ hr_
assertDelMoveL (ZAVL p (N ll le lr) hl _ r hr) = case popRN ll le lr of
UBT2(l,e) -> case l of
Z _ _ _ -> ZAVL p l DECINT1(hl) e r hr
N _ _ _ -> ZAVL p l hl e r hr
_ -> error "assertDelMoveL: Bug0"
assertDelMoveL (ZAVL p (Z ll le lr) hl _ r hr) = case popRZ ll le lr of
UBT2(l,e) -> case l of
E -> ZAVL p l DECINT1(hl) e r hr
N _ _ _ -> error "assertDelMoveL: Bug1"
_ -> ZAVL p l hl e r hr
assertDelMoveL (ZAVL p (P ll le lr) hl _ r hr) = case popRP ll le lr of
UBT2(l,e) -> case l of
E -> error "assertDelMoveL: Bug2"
Z _ _ _ -> ZAVL p l DECINT1(hl) e r hr
_ -> ZAVL p l hl e r hr
tryDelMoveL :: ZAVL e -> Maybe (ZAVL e)
tryDelMoveL (ZAVL p E _ _ r hr) = dR p r hr
where dR EP _ _ = Nothing
dR (LP p_ e_ r_ hr_) l_ hl_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> dR p_ t ht
dR (RP p_ e_ l_ hl_) r_ hr_ = Just $! ZAVL p_ l_ hl_ e_ r_ hr_
tryDelMoveL (ZAVL p (N ll le lr) hl _ r hr) = Just $! case popRN ll le lr of
UBT2(l,e) -> case l of
Z _ _ _ -> ZAVL p l DECINT1(hl) e r hr
N _ _ _ -> ZAVL p l hl e r hr
_ -> error "tryDelMoveL: Bug0"
tryDelMoveL (ZAVL p (Z ll le lr) hl _ r hr) = Just $! case popRZ ll le lr of
UBT2(l,e) -> case l of
E -> ZAVL p l DECINT1(hl) e r hr
N _ _ _ -> error "tryDelMoveL: Bug1"
_ -> ZAVL p l hl e r hr
tryDelMoveL (ZAVL p (P ll le lr) hl _ r hr) = Just $! case popRP ll le lr of
UBT2(l,e) -> case l of
E -> error "tryDelMoveL: Bug2"
Z _ _ _ -> ZAVL p l DECINT1(hl) e r hr
_ -> ZAVL p l hl e r hr
assertDelMoveR :: ZAVL e -> ZAVL e
assertDelMoveR (ZAVL p l hl _ E _ ) = dL p l hl
where dL EP _ _ = error "delMoveR: Can't move right."
dL (LP p_ e_ r_ hr_) l_ hl_ = ZAVL p_ l_ hl_ e_ r_ hr_
dL (RP p_ e_ l_ hl_) r_ hr_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> dL p_ t ht
assertDelMoveR (ZAVL p l hl _ (N rl re rr) hr) = case popLN rl re rr of
UBT2(e,r) -> case r of
E -> error "delMoveR: Bug0"
Z _ _ _ -> ZAVL p l hl e r DECINT1(hr)
_ -> ZAVL p l hl e r hr
assertDelMoveR (ZAVL p l hl _ (Z rl re rr) hr) = case popLZ rl re rr of
UBT2(e,r) -> case r of
E -> ZAVL p l hl e r DECINT1(hr)
P _ _ _ -> error "delMoveR: Bug1"
_ -> ZAVL p l hl e r hr
assertDelMoveR (ZAVL p l hl _ (P rl re rr) hr) = case popLP rl re rr of
UBT2(e,r) -> case r of
Z _ _ _ -> ZAVL p l hl e r DECINT1(hr)
P _ _ _ -> ZAVL p l hl e r hr
_ -> error "delMoveR: Bug2"
tryDelMoveR :: ZAVL e -> Maybe (ZAVL e)
tryDelMoveR (ZAVL p l hl _ E _ ) = dL p l hl
where dL EP _ _ = Nothing
dL (LP p_ e_ r_ hr_) l_ hl_ = Just $! ZAVL p_ l_ hl_ e_ r_ hr_
dL (RP p_ e_ l_ hl_) r_ hr_ = case spliceH l_ hl_ e_ r_ hr_ of UBT2(t,ht) -> dL p_ t ht
tryDelMoveR (ZAVL p l hl _ (N rl re rr) hr) = Just $! case popLN rl re rr of
UBT2(e,r) -> case r of
E -> error "tryDelMoveR: Bug0"
Z _ _ _ -> ZAVL p l hl e r DECINT1(hr)
_ -> ZAVL p l hl e r hr
tryDelMoveR (ZAVL p l hl _ (Z rl re rr) hr) = Just $! case popLZ rl re rr of
UBT2(e,r) -> case r of
E -> ZAVL p l hl e r DECINT1(hr)
P _ _ _ -> error "tryDelMoveR: Bug1"
_ -> ZAVL p l hl e r hr
tryDelMoveR (ZAVL p l hl _ (P rl re rr) hr) = Just $! case popLP rl re rr of
UBT2(e,r) -> case r of
Z _ _ _ -> ZAVL p l hl e r DECINT1(hr)
P _ _ _ -> ZAVL p l hl e r hr
_ -> error "tryDelMoveR: Bug2"
delAllL :: ZAVL e -> ZAVL e
delAllL (ZAVL p l hl e r hr) =
let hE = case COMPAREUINT hl hr of
LT -> SUBINT(hl,height l)
EQ -> SUBINT(hr,height r)
GT -> SUBINT(hr,height r)
p_ = noRP p
in p_ `seq` ZAVL p_ E hE e r hr
delAllR :: ZAVL e -> ZAVL e
delAllR (ZAVL p l hl e r hr) =
let hE = case COMPAREUINT hl hr of
LT -> SUBINT(hl,height l)
EQ -> SUBINT(hl,height l)
GT -> SUBINT(hr,height r)
p_ = noLP p
in p_ `seq` ZAVL p_ l hl e E hE
delAllCloseL :: ZAVL e -> AVL e
delAllCloseL (ZAVL p _ _ e r hr) = case pushHL e r hr of UBT2(t,ht) -> closeNoRP p t ht
delAllCloseR :: ZAVL e -> AVL e
delAllCloseR (ZAVL p l hl e _ _) = case pushHR l hl e of UBT2(t,ht) -> closeNoLP p t ht
delAllIncCloseL :: ZAVL e -> AVL e
delAllIncCloseL (ZAVL p _ _ _ r hr) = closeNoRP p r hr
delAllIncCloseR :: ZAVL e -> AVL e
delAllIncCloseR (ZAVL p l hl _ _ _) = closeNoLP p l hl
sizeL :: ZAVL e -> Int
sizeL (ZAVL p l _ _ _ _) = addSizeRP (size l) p
sizeR :: ZAVL e -> Int
sizeR (ZAVL p _ _ _ r _) = addSizeLP (size r) p
sizeZAVL :: ZAVL e -> Int
sizeZAVL (ZAVL p l _ _ r _) = addSizeP (addSize (addSize 1 l) r) p
data BAVL e = BAVL (AVL e) (BinPath e)
genOpenBAVL :: (e -> Ordering) -> AVL e -> BAVL e
genOpenBAVL c t = bp `seq` BAVL t bp
where bp = genOpenPath c t
closeBAVL :: BAVL e -> AVL e
closeBAVL (BAVL t _) = t
fullBAVL :: BAVL e -> Bool
fullBAVL (BAVL _ (FullBP _ _)) = True
fullBAVL (BAVL _ (EmptyBP _ )) = False
emptyBAVL :: BAVL e -> Bool
emptyBAVL (BAVL _ (FullBP _ _)) = False
emptyBAVL (BAVL _ (EmptyBP _ )) = True
tryReadBAVL :: BAVL e -> Maybe e
tryReadBAVL (BAVL _ (FullBP _ e)) = Just e
tryReadBAVL (BAVL _ (EmptyBP _ )) = Nothing
readFullBAVL :: BAVL e -> e
readFullBAVL (BAVL _ (FullBP _ e)) = e
readFullBAVL (BAVL _ (EmptyBP _ )) = error "readFullBAVL: Empty BAVL."
pushBAVL :: e -> BAVL e -> AVL e
pushBAVL e (BAVL t (FullBP p _)) = writePath p e t
pushBAVL e (BAVL t (EmptyBP p )) = insertPath p e t
deleteBAVL :: BAVL e -> AVL e
deleteBAVL (BAVL t (FullBP p _)) = deletePath p t
deleteBAVL (BAVL t (EmptyBP _ )) = t
fullBAVLtoZAVL :: BAVL e -> ZAVL e
fullBAVLtoZAVL (BAVL t (FullBP i _)) = openFull i EP L(0) t
fullBAVLtoZAVL (BAVL _ (EmptyBP _ )) = error "fullBAVLtoZAVL: Empty BAVL."
openFull :: UINT -> (Path e) -> UINT -> AVL e -> ZAVL e
openFull _ _ _ E = error "openFull: Bug0."
openFull i p h (N l e r) = case sel i of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` openFull (goL i) p_ DECINT2(h) l
EQ -> ZAVL p l DECINT2(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` openFull (goR i) p_ DECINT1(h) r
openFull i p h (Z l e r) = case sel i of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` openFull (goL i) p_ DECINT1(h) l
EQ -> ZAVL p l DECINT1(h) e r DECINT1(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` openFull (goR i) p_ DECINT1(h) r
openFull i p h (P l e r) = case sel i of
LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` openFull (goL i) p_ DECINT1(h) l
EQ -> ZAVL p l DECINT1(h) e r DECINT2(h)
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` openFull (goR i) p_ DECINT2(h) r
emptyBAVLtoPAVL :: BAVL e -> PAVL e
emptyBAVLtoPAVL (BAVL _ (FullBP _ _)) = error "emptyBAVLtoPAVL: Full BAVL."
emptyBAVLtoPAVL (BAVL t (EmptyBP i )) = openEmpty i EP L(0) t
openEmpty :: UINT -> (Path e) -> UINT -> AVL e -> PAVL e
openEmpty _ p h E = PAVL p h
openEmpty i p h (N l e r) = case sel i of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` openEmpty (goL i) p_ DECINT2(h) l
EQ -> error "openEmpty: Bug0"
GT -> let p_ = RP p e l DECINT2(h) in p_ `seq` openEmpty (goR i) p_ DECINT1(h) r
openEmpty i p h (Z l e r) = case sel i of
LT -> let p_ = LP p e r DECINT1(h) in p_ `seq` openEmpty (goL i) p_ DECINT1(h) l
EQ -> error "openEmpty: Bug1"
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` openEmpty (goR i) p_ DECINT1(h) r
openEmpty i p h (P l e r) = case sel i of
LT -> let p_ = LP p e r DECINT2(h) in p_ `seq` openEmpty (goL i) p_ DECINT1(h) l
EQ -> error "openEmpty: Bug2"
GT -> let p_ = RP p e l DECINT1(h) in p_ `seq` openEmpty (goR i) p_ DECINT2(h) r
anyBAVLtoEither :: BAVL e -> Either (PAVL e) (ZAVL e)
anyBAVLtoEither (BAVL t (FullBP i _)) = Right (openFull i EP L(0) t)
anyBAVLtoEither (BAVL t (EmptyBP i )) = Left (openEmpty i EP L(0) t)