{-# OPTIONS_HADDOCK hide #-}
module Data.Tree.AVL.Write
(
writeL,tryWriteL,writeR,tryWriteR,
write,writeFast,tryWrite,writeMaybe,tryWriteMaybe
) where
import Prelude
import Data.COrdering
import Data.Tree.AVL.Internals.Types(AVL(..))
import Data.Tree.AVL.BinPath(BinPath(..),openPathWith,writePath)
writeL :: e -> AVL e -> AVL e
writeL :: forall e. e -> AVL e -> AVL e
writeL e
_ AVL e
E = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"writeL: Empty Tree"
writeL e
e' (N AVL e
l e
e AVL e
r) = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLN e
e' AVL e
l e
e AVL e
r
writeL e
e' (Z AVL e
l e
e AVL e
r) = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLZ e
e' AVL e
l e
e AVL e
r
writeL e
e' (P AVL e
l e
e AVL e
r) = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLP e
e' AVL e
l e
e AVL e
r
tryWriteL :: e -> AVL e -> Maybe (AVL e)
tryWriteL :: forall e. e -> AVL e -> Maybe (AVL e)
tryWriteL e
_ AVL e
E = Maybe (AVL e)
forall a. Maybe a
Nothing
tryWriteL e
e' (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
$! e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLN e
e' AVL e
l e
e AVL e
r
tryWriteL e
e' (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
$! e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLZ e
e' AVL e
l e
e AVL e
r
tryWriteL e
e' (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
$! e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLP e
e' AVL e
l e
e AVL e
r
writeL' :: e -> AVL e -> AVL e
writeL' :: forall e. e -> AVL e -> AVL e
writeL' e
_ AVL e
E = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"writeL': Bug0"
writeL' e
e' (N AVL e
l e
e AVL e
r) = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLN e
e' AVL e
l e
e AVL e
r
writeL' e
e' (Z AVL e
l e
e AVL e
r) = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLZ e
e' AVL e
l e
e AVL e
r
writeL' e
e' (P AVL e
l e
e AVL e
r) = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLP e
e' AVL e
l e
e AVL e
r
writeLN :: e -> AVL e -> e -> AVL e -> AVL e
writeLN :: forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLN e
e' AVL 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
writeLN e
e' (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLN e
e' 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
writeLN e
e' (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLZ e
e' 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
writeLN e
e' (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLP e
e' 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
writeLZ :: e -> AVL e -> e -> AVL e -> AVL e
writeLZ :: forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLZ e
e' AVL 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
writeLZ e
e' (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLN e
e' 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
writeLZ e
e' (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLZ e
e' 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
writeLZ e
e' (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let l' :: AVL e
l' = e -> AVL e -> e -> AVL e -> AVL e
forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLP e
e' 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
{-# INLINE writeLP #-}
writeLP :: e -> AVL e -> e -> AVL e -> AVL e
writeLP :: forall e. e -> AVL e -> e -> AVL e -> AVL e
writeLP e
e' AVL e
l e
e AVL e
r = let l' :: AVL e
l' = e -> AVL e -> AVL e
forall e. e -> AVL e -> AVL e
writeL' e
e' AVL e
l 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
writeR :: AVL e -> e -> AVL e
writeR :: forall e. AVL e -> e -> AVL e
writeR AVL e
E e
_ = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"writeR: Empty Tree"
writeR (N AVL e
l e
e AVL e
r) e
e' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRN AVL e
l e
e AVL e
r e
e'
writeR (Z AVL e
l e
e AVL e
r) e
e' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRZ AVL e
l e
e AVL e
r e
e'
writeR (P AVL e
l e
e AVL e
r) e
e' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRP AVL e
l e
e AVL e
r e
e'
tryWriteR :: AVL e -> e -> Maybe (AVL e)
tryWriteR :: forall e. AVL e -> e -> Maybe (AVL e)
tryWriteR AVL e
E e
_ = Maybe (AVL e)
forall a. Maybe a
Nothing
tryWriteR (N AVL e
l e
e AVL e
r) e
e' = 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 -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRN AVL e
l e
e AVL e
r e
e'
tryWriteR (Z AVL e
l e
e AVL e
r) e
e' = 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 -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRZ AVL e
l e
e AVL e
r e
e'
tryWriteR (P AVL e
l e
e AVL e
r) e
e' = 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 -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRP AVL e
l e
e AVL e
r e
e'
writeR' :: AVL e -> e -> AVL e
writeR' :: forall e. AVL e -> e -> AVL e
writeR' AVL e
E e
_ = [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"writeR': Bug0"
writeR' (N AVL e
l e
e AVL e
r) e
e' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRN AVL e
l e
e AVL e
r e
e'
writeR' (Z AVL e
l e
e AVL e
r) e
e' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRZ AVL e
l e
e AVL e
r e
e'
writeR' (P AVL e
l e
e AVL e
r) e
e' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRP AVL e
l e
e AVL e
r e
e'
{-# INLINE writeRN #-}
writeRN :: AVL e -> e -> AVL e -> e -> AVL e
writeRN :: forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRN AVL e
l e
e AVL e
r e
e' = let r' :: AVL e
r' = AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e
writeR' AVL e
r e
e' 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'
writeRZ :: AVL e -> e -> AVL e -> e -> AVL e
writeRZ :: forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRZ AVL e
l e
_ AVL e
E 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
writeRZ AVL e
l e
e (N AVL e
rl e
re AVL e
rr) e
e' = let r' :: AVL e
r' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRN AVL e
rl e
re AVL e
rr e
e' 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'
writeRZ AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) e
e' = let r' :: AVL e
r' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRZ AVL e
rl e
re AVL e
rr e
e' 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'
writeRZ AVL e
l e
e (P AVL e
rl e
re AVL e
rr) e
e' = let r' :: AVL e
r' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRP AVL e
rl e
re AVL e
rr e
e' 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'
writeRP :: AVL e -> e -> AVL e -> e -> AVL e
writeRP :: forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRP AVL e
l e
_ AVL e
E 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
writeRP AVL e
l e
e (N AVL e
rl e
re AVL e
rr) e
e' = let r' :: AVL e
r' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRN AVL e
rl e
re AVL e
rr e
e' 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'
writeRP AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) e
e' = let r' :: AVL e
r' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRZ AVL e
rl e
re AVL e
rr e
e' 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'
writeRP AVL e
l e
e (P AVL e
rl e
re AVL e
rr) e
e' = let r' :: AVL e
r' = AVL e -> e -> AVL e -> e -> AVL e
forall e. AVL e -> e -> AVL e -> e -> AVL e
writeRP AVL e
rl e
re AVL e
rr e
e' 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'
write :: (e -> COrdering e) -> AVL e -> AVL e
write :: forall e. (e -> COrdering e) -> AVL e -> AVL e
write e -> COrdering e
c AVL e
t = case (e -> COrdering e) -> AVL e -> BinPath e
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering e
c AVL e
t of
FullBP Int#
pth e
e -> Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
writePath Int#
pth e
e AVL e
t
BinPath e
_ -> AVL e
t
writeFast :: (e -> COrdering e) -> AVL e -> AVL e
writeFast :: forall e. (e -> COrdering e) -> AVL e -> AVL e
writeFast e -> COrdering e
c = AVL e -> AVL e
w where
w :: AVL e -> AVL e
w AVL e
E = AVL e
forall e. AVL e
E
w (N AVL e
l e
e AVL e
r) = case e -> COrdering e
c e
e of
COrdering e
Lt -> let l' :: AVL e
l' = AVL e -> AVL e
w AVL e
l 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
Eq e
v -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l e
v AVL e
r
COrdering e
Gt -> let r' :: AVL e
r' = AVL e -> AVL e
w AVL e
r 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'
w (Z AVL e
l e
e AVL e
r) = case e -> COrdering e
c e
e of
COrdering e
Lt -> let l' :: AVL e
l' = AVL e -> AVL e
w AVL e
l 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
Eq e
v -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l e
v AVL e
r
COrdering e
Gt -> let r' :: AVL e
r' = AVL e -> AVL e
w AVL e
r 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'
w (P AVL e
l e
e AVL e
r) = case e -> COrdering e
c e
e of
COrdering e
Lt -> let l' :: AVL e
l' = AVL e -> AVL e
w AVL e
l 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
Eq e
v -> AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l e
v AVL e
r
COrdering e
Gt -> let r' :: AVL e
r' = AVL e -> AVL e
w AVL e
r 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'
tryWrite :: (e -> COrdering e) -> AVL e -> Maybe (AVL e)
tryWrite :: forall e. (e -> COrdering e) -> AVL e -> Maybe (AVL e)
tryWrite e -> COrdering e
c AVL e
t = case (e -> COrdering e) -> AVL e -> BinPath e
forall e a. (e -> COrdering a) -> AVL e -> BinPath a
openPathWith e -> COrdering e
c AVL e
t of
FullBP Int#
pth e
e -> 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
$! Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
writePath Int#
pth e
e AVL e
t
BinPath e
_ -> Maybe (AVL e)
forall a. Maybe a
Nothing
writeMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL e
writeMaybe :: forall e. (e -> COrdering (Maybe e)) -> AVL e -> AVL e
writeMaybe 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#
pth (Just e
e) -> Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
writePath Int#
pth e
e AVL e
t
BinPath (Maybe e)
_ -> AVL e
t
tryWriteMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> Maybe (AVL e)
tryWriteMaybe :: forall e. (e -> COrdering (Maybe e)) -> AVL e -> Maybe (AVL e)
tryWriteMaybe 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#
pth (Just e
e) -> 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
$! Int# -> e -> AVL e -> AVL e
forall e. Int# -> e -> AVL e -> AVL e
writePath Int#
pth e
e AVL e
t
FullBP Int#
_ Maybe e
Nothing -> AVL e -> Maybe (AVL e)
forall a. a -> Maybe a
Just AVL e
t
BinPath (Maybe e)
_ -> Maybe (AVL e)
forall a. Maybe a
Nothing