-- |
-- Copyright   :  (c) Adrian Hey 2004,2005
-- License     :  BSD3
--
-- HAVL data type and related utilities
{-# OPTIONS_HADDOCK hide #-}
module Data.Tree.AVL.Internals.HAVL
        (
         HAVL(HAVL),emptyHAVL,toHAVL,isEmptyHAVL,isNonEmptyHAVL,
         spliceHAVL,joinHAVL,
         pushLHAVL,pushRHAVL
        ) where

import Data.Tree.AVL.Internals.Types(AVL(..))
import Data.Tree.AVL.Height(addHeight)
import Data.Tree.AVL.Internals.HJoin(spliceH,joinH)
import Data.Tree.AVL.Internals.HPush(pushHL,pushHR)

import GHC.Base
#include "ghcdefs.h"

-- | An HAVL represents an AVL tree of known height.
data HAVL e = HAVL (AVL e) {-# UNPACK #-} !UINT

-- | Empty HAVL (height is 0).
emptyHAVL :: HAVL e
emptyHAVL :: forall e. HAVL e
emptyHAVL = AVL e -> Int# -> HAVL e
forall e. AVL e -> Int# -> HAVL e
HAVL AVL e
forall e. AVL e
E L(0)

-- | Returns 'True' if the AVL component of an HAVL tree is empty. Note that height component
-- is ignored, so it's OK to use this function in cases where the height is relative.
--
-- Complexity: O(1)
{-# INLINE isEmptyHAVL #-}
isEmptyHAVL :: HAVL e -> Bool
isEmptyHAVL :: forall e. HAVL e -> Bool
isEmptyHAVL (HAVL AVL e
E Int#
_) = Bool
True
isEmptyHAVL (HAVL AVL e
_ Int#
_) = Bool
False

-- | Returns 'True' if the AVL component of an HAVL tree is non-empty. Note that height component
-- is ignored, so it's OK to use this function in cases where the height is relative.
--
-- Complexity: O(1)
{-# INLINE isNonEmptyHAVL #-}
isNonEmptyHAVL :: HAVL e -> Bool
isNonEmptyHAVL :: forall e. HAVL e -> Bool
isNonEmptyHAVL (HAVL AVL e
E Int#
_) = Bool
False
isNonEmptyHAVL (HAVL AVL e
_ Int#
_) = Bool
True

-- | Converts an AVL to HAVL
toHAVL :: AVL e -> HAVL e
toHAVL :: forall e. AVL e -> HAVL e
toHAVL AVL e
t = AVL e -> Int# -> HAVL e
forall e. AVL e -> Int# -> HAVL e
HAVL AVL e
t (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(0AVL e
) t)

-- | Splice two HAVL trees using the supplied bridging element.
-- That is, the bridging element appears "in the middle" of the resulting HAVL tree.
-- The elements of the first tree argument are to the left of the bridging element and
-- the elements of the second tree are to the right of the bridging element.
--
-- This function does not require that the AVL heights are absolutely correct, only that
-- the difference in supplied heights is equal to the difference in actual heights. So it's
-- OK if the input heights both have the same unknown constant offset. (The output height
-- will also have the same constant offset in this case.)
--
-- Complexity: O(d), where d is the absolute difference in tree heights.
{-# INLINE spliceHAVL #-}
spliceHAVL :: HAVL e -> e -> HAVL e -> HAVL e
spliceHAVL :: forall e. HAVL e -> e -> HAVL e -> HAVL e
spliceHAVL (HAVL AVL e
l Int#
hl) e
e (HAVL AVL e
r Int#
hr) = case AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL e
l Int#
hl e
e AVL e
r Int#
hr of UBT2(t,ht) -> AVL e -> Int# -> HAVL e
forall e. AVL e -> Int# -> HAVL e
HAVL AVL e
t Int#
ht

-- | Join two HAVL trees.
-- It's OK if heights are relative (I.E. if they share same fixed offset).
--
-- Complexity: O(d), where d is the absolute difference in tree heights.
{-# INLINE joinHAVL #-}
joinHAVL :: HAVL e -> HAVL e -> HAVL e
joinHAVL :: forall e. HAVL e -> HAVL e -> HAVL e
joinHAVL (HAVL AVL e
l Int#
hl) (HAVL AVL e
r Int#
hr) = case AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
joinH AVL e
l Int#
hl AVL e
r Int#
hr of UBT2(t,ht) -> AVL e -> Int# -> HAVL e
forall e. AVL e -> Int# -> HAVL e
HAVL AVL e
t Int#
ht

-- | A version of 'Data.Tree.AVL.pushL' for HAVL trees.
-- It's OK if height is relative, with fixed offset. In this case the height of the result
-- will have the same fixed offset.
{-# INLINE pushLHAVL #-}
pushLHAVL :: e -> HAVL e -> HAVL e
pushLHAVL :: forall e. e -> HAVL e -> HAVL e
pushLHAVL e
e (HAVL AVL e
t Int#
ht) = case e -> AVL e -> Int# -> (# AVL e, Int# #)
forall e. e -> AVL e -> Int# -> (# AVL e, Int# #)
pushHL e
e AVL e
t Int#
ht of UBT2(t_,ht_) -> AVL e -> Int# -> HAVL e
forall e. AVL e -> Int# -> HAVL e
HAVL AVL e
t_ Int#
ht_

-- | A version of 'Data.Tree.AVL.pushR' for HAVL trees.
-- It's OK if height is relative, with fixed offset. In this case the height of the result
-- will have the same fixed offset.
{-# INLINE pushRHAVL #-}
pushRHAVL :: HAVL e -> e -> HAVL e
pushRHAVL :: forall e. HAVL e -> e -> HAVL e
pushRHAVL (HAVL AVL e
t Int#
ht) e
e = case AVL e -> Int# -> e -> (# AVL e, Int# #)
forall e. AVL e -> Int# -> e -> (# AVL e, Int# #)
pushHR AVL e
t Int#
ht e
e of UBT2(t_,ht_) -> AVL e -> Int# -> HAVL e
forall e. AVL e -> Int# -> HAVL e
HAVL AVL e
t_ Int#
ht_