-- |
-- Copyright   :  (c) Adrian Hey 2004,2005
-- License     :  BSD3
--
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Tree.AVL.List
(-- * List related utilities for AVL trees

 -- ** Converting AVL trees to Lists (fixed element order).
 -- | These functions are lazy and allow normal lazy list processing
 -- style to be used (without necessarily converting the entire tree
 -- to a list in one gulp).
 asListL,toListL,asListR,toListR,

 -- ** Converting Lists to AVL trees (fixed element order)
 asTreeLenL,asTreeL,
 asTreeLenR,asTreeR,

 -- ** Converting unsorted Lists to sorted AVL trees
 asTree,

 -- ** \"Pushing\" unsorted Lists in sorted AVL trees
 pushList,

 -- * Some analogues of common List functions
 reverse,map,map',
 mapAccumL  ,mapAccumR  ,
 mapAccumL' ,mapAccumR' ,
 replicate,
 filter,mapMaybe,
 filterViaList,mapMaybeViaList,
 partition,
 traverseAVL,

 -- ** Folds
 -- | Note that unlike folds over lists ('foldr' and 'foldl'), there is no
 -- significant difference between left and right folds in AVL trees, other
 -- than which side of the tree each starts with.
 -- Therefore this library provides strict and lazy versions of both.
 foldr,foldr',foldr1,foldr1',foldr2,foldr2',
 foldl,foldl',foldl1,foldl1',foldl2,foldl2',

         -- ** (GHC Only)
         mapAccumL'',mapAccumR'', foldrInt#,

 -- * Some clones of common List functions
 -- | These are a cure for the horrible @O(n^2)@ complexity the noddy Data.List definitions.
 nub,nubBy,

 -- * \"Flattening\" AVL trees
 -- | These functions can be improve search times by reducing a tree of given size to
 -- the minimum possible height.
 flatten,
 flatReverse,flatMap,flatMap',
) where

import Prelude (seq, (+), (-), odd, error)
import Data.Eq ((==))
import Data.Bool (Bool(..), (||))
import Data.Int (Int)
import Data.Foldable (length)
import Data.Maybe (Maybe(..))
import Data.Ord (Ord, compare, Ordering)
import Data.COrdering
import Data.Tree.AVL.Internals.Types(AVL(..))
import Data.Tree.AVL.Utils(empty)
import Data.Tree.AVL.Size(size)
import Data.Tree.AVL.Push(push)
import Data.Tree.AVL.BinPath(findEmptyPath,insertPath)
import Data.Tree.AVL.Internals.HJoin(spliceH,joinH)

