-- |
-- Copyright   :  (c) Adrian Hey 2004,2005
-- License     :  BSD3
--
{-# OPTIONS_HADDOCK hide #-}
module Data.Tree.AVL.Set
(-- * Set operations
 -- | Functions for manipulating AVL trees which represent ordered sets (I.E. /sorted/ trees).
 -- Note that although many of these functions work with a variety of different element
 -- types they all require that elements are sorted according to the same criterion (such
 -- as a field value in a record).

 -- ** Union
 union,unionMaybe,disjointUnion,unions,

 -- ** Difference
 difference,differenceMaybe,symDifference,

 -- ** Intersection
 intersection,intersectionMaybe,

 -- *** Intersection with the result as a list
 -- | Sometimes you don\'t want intersection to give a tree, particularly if the
 -- resulting elements are not orderered or sorted according to whatever criterion was
 -- used to sort the elements of the input sets.
 --
 -- The reason these variants are provided for intersection only (and not the other
 -- set functions) is that the (tree returning) intersections always construct an entirely
 -- new tree, whereas with the others the resulting tree will typically share sub-trees
 -- with one or both of the originals. (Of course the results of the others can easily be
 -- converted to a list too if required.)
 intersectionToList,intersectionAsList,
 intersectionMaybeToList,intersectionMaybeAsList,

 -- ** \'Venn diagram\' operations
 -- | Given two sets A and B represented as sorted AVL trees, the venn operations evaluate
 -- components @A-B@, @A.B@ and @B-A@. The intersection part may be obtained as a List
 -- rather than AVL tree if required.
 --
 -- Note that in all cases the three resulting sets are /disjoint/ and can safely be re-combined
 -- after most \"munging\" operations using 'disjointUnion'.
 venn,vennMaybe,

 -- *** \'Venn diagram\' operations with the intersection component as a List.
 -- | These variants are provided for the same reasons as the Intersection as List variants.
 vennToList,vennAsList,
 vennMaybeToList,vennMaybeAsList,

 -- ** Subset
 isSubsetOf,isSubsetOfBy,
) where

import Prelude -- so haddock finds the symbols there

import Data.Tree.AVL.Internals.Types(AVL(..))
import Data.Tree.AVL.Height(addHeight)
import Data.Tree.AVL.List(asTreeLenL)
import Data.Tree.AVL.Internals.HJoin(spliceH)
import Data.Tree.AVL.Internals.HSet(unionH,unionMaybeH,disjointUnionH,
                                    intersectionH,intersectionMaybeH,
                                    vennH,vennMaybeH,
                                    differenceH,differenceMaybeH,symDifferenceH)

import Data.COrdering

import GHC.Base
#include "ghcdefs.h"

-- | Uses the supplied combining comparison to evaluate the union of two sets represented as
-- sorted AVL trees. Whenever the combining comparison is applied, the first comparison argument is
-- an element of the first tree and the second comparison argument is an element of the second tree.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
union :: (e -> e -> COrdering e) -> AVL e -> AVL e -> AVL e
union :: forall e. (e -> e -> COrdering e) -> AVL e -> AVL e -> AVL e
union e -> e -> COrdering e
c = AVL e -> AVL e -> AVL e
gu where -- This is to avoid O(log n) height calculation for empty sets
 gu :: AVL e -> AVL e -> AVL e
gu     AVL e
E          AVL e
t1             = AVL e
t1
 gu AVL e
t0                 AVL e
E          = AVL e
t0
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) r1)
 gu_ :: AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 Int#
h0 AVL e
t1 Int#
h1 = case (e -> e -> COrdering e)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
forall e.
(e -> e -> COrdering e)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
unionH e -> e -> COrdering e
c AVL e
t0 Int#
h0 AVL e
t1 Int#
h1 of UBT2(Int#
t,_) -> AVL e
t

-- | Similar to 'union', but the resulting tree does not include elements in cases where
-- the supplied combining comparison returns @(Eq Nothing)@.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
unionMaybe :: (e -> e -> COrdering (Maybe e)) -> AVL e -> AVL e -> AVL e
unionMaybe :: forall e.
(e -> e -> COrdering (Maybe e)) -> AVL e -> AVL e -> AVL e
unionMaybe e -> e -> COrdering (Maybe e)
c = AVL e -> AVL e -> AVL e
gu where -- This is to avoid O(log n) height calculation for empty sets
 gu :: AVL e -> AVL e -> AVL e
gu     AVL e
E          AVL e
t1             = AVL e
t1
 gu AVL e
t0                 AVL e
E          = AVL e
t0
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) r1)
 gu_ :: AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 Int#
h0 AVL e
t1 Int#
h1 = case (e -> e -> COrdering (Maybe e))
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
forall e.
(e -> e -> COrdering (Maybe e))
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
unionMaybeH e -> e -> COrdering (Maybe e)
c AVL e
t0 Int#
h0 AVL e
t1 Int#
h1 of UBT2(Int#
t,_) -> AVL e
t

-- | Uses the supplied comparison to evaluate the union of two /disjoint/ sets represented as
-- sorted AVL trees. It will be slightly faster than 'union' but will raise an error if the
-- two sets intersect. Typically this would be used to re-combine the \"post-munge\" results
-- from one of the \"venn\" operations.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
-- (Faster than Hedge union from Data.Set at any rate).
disjointUnion :: (e -> e -> Ordering) -> AVL e -> AVL e -> AVL e
disjointUnion :: forall e. (e -> e -> Ordering) -> AVL e -> AVL e -> AVL e
disjointUnion e -> e -> Ordering
c = AVL e -> AVL e -> AVL e
gu where -- This is to avoid O(log n) height calculation for empty sets
 gu :: AVL e -> AVL e -> AVL e
gu     AVL e
E          AVL e
t1             = AVL e
t1
 gu AVL e
t0                 AVL e
E          = AVL e
t0
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) r1)
 gu_ :: AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 Int#
h0 AVL e
t1 Int#
h1 = case (e -> e -> Ordering)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
forall e.
(e -> e -> Ordering)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
disjointUnionH e -> e -> Ordering
c AVL e
t0 Int#
h0 AVL e
t1 Int#
h1 of UBT2(Int#
t,_) -> AVL e
t

-- | Uses the supplied combining comparison to evaluate the union of all sets in a list
-- of sets represented as sorted AVL trees. Behaves as if defined..
--
-- @unions ccmp avls = foldl' ('union' ccmp) empty avls@
unions :: (e -> e -> COrdering e) -> [AVL e] -> AVL e
unions :: forall e. (e -> e -> COrdering e) -> [AVL e] -> AVL e
unions e -> e -> COrdering e
c = AVL e -> Int# -> [AVL e] -> AVL e
gus AVL e
forall e. AVL e
E L(0) where
 gus :: AVL e -> Int# -> [AVL e] -> AVL e
gus AVL e
a Int#
_  []                 = AVL e
a
 gus AVL e
a Int#
ha (   AVL e
E       :[AVL e]
avls) = AVL e -> Int# -> [AVL e] -> AVL e
gus AVL e
a Int#
ha [AVL e]
avls
 gus AVL e