import Data.Bits(shiftR,(.&.))
import qualified Data.List as List (foldl',map)
import Control.Applicative hiding (empty)

import GHC.Base(Int#,(-#))
#include "ghcdefs.h"

-- | List AVL tree contents in left to right order.
-- The resulting list in ascending order if the tree is sorted.
--
-- Complexity: O(n)
asListL  :: AVL e -> [e]
asListL :: forall e. AVL e -> [e]
asListL AVL e
avl = AVL e -> [e] -> [e]
forall e. AVL e -> [e] -> [e]
toListL AVL e
avl []

-- | Join the AVL tree contents to an existing list in left to right order.
-- This is a ++ free function which behaves as if defined thusly..
--
-- > avl `toListL` as = (asListL avl) ++ as
--
-- Complexity: O(n)
toListL :: AVL e -> [e] -> [e]
toListL :: forall e. AVL e -> [e] -> [e]
toListL  AVL e
E        [e]
es = [e]
es
toListL (N AVL e
l e
e AVL e
r) [e]
es = AVL e -> e -> AVL e -> [e] -> [e]
forall e. AVL e -> e -> AVL e -> [e] -> [e]
toListL' AVL e
l e
e AVL e
r [e]
es
toListL (Z AVL e
l e
e AVL e
r) [e]
es = AVL e -> e -> AVL e -> [e] -> [e]
forall e. AVL e -> e -> AVL e -> [e] -> [e]
toListL' AVL e
l e
e AVL e
r [e]
es
toListL (P AVL e
l e
e AVL e
r) [e]
es = AVL e -> e -> AVL e -> [e] -> [e]
forall e. AVL e -> e -> AVL e -> [e] -> [e]
toListL' AVL e
l e
e AVL e
r [e]
es
toListL' :: AVL e -> e -> AVL e -> [e] -> [e]
toListL' :: forall e. AVL e -> e -> AVL e -> [e] -> [e]
toListL'   AVL e
l e
e AVL e
r  [e]
es = AVL e -> [e] -> [e]
forall e. AVL e -> [e] -> [e]
toListL AVL e
l (e
ee -> [e] -> [e]
forall a. a -> [a] -> [a]
:(AVL e -> [e] -> [e]
forall e. AVL e -> [e] -> [e]
toListL AVL e
r [e]
es))

-- | List AVL tree contents in right to left order.
-- The resulting list in descending order if the tree is sorted.
--
-- Complexity: O(n)
asListR  :: AVL e -> [e]
asListR :: forall e. AVL e -> [e]
asListR AVL e
avl = AVL e -> [e] -> [e]
forall e. AVL e -> [e] -> [e]
toListR AVL e
avl []

-- | Join the AVL tree contents to an existing list in right to left order.
-- This is a ++ free function which behaves as if defined thusly..
--
-- > avl `toListR` as = (asListR avl) ++ as
--
-- Complexity: O(n)
toListR :: AVL e -> [e] -> [e]
toListR :: forall e. AVL e -> [e] -> [e]
toListR  AVL e
E        [e]
es = [e]
es
toListR (N AVL e
l e
e AVL e
r) [e]
es = AVL e -> e -> AVL e -> [e] -> [e]
forall e. AVL e -> e -> AVL e -> [e] -> [e]
toListR' AVL e
l e
e AVL e
r [e]
es
toListR (Z AVL e
l e
e AVL e
r) [e]
es = AVL e -> e -> AVL e -> [e] -> [e]
forall e. AVL e -> e -> AVL e -> [e] -> [e]
toListR' AVL e
l e
e AVL e
r [e]
es
toListR (P AVL e
l e
e AVL e
r) [e]
es = AVL e -> e -> AVL e -> [e] -> [e]
forall e. AVL e -> e -> AVL e -> [e] -> [e]
toListR' AVL e
l e
e AVL e
r [e]
es
toListR' :: AVL e -> e -> AVL e -> [e] -> [e]
toListR' :: forall e. AVL e -> e -> AVL e -> [e] -> [e]
toListR'   AVL e
l e
e AVL e
r  [e]
es = AVL e -> [e] -> [e]
forall e. AVL e -> [e] -> [e]
toListR AVL e
r (e
ee -> [e] -> [e]
forall a. a -> [a] -> [a]
:(AVL e -> [e] -> [e]
forall e. AVL e -> [e] -> [e]
toListR AVL e
l [e]
es))

-- | The AVL equivalent of 'foldr' on lists. This is a the lazy version (as lazy as the folding function
-- anyway). Using this version with a function that is strict in it's second argument will result in O(n)
-- stack use. See 'foldr'' for a strict version.
--
-- It behaves as if defined..
--
-- > foldr f a avl = foldr f a (asListL avl)
--
-- For example, the 'asListL' function could be defined..
--
-- > asListL = foldr (:) []
--
-- Complexity: O(n)
foldr :: (e -> a -> a) -> a -> AVL e -> a
foldr :: forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr e -> a -> a
f = a -> AVL e -> a
foldU where
 foldU :: a -> AVL e -> a
foldU a
a  AVL e
E        = a
a
 foldU a
a (N AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldU a
a (Z AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldU a
a (P AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldV :: a -> AVL e -> e -> AVL e -> a
foldV a
a    AVL e
l e
e AVL e
r  = a -> AVL e -> a
foldU (e -> a -> a
f e
e (a -> AVL e -> a
foldU a
a AVL e
r)) AVL e
l

-- | The strict version of 'foldr', which is useful for functions which are strict in their second
-- argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
-- version gives (when used with strict functions) to O(log n).
--
-- Complexity: O(n)
foldr' :: (e -> a -> a) -> a -> AVL e -> a
foldr' :: forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr' e -> a -> a
f = a -> AVL e -> a
foldU where
 foldU :: a -> AVL e -> a
foldU a
a  AVL e
E        = a
a
 foldU a
a (N AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldU a
a (Z AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldU a
a (P AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldV :: a -> AVL e -> e -> AVL e -> a
foldV a
a    AVL e
l e
e AVL e
r  = let a' :: a
a'  = a -> AVL e -> a
foldU a
a AVL e
r
                         a'' :: a
a'' = e -> a -> a
f e
e a
a'
                     in a
a' a -> a -> a
forall a b. a -> b -> b
`seq` a
a'' a -> a -> a
forall a b. a -> b -> b
`seq` a -> AVL e -> a
foldU a
a'' AVL e
l

-- | The AVL equivalent of 'foldr1' on lists. This is a the lazy version (as lazy as the folding function
-- anyway). Using this version with a function that is strict in it's second argument will result in O(n)
-- stack use. See 'foldr1'' for a strict version.
--
-- > foldr1 f avl = foldr1 f (asListL avl)
--
-- This function raises an error if the tree is empty.
--
-- Complexity: O(n)
foldr1 :: (e -> e -> e) -> AVL e -> e
foldr1 :: forall e. (e -> e -> e) -> AVL e -> e
foldr1 e -> e -> e
f = AVL e -> e
foldU where
 foldU :: AVL e -> e
foldU  AVL e
E        = [Char] -> e
forall a. HasCallStack => [Char] -> a
error [Char]
"foldr1: Empty Tree"
 foldU (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldV AVL e
l e
e AVL e
r  -- r can't be E
 foldU (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldW AVL e
l e
e AVL e
r  -- r might be E
 foldU (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldW AVL e
l e
e AVL e
r  -- r might be E
 -- Use this when r can't be E
 foldV :: AVL e -> e -> AVL e -> e
foldV AVL e
l e
e AVL e
r     = (e -> e -> e) -> e -> AVL e -> e
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr e -> e -> e
f (e -> e -> e
f e
e (AVL e -> e
foldU AVL e
r)) AVL e
l
 -- Use this when r might be E
 foldW :: AVL e -> e -> AVL e -> e
foldW AVL e
l e
e  AVL e
E           = (e -> e -> e) -> e -> AVL e -> e
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr e -> e -> e
f e
e AVL e
l
 foldW AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = (e -> e -> e) -> e -> AVL e -> e
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr e -> e -> e
f (e -> e -> e
f e
e (AVL e -> e -> AVL e -> e
foldV AVL e
rl e
re AVL e
rr)) AVL e
l -- rr can't be E
 foldW AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr                  -- rr might be E
 foldW AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr                  -- rr might be E
 -- Common code for foldW (Z and P cases)
 foldX :: AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr = (e -> e -> e) -> e -> AVL e -> e
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr e -> e -> e
f (e -> e -> e
f e
e (AVL e -> e -> AVL e -> e
foldW AVL e
rl e
re AVL e
rr)) AVL e
l

-- | The strict version of 'foldr1', which is useful for functions which are strict in their second
-- argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
-- version gives (when used with strict functions) to O(log n).
--
-- Complexity: O(n)
foldr1' :: (e -> e -> e) -> AVL e -> e
foldr1' :: forall e. (e -> e -> e) -> AVL e -> e
foldr1' e -> e -> e
f = AVL e -> e
foldU where
 foldU :: AVL e -> e
foldU  AVL e
E        = [Char] -> e
forall a. HasCallStack => [Char] -> a
error [Char]
"foldr1': Empty Tree"
 foldU (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldV AVL e
l e
e AVL e
r  -- r can't be E
 foldU (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldW AVL e
l e
e AVL e
r  -- r might be E
 foldU (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldW AVL e
l e
e AVL e
r  -- r might be E
 -- Use this when r can't be E
 foldV :: AVL e -> e -> AVL e -> e
foldV AVL e
l e
e AVL e
r     = let a :: e
a  = AVL e -> e
foldU AVL e
r
                       a' :: e
a' = e -> e -> e
f e
e e
a
                   in e
a e -> e -> e
forall a b. a -> b -> b
`seq` e
a' e -> e -> e
forall a b. a -> b -> b
`seq` (e -> e -> e) -> e -> AVL e -> e
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr' e -> e -> e
f e
a' AVL e
l
 -- Use this when r might be E
 foldW :: AVL e -> e -> AVL e -> e
foldW AVL e
l e
e  AVL e
E           = (e -> e -> e) -> e -> AVL e -> e
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr' e -> e -> e
f e
e AVL e
l
 foldW AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let a :: e
a  = AVL e -> e -> AVL e -> e
foldV AVL e
rl e
re AVL e
rr       -- rr can't be E
                              a' :: e
a' = e -> e -> e
f e
e e
a
                          in e
a e -> e -> e
forall a b. a -> b -> b
`seq` e
a' e -> e -> e
forall a b. a -> b -> b
`seq` (e -> e -> e) -> e -> AVL e -> e
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr' e -> e -> e
f e
a' AVL e
l
 foldW AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr            -- rr might be E
 foldW AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr            -- rr might be E
 -- Common code for foldW (Z and P cases)
 foldX :: AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr = let a :: e
a  = AVL e -> e -> AVL e -> e
foldW AVL e
rl e
re AVL e
rr
                          a' :: e
a' = e -> e -> e
f e
e e
a
                      in e
a e -> e -> e
forall a b. a -> b -> b
`seq` e
a' e -> e -> e
forall a b. a -> b -> b
`seq` (e -> e -> e) -> e -> AVL e -> e
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr' e -> e -> e
f e
a' AVL e
l

-- | This fold is a hybrid between 'foldr' and 'foldr1'. As with 'foldr1', it requires
-- a non-empty tree, but instead of treating the rightmost element as an initial value, it applies
-- a function to it (second function argument) and uses the result instead. This allows
-- a more flexible type for the main folding function (same type as that used by 'foldr').
-- As with 'foldr' and 'foldr1', this function is lazy, so it's best not to use it with functions
-- that are strict in their second argument. See 'foldr2'' for a strict version.
--
-- Complexity: O(n)
foldr2 :: (e -> a -> a) -> (e -> a) -> AVL e -> a
foldr2 :: forall e a. (e -> a -> a) -> (e -> a) -> AVL e -> a
foldr2 e -> a -> a
f e -> a
g = AVL e -> a
foldU where
 foldU :: AVL e -> a
foldU  AVL e
E        = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"foldr2: Empty Tree"
 foldU (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldV AVL e
l e
e AVL e
r  -- r can't be E
 foldU (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldW AVL e
l e
e AVL e
r  -- r might be E
 foldU (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldW AVL e
l e
e AVL e
r  -- r might be E
 -- Use this when r can't be E
 foldV :: AVL e -> e -> AVL e -> a
foldV AVL e
l e
e AVL e
r     = (e -> a -> a) -> a -> AVL e -> a
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr e -> a -> a
f (e -> a -> a
f e
e (AVL e -> a
foldU AVL e
r)) AVL e
l
 -- Use this when r might be E
 foldW :: AVL e -> e -> AVL e -> a
foldW AVL e
l e
e  AVL e
E           = (e -> a -> a) -> a -> AVL e -> a
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr e -> a -> a
f (e -> a
g e
e) AVL e
l
 foldW AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = (e -> a -> a) -> a -> AVL e -> a
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr e -> a -> a
f (e -> a -> a
f e
e (AVL e -> e -> AVL e -> a
foldV AVL e
rl e
re AVL e
rr)) AVL e
l -- rr can't be E
 foldW AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr                  -- rr might be E
 foldW AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr                  -- rr might be E
 -- Common code for foldW (Z and P cases)
 foldX :: AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr = (e -> a -> a) -> a -> AVL e -> a
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr e -> a -> a
f (e -> a -> a
f e
e (AVL e -> e -> AVL e -> a
foldW AVL e
rl e
re AVL e
rr)) AVL e
l

-- | The strict version of 'foldr2', which is useful for functions which are strict in their second
-- argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
-- version gives (when used with strict functions) to O(log n).
--
-- Complexity: O(n)
foldr2' :: (e -> a -> a) -> (e -> a) -> AVL e -> a
foldr2' :: forall e a. (e -> a -> a) -> (e -> a) -> AVL e -> a
foldr2' e -> a -> a
f e -> a
g = AVL e -> a
foldU where
 foldU :: AVL e -> a
foldU  AVL e
E        = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"foldr2': Empty Tree"
 foldU (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldV AVL e
l e
e AVL e
r  -- r can't be E
 foldU (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldW AVL e
l e
e AVL e
r  -- r might be E
 foldU (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldW AVL e
l e
e AVL e
r  -- r might be E
 -- Use this when r can't be E
 foldV :: AVL e -> e -> AVL e -> a
foldV AVL e
l e
e AVL e
r     = let a :: a
a  = AVL e -> a
foldU AVL e
r
                       a' :: a
a' = e -> a -> a
f e
e a
a
                   in a
a a -> a -> a
forall a b. a -> b -> b
`seq` a
a' a -> a -> a
forall a b. a -> b -> b
`seq` (e -> a -> a) -> a -> AVL e -> a
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr' e -> a -> a
f a
a' AVL e
l
 -- Use this when r might be E
 foldW :: AVL e -> e -> AVL e -> a
foldW AVL e
l e
e  AVL e
E           = let a :: a
a = e -> a
g e
e in a
a a -> a -> a
forall a b. a -> b -> b
`seq` (e -> a -> a) -> a -> AVL e -> a
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr' e -> a -> a
f a
a AVL e
l
 foldW AVL e
l e
e (N AVL e
rl e
re AVL e
rr) = let a :: a
a  = AVL e -> e -> AVL e -> a
foldV AVL e
rl e
re AVL e
rr              -- rr can't be E
                              a' :: a
a' = e -> a -> a
f e
e a
a
                          in a
a a -> a -> a
forall a b. a -> b -> b
`seq` a
a' a -> a -> a
forall a b. a -> b -> b
`seq` (e -> a -> a) -> a -> AVL e -> a
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr' e -> a -> a
f a
a' AVL e
l
 foldW AVL e
l e
e (Z AVL e
rl e
re AVL e
rr) = AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr                   -- rr might be E
 foldW AVL e
l e
e (P AVL e
rl e
re AVL e
rr) = AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr                   -- rr might be E
 -- Common code for foldW (Z and P cases)
 foldX :: AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
l e
e AVL e
rl e
re AVL e
rr = let a :: a
a  = AVL e -> e -> AVL e -> a
foldW AVL e
rl e
re AVL e
rr
                          a' :: a
a' = e -> a -> a
f e
e a
a
                      in a
a a -> a -> a
forall a b. a -> b -> b
`seq` a
a' a -> a -> a
forall a b. a -> b -> b
`seq` (e -> a -> a) -> a -> AVL e -> a
forall e a. (e -> a -> a) -> a -> AVL e -> a
foldr' e -> a -> a
f a
a' AVL e
l


-- | The AVL equivalent of 'foldl' on lists. This is a the lazy version (as lazy as the folding function
-- anyway). Using this version with a function that is strict in it's first argument will result in O(n)
-- stack use. See 'foldl'' for a strict version.
--
-- > foldl f a avl = foldl f a (asListL avl)
--
-- For example, the 'asListR' function could be defined..
--
-- > asListR = foldl (flip (:)) []
--
-- Complexity: O(n)
foldl :: (a -> e -> a) -> a -> AVL e -> a
foldl :: forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl a -> e -> a
f = a -> AVL e -> a
foldU where
 foldU :: a -> AVL e -> a
foldU a
a  AVL e
E        = a
a
 foldU a
a (N AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldU a
a (Z AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldU a
a (P AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldV :: a -> AVL e -> e -> AVL e -> a
foldV a
a    AVL e
l e
e AVL e
r  = a -> AVL e -> a
foldU (a -> e -> a
f (a -> AVL e -> a
foldU a
a AVL e
l) e
e) AVL e
r

-- | The strict version of 'foldl', which is useful for functions which are strict in their first
-- argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
-- version gives (when used with strict functions) to O(log n).
--
-- Complexity: O(n)
foldl' :: (a -> e -> a) -> a -> AVL e -> a
foldl' :: forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl' a -> e -> a
f = a -> AVL e -> a
foldU where
 foldU :: a -> AVL e -> a
foldU a
a  AVL e
E        = a
a
 foldU a
a (N AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldU a
a (Z AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldU a
a (P AVL e
l e
e AVL e
r) = a -> AVL e -> e -> AVL e -> a
foldV a
a AVL e
l e
e AVL e
r
 foldV :: a -> AVL e -> e -> AVL e -> a
foldV a
a    AVL e
l e
e AVL e
r  = let a' :: a
a'  = a -> AVL e -> a
foldU a
a AVL e
l
                         a'' :: a
a'' = a -> e -> a
f a
a' e
e
                     in a
a' a -> a -> a
forall a b. a -> b -> b
`seq` a
a'' a -> a -> a
forall a b. a -> b -> b
`seq` a -> AVL e -> a
foldU a
a'' AVL e
r

-- | The AVL equivalent of 'foldl1' on lists. This is a the lazy version (as lazy as the folding function
-- anyway). Using this version with a function that is strict in it's first argument will result in O(n)
-- stack use. See 'foldl1'' for a strict version.
--
-- > foldl1 f avl = foldl1 f (asListL avl)
--
-- This function raises an error if the tree is empty.
--
-- Complexity: O(n)
foldl1 :: (e -> e -> e) -> AVL e -> e
foldl1 :: forall e. (e -> e -> e) -> AVL e -> e
foldl1 e -> e -> e
f = AVL e -> e
foldU where
 foldU :: AVL e -> e
foldU  AVL e
E        = [Char] -> e
forall a. HasCallStack => [Char] -> a
error [Char]
"foldl1: Empty Tree"
 foldU (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldW AVL e
l e
e AVL e
r  -- l might be E
 foldU (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldW AVL e
l e
e AVL e
r  -- l might be E
 foldU (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldV AVL e
l e
e AVL e
r  -- l can't be E
 -- Use this when l can't be E
 foldV :: AVL e -> e -> AVL e -> e
foldV AVL e
l e
e AVL e
r     = (e -> e -> e) -> e -> AVL e -> e
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl e -> e -> e
f (e -> e -> e
f (AVL e -> e
foldU AVL e
l) e
e) AVL e
r
 -- Use this when l might be E
 foldW :: AVL e -> e -> AVL e -> e
foldW  AVL e
E           e
e AVL e
r = (e -> e -> e) -> e -> AVL e -> e
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl e -> e -> e
f e
e AVL e
r
 foldW (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r                  -- ll might be E
 foldW (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r                  -- ll might be E
 foldW (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = (e -> e -> e) -> e -> AVL e -> e
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl e -> e -> e
f (e -> e -> e
f (AVL e -> e -> AVL e -> e
foldV AVL e
ll e
le AVL e
lr) e
e) AVL e
r -- ll can't be E
 -- Common code for foldW (Z and P cases)
 foldX :: AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r = (e -> e -> e) -> e -> AVL e -> e
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl e -> e -> e
f (e -> e -> e
f (AVL e -> e -> AVL e -> e
foldW AVL e
ll e
le AVL e
lr) e
e) AVL e
r

-- | The strict version of 'foldl1', which is useful for functions which are strict in their first
-- argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
-- version gives (when used with strict functions) to O(log n).
--
-- Complexity: O(n)
foldl1' :: (e -> e -> e) -> AVL e -> e
foldl1' :: forall e. (e -> e -> e) -> AVL e -> e
foldl1' e -> e -> e
f = AVL e -> e
foldU where
 foldU :: AVL e -> e
foldU  AVL e
E        = [Char] -> e
forall a. HasCallStack => [Char] -> a
error [Char]
"foldl1': Empty Tree"
 foldU (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldW AVL e
l e
e AVL e
r  -- l might be E
 foldU (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldW AVL e
l e
e AVL e
r  -- l might be E
 foldU (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> e
foldV AVL e
l e
e AVL e
r  -- l can't be E
 -- Use this when l can't be E
 foldV :: AVL e -> e -> AVL e -> e
foldV AVL e
l e
e AVL e
r     = let a :: e
a  = AVL e -> e
foldU AVL e
l
                       a' :: e
a' = e -> e -> e
f e
a e
e
                   in e
a e -> e -> e
forall a b. a -> b -> b
`seq` e
a' e -> e -> e
forall a b. a -> b -> b
`seq` (e -> e -> e) -> e -> AVL e -> e
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl' e -> e -> e
f e
a' AVL e
r
 -- Use this when l might be E
 foldW :: AVL e -> e -> AVL e -> e
foldW  AVL e
E           e
e AVL e
r = (e -> e -> e) -> e -> AVL e -> e
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl' e -> e -> e
f e
e AVL e
r
 foldW (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r                  -- ll might be E
 foldW (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r                  -- ll might be E
 foldW (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let a :: e
a  = AVL e -> e -> AVL e -> e
foldV AVL e
ll e
le AVL e
lr             -- ll can't be E
                              a' :: e
a' = e -> e -> e
f e
a e
e
                          in e
a e -> e -> e
forall a b. a -> b -> b
`seq` e
a' e -> e -> e
forall a b. a -> b -> b
`seq` (e -> e -> e) -> e -> AVL e -> e
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl' e -> e -> e
f e
a' AVL e
r
 -- Common code for foldW (Z and P cases)
 foldX :: AVL e -> e -> AVL e -> e -> AVL e -> e
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r = let a :: e
a  = AVL e -> e -> AVL e -> e
foldW AVL e
ll e
le AVL e
lr
                          a' :: e
a' = e -> e -> e
f e
a e
e
                      in e
a e -> e -> e
forall a b. a -> b -> b
`seq` e
a' e -> e -> e
forall a b. a -> b -> b
`seq` (e -> e -> e) -> e -> AVL e -> e
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl' e -> e -> e
f e
a' AVL e
r

-- | This fold is a hybrid between 'foldl' and 'foldl1'. As with 'foldl1', it requires
-- a non-empty tree, but instead of treating the leftmost element as an initial value, it applies
-- a function to it (second function argument) and uses the result instead. This allows
-- a more flexible type for the main folding function (same type as that used by 'foldl').
-- As with 'foldl' and 'foldl1', this function is lazy, so it's best not to use it with functions
-- that are strict in their first argument. See 'foldl2'' for a strict version.
--
-- Complexity: O(n)
foldl2 :: (a -> e -> a) -> (e -> a) -> AVL e -> a
foldl2 :: forall a e. (a -> e -> a) -> (e -> a) -> AVL e -> a
foldl2 a -> e -> a
f e -> a
g = AVL e -> a
foldU where
 foldU :: AVL e -> a
foldU  AVL e
E        = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"foldl2: Empty Tree"
 foldU (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldW AVL e
l e
e AVL e
r  -- l might be E
 foldU (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldW AVL e
l e
e AVL e
r  -- l might be E
 foldU (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldV AVL e
l e
e AVL e
r  -- l can't be E
 -- Use this when l can't be E
 foldV :: AVL e -> e -> AVL e -> a
foldV AVL e
l e
e AVL e
r     = (a -> e -> a) -> a -> AVL e -> a
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl a -> e -> a
f (a -> e -> a
f (AVL e -> a
foldU AVL e
l) e
e) AVL e
r
 -- Use this when l might be E
 foldW :: AVL e -> e -> AVL e -> a
foldW  AVL e
E           e
e AVL e
r = (a -> e -> a) -> a -> AVL e -> a
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl a -> e -> a
f (e -> a
g e
e) AVL e
r
 foldW (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r                  -- ll might be E
 foldW (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r                  -- ll might be E
 foldW (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = (a -> e -> a) -> a -> AVL e -> a
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl a -> e -> a
f (a -> e -> a
f (AVL e -> e -> AVL e -> a
foldV AVL e
ll e
le AVL e
lr) e
e) AVL e
r -- ll can't be E
 -- Common code for foldW (Z and P cases)
 foldX :: AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r = (a -> e -> a) -> a -> AVL e -> a
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl a -> e -> a
f (a -> e -> a
f (AVL e -> e -> AVL e -> a
foldW AVL e
ll e
le AVL e
lr) e
e) AVL e
r

-- | The strict version of 'foldl2', which is useful for functions which are strict in their first
-- argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
-- version gives (when used with strict functions) to O(log n).
--
-- Complexity: O(n)
foldl2' :: (a -> e -> a) -> (e -> a) -> AVL e -> a
foldl2' :: forall a e. (a -> e -> a) -> (e -> a) -> AVL e -> a
foldl2' a -> e -> a
f e -> a
g = AVL e -> a
foldU where
 foldU :: AVL e -> a
foldU  AVL e
E        = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"foldl2': Empty Tree"
 foldU (N AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldW AVL e
l e
e AVL e
r  -- l might be E
 foldU (Z AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldW AVL e
l e
e AVL e
r  -- l might be E
 foldU (P AVL e
l e
e AVL e
r) = AVL e -> e -> AVL e -> a
foldV AVL e
l e
e AVL e
r  -- l can't be E
 -- Use this when l can't be E
 foldV :: AVL e -> e -> AVL e -> a
foldV AVL e
l e
e AVL e
r     = let a :: a
a  = AVL e -> a
foldU AVL e
l
                       a' :: a
a' = a -> e -> a
f a
a e
e
                   in a
a a -> a -> a
forall a b. a -> b -> b
`seq` a
a' a -> a -> a
forall a b. a -> b -> b
`seq` (a -> e -> a) -> a -> AVL e -> a
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl' a -> e -> a
f a
a' AVL e
r
 -- Use this when l might be E
 foldW :: AVL e -> e -> AVL e -> a
foldW  AVL e
E           e
e AVL e
r = let a :: a
a = e -> a
g e
e in a
a a -> a -> a
forall a b. a -> b -> b
`seq` (a -> e -> a) -> a -> AVL e -> a
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl' a -> e -> a
f a
a AVL e
r
 foldW (N AVL e
ll e
le AVL e
lr) e
e AVL e
r = AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r                  -- ll might be E
 foldW (Z AVL e
ll e
le AVL e
lr) e
e AVL e
r = AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r                  -- ll might be E
 foldW (P AVL e
ll e
le AVL e
lr) e
e AVL e
r = let a :: a
a  = AVL e -> e -> AVL e -> a
foldV AVL e
ll e
le AVL e
lr             -- ll can't be E
                              a' :: a
a' = a -> e -> a
f a
a e
e
                          in a
a a -> a -> a
forall a b. a -> b -> b
`seq` a
a' a -> a -> a
forall a b. a -> b -> b
`seq` (a -> e -> a) -> a -> AVL e -> a
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl' a -> e -> a
f a
a' AVL e
r
 -- Common code for foldW (Z and P cases)
 foldX :: AVL e -> e -> AVL e -> e -> AVL e -> a
foldX AVL e
ll e
le AVL e
lr e
e AVL e
r = let a :: a
a  = AVL e -> e -> AVL e -> a
foldW AVL e
ll e
le AVL e
lr
                          a' :: a
a' = a -> e -> a
f a
a e
e
                      in a
a a -> a -> a
forall a b. a -> b -> b
`seq` a
a' a -> a -> a
forall a b. a -> b -> b
`seq` (a -> e -> a) -> a -> AVL e -> a
forall a e. (a -> e -> a) -> a -> AVL e -> a
foldl' a -> e -> a
f a
a' AVL e
r

-- | This is a specialised version of 'foldr'' for use with an
-- /unboxed/ Int accumulator.
--
-- Complexity: O(n)
foldrInt# :: (e -> UINT -> UINT) -> UINT -> AVL e -> UINT
foldrInt# :: forall e. (e -> Int# -> Int#) -> Int# -> AVL e -> Int#
foldrInt# e -> Int# -> Int#
f = Int# -> AVL e -> Int#
foldU where
 foldU :: Int# -> AVL e -> Int#
foldU Int#
a  AVL e
E        = Int#
a
 foldU Int#
a (N AVL e
l e
e AVL e
r) = Int# -> AVL e -> e -> AVL e -> Int#
foldV Int#
a AVL e
l e
e AVL e
r
 foldU Int#
a (Z AVL e
l e
e AVL e
r) = Int# -> AVL e -> e -> AVL e -> Int#
foldV Int#
a AVL e
l e
e AVL e
r
 foldU Int#
a (P AVL e
l e
e AVL e
r) = Int# -> AVL e -> e -> AVL e -> Int#
foldV Int#
a AVL e
l e
e AVL e
r
 foldV :: Int# -> AVL e -> e -> AVL e -> Int#
foldV Int#
a    AVL e
l e
e AVL e
r  = Int# -> AVL e -> Int#
foldU (e -> Int# -> Int#
f e
e (Int# -> AVL e -> Int#
foldU Int#
a AVL e
r)) AVL e
l

-- | The AVL equivalent of 'Data.List.mapAccumL' on lists.
-- It behaves like a combination of 'map' and 'foldl'.
-- It applies a function to each element of a tree, passing an accumulating parameter from
-- left to right, and returning a final value of this accumulator together with the new tree.
--
-- Using this version with a function that is strict in it's first argument will result in
-- O(n) stack use. See 'mapAccumL'' for a strict version.
--
-- Complexity: O(n)
mapAccumL :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
mapAccumL :: forall z a b. (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
mapAccumL z -> a -> (z, b)
f z
z AVL a
ta = case z -> AVL a -> (# z, AVL b #)
mapAL z
z AVL a
ta of
                      UBT2(zt,tb) -> (z
zt,AVL b
tb)
 where mapAL :: z -> AVL a -> (# z, AVL b #)
mapAL z
z_  AVL a
E          = UBT2(z_,E)
       mapAL z
z_ (N AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
N AVL a
la a
a AVL a
ra
       mapAL z
z_ (Z AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL a
la a
a AVL a
ra
       mapAL z
z_ (P AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
P AVL a
la a
a AVL a
ra
       {-# INLINE mapAL' #-}
       mapAL' :: z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z' AVL b -> b -> AVL b -> AVL b
c AVL a
la a
a AVL a
ra = case z -> AVL a -> (# z, AVL b #)
mapAL z
z' AVL a
la of
                             UBT2(zl,lb) -> let (z
za,b
b) = z -> a -> (z, b)
f z
zl a
a
                                            in case z -> AVL a -> (# z, AVL b #)
mapAL z
za AVL a
ra of
                                               UBT2(zr,rb) -> UBT2(zrAVL b -> b -> AVL b -> AVL b
, c lb b rb)

-- | This is a strict version of 'mapAccumL', which is useful for functions which
-- are strict in their first argument. The advantage of this version is that it reduces
-- the stack use from the O(n) that the lazy version gives (when used with strict functions)
-- to O(log n).
--
-- Complexity: O(n)
mapAccumL' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
mapAccumL' :: forall z a b. (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
mapAccumL' z -> a -> (z, b)
f z
z AVL a
ta = case z -> AVL a -> (# z, AVL b #)
mapAL z
z AVL a
ta of
                       UBT2(zt,tb) -> (z
zt,AVL b
tb)
 where mapAL :: z -> AVL a -> (# z, AVL b #)
mapAL z
z_  AVL a
E          = UBT2(z_,E)
       mapAL z
z_ (N AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
N AVL a
la a
a AVL a
ra
       mapAL z
z_ (Z AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL a
la a
a AVL a
ra
       mapAL z
z_ (P AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
P AVL a
la a
a AVL a
ra
       {-# INLINE mapAL' #-}
       mapAL' :: z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z' AVL b -> b -> AVL b -> AVL b
c AVL a
la a
a AVL a
ra = case z -> AVL a -> (# z, AVL b #)
mapAL z
z' AVL a
la of
                             UBT2(zl,lb) -> case z -> a -> (z, b)
f z
zl a
a of
                                            (z
za,b
b) -> case z -> AVL a -> (# z, AVL b #)
mapAL z
za AVL a
ra of
                                                      UBT2(zr,rb) -> UBT2(zrAVL b -> b -> AVL b -> AVL b
, c lb b rb)


-- | The AVL equivalent of 'Data.List.mapAccumR' on lists.
-- It behaves like a combination of 'map' and 'foldr'.
-- It applies a function to each element of a tree, passing an accumulating parameter from
-- right to left, and returning a final value of this accumulator together with the new tree.
--
-- Using this version with a function that is strict in it's first argument will result in
-- O(n) stack use. See 'mapAccumR'' for a strict version.
--
-- Complexity: O(n)
mapAccumR :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
mapAccumR :: forall z a b. (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
mapAccumR z -> a -> (z, b)
f z
z AVL a
ta = case z -> AVL a -> (# z, AVL b #)
mapAR z
z AVL a
ta of
                      UBT2(zt,tb) -> (z
zt,AVL b
tb)
 where mapAR :: z -> AVL a -> (# z, AVL b #)
mapAR z
z_  AVL a
E          = UBT2(z_,E)
       mapAR z
z_ (N AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
N AVL a
la a
a AVL a
ra
       mapAR z
z_ (Z AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL a
la a
a AVL a
ra
       mapAR z
z_ (P AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
P AVL a
la a
a AVL a
ra
       {-# INLINE mapAR' #-}
       mapAR' :: z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z' AVL b -> b -> AVL b -> AVL b
c AVL a
la a
a AVL a
ra = case z -> AVL a -> (# z, AVL b #)
mapAR z
z' AVL a
ra of
                             UBT2(zr,rb) -> let (z
za,b
b) = z -> a -> (z, b)
f z
zr a
a
                                            in case z -> AVL a -> (# z, AVL b #)
mapAR z
za AVL a
la of
                                               UBT2(zl,lb) -> UBT2(zlAVL b -> b -> AVL b -> AVL b
, c lb b rb)

-- | This is a strict version of 'mapAccumR', which is useful for functions which
-- are strict in their first argument. The advantage of this version is that it reduces
-- the stack use from the O(n) that the lazy version gives (when used with strict functions)
-- to O(log n).
--
-- Complexity: O(n)
mapAccumR' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
mapAccumR' :: forall z a b. (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
mapAccumR' z -> a -> (z, b)
f z
z AVL a
ta = case z -> AVL a -> (# z, AVL b #)
mapAR z
z AVL a
ta of
                       UBT2(zt,tb) -> (z
zt,AVL b
tb)
 where mapAR :: z -> AVL a -> (# z, AVL b #)
mapAR z
z_  AVL a
E          = UBT2(z_,E)
       mapAR z
z_ (N AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
N AVL a
la a
a AVL a
ra
       mapAR z
z_ (Z AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL a
la a
a AVL a
ra
       mapAR z
z_ (P AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
P AVL a
la a
a AVL a
ra
       {-# INLINE mapAR' #-}
       mapAR' :: z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z' AVL b -> b -> AVL b -> AVL b
c AVL a
la a
a AVL a
ra = case z -> AVL a -> (# z, AVL b #)
mapAR z
z' AVL a
ra of
                             UBT2(zr,rb) -> case z -> a -> (z, b)
f z
zr a
a of
                                            (z
za,b
b) -> case z -> AVL a -> (# z, AVL b #)
mapAR z
za AVL a
la of
                                                      UBT2(zl,lb) -> UBT2(zlAVL b -> b -> AVL b -> AVL b
, c lb b rb)

-- These two functions attempt to make the strict mapAccums more efficient and reduce heap
-- burn rate with ghc by using an accumulating function that returns an unboxed pair.

-- | Similar to 'mapAccumL'' but uses an unboxed pair in the
-- accumulating function.
--
-- Complexity: O(n)
mapAccumL''
               :: (z -> a -> UBT2(z, b)) -> z -> AVL a -> (z, AVL b)
mapAccumL'' :: forall z a b. (z -> a -> (# z, b #)) -> z -> AVL a -> (z, AVL b)
mapAccumL'' z -> a -> (# z, b #)
f z
z AVL a
ta = case z -> AVL a -> (# z, AVL b #)
mapAL z
z AVL a
ta of
                        UBT2(zt,tb) -> (z
zt,AVL b
tb)
 where mapAL :: z -> AVL a -> (# z, AVL b #)
mapAL z
z_  AVL a
E          = UBT2(z_,E)
       mapAL z
z_ (N AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
N AVL a
la a
a AVL a
ra
       mapAL z
z_ (Z AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL a
la a
a AVL a
ra
       mapAL z
z_ (P AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
P AVL a
la a
a AVL a
ra
       {-# INLINE mapAL' #-}
       mapAL' :: z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAL' z
z' AVL b -> b -> AVL b -> AVL b
c AVL a
la a
a AVL a
ra = case z -> AVL a -> (# z, AVL b #)
mapAL z
z' AVL a
la of
                             UBT2(zl,lb) -> case z -> a -> (# z, b #)
f z
zl a
a of
                                            UBT2(za,b) -> case z -> AVL a -> (# z, AVL b #)
mapAL z
za AVL a
ra of
                                                          UBT2(zr,rb) -> UBT2(zrAVL b -> b -> AVL b -> AVL b
, c lb b rb)

-- | Similar to 'mapAccumR'' but uses an unboxed pair in the
-- accumulating function.
--
-- Complexity: O(n)
mapAccumR''
               :: (z -> a -> UBT2(z, b)) -> z -> AVL a -> (z, AVL b)
mapAccumR'' :: forall z a b. (z -> a -> (# z, b #)) -> z -> AVL a -> (z, AVL b)
mapAccumR'' z -> a -> (# z, b #)
f z
z AVL a
ta = case z -> AVL a -> (# z, AVL b #)
mapAR z
z AVL a
ta of
                        UBT2(zt,tb) -> (z
zt,AVL b
tb)
 where mapAR :: z -> AVL a -> (# z, AVL b #)
mapAR z
z_  AVL a
E          = UBT2(z_,E)
       mapAR z
z_ (N AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
N AVL a
la a
a AVL a
ra
       mapAR z
z_ (Z AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL a
la a
a AVL a
ra
       mapAR z
z_ (P AVL a
la a
a AVL a
ra) = z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z_ AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
P AVL a
la a
a AVL a
ra
       {-# INLINE mapAR' #-}
       mapAR' :: z
-> (AVL b -> b -> AVL b -> AVL b)
-> AVL a
-> a
-> AVL a
-> (# z, AVL b #)
mapAR' z
z' AVL b -> b -> AVL b -> AVL b
c AVL a
la a
a AVL a
ra = case z -> AVL a -> (# z, AVL b #)
mapAR z
z' AVL a
ra of
                             UBT2(zr,rb) -> case z -> a -> (# z, b #)
f z
zr a
a of
                                            UBT2(za,b) -> case z -> AVL a -> (# z, AVL b #)
mapAR z
za AVL a
la of
                                                          UBT2(zl,lb) -> UBT2(zlAVL b -> b -> AVL b -> AVL b
, c lb b rb)

--------------------------------------
-- | Convert a list of known length into an AVL tree, such that the head of the list becomes
-- the leftmost tree element. The resulting tree is flat (and also sorted if the supplied list
-- is sorted in ascending order).
--
-- If the actual length of the list is not the same as the supplied length then
-- an error will be raised.
--
-- Complexity: O(n)
asTreeLenL :: Int -> [e] -> AVL e
asTreeLenL :: forall e. Int -> [e] -> AVL e
asTreeLenL Int
n [e]
es = case AVL () -> [e] -> (# AVL e, [e] #)
forall {e} {e}. AVL e -> [e] -> (# AVL e, [e] #)
subst (Int -> () -> AVL ()
forall e. Int -> e -> AVL e
replicate Int
n ()) [e]
es of
                  UBT2(tree,es_) -> case [e]
es_ of
                                    [] -> AVL e
tree
                                    [e]
_  -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"asTreeLenL: List too long."
 where
 -- Substitute template values for real values taken from the list
 subst :: AVL e -> [e] -> (# AVL e, [e] #)
subst  AVL e
E        [e]
as = UBT2(E,as)
 subst (N AVL e
l e
_ AVL e
r) [e]
as = (AVL e -> e -> AVL e -> AVL e)
-> AVL e -> AVL e -> [e] -> (# AVL e, [e] #)
subst' AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l AVL e
r [e]
as
 subst (Z AVL e
l e
_ AVL e
r) [e]
as = (AVL e -> e -> AVL e -> AVL e)
-> AVL e -> AVL e -> [e] -> (# AVL e, [e] #)
subst' AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l AVL e
r [e]
as
 subst (P AVL e
l e
_ AVL e
r) [e]
as = (AVL e -> e -> AVL e -> AVL e)
-> AVL e -> AVL e -> [e] -> (# AVL e, [e] #)
subst' AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l AVL e
r [e]
as
 {-# INLINE subst' #-}
 subst' :: (AVL e -> e -> AVL e -> AVL e)
-> AVL e -> AVL e -> [e] -> (# AVL e, [e] #)
subst' AVL e -> e -> AVL e -> AVL e
f AVL e
l AVL e
r [e]
as = case AVL e -> [e] -> (# AVL e, [e] #)
subst AVL e
l [e]
as of
                   UBT2(l_,xs) -> case [e]
xs of
                                  e
a:[e]
as' -> case AVL e -> [e] -> (# AVL e, [e] #)
subst AVL e
r [e]
as' of
                                           UBT2(r_,as__) -> let t_ :: AVL e
t_ = AVL e -> e -> AVL e -> AVL e
f AVL e
l_ e
a AVL e
r_
                                                            in AVL e
t_ AVL e -> (# AVL e, [e] #) -> (# AVL e, [e] #)
forall a b. a -> b -> b
`seq` UBT2(t_,as__)
                                  []    -> [Char] -> (# AVL e, [e] #)
forall a. HasCallStack => [Char] -> a
error [Char]
"asTreeLenL: List too short."


-- | As 'asTreeLenL', except the length of the list is calculated internally, not supplied
-- as an argument.
--
-- Complexity: O(n)
asTreeL :: [e] -> AVL e
asTreeL :: forall e. [e] -> AVL e
asTreeL [e]
es = Int -> [e] -> AVL e
forall e. Int -> [e] -> AVL e
asTreeLenL ([e] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
es) [e]
es

-- | Convert a list of known length into an AVL tree, such that the head of the list becomes
-- the rightmost tree element. The resulting tree is flat (and also sorted if the supplied list
-- is sorted in descending order).
--
-- If the actual length of the list is not the same as the supplied length then
-- an error will be raised.
--
-- Complexity: O(n)
asTreeLenR :: Int -> [e] -> AVL e
asTreeLenR :: forall e. Int -> [e] -> AVL e
asTreeLenR Int
n [e]
es = case AVL () -> [e] -> (# AVL e, [e] #)
forall {e} {e}. AVL e -> [e] -> (# AVL e, [e] #)
subst (Int -> () -> AVL ()
forall e. Int -> e -> AVL e
replicate Int
n ()) [e]
es of
                  UBT2(tree,es_) -> case [e]
es_ of
                                    [] -> AVL e
tree
                                    [e]
_  -> [Char] -> AVL e
forall a. HasCallStack => [Char] -> a
error [Char]
"asTreeLenR: List too long."
 where
 -- Substitute template values for real values taken from the list
 subst :: AVL e -> [e] -> (# AVL e, [e] #)
subst  AVL e
E        [e]
as = UBT2(E,as)
 subst (N AVL e
l e
_ AVL e
r) [e]
as = (AVL e -> e -> AVL e -> AVL e)
-> AVL e -> AVL e -> [e] -> (# AVL e, [e] #)
subst' AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
N AVL e
l AVL e
r [e]
as
 subst (Z AVL e
l e
_ AVL e
r) [e]
as = (AVL e -> e -> AVL e -> AVL e)
-> AVL e -> AVL e -> [e] -> (# AVL e, [e] #)
subst' AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL e
l AVL e
r [e]
as
 subst (P AVL e
l e
_ AVL e
r) [e]
as = (AVL e -> e -> AVL e -> AVL e)
-> AVL e -> AVL e -> [e] -> (# AVL e, [e] #)
subst' AVL e -> e -> AVL e -> AVL e
forall e. AVL e -> e -> AVL e -> AVL e
P AVL e
l AVL e
r [e]
as
 {-# INLINE subst' #-}
 subst' :: (AVL e -> e -> AVL e -> AVL e)
-> AVL e -> AVL e -> [e] -> (# AVL e, [e] #)
subst' AVL e -> e -> AVL e -> AVL e
f AVL e
l AVL e
r [e]
as = case AVL e -> [e] -> (# AVL e, [e] #)
subst AVL e
r [e]
as of
                   UBT2(r_,xs) -> case [e]
xs of
                                  e
a:[e]
as' -> case AVL e -> [e] -> (# AVL e, [e] #)
subst AVL e
l [e]
as' of
                                           UBT2(l_,as__) -> let t_ :: AVL e
t_ = AVL e -> e -> AVL e -> AVL e
f AVL e
l_ e
a AVL e
r_
                                                            in AVL e
t_ AVL e -> (# AVL e, [e] #) -> (# AVL e, [e] #)
forall a b. a -> b -> b
`seq` UBT2(t_,as__)
                                  []    -> [Char] -> (# AVL e, [e] #)
forall a. HasCallStack => [Char] -> a
error [Char]
"asTreeLenR: List too short."

-- | As 'asTreeLenR', except the length of the list is calculated internally, not supplied
-- as an argument.
--
-- Complexity: O(n)
asTreeR :: [e] -> AVL e
asTreeR :: forall e. [e] -> AVL e
asTreeR [e]
es = Int -> [e] -> AVL e
forall e. Int -> [e] -> AVL e
asTreeLenR ([e] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
es) [e]
es

-- | Reverse an AVL tree (swaps and reverses left and right sub-trees).
-- The resulting tree is the mirror image of the original.
--
-- Complexity: O(n)
reverse :: AVL e -> AVL e
reverse :: forall e. AVL e -> AVL e
reverse  AVL e
E        = AVL e
forall e. AVL e
E
reverse (N AVL e
l e
e AVL e
r) = let l' :: AVL e
l' = AVL e -> AVL e
forall e. AVL e -> AVL e
reverse AVL e
l
                        r' :: AVL e
r' = AVL e -> AVL e
forall e. AVL e -> AVL e
reverse AVL e
r
                    in  AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` 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
r' e
e AVL e
l'
reverse (Z AVL e
l e
e AVL e
r) = let l' :: AVL e
l' = AVL e -> AVL e
forall e. AVL e -> AVL e
reverse AVL e
l
                        r' :: AVL e
r' = AVL e -> AVL e
forall e. AVL e -> AVL e
reverse AVL e
r
                    in  AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` 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
r' e
e AVL e
l'
reverse (P AVL e
l e
e AVL e
r) = let l' :: AVL e
l' = AVL e -> AVL e
forall e. AVL e -> AVL e
reverse AVL e
l
                        r' :: AVL e
r' = AVL e -> AVL e
forall e. AVL e -> AVL e
reverse AVL e
r
                    in  AVL e
l' AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` 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
r' e
e AVL e
l'

-- | Apply a function to every element in an AVL tree. This function preserves the tree shape.
-- There is also a strict version of this function ('map'').
--
-- N.B. If the tree is sorted the result of this operation will only be sorted if
-- the applied function preserves ordering (for some suitable ordering definition).
--
-- Complexity: O(n)
map :: (a -> b) -> AVL a -> AVL b
map :: forall a b. (a -> b) -> AVL a -> AVL b
map a -> b
f = AVL a -> AVL b
mp where
 mp :: AVL a -> AVL b
mp  AVL a
E        = AVL b
forall e. AVL e
E
 mp (N AVL a
l a
a AVL a
r) = let l' :: AVL b
l' = AVL a -> AVL b
mp AVL a
l
                    r' :: AVL b
r' = AVL a -> AVL b
mp AVL a
r
                in  AVL b
l' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b
r' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
N AVL b
l' (a -> b
f a
a) AVL b
r'
 mp (Z AVL a
l a
a AVL a
r) = let l' :: AVL b
l' = AVL a -> AVL b
mp AVL a
l
                    r' :: AVL b
r' = AVL a -> AVL b
mp AVL a
r
                in  AVL b
l' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b
r' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL b
l' (a -> b
f a
a) AVL b
r'
 mp (P AVL a
l a
a AVL a
r) = let l' :: AVL b
l' = AVL a -> AVL b
mp AVL a
l
                    r' :: AVL b
r' = AVL a -> AVL b
mp AVL a
r
                in  AVL b
l' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b
r' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
P AVL b
l' (a -> b
f a
a) AVL b
r'

-- | Similar to 'map', but the supplied function is applied strictly.
--
-- Complexity: O(n)
map' :: (a -> b) -> AVL a -> AVL b
map' :: forall a b. (a -> b) -> AVL a -> AVL b
map' a -> b
f = AVL a -> AVL b
mp' where
 mp' :: AVL a -> AVL b
mp'  AVL a
E        = AVL b
forall e. AVL e
E
 mp' (N AVL a
l a
a AVL a
r) = let l' :: AVL b
l' = AVL a -> AVL b
mp' AVL a
l
                     r' :: AVL b
r' = AVL a -> AVL b
mp' AVL a
r
                     b :: b
b  = a -> b
f a
a
                 in  b
b b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b
l' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b
r' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
N AVL b
l' b
b AVL b
r'
 mp' (Z AVL a
l a
a AVL a
r) = let l' :: AVL b
l' = AVL a -> AVL b
mp' AVL a
l
                     r' :: AVL b
r' = AVL a -> AVL b
mp' AVL a
r
                     b :: b
b  = a -> b
f a
a
                 in  b
b b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b
l' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b
r' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
Z AVL b
l' b
b AVL b
r'
 mp' (P AVL a
l a
a AVL a
r) = let l' :: AVL b
l' = AVL a -> AVL b
mp' AVL a
l
                     r' :: AVL b
r' = AVL a -> AVL b
mp' AVL a
r
                     b :: b
b  = a -> b
f a
a
                 in  b
b b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b
l' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b
r' AVL b -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
P AVL b
l' b
b AVL b
r'


-- | Construct a flat AVL tree of size n (n>=0), where all elements are identical.
--
-- Complexity: O(log n)
replicate :: Int -> e -> AVL e
replicate :: forall e. Int -> e -> AVL e
replicate Int
m e
e = Int -> AVL e
forall {a}. (Integral a, Bits a) => a -> AVL e
rep Int
m where -- Functional spaghetti follows :-)
 rep :: a -> AVL e
rep a
n | a -> Bool
forall a. Integral a => a -> Bool
odd a
n = a -> AVL e
repOdd a
n -- n is odd , >=1
 rep a
n         = a -> AVL e
repEvn a
n -- n is even, >=0
 -- n is known to be odd (>=1), so left and right sub-trees are identical
 repOdd :: a -> AVL e
repOdd a
n      = let sub :: AVL e
sub = a -> AVL e
rep (a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) in AVL e
sub 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
sub e
e AVL e
sub
 -- n is known to be even (>=0)
 repEvn :: a -> AVL e
repEvn a
n | a
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a -> AVL e
forall {a}. (Num a, Bits a) => a -> AVL e
repP2 a
n -- treat exact powers of 2 specially, traps n=0 too
 repEvn a
n      = let nl :: a
nl = a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1 -- size of left subtree  (odd or even)
                     nr :: a
nr = a
nl a -> a -> a
forall a. Num a => a -> a -> a
- a
1       -- size of right subtree (even or odd)
                 in if a -> Bool
forall a. Integral a => a -> Bool
odd a
nr
                    then let l :: AVL e
l = a -> AVL e
repEvn a
nl           -- right sub-tree is odd , so left is even (>=2)
                             r :: AVL e
r = a -> AVL e
repOdd a
nr
                         in AVL e
l AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` 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
                    else let l :: AVL e
l = a -> AVL e
repOdd a
nl           -- right sub-tree is even, so left is odd (>=2)
                             r :: AVL e
r = a -> AVL e
repEvn a
nr
                         in AVL e
l AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` 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
 -- n is an exact power of 2 (or 0), I.E. 0,1,2,4,8,16..
 repP2 :: a -> AVL e
repP2 a
0       = AVL e
forall e. AVL e
E
 repP2 a
1       = 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
forall e. AVL e
E
 repP2 a
n       = let nl :: a
nl = a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1 -- nl is also an exact power of 2
                     nr :: a
nr = a
nl a -> a -> a
forall a. Num a => a -> a -> a
- a
1       -- nr is one less that an exact power of 2
                     l :: AVL e
l  = a -> AVL e
repP2 a
nl
                     r :: AVL e
r  = a -> AVL e
forall {a}. (Num a, Bits a) => a -> AVL e
repP2M1 a
nr
                 in  AVL e
l AVL e -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` 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 -- BF=+1
 -- n is one less than an exact power of 2, I.E. 0,1,3,7,15..
 repP2M1 :: a -> AVL e
repP2M1 a
0     = AVL e
forall e. AVL e
E
 repP2M1 a
n     = let sub :: AVL e
sub = a -> AVL e
repP2M1 (a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) in AVL e
sub 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
sub e
e AVL e
sub

-- | Flatten an AVL tree, preserving the ordering of the tree elements.
--
-- Complexity: O(n)
flatten :: AVL e -> AVL e
flatten :: forall e. AVL e -> AVL e
flatten AVL e
t = Int -> [e] -> AVL e
forall e. Int -> [e] -> AVL e
asTreeLenL (AVL e -> Int
forall e. AVL e -> Int
size AVL e
t) (AVL e -> [e]
forall e. AVL e -> [e]
asListL AVL e
t)

-- | Similar to 'flatten', but the tree elements are reversed. This function has higher constant
-- factor overhead than 'reverse'.
--
-- Complexity: O(n)
flatReverse :: AVL e -> AVL e
flatReverse :: forall e. AVL e -> AVL e
flatReverse AVL e
t = Int -> [e] -> AVL e
forall e. Int -> [e] -> AVL e
asTreeLenL (AVL e -> Int
forall e. AVL e -> Int
size AVL e
t) (AVL e -> [e]
forall e. AVL e -> [e]
asListR AVL e
t)

-- | Similar to 'map', but the resulting tree is flat.
-- This function has higher constant factor overhead than 'map'.
--
-- Complexity: O(n)
flatMap :: (a -> b) -> AVL a -> AVL b
flatMap :: forall a b. (a -> b) -> AVL a -> AVL b
flatMap a -> b
f AVL a
t = Int -> [b] -> AVL b
forall e. Int -> [e] -> AVL e
asTreeLenL (AVL a -> Int
forall e. AVL e -> Int
size AVL a
t) ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
List.map a -> b
f (AVL a -> [a]
forall e. AVL e -> [e]
asListL AVL a
t))

-- | Same as 'flatMap', but the supplied function is applied strictly.
--
-- Complexity: O(n)
flatMap' :: (a -> b) -> AVL a -> AVL b
flatMap' :: forall a b. (a -> b) -> AVL a -> AVL b
flatMap' a -> b
f AVL a
t = Int -> [b] -> AVL b
forall e. Int -> [e] -> AVL e
asTreeLenL (AVL a -> Int
forall e. AVL e -> Int
size AVL a
t) ((a -> b) -> [a] -> [b]
mp' a -> b
f (AVL a -> [a]
forall e. AVL e -> [e]
asListL AVL a
t)) where
 mp' :: (a -> b) -> [a] -> [b]
mp' a -> b
_ []     = []
 mp' a -> b
g (a
a:[a]
as) = let b :: b
b = a -> b
g a
a in b
b b -> [b] -> [b]
forall a b. a -> b -> b
`seq` (b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (a -> b) -> [a] -> [b]
mp' a -> b
f [a]
as)

-- | Remove all AVL tree elements which do not satisfy the supplied predicate.
-- Element ordering is preserved. The resulting tree is flat.
-- See 'filter' for an alternative implementation which is probably more efficient.
--
-- Complexity: O(n)
filterViaList :: (e -> Bool) -> AVL e -> AVL e
filterViaList :: forall e. (e -> Bool) -> AVL e -> AVL e
filterViaList e -> Bool
p AVL e
t = [e] -> Int -> [e] -> AVL e
filter' [] Int
0 (AVL e -> [e]
forall e. AVL e -> [e]
asListR AVL e
t) where
 filter' :: [e] -> Int -> [e] -> AVL e
filter' [e]
se Int
n []     = Int -> [e] -> AVL e
forall e. Int -> [e] -> AVL e
asTreeLenL Int
n [e]
se
 filter' [e]
se Int
n (e
e:[e]
es) = if e -> Bool
p e
e then  let n' :: Int
n'=Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1  in  Int
n' Int -> AVL e -> AVL e
forall a b. a -> b -> b
`seq` [e] -> Int -> [e] -> AVL e
filter' (e
ee -> [e] -> [e]
forall a. a -> [a] -> [a]
:[e]
se) Int
n' [e]
es
                              else  [e] -> Int -> [e] -> AVL e
filter' [e]
se Int
n [e]
es

-- | Remove all AVL tree elements which do not satisfy the supplied predicate.
-- Element ordering is preserved.
--
-- Complexity: O(n)
filter :: forall e. (e -> Bool) -> AVL e -> AVL e
filter :: forall e. (e -> Bool) -> AVL e -> AVL e
filter e -> Bool
p AVL e
t0 = case Int# -> AVL e -> (# Bool, AVL e, Int# #)
filter_ L(0) t0 of UBT3(_,t_,_) -> t_  -- Work with relative heights!!
 where
    filter_ :: UINT -> AVL e -> UBT3(Bool, AVL e, UINT)
    filter_ :: Int# -> AVL e -> (# Bool, AVL e, Int# #)
filter_ Int#
h AVL e
t = case AVL e
t of
                     AVL e
E       -> UBT3(False,Int#
E,h)
                     N AVL e
l e
e AVL e
r -> AVL e -> Int# -> e -> AVL e -> Int# -> (# Bool, AVL e, Int# #)
f AVL e
l DECINT2(h) e r DECINT1(h)
                     Z AVL e
l e
e AVL e
r -> AVL e -> Int# -> e -> AVL e -> Int# -> (# Bool, AVL e, Int# #)
f AVL e
l DECINT1(h) e r DECINT1(h)
                     P AVL e
l e
e AVL e
r -> AVL e -> Int# -> e -> AVL e -> Int# -> (# Bool, AVL e, Int# #)
f AVL e
l DECINT1(h) e r DECINT2(h)
        where f :: AVL e -> Int# -> e -> AVL e -> Int# -> (# Bool, AVL e, Int# #)
f AVL e
l Int#
hl e
e AVL e
r Int#
hr =                     case Int# -> AVL e -> (# Bool, AVL e, Int# #)
filter_ Int#
hl AVL e
l of
                              UBT3(bl,l_,hl_)  -> case Int# -> AVL e -> (# Bool, AVL e, Int# #)
filter_ Int#
hr AVL e
r of
                               UBT3(br,r_,hr_) -> if e -> Bool
p e
e
                                                  then if Bool
bl Bool -> Bool -> Bool
|| Bool
br
                                                       then 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_,h_) -> UBT3(True,t_,h_)
                                                       else UBT3(False,Int#
t,h)
                                                  else 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_,h_) -> UBT3(True,t_,h_)

-- | Partition an AVL tree using the supplied predicate. The first AVL tree in the
-- resulting pair contains all elements for which the predicate is True, the second
-- contains all those for which the predicate is False. Element ordering is preserved.
-- Both of the resulting trees are flat.
--
-- Complexity: O(n)
partition :: (e -> Bool) -> AVL e -> (AVL e, AVL e)
partition :: forall e. (e -> Bool) -> AVL e -> (AVL e, AVL e)
partition e -> Bool
p AVL e
t = Int -> [e] -> Int -> [e] -> [e] -> (AVL e, AVL e)
part Int
0 [] Int
0 [] (AVL e -> [e]
forall e. AVL e -> [e]
asListR AVL e
t) where
 part :: Int -> [e] -> Int -> [e] -> [e] -> (AVL e, AVL e)
part Int
nT [e]
lstT Int
nF [e]
lstF []     = let avlT :: AVL e
avlT = Int -> [e] -> AVL e
forall e. Int -> [e] -> AVL e
asTreeLenL Int
nT [e]
lstT
                                   avlF :: AVL e
avlF = Int -> [e] -> AVL e
forall e. Int -> [e] -> AVL e
asTreeLenL Int
nF [e]
lstF
                               in (AVL e
avlT,AVL e
avlF) -- Non strict in avlT, avlF !!
 part Int
nT [e]
lstT Int
nF [e]
lstF (e
e:[e]
es) = if e -> Bool
p e
e then let nT' :: Int
nT'=Int
nTInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 in Int
nT' Int -> (AVL e, AVL e) -> (AVL e, AVL e)
forall a b. a -> b -> b
`seq` Int -> [e] -> Int -> [e] -> [e] -> (AVL e, AVL e)
part Int
nT' (e
ee -> [e] -> [e]
forall a. a -> [a] -> [a]
:[e]
lstT) Int
nF     [e]
lstF  [e]
es
                                      else let nF' :: Int
nF'=Int
nFInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 in Int
nF' Int -> (AVL e, AVL e) -> (AVL e, AVL e)
forall a b. a -> b -> b
`seq` Int -> [e] -> Int -> [e] -> [e] -> (AVL e, AVL e)
part Int
nT     [e]
lstT  Int
nF' (e
ee -> [e] -> [e]
forall a. a -> [a] -> [a]
:[e]
lstF) [e]
es

-- | Remove all AVL tree elements for which the supplied function returns 'Nothing'.
-- Element ordering is preserved. The resulting tree is flat.
-- See 'mapMaybe' for an alternative implementation which is probably more efficient.
--
-- Complexity: O(n)
mapMaybeViaList :: (a -> Maybe b) -> AVL a -> AVL b
mapMaybeViaList :: forall a b. (a -> Maybe b) -> AVL a -> AVL b
mapMaybeViaList a -> Maybe b
f AVL a
t = [b] -> Int -> [a] -> AVL b
mp' [] Int
0 (AVL a -> [a]
forall e. AVL e -> [e]
asListR AVL a
t) where
 mp' :: [b] -> Int -> [a] -> AVL b
mp' [b]
sb Int
n []     = Int -> [b] -> AVL b
forall e. Int -> [e] -> AVL e
asTreeLenL Int
n [b]
sb
 mp' [b]
sb Int
n (a
a:[a]
as) = case a -> Maybe b
f a
a of
                   Just b
b  -> let n' :: Int
n'=Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1  in  Int
n' Int -> AVL b -> AVL b
forall a b. a -> b -> b
`seq` [b] -> Int -> [a] -> AVL b
mp' (b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
sb) Int
n' [a]
as
                   Maybe b
Nothing -> [b] -> Int -> [a] -> AVL b
mp' [b]
sb Int
n [a]
as

-- | Remove all AVL tree elements for which the supplied function returns 'Nothing'.
-- Element ordering is preserved.
--
-- Complexity: O(n)
mapMaybe :: forall a b. (a -> Maybe b) -> AVL a -> AVL b
mapMaybe :: forall a b. (a -> Maybe b) -> AVL a -> AVL b
mapMaybe a -> Maybe b
f AVL a
t0 = case Int# -> AVL a -> (# AVL b, Int# #)
mapMaybe_ L(0) t0 of UBT2(t_,_) -> t_  -- Work with relative heights!!
 where
    mapMaybe_ :: UINT -> AVL a -> UBT2(AVL b, UINT)
    mapMaybe_ :: Int# -> AVL a -> (# AVL b, Int# #)
mapMaybe_ Int#
h AVL a
t = case AVL a
t of
                       AVL a
E       -> UBT2(Int#
E,h)
                       N AVL a
l a
a AVL a
r -> AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL b, Int# #)
m AVL a
l DECINT2(h) a r DECINT1(h)
                       Z AVL a
l a
a AVL a
r -> AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL b, Int# #)
m AVL a
l DECINT1(h) a r DECINT1(h)
                       P AVL a
l a
a AVL a
r -> AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL b, Int# #)
m AVL a
l DECINT1(h) a r DECINT2(h)
        where m :: AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL b, Int# #)
m AVL a
l Int#
hl a
a AVL a
r Int#
hr =                  case Int# -> AVL a -> (# AVL b, Int# #)
mapMaybe_ Int#
hl AVL a
l of
                              UBT2(l_,hl_)  -> case Int# -> AVL a -> (# AVL b, Int# #)
mapMaybe_ Int#
hr AVL a
r of
                               UBT2(r_,hr_) -> case a -> Maybe b
f a
a of
                                               Just b
b  -> AVL b -> Int# -> b -> AVL b -> Int# -> (# AVL b, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL b
l_ Int#
hl_ b
b AVL b
r_ Int#
hr_
                                               Maybe b
Nothing ->   AVL b -> Int# -> AVL b -> Int# -> (# AVL b, Int# #)
forall e. AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
joinH AVL b
l_ Int#
hl_   AVL b
r_ Int#
hr_

-- | Invokes 'pushList' on the empty AVL tree.
--
-- Complexity: O(n.(log n))
asTree :: (e -> e -> COrdering e) -> [e] -> AVL e
asTree :: forall e. (e -> e -> COrdering e) -> [e] -> AVL e
asTree e -> e -> COrdering e
c = (e -> e -> COrdering e) -> AVL e -> [e] -> AVL e
forall e. (e -> e -> COrdering e) -> AVL e -> [e] -> AVL e
pushList e -> e -> COrdering e
c AVL e
forall e. AVL e
empty
{-# INLINE asTree #-}

-- | Push the elements of an unsorted List in a sorted AVL tree using the supplied combining comparison.
--
-- Complexity: O(n.(log (m+n))) where n is the list length, m is the tree size.
pushList :: (e -> e -> COrdering e) -> AVL e -> [e] -> AVL e
pushList :: forall e. (e -> e -> COrdering e) -> AVL e -> [e] -> AVL e
pushList e -> e -> COrdering e
c AVL e
avl = (AVL e -> e -> AVL e) -> AVL e -> [e] -> AVL e
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' AVL e -> e -> AVL e
addElem AVL e
avl
 where addElem :: AVL e -> e -> AVL e
addElem AVL e
t e
e = (e -> COrdering e) -> e -> AVL e -> AVL e
forall e. (e -> COrdering e) -> e -> AVL e -> AVL e
push (e -> e -> COrdering e
c e
e) e
e AVL e
t

-- | A fast alternative implementation for 'Data.List.nub'.
-- Deletes all but the first occurrence of an element from the input list.
--
-- Complexity: O(n.(log n))
nub :: Ord a => [a] -> [a]
nub :: forall a. Ord a => [a] -> [a]
nub = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE nub #-}

-- | A fast alternative implementation for 'Data.List.nubBy'.
-- Deletes all but the first occurrence of an element from the input list.
--
-- Complexity: O(n.(log n))
nubBy :: (a -> a -> Ordering) -> [a] -> [a]
nubBy :: forall a. (a -> a -> Ordering) -> [a] -> [a]
nubBy a -> a -> Ordering
c = AVL a -> [a] -> [a]
nubbit AVL a
forall e. AVL e
E where
 nubbit :: AVL a -> [a] -> [a]
nubbit AVL a
_   []     = []
 nubbit AVL a
avl (a
a:[a]
as) = case (a -> Ordering) -> AVL a -> Int#
forall e. (e -> Ordering) -> AVL e -> Int#
findEmptyPath (a -> a -> Ordering
c a
a) AVL a
avl of
                     L(-1) -> nubbit avl as                  -- Already encountered
                     Int#
p     -> let avl' :: AVL a
avl' = Int# -> a -> AVL a -> AVL a
forall e. Int# -> e -> AVL e -> AVL e
insertPath Int#
p a
a AVL a
avl  -- First encounter
                              in AVL a
avl' AVL a -> [a] -> [a]
forall a b. a -> b -> b
`seq` (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: AVL a -> [a] -> [a]
nubbit AVL a
avl' [a]
as)

-- | This is the non-overloaded version of the 'Data.Traversable.traverse' method for AVL trees.
traverseAVL :: Applicative f => (a -> f b) -> AVL a -> f (AVL b)
traverseAVL :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AVL a -> f (AVL b)
traverseAVL a -> f b
_f AVL a
E = AVL b -> f (AVL b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AVL b
forall e. AVL e
E
traverseAVL a -> f b
f (N AVL a
l a
v AVL a
r) = AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
N (AVL b -> b -> AVL b -> AVL b)
-> f (AVL b) -> f (b -> AVL b -> AVL b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> AVL a -> f (AVL b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AVL a -> f (AVL b)
traverseAVL a -> f b
f AVL a
l f (b -> AVL b -> AVL b) -> f b -> f (AVL b -> AVL b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
v f (AVL b -> AVL b) -> f (AVL b) -> f (AVL b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> AVL a -> f (AVL b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AVL a -> f (AVL b)
traverseAVL a -> f b
f AVL a
r
traverseAVL a -> f b
f (Z AVL a
l a
v AVL a
r) = AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
Z (AVL b -> b -> AVL b -> AVL b)
-> f (AVL b) -> f (b -> AVL b -> AVL b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> AVL a -> f (AVL b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AVL a -> f (AVL b)
traverseAVL a -> f b
f AVL a
l f (b -> AVL b -> AVL b) -> f b -> f (AVL b -> AVL b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
v f (AVL b -> AVL b) -> f (AVL b) -> f (AVL b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> AVL a -> f (AVL b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AVL a -> f (AVL b)
traverseAVL a -> f b
f AVL a
r
traverseAVL a -> f b
f (P AVL a
l a
v AVL a
r) = AVL b -> b -> AVL b -> AVL b
forall e. AVL e -> e -> AVL e -> AVL e
P (AVL b -> b -> AVL b -> AVL b)
-> f (AVL b) -> f (b -> AVL b -> AVL b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> AVL a -> f (AVL b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AVL a -> f (AVL b)
traverseAVL a -> f b
f AVL a
l f (b -> AVL b -> AVL b) -> f b -> f (AVL b -> AVL b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
v f (AVL b -> AVL b) -> f (AVL b) -> f (AVL b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> AVL a -> f (AVL b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AVL a -> f (AVL b)
traverseAVL a -> f b
f AVL a
r