a Int#
ha (t :: AVL e
t@(N AVL e
l e
_ AVL e
_):[AVL e]
avls) = case (e -> e -> COrdering e)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
forall e.
(e -> e -> COrdering e)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
unionH e -> e -> COrdering e
c AVL e
a Int#
ha AVL e
t (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2AVL e
) l) of UBT2(a_,ha_) -> gus a_ ha_ avls
 gus AVL e
a Int#
ha (t :: AVL e
t@(Z AVL e
l e
_ AVL e
_):[AVL e]
avls) = case (e -> e -> COrdering e)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
forall e.
(e -> e -> COrdering e)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
unionH e -> e -> COrdering e
c AVL e
a Int#
ha AVL e
t (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1AVL e
) l) of UBT2(a_,ha_) -> gus a_ ha_ avls
 gus AVL e
a Int#
ha (t :: AVL e
t@(P AVL e
_ e
_ AVL e
r):[AVL e]
avls) = case (e -> e -> COrdering e)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
forall e.
(e -> e -> COrdering e)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
unionH e -> e -> COrdering e
c AVL e
a Int#
ha AVL e
t (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2AVL e
) r) of UBT2(a_,ha_) -> gus a_ ha_ avls

-- | Uses the supplied combining comparison to evaluate the intersection of two sets represented as
-- sorted AVL trees.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
intersection :: (a -> b -> COrdering c) -> AVL a -> AVL b -> AVL c
intersection :: forall a b c. (a -> b -> COrdering c) -> AVL a -> AVL b -> AVL c
intersection a -> b -> COrdering c
c AVL a
t0 AVL b
t1 = case (a -> b -> COrdering c) -> AVL a -> AVL b -> (# AVL c, Int# #)
forall a b c.
(a -> b -> COrdering c) -> AVL a -> AVL b -> (# AVL c, Int# #)
intersectionH a -> b -> COrdering c
c AVL a
t0 AVL b
t1 of UBT2(Int#
t,_) -> AVL c
t

-- | Similar to 'intersection', but the resulting tree does not include elements in cases where
-- the supplied combining comparison returns @(Eq Nothing)@.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
intersectionMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> AVL c
intersectionMaybe :: forall a b c.
(a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> AVL c
intersectionMaybe a -> b -> COrdering (Maybe c)
c AVL a
t0 AVL b
t1 = case (a -> b -> COrdering (Maybe c))
-> AVL a -> AVL b -> (# AVL c, Int# #)
forall a b c.
(a -> b -> COrdering (Maybe c))
-> AVL a -> AVL b -> (# AVL c, Int# #)
intersectionMaybeH a -> b -> COrdering (Maybe c)
c AVL a
t0 AVL b
t1 of UBT2(Int#
t,_) -> AVL c
t

-- | Similar to 'intersection', but prepends the result to the supplied list in
-- ascending order. This is a (++) free function which behaves as if defined:
--
-- @intersectionToList c setA setB cs = asListL (intersection c setA setB) ++ cs@
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
intersectionToList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c] -> [c]
intersectionToList :: forall a b c.
(a -> b -> COrdering c) -> AVL a -> AVL b -> [c] -> [c]
intersectionToList a -> b -> COrdering c
comp = AVL a -> AVL b -> [c] -> [c]
i where
 -- i :: AVL a -> AVL b -> [c] -> [c]
 i :: AVL a -> AVL b -> [c] -> [c]
i  AVL a
E            AVL b
_           [c]
cs = [c]
cs
 i  AVL a
_            AVL b
E           [c]
cs = [c]
cs
 i (N AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (N AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (N AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (Z AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (Z AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (Z AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (P AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (P AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (P AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i' :: AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs =
  case a -> b -> COrdering c
comp a
e0 b
e1 of
  -- e0 < e1, so (l0 < e0 < e1) & (e0 < e1 < r1)
  COrdering c
Lt   ->                            case AVL a -> b -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR AVL a
r0 b
e1 of
          UBT5(rl0,_,mbc1,rr0,_)  -> case a -> AVL b -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL a
e0 AVL b
l1 of -- (e0  < rl0 < e1) & (e0 < e1  < rr0)
           UBT5(ll1,_,mbc0,lr1,_) ->                     -- (ll1 < e0  < e1) & (e0 < lr1 < e1)
            -- (l0 + ll1) < e0 < (rl0 + lr1) < e1 < (rr0 + r1)
            let cs' :: [c]
cs'  = AVL a -> AVL b -> [c] -> [c]
i AVL a
rr0 AVL b
r1 [c]
cs
                cs'' :: [c]
cs'' = [c]
cs'  [c] -> [c] -> [c]
forall a b. a -> b -> b
`seq` case Maybe c
mbc1 of
                                  Maybe c
Nothing -> AVL a -> AVL b -> [c] -> [c]
i AVL a
rl0 AVL b
lr1 [c]
cs'
                                  Just c
c1 -> AVL a -> AVL b -> [c] -> [c]
i AVL a
rl0 AVL b
lr1 (c
c1c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs')
            in         [c]
cs'' [c] -> [c] -> [c]
forall a b. a -> b -> b
`seq` case Maybe c
mbc0 of
                                  Maybe c
Nothing -> AVL a -> AVL b -> [c] -> [c]
i AVL a
l0 AVL b
ll1 [c]
cs''
                                  Just c
c0 -> AVL a -> AVL b -> [c] -> [c]
i AVL a
l0 AVL b
ll1 (c
c0c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs'')
  -- e0 = e1
  Eq c
c -> let cs' :: [c]
cs' = AVL a -> AVL b -> [c] -> [c]
i AVL a
r0 AVL b
r1 [c]
cs in [c]
cs' [c] -> [c] -> [c]
forall a b. a -> b -> b
`seq` AVL a -> AVL b -> [c] -> [c]
i AVL a
l0 AVL b
l1 (c
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs')
  -- e1 < e0, so (l1 < e1 < e0) & (e1 < e0 < r0)
  COrdering c
Gt   ->                            case a -> AVL b -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL a
e0 AVL b
r1 of
          UBT5(rl1,_,mbc0,rr1,_)  -> case AVL a -> b -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR AVL a
l0 b
e1 of -- (e1  < rl1 < e0) & (e1 < e0  < rr1)
           UBT5(ll0,_,mbc1,lr0,_) ->                     -- (ll0 < e1  < e0) & (e1 < lr0 < e0)
            -- (ll0 + l1) < e1 < (lr0 + rl1) < e0 < (r0 + rr1)
            let cs' :: [c]
cs'  = AVL a -> AVL b -> [c] -> [c]
i AVL a
r0 AVL b
rr1 [c]
cs
                cs'' :: [c]
cs'' = [c]
cs'  [c] -> [c] -> [c]
forall a b. a -> b -> b
`seq` case Maybe c
mbc0 of
                                  Maybe c
Nothing -> AVL a -> AVL b -> [c] -> [c]
i AVL a
lr0 AVL b
rl1 [c]
cs'
                                  Just c
c0 -> AVL a -> AVL b -> [c] -> [c]
i AVL a
lr0 AVL b
rl1 (c
c0c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs')
            in         [c]
cs'' [c] -> [c] -> [c]
forall a b. a -> b -> b
`seq` case Maybe c
mbc1 of
                                  Maybe c
Nothing -> AVL a -> AVL b -> [c] -> [c]
i AVL a
ll0 AVL b
l1 [c]
cs''
                                  Just c
c1 -> AVL a -> AVL b -> [c] -> [c]
i AVL a
ll0 AVL b
l1 (c
c1c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs'')
 -- We need 2 different versions of fork (L & R) to ensure that comparison arguments are used in
 -- the right order (c e0 e1)
 -- forkL :: a -> AVL b -> UBT5(AVL b,UINT,Maybe c,AVL b,UINT)
 forkL :: a -> AVL b -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL a
e0 AVL b
t1 = AVL b -> Int# -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL_ AVL b
t1 L(0) where
  forkL_ :: AVL b -> Int# -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL_  AVL b
E        Int#
h = UBT5(Int#
E,h,Nothing,Int#
E,h) -- Relative heights!!
  forkL_ (N AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL__ AVL b
l DECINT2(h) e r DECINT1(h)
  forkL_ (Z AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL__ AVL b
l DECINT1(h) e r DECINT1(h)
  forkL_ (P AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL__ AVL b
l DECINT1(h) e r DECINT2(h)
  forkL__ :: AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL__ AVL b
l Int#
hl b
e AVL b
r Int#
hr = case a -> b -> COrdering c
comp a
e0 b
e of
                        COrdering c
Lt    ->                             case AVL b -> Int# -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL_ AVL b
l Int#
hl of
                                 UBT5(l0,hl0,mbc0,l1,hl1) -> case 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
l1 Int#
hl1 b
e AVL b
r Int#
hr of
                                  UBT2(l1_,hl1_)          -> UBT5(l0,hl0,mbc0,l1_,hl1_)
                        Eq c
c0 -> UBT5(l,hl,Just c0,r,hr)
                        COrdering c
Gt    ->                             case AVL b -> Int# -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL_ AVL b
r Int#
hr of
                                 UBT5(l0,hl0,mbc0,l1,hl1) -> case 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
e AVL b
l0 Int#
hl0 of
                                  UBT2(l0_,hl0_)          -> UBT5(l0_,hl0_,mbc0,l1,hl1)
 -- forkR :: AVL a -> b -> UBT5(AVL a,UINT,Maybe c,AVL a,UINT)
 forkR :: AVL a -> b -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR AVL a
t0 b
e1 = AVL a -> Int# -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR_ AVL a
t0 L(0) where
  forkR_ :: AVL a -> Int# -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR_  AVL a
E        Int#
h = UBT5(Int#
E,h,Nothing,Int#
E,h) -- Relative heights!!
  forkR_ (N AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR__ AVL a
l DECINT2(h) e r DECINT1(h)
  forkR_ (Z AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR__ AVL a
l DECINT1(h) e r DECINT1(h)
  forkR_ (P AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR__ AVL a
l DECINT1(h) e r DECINT2(h)
  forkR__ :: AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR__ AVL a
l Int#
hl a
e AVL a
r Int#
hr = case a -> b -> COrdering c
comp a
e b
e1 of
                        COrdering c
Lt    ->                             case AVL a -> Int# -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR_ AVL a
r Int#
hr of
                                 UBT5(l0,hl0,mbc1,l1,hl1) -> case AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL a, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL a
l Int#
hl a
e AVL a
l0 Int#
hl0 of
                                  UBT2(l0_,hl0_)          -> UBT5(l0_,hl0_,mbc1,l1,hl1)
                        Eq c
c1 -> UBT5(l,hl,Just c1,r,hr)
                        COrdering c
Gt    ->                             case AVL a -> Int# -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR_ AVL a
l Int#
hl of
                                 UBT5(l0,hl0,mbc1,l1,hl1) -> case AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL a, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL a
l1 Int#
hl1 a
e AVL a
r Int#
hr of
                                  UBT2(l1_,hl1_)          -> UBT5(l0,hl0,mbc1,l1_,hl1_)

-- | Applies 'intersectionToList' to the empty list.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
intersectionAsList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c]
intersectionAsList :: forall a b c. (a -> b -> COrdering c) -> AVL a -> AVL b -> [c]
intersectionAsList a -> b -> COrdering c
c AVL a
setA AVL b
setB = (a -> b -> COrdering c) -> AVL a -> AVL b -> [c] -> [c]
forall a b c.
(a -> b -> COrdering c) -> AVL a -> AVL b -> [c] -> [c]
intersectionToList a -> b -> COrdering c
c AVL a
setA AVL b
setB []

-- | Similar to 'intersectionToList', but the result does not include elements in cases where
-- the supplied combining comparison returns @(Eq Nothing)@.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
intersectionMaybeToList :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c] -> [c]
intersectionMaybeToList :: forall a b c.
(a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c] -> [c]
intersectionMaybeToList a -> b -> COrdering (Maybe c)
comp = AVL a -> AVL b -> [c] -> [c]
i where
 -- i :: AVL a -> AVL b -> [c] -> [c]
 i :: AVL a -> AVL b -> [c] -> [c]
i  AVL a
E            AVL b
_           [c]
cs = [c]
cs
 i  AVL a
_            AVL b
E           [c]
cs = [c]
cs
 i (N AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (N AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (N AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (Z AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (Z AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (Z AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (P AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (P AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i (P AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) [c]
cs = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs
 i' :: AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> [c] -> [c]
i' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 [c]
cs =
  case a -> b -> COrdering (Maybe c)
comp a
e0 b
e1 of
  -- e0 < e1, so (l0 < e0 < e1) & (e0 < e1 < r1)
  COrdering (Maybe c)
Lt   ->                            case AVL a -> b -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR AVL a
r0 b
e1 of
          UBT5(rl0,_,mbc1,rr0,_)  -> case a -> AVL b -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL a
e0 AVL b
l1 of -- (e0  < rl0 < e1) & (e0 < e1  < rr0)
           UBT5(ll1,_,mbc0,lr1,_) ->                     -- (ll1 < e0  < e1) & (e0 < lr1 < e1)
            -- (l0 + ll1) < e0 < (rl0 + lr1) < e1 < (rr0 + r1)
            let cs' :: [c]
cs'  = AVL a -> AVL b -> [c] -> [c]
i AVL a
rr0 AVL b
r1 [c]
cs
                cs'' :: [c]
cs'' = [c]
cs'  [c] -> [c] -> [c]
forall a b. a -> b -> b
`seq` case Maybe c
mbc1 of
                                  Maybe c
Nothing -> AVL a -> AVL b -> [c] -> [c]
i AVL a
rl0 AVL b
lr1 [c]
cs'
                                  Just c
c1 -> AVL a -> AVL b -> [c] -> [c]
i AVL a
rl0 AVL b
lr1 (c
c1c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs')
            in         [c]
cs'' [c] -> [c] -> [c]
forall a b. a -> b -> b
`seq` case Maybe c
mbc0 of
                                  Maybe c
Nothing -> AVL a -> AVL b -> [c] -> [c]
i AVL a
l0 AVL b
ll1 [c]
cs''
                                  Just c
c0 -> AVL a -> AVL b -> [c] -> [c]
i AVL a
l0 AVL b
ll1 (c
c0c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs'')
  -- e0 = e1
  Eq Maybe c
mbc  -> let cs' :: [c]
cs' = AVL a -> AVL b -> [c] -> [c]
i AVL a
r0 AVL b
r1 [c]
cs in [c]
cs' [c] -> [c] -> [c]
forall a b. a -> b -> b
`seq` case Maybe c
mbc of
                                               Maybe c
Nothing -> AVL a -> AVL b -> [c] -> [c]
i AVL a
l0 AVL b
l1 [c]
cs'
                                               Just c
c  -> AVL a -> AVL b -> [c] -> [c]
i AVL a
l0 AVL b
l1 (c
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs')
  -- e1 < e0, so (l1 < e1 < e0) & (e1 < e0 < r0)
  COrdering (Maybe c)
Gt   ->                            case a -> AVL b -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL a
e0 AVL b
r1 of
          UBT5(rl1,_,mbc0,rr1,_)  -> case AVL a -> b -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR AVL a
l0 b
e1 of -- (e1  < rl1 < e0) & (e1 < e0  < rr1)
           UBT5(ll0,_,mbc1,lr0,_) ->                     -- (ll0 < e1  < e0) & (e1 < lr0 < e0)
            -- (ll0 + l1) < e1 < (lr0 + rl1) < e0 < (r0 + rr1)
            let cs' :: [c]
cs'  = AVL a -> AVL b -> [c] -> [c]
i AVL a
r0 AVL b
rr1 [c]
cs
                cs'' :: [c]
cs'' = [c]
cs'  [c] -> [c] -> [c]
forall a b. a -> b -> b
`seq` case Maybe c
mbc0 of
                                  Maybe c
Nothing -> AVL a -> AVL b -> [c] -> [c]
i AVL a
lr0 AVL b
rl1 [c]
cs'
                                  Just c
c0 -> AVL a -> AVL b -> [c] -> [c]
i AVL a
lr0 AVL b
rl1 (c
c0c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs')
            in         [c]
cs'' [c] -> [c] -> [c]
forall a b. a -> b -> b
`seq` case Maybe c
mbc1 of
                                  Maybe c
Nothing -> AVL a -> AVL b -> [c] -> [c]
i AVL a
ll0 AVL b
l1 [c]
cs''
                                  Just c
c1 -> AVL a -> AVL b -> [c] -> [c]
i AVL a
ll0 AVL b
l1 (c
c1c -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs'')
 -- We need 2 different versions of fork (L & R) to ensure that comparison arguments are used in
 -- the right order (c e0 e1)
 -- forkL :: a -> AVL b -> UBT5(AVL b,UINT,Maybe c,AVL b,UINT)
 forkL :: a -> AVL b -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL a
e0 AVL b
t1 = AVL b -> Int# -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL_ AVL b
t1 L(0) where
  forkL_ :: AVL b -> Int# -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL_  AVL b
E        Int#
h = UBT5(Int#
E,h,Nothing,Int#
E,h) -- Relative heights!!
  forkL_ (N AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL__ AVL b
l DECINT2(h) e r DECINT1(h)
  forkL_ (Z AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL__ AVL b
l DECINT1(h) e r DECINT1(h)
  forkL_ (P AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL__ AVL b
l DECINT1(h) e r DECINT2(h)
  forkL__ :: AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL__ AVL b
l Int#
hl b
e AVL b
r Int#
hr = case a -> b -> COrdering (Maybe c)
comp a
e0 b
e of
                        COrdering (Maybe c)
Lt      ->                             case AVL b -> Int# -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL_ AVL b
l Int#
hl of
                                   UBT5(l0,hl0,mbc0,l1,hl1) -> case 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
l1 Int#
hl1 b
e AVL b
r Int#
hr of
                                    UBT2(l1_,hl1_)          -> UBT5(l0,hl0,mbc0,l1_,hl1_)
                        Eq Maybe c
mbc0 -> UBT5(l,hl,mbc0,r,hr)
                        COrdering (Maybe c)
Gt      ->                             case AVL b -> Int# -> (# AVL b, Int#, Maybe c, AVL b, Int# #)
forkL_ AVL b
r Int#
hr of
                                   UBT5(l0,hl0,mbc0,l1,hl1) -> case 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
e AVL b
l0 Int#
hl0 of
                                    UBT2(l0_,hl0_)          -> UBT5(l0_,hl0_,mbc0,l1,hl1)
 -- forkR :: AVL a -> b -> UBT5(AVL a,UINT,Maybe c,AVL a,UINT)
 forkR :: AVL a -> b -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR AVL a
t0 b
e1 = AVL a -> Int# -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR_ AVL a
t0 L(0) where
  forkR_ :: AVL a -> Int# -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR_  AVL a
E        Int#
h = UBT5(Int#
E,h,Nothing,Int#
E,h) -- Relative heights!!
  forkR_ (N AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR__ AVL a
l DECINT2(h) e r DECINT1(h)
  forkR_ (Z AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR__ AVL a
l DECINT1(h) e r DECINT1(h)
  forkR_ (P AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR__ AVL a
l DECINT1(h) e r DECINT2(h)
  forkR__ :: AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR__ AVL a
l Int#
hl a
e AVL a
r Int#
hr = case a -> b -> COrdering (Maybe c)
comp a
e b
e1 of
                        COrdering (Maybe c)
Lt      ->                             case AVL a -> Int# -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR_ AVL a
r Int#
hr of
                                   UBT5(l0,hl0,mbc1,l1,hl1) -> case AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL a, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL a
l Int#
hl a
e AVL a
l0 Int#
hl0 of
                                    UBT2(l0_,hl0_)          -> UBT5(l0_,hl0_,mbc1,l1,hl1)
                        Eq Maybe c
mbc1 -> UBT5(l,hl,mbc1,r,hr)
                        COrdering (Maybe c)
Gt      ->                             case AVL a -> Int# -> (# AVL a, Int#, Maybe c, AVL a, Int# #)
forkR_ AVL a
l Int#
hl of
                                   UBT5(l0,hl0,mbc1,l1,hl1) -> case AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL a, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL a
l1 Int#
hl1 a
e AVL a
r Int#
hr of
                                    UBT2(l1_,hl1_)          -> UBT5(l0,hl0,mbc1,l1_,hl1_)

-- | Applies 'intersectionMaybeToList' to the empty list.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
intersectionMaybeAsList :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c]
intersectionMaybeAsList :: forall a b c.
(a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c]
intersectionMaybeAsList a -> b -> COrdering (Maybe c)
c AVL a
setA AVL b
setB = (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c] -> [c]
forall a b c.
(a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c] -> [c]
intersectionMaybeToList a -> b -> COrdering (Maybe c)
c AVL a
setA AVL b
setB []

-- | Uses the supplied comparison to evaluate the difference between two sets represented as
-- sorted AVL trees. The expression..
--
-- > difference cmp setA setB
--
-- .. is a set containing all those elements of @setA@ which do not appear in @setB@.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
difference :: (a -> b -> Ordering) -> AVL a -> AVL b -> AVL a
-- N.B. differenceH works with relative heights on first tree, and needs no height for the second.
difference :: forall a b. (a -> b -> Ordering) -> AVL a -> AVL b -> AVL a
difference a -> b -> Ordering
c AVL a
t0 AVL b
t1 = case (a -> b -> Ordering) -> AVL a -> Int# -> AVL b -> (# AVL a, Int# #)
forall a b.
(a -> b -> Ordering) -> AVL a -> Int# -> AVL b -> (# AVL a, Int# #)
differenceH a -> b -> Ordering
c AVL a
t0 L(0) t1 of UBT2(t,_) -> t

-- | Similar to 'difference', but the resulting tree also includes those elements a\' for which the
-- combining comparison returns @(Eq (Just a\'))@.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
differenceMaybe :: (a -> b -> COrdering (Maybe a)) -> AVL a -> AVL b -> AVL a
-- N.B. differenceMaybeH works with relative heights on first tree, and needs no height for the second.
differenceMaybe :: forall a b.
(a -> b -> COrdering (Maybe a)) -> AVL a -> AVL b -> AVL a
differenceMaybe a -> b -> COrdering (Maybe a)
c AVL a
t0 AVL b
t1 = case (a -> b -> COrdering (Maybe a))
-> AVL a -> Int# -> AVL b -> (# AVL a, Int# #)
forall a b.
(a -> b -> COrdering (Maybe a))
-> AVL a -> Int# -> AVL b -> (# AVL a, Int# #)
differenceMaybeH a -> b -> COrdering (Maybe a)
c AVL a
t0 L(0) t1 of UBT2(t,_) -> t

-- | Uses the supplied comparison to test whether the first set is a subset of the second,
-- both sets being represented as sorted AVL trees.  This function returns True if any of
-- the following conditions hold..
--
-- * The first set is empty (the empty set is a subset of any set).
--
-- * The two sets are equal.
--
-- * The first set is a proper subset of the second set.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
isSubsetOf :: (a -> b -> Ordering) -> AVL a -> AVL b -> Bool
isSubsetOf :: forall a b. (a -> b -> Ordering) -> AVL a -> AVL b -> Bool
isSubsetOf a -> b -> Ordering
comp = AVL a -> AVL b -> Bool
s where
 -- s :: AVL a -> AVL b -> Bool
 s :: AVL a -> AVL b -> Bool
s  AVL a
E            AVL b
_           = Bool
True
 s  AVL a
_            AVL b
E           = Bool
False
 s (N AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (N AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (N AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (Z AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (Z AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (Z AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (P AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (P AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (P AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s' :: AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 =
  case a -> b -> Ordering
comp a
e0 b
e1 of
  -- e0 < e1, so (l0 < e0 < e1) & (e0 < e1 < r1)
  Ordering
LT -> case a -> AVL b -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL a
e0 AVL b
l1 of
        UBT5(False,_  ,AVL b
_,_  ,_) -> Bool
False
        UBT5(True ,ll1,_,lr1,_) -> (AVL a -> AVL b -> Bool
s AVL a
l0 AVL b
ll1) Bool -> Bool -> Bool
&& case AVL a -> b -> (# AVL a, Int#, AVL a, Int# #)
forkR AVL a
r0 b
e1 of  -- (ll1 < e0  < e1) & (e0 < lr1 < e1)
              UBT4(rl0,_,rr0,_) -> (AVL a -> AVL b -> Bool
s AVL a
rl0 AVL b
lr1) Bool -> Bool -> Bool
&& (AVL a -> AVL b -> Bool
s AVL a
rr0 AVL b
r1)          -- (e0  < rl0 < e1) & (e0 < e1  < rr0)
  -- e0 = e1
  Ordering
EQ -> (AVL a -> AVL b -> Bool
s AVL a
l0 AVL b
l1) Bool -> Bool -> Bool
&& (AVL a -> AVL b -> Bool
s AVL a
r0 AVL b
r1)
  -- e1 < e0, so (l1 < e1 < e0) & (e1 < e0 < r0)
  Ordering
GT -> case a -> AVL b -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL a
e0 AVL b
r1 of
        UBT5(False,_  ,AVL b
_,_  ,_) -> Bool
False
        UBT5(True ,rl1,_,rr1,_) -> (AVL a -> AVL b -> Bool
s AVL a
r0 AVL b
rr1) Bool -> Bool -> Bool
&& case AVL a -> b -> (# AVL a, Int#, AVL a, Int# #)
forkR AVL a
l0 b
e1 of  -- (e1  < rl1 < e0) & (e1 < e0  < rr1)
              UBT4(ll0,_,lr0,_) -> (AVL a -> AVL b -> Bool
s AVL a
lr0 AVL b
rl1) Bool -> Bool -> Bool
&& (AVL a -> AVL b -> Bool
s AVL a
ll0 AVL b
l1)          -- (ll0 < e1  < e0) & (e1 < lr0 < e0)
 -- forkL returns False if t1 does not contain e0 (which implies set 0 cannot be a subset of set 1)
 -- forkL :: a -> AVL b -> UBT5(Bool,AVL b,UINT,AVL b,UINT) -- Vals 1..4 only valid if Bool is True!
 forkL :: a -> AVL b -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL a
e0 AVL b
t = AVL b -> Int# -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL_ AVL b
t L(0) where
  forkL_ :: AVL b -> Int# -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL_  AVL b
E        Int#
h = UBT5(False,Int#
E,AVL b
forall e. AVL e
h,Int#
E,h)
  forkL_ (N AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL__ AVL b
l DECINT2(h) e r DECINT1(h)
  forkL_ (Z AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL__ AVL b
l DECINT1(h) e r DECINT1(h)
  forkL_ (P AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL__ AVL b
l DECINT1(h) e r DECINT2(h)
  forkL__ :: AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL__ AVL b
l Int#
hl b
e AVL b
r Int#
hr = case a -> b -> Ordering
comp a
e0 b
e of
                        Ordering
LT -> case AVL b -> Int# -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL_ AVL b
l Int#
hl of
                              UBT5(False,t0,ht0,t1,ht1) -> UBT5(False,t0,ht0,t1,ht1)
                              UBT5(True ,t0,ht0,t1,ht1) -> case 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
t1 Int#
ht1 b
e AVL b
r Int#
hr of
                                                           UBT2(t1_,ht1_) -> UBT5(True,t0,ht0,t1_,ht1_)
                        Ordering
EQ -> UBT5(True,l,hl,r,hr)
                        Ordering
GT -> case AVL b -> Int# -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL_ AVL b
r Int#
hr of
                              UBT5(False,t0,ht0,t1,ht1) -> UBT5(False,t0,ht0,t1,ht1)
                              UBT5(True ,t0,ht0,t1,ht1) -> case 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
e AVL b
t0 Int#
ht0 of
                                                           UBT2(t0_,ht0_) -> UBT5(True,t0_,ht0_,t1,ht1)
 -- forkR discards an element from set 0 if it is equal to the element from set 1
 -- forkR :: AVL a -> b -> UBT4(AVL a,UINT,AVL a,UINT)
 forkR :: AVL a -> b -> (# AVL a, Int#, AVL a, Int# #)
forkR AVL a
t b
e1 = AVL a -> Int# -> (# AVL a, Int#, AVL a, Int# #)
forkR_ AVL a
t L(0) where
  forkR_ :: AVL a -> Int# -> (# AVL a, Int#, AVL a, Int# #)
forkR_  AVL a
E        Int#
h = UBT4(Int#
E,AVL a
forall e. AVL e
h,Int#
E,h) -- Relative heights!!
  forkR_ (N AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int# -> a -> AVL a -> Int# -> (# AVL a, Int#, AVL a, Int# #)
forkR__ AVL a
l DECINT2(h) e r DECINT1(h)
  forkR_ (Z AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int# -> a -> AVL a -> Int# -> (# AVL a, Int#, AVL a, Int# #)
forkR__ AVL a
l DECINT1(h) e r DECINT1(h)
  forkR_ (P AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int# -> a -> AVL a -> Int# -> (# AVL a, Int#, AVL a, Int# #)
forkR__ AVL a
l DECINT1(h) e r DECINT2(h)
  forkR__ :: AVL a
-> Int# -> a -> AVL a -> Int# -> (# AVL a, Int#, AVL a, Int# #)
forkR__ AVL a
l Int#
hl a
e AVL a
r Int#
hr = case a -> b -> Ordering
comp a
e b
e1 of
                        Ordering
LT -> case AVL a -> Int# -> (# AVL a, Int#, AVL a, Int# #)
forkR_ AVL a
r Int#
hr of
                              UBT4(t0,ht0,t1,ht1) -> case AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL a, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL a
l Int#
hl a
e AVL a
t0 Int#
ht0 of
                               UBT2(t0_,ht0_)     -> UBT4(t0_,ht0_,t1,ht1)
                        Ordering
EQ -> UBT4(l,hl,r,hr)     -- e is discarded from set 0
                        Ordering
GT -> case AVL a -> Int# -> (# AVL a, Int#, AVL a, Int# #)
forkR_ AVL a
l Int#
hl of
                              UBT4(t0,ht0,t1,ht1) -> case AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL a, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL a
t1 Int#
ht1 a
e AVL a
r Int#
hr of
                               UBT2(t1_,ht1_)     -> UBT4(t0,ht0,t1_,ht1_)

-- | Similar to 'isSubsetOf', but also requires that the supplied combining
-- comparison returns @('Data.COrdering.Eq' True)@ for matching elements.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
isSubsetOfBy :: (a -> b -> COrdering Bool) -> AVL a -> AVL b -> Bool
isSubsetOfBy :: forall a b. (a -> b -> COrdering Bool) -> AVL a -> AVL b -> Bool
isSubsetOfBy a -> b -> COrdering Bool
comp = AVL a -> AVL b -> Bool
s where
 -- s :: AVL a -> AVL b -> Bool
 s :: AVL a -> AVL b -> Bool
s  AVL a
E            AVL b
_           = Bool
True
 s  AVL a
_            AVL b
E           = Bool
False
 s (N AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (N AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (N AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (Z AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (Z AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (Z AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (P AVL a
l0 a
e0 AVL a
r0) (N AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (P AVL a
l0 a
e0 AVL a
r0) (Z AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s (P AVL a
l0 a
e0 AVL a
r0) (P AVL b
l1 b
e1 AVL b
r1) = AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1
 s' :: AVL a -> a -> AVL a -> AVL b -> b -> AVL b -> Bool
s' AVL a
l0 a
e0 AVL a
r0 AVL b
l1 b
e1 AVL b
r1 =
  case a -> b -> COrdering Bool
comp a
e0 b
e1 of
  -- e0 < e1, so (l0 < e0 < e1) & (e0 < e1 < r1)
  COrdering Bool
Lt       -> case a -> AVL b -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL a
e0 AVL b
l1 of
              UBT5(False,_  ,AVL b
_,_  ,_)  -> Bool
False
              UBT5(True ,ll1,_,lr1,_)  -> (AVL a -> AVL b -> Bool
s AVL a
l0 AVL b
ll1) Bool -> Bool -> Bool
&& case AVL a -> b -> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR AVL a
r0 b
e1 of -- (ll1 < e0  < e1) & (e0 < lr1 < e1)
               UBT5(False,_  ,AVL a
_,_  ,_) -> Bool
False
               UBT5(True ,rl0,_,rr0,_) -> (AVL a -> AVL b -> Bool
s AVL a
rl0 AVL b
lr1) Bool -> Bool -> Bool
&& (AVL a -> AVL b -> Bool
s AVL a
rr0 AVL b
r1)         -- (e0  < rl0 < e1) & (e0 < e1  < rr0)
  -- e0 = e1
  Eq Bool
True  -> (AVL a -> AVL b -> Bool
s AVL a
l0 AVL b
l1) Bool -> Bool -> Bool
&& (AVL a -> AVL b -> Bool
s AVL a
r0 AVL b
r1)
  Eq Bool
False -> Bool
False
  -- e1 < e0, so (l1 < e1 < e0) & (e1 < e0 < r0)
  COrdering Bool
Gt       -> case a -> AVL b -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL a
e0 AVL b
r1 of
              UBT5(False,_  ,AVL b
_,_  ,_)  -> Bool
False
              UBT5(True ,rl1,_,rr1,_)  -> (AVL a -> AVL b -> Bool
s AVL a
r0 AVL b
rr1) Bool -> Bool -> Bool
&& case AVL a -> b -> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR AVL a
l0 b
e1 of  -- (e1  < rl1 < e0) & (e1 < e0  < rr1)
               UBT5(False,_  ,AVL a
_,_  ,_) -> Bool
False
               UBT5(True ,ll0,_,lr0,_) -> (AVL a -> AVL b -> Bool
s AVL a
lr0 AVL b
rl1) Bool -> Bool -> Bool
&& (AVL a -> AVL b -> Bool
s AVL a
ll0 AVL b
l1)          -- (ll0 < e1  < e0) & (e1 < lr0 < e0)
 -- forkL returns False if t1 does not contain e0 (which implies set 0 cannot be a subset of set 1)
 -- forkL :: a -> AVL b -> UBT5(Bool,AVL b,UINT,AVL b,UINT) -- Vals 1..4 only valid if Bool is True!
 forkL :: a -> AVL b -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL a
e0 AVL b
t = AVL b -> Int# -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL_ AVL b
t L(0) where
  forkL_ :: AVL b -> Int# -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL_  AVL b
E        Int#
h = UBT5(False,Int#
E,AVL b
forall e. AVL e
h,Int#
E,h)
  forkL_ (N AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL__ AVL b
l DECINT2(h) e r DECINT1(h)
  forkL_ (Z AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL__ AVL b
l DECINT1(h) e r DECINT1(h)
  forkL_ (P AVL b
l b
e AVL b
r) Int#
h = AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL__ AVL b
l DECINT1(h) e r DECINT2(h)
  forkL__ :: AVL b
-> Int#
-> b
-> AVL b
-> Int#
-> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL__ AVL b
l Int#
hl b
e AVL b
r Int#
hr = case a -> b -> COrdering Bool
comp a
e0 b
e of
                        COrdering Bool
Lt   -> case AVL b -> Int# -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL_ AVL b
l Int#
hl of
                                UBT5(False,t0,ht0,t1,ht1) -> UBT5(False,t0,ht0,t1,ht1)
                                UBT5(True ,t0,ht0,t1,ht1) -> case 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
t1 Int#
ht1 b
e AVL b
r Int#
hr of
                                                             UBT2(t1_,ht1_) -> UBT5(True,t0,ht0,t1_,ht1_)
                        Eq Bool
b -> UBT5(AVL b
b,l,hl,r,hr)
                        COrdering Bool
Gt   -> case AVL b -> Int# -> (# Bool, AVL b, Int#, AVL b, Int# #)
forkL_ AVL b
r Int#
hr of
                                UBT5(False,t0,ht0,t1,ht1) -> UBT5(False,t0,ht0,t1,ht1)
                                UBT5(True ,t0,ht0,t1,ht1) -> case 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
e AVL b
t0 Int#
ht0 of
                                                             UBT2(t0_,ht0_) -> UBT5(True,t0_,ht0_,t1,ht1)
 -- forkR discards an element from set 0 if it is equal to the element from set 1
 -- forkR :: AVL a -> b -> UBT5(Bool,AVL a,UINT,AVL a,UINT)  -- Vals 1..4 only valid if Bool is True!
 forkR :: AVL a -> b -> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR AVL a
t b
e1 = AVL a -> Int# -> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR_ AVL a
t L(0) where
  forkR_ :: AVL a -> Int# -> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR_  AVL a
E        Int#
h = UBT5(True,Int#
E,AVL a
forall e. AVL e
h,Int#
E,h) -- Relative heights!!
  forkR_ (N AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR__ AVL a
l DECINT2(h) e r DECINT1(h)
  forkR_ (Z AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR__ AVL a
l DECINT1(h) e r DECINT1(h)
  forkR_ (P AVL a
l a
e AVL a
r) Int#
h = AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR__ AVL a
l DECINT1(h) e r DECINT2(h)
  forkR__ :: AVL a
-> Int#
-> a
-> AVL a
-> Int#
-> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR__ AVL a
l Int#
hl a
e AVL a
r Int#
hr = case a -> b -> COrdering Bool
comp a
e b
e1 of
                        COrdering Bool
Lt   -> case AVL a -> Int# -> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR_ AVL a
r Int#
hr of
                                UBT5(False,t0,ht0,t1,ht1) -> UBT5(False,t0,ht0,t1,ht1)
                                UBT5(True ,t0,ht0,t1,ht1) -> case AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL a, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL a
l Int#
hl a
e AVL a
t0 Int#
ht0 of
                                                             UBT2(t0_,ht0_) -> UBT5(True,t0_,ht0_,t1,ht1)
                        Eq Bool
b -> UBT5(AVL a
b,l,hl,r,hr)     -- e is discarded from set 0
                        COrdering Bool
Gt   -> case AVL a -> Int# -> (# Bool, AVL a, Int#, AVL a, Int# #)
forkR_ AVL a
l Int#
hl of
                                UBT5(False,t0,ht0,t1,ht1) -> UBT5(False,t0,ht0,t1,ht1)
                                UBT5(True ,t0,ht0,t1,ht1) -> case AVL a -> Int# -> a -> AVL a -> Int# -> (# AVL a, Int# #)
forall e. AVL e -> Int# -> e -> AVL e -> Int# -> (# AVL e, Int# #)
spliceH AVL a
t1 Int#
ht1 a
e AVL a
r Int#
hr of
                                                             UBT2(t1_,ht1_) -> UBT5(True,t0,ht0,t1_,ht1_)

-- | The symmetric difference is the set of elements which occur in one set or the other but /not both/.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
symDifference :: (e -> e -> Ordering) -> AVL e -> AVL e -> AVL e
symDifference :: forall e. (e -> e -> Ordering) -> AVL e -> AVL e -> AVL e
symDifference e -> e -> Ordering
c = AVL e -> AVL e -> AVL e
gu where -- This is to avoid O(log n) height calculation for empty sets
 gu :: AVL e -> AVL e -> AVL e
gu     AVL e
E          AVL e
t1             = AVL e
t1
 gu AVL e
t0                 AVL e
E          = AVL e
t0
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(N AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(Z AVL e
l0 e
_ AVL e
_ ) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(N AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) l1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(Z AVL e
l1 e
_ AVL e
_ ) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(1) l1)
 gu t0 :: AVL e
t0@(P AVL e
_  e
_ AVL e
r0) t1 :: AVL e
t1@(P AVL e
_  e
_ AVL e
r1) = AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 (Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) r1)
 gu_ :: AVL e -> Int# -> AVL e -> Int# -> AVL e
gu_ AVL e
t0 Int#
h0 AVL e
t1 Int#
h1 = case (e -> e -> Ordering)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
forall e.
(e -> e -> Ordering)
-> AVL e -> Int# -> AVL e -> Int# -> (# AVL e, Int# #)
symDifferenceH e -> e -> Ordering
c AVL e
t0 Int#
h0 AVL e
t1 Int#
h1 of UBT2(Int#
t,_) -> AVL e
t

-- | Given two Sets @A@ and @B@ represented as sorted AVL trees, this function
-- extracts the \'Venn diagram\' components @A-B@, @A.B@ and @B-A@.
-- See also 'vennMaybe'.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
venn :: (a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)
venn :: forall a b c.
(a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)
venn a -> b -> COrdering c
c = AVL a -> AVL b -> (AVL a, AVL c, AVL b)
gu where  -- This is to avoid O(log n) height calculation for empty sets
 gu :: AVL a -> AVL b -> (AVL a, AVL c, AVL b)
gu     AVL a
E          AVL b
t1             = (AVL a
forall e. AVL e
E ,AVL c
forall e. AVL e
E,AVL b
t1)
 gu AVL a
t0                 AVL b
E          = (AVL a
t0,AVL c
forall e. AVL e
E,AVL b
forall e. AVL e
E )
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) r1)
 gu_ :: AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 Int#
h0 AVL b
t1 Int#
h1 = case (a -> b -> COrdering c)
-> [c]
-> Int#
-> AVL a
-> Int#
-> AVL b
-> Int#
-> (# AVL a, Int#, [c], Int#, AVL b, Int# #)
forall a b c.
(a -> b -> COrdering c)
-> [c]
-> Int#
-> AVL a
-> Int#
-> AVL b
-> Int#
-> (# AVL a, Int#, [c], Int#, AVL b, Int# #)
vennH a -> b -> COrdering c
c [] L(0) t0 h0 t1 h1 of
                   UBT6(tab,_,cs,cl,tba,_) -> let tc :: AVL c
tc = Int -> [c] -> AVL c
forall e. Int -> [e] -> AVL e
asTreeLenL ASINT(cl) [c]
cs
                                              in AVL c
tc AVL c -> (AVL a, AVL c, AVL b) -> (AVL a, AVL c, AVL b)
forall a b. a -> b -> b
`seq` (AVL a
tab,AVL c
tc,AVL b
tba)

-- | Similar to 'venn', but intersection elements for which the combining comparison
-- returns @('Data.COrdering.Eq' 'Nothing')@ are deleted from the intersection result.
--
-- Complexity: Not sure, but I\'d appreciate it if someone could figure it out.
vennMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)
vennMaybe :: forall a b c.
(a -> b -> COrdering (Maybe c))
-> AVL a -> AVL b -> (AVL a, AVL c, AVL b)
vennMaybe a -> b -> COrdering (Maybe c)
c = AVL a -> AVL b -> (AVL a, AVL c, AVL b)
gu where -- This is to avoid O(log n) height calculation for empty sets
 gu :: AVL a -> AVL b -> (AVL a, AVL c, AVL b)
gu     AVL a
E          AVL b
t1             = (AVL a
forall e. AVL e
E ,AVL c
forall e. AVL e
E,AVL b
t1)
 gu AVL a
t0                 AVL b
E          = (AVL a
t0,AVL c
forall e. AVL e
E,AVL b
forall e. AVL e
E )
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) r1)
 gu_ :: AVL a -> Int# -> AVL b -> Int# -> (AVL a, AVL c, AVL b)
gu_ AVL a
t0 Int#
h0 AVL b
t1 Int#
h1 = case (a -> b -> COrdering (Maybe c))
-> [c]
-> Int#
-> AVL a
-> Int#
-> AVL b
-> Int#
-> (# AVL a, Int#, [c], Int#, AVL b, Int# #)
forall a b c.
(a -> b -> COrdering (Maybe c))
-> [c]
-> Int#
-> AVL a
-> Int#
-> AVL b
-> Int#
-> (# AVL a, Int#, [c], Int#, AVL b, Int# #)
vennMaybeH a -> b -> COrdering (Maybe c)
c [] L(0) t0 h0 t1 h1 of
                   UBT6(tab,_,cs,cl,tba,_) -> let tc :: AVL c
tc = Int -> [c] -> AVL c
forall e. Int -> [e] -> AVL e
asTreeLenL ASINT(cl) [c]
cs
                                              in AVL c
tc AVL c -> (AVL a, AVL c, AVL b) -> (AVL a, AVL c, AVL b)
forall a b. a -> b -> b
`seq` (AVL a
tab,AVL c
tc,AVL b
tba)

-- | Same as 'venn', but prepends the intersection component to the supplied list
-- in ascending order.
vennToList :: (a -> b -> COrdering c) -> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
vennToList :: forall a b c.
(a -> b -> COrdering c)
-> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
vennToList a -> b -> COrdering c
cmp [c]
cs = AVL a -> AVL b -> (AVL a, [c], AVL b)
gu where  -- This is to avoid O(log n) height calculation for empty sets
 gu :: AVL a -> AVL b -> (AVL a, [c], AVL b)
gu     AVL a
E          AVL b
t1             = (AVL a
forall e. AVL e
E ,[c]
cs,AVL b
t1)
 gu AVL a
t0                 AVL b
E          = (AVL a
t0,[c]
cs,AVL b
forall e. AVL e
E )
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) r1)
 gu_ :: AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 Int#
h0 AVL b
t1 Int#
h1 = case (a -> b -> COrdering c)
-> [c]
-> Int#
-> AVL a
-> Int#
-> AVL b
-> Int#
-> (# AVL a, Int#, [c], Int#, AVL b, Int# #)
forall a b c.
(a -> b -> COrdering c)
-> [c]
-> Int#
-> AVL a
-> Int#
-> AVL b
-> Int#
-> (# AVL a, Int#, [c], Int#, AVL b, Int# #)
vennH a -> b -> COrdering c
cmp [c]
cs L(0) t0 h0 t1 h1 of
                   UBT6(tab,_,cs_,_,tba,_) -> (AVL a
tab,[c]
cs_,AVL b
tba)

-- | Same as 'vennMaybe', but prepends the intersection component to the supplied list
-- in ascending order.
vennMaybeToList  :: (a -> b -> COrdering (Maybe c)) -> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
vennMaybeToList :: forall a b c.
(a -> b -> COrdering (Maybe c))
-> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
vennMaybeToList a -> b -> COrdering (Maybe c)
cmp [c]
cs = AVL a -> AVL b -> (AVL a, [c], AVL b)
gu where  -- This is to avoid O(log n) height calculation for empty sets
 gu :: AVL a -> AVL b -> (AVL a, [c], AVL b)
gu     AVL a
E          AVL b
t1             = (AVL a
forall e. AVL e
E ,[c]
cs,AVL b
t1)
 gu AVL a
t0                 AVL b
E          = (AVL a
t0,[c]
cs,AVL b
forall e. AVL e
E )
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(N AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(Z AVL a
l0 a
_ AVL a
_ ) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(1) l0) t1 (addHeight L(2) r1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(N AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) l1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(Z AVL b
l1 b
_ AVL b
_ ) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(1) l1)
 gu t0 :: AVL a
t0@(P AVL a
_  a
_ AVL a
r0) t1 :: AVL b
t1@(P AVL b
_  b
_ AVL b
r1) = AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 (Int# -> AVL a -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(2) r0) t1 (addHeight L(2) r1)
 gu_ :: AVL a -> Int# -> AVL b -> Int# -> (AVL a, [c], AVL b)
gu_ AVL a
t0 Int#
h0 AVL b
t1 Int#
h1 = case (a -> b -> COrdering (Maybe c))
-> [c]
-> Int#
-> AVL a
-> Int#
-> AVL b
-> Int#
-> (# AVL a, Int#, [c], Int#, AVL b, Int# #)
forall a b c.
(a -> b -> COrdering (Maybe c))
-> [c]
-> Int#
-> AVL a
-> Int#
-> AVL b
-> Int#
-> (# AVL a, Int#, [c], Int#, AVL b, Int# #)
vennMaybeH a -> b -> COrdering (Maybe c)
cmp [c]
cs L(0) t0 h0 t1 h1 of
                   UBT6(tab,_,cs_,_,tba,_) -> (AVL a
tab,[c]
cs_,AVL b
tba)

-- | Same as 'venn', but returns the intersection component as a list in ascending order.
-- This is just 'vennToList' applied to an empty initial intersection list.
vennAsList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, [c], AVL b)
vennAsList :: forall a b c.
(a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, [c], AVL b)
vennAsList a -> b -> COrdering c
cmp = (a -> b -> COrdering c)
-> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
forall a b c.
(a -> b -> COrdering c)
-> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
vennToList a -> b -> COrdering c
cmp []
{-# INLINE vennAsList #-}

-- | Same as 'vennMaybe', but returns the intersection component as a list in ascending order.
-- This is just 'vennMaybeToList' applied to an empty initial intersection list.
vennMaybeAsList  :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> (AVL a, [c], AVL b)
vennMaybeAsList :: forall a b c.
(a -> b -> COrdering (Maybe c))
-> AVL a -> AVL b -> (AVL a, [c], AVL b)
vennMaybeAsList a -> b -> COrdering (Maybe c)
cmp = (a -> b -> COrdering (Maybe c))
-> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
forall a b c.
(a -> b -> COrdering (Maybe c))
-> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
vennMaybeToList a -> b -> COrdering (Maybe c)
cmp []
{-# INLINE vennMaybeAsList #-}