module Data.GMap.IntMap
(
IntMap
) where
import Prelude hiding (foldr,map,filter,lookup)
import Data.GMap
import qualified Data.Monoid as M (Monoid(..))
import qualified Data.Foldable as F (Foldable(..))
import Data.Bits(shiftR,(.&.))
import Data.Typeable
import qualified Data.List as L
import qualified Data.Maybe as MB
import Control.Monad(foldM)
import GHC.Base hiding (map)
import qualified Text.Read as R (Read(..),Lexeme(..),parens,prec,lexP,readListPrecDefault)
type Key = Int#
data IntMap a = E
| N !Key (IntMap a) a (IntMap a)
| Z !Key (IntMap a) a (IntMap a)
| P !Key (IntMap a) a (IntMap a)
instance Map IntMap Int where
empty = emptyIntMap
nonEmpty = nonEmptyIntMap
status = statusIntMap
addSize = addSizeIntMap
union = unionIntMap
union' = unionIntMap'
unionMaybe = unionMaybeIntMap
disjointUnion = disjointUnionIntMap
intersection = intersectionIntMap
intersection' = intersectionIntMap'
intersectionMaybe = intersectionMaybeIntMap
difference = differenceIntMap
differenceMaybe = differenceMaybeIntMap
isSubsetOf = isSubsetOfIntMap
isSubmapOf = isSubmapOfIntMap
map = mapIntMap
map' = mapIntMap'
mapMaybe = mapMaybeIntMap
mapWithKey f imp = mapWithKeyIntMap (\i a -> f (I# (i)) a) imp
mapWithKey' f imp = mapWithKeyIntMap' (\i a -> f (I# (i)) a) imp
filter = filterIntMap
foldKeys f imp b0 = foldKeysAscIntMap (\i b -> f (I# (i)) b) imp b0
foldAssocs f imp b0 = foldAssocsAscIntMap (\i a b -> f (I# (i)) a b) imp b0
foldElems = foldElemsAscIntMap
foldElems' = foldElemsAscIntMap'
foldKeys' f imp b0 = foldKeysAscIntMap' (\i b -> f (I# (i)) b) imp b0
foldAssocs' f imp b0 = foldAssocsAscIntMap' (\i a b -> f (I# (i)) a b) imp b0
foldElemsUInt = foldElemsUIntIntMap
valid = validIntMap
singleton (I# (i)) a = singletonIntMap i a
pair (I# (i0)) (I# (i1)) = pairIntMap i0 i1
lookup (I# (i)) imp = lookupIntMap i imp
lookupCont f (I# (i)) imp = lookupContIntMap f i imp
alter f (I# (i)) imp = alterIntMap f i imp
insertWith f (I# (i)) a imp = insertWithIntMap f i a imp
insertWith' f (I# (i)) a imp = insertWithIntMap' f i a imp
insertMaybe f (I# (i)) a imp = insertMaybeIntMap f i a imp
delete (I# (i)) imp = deleteIntMap i imp
adjustWith f (I# (i)) imp = adjustWithIntMap f i imp
adjustWith' f (I# (i)) imp = adjustWithIntMap' f i imp
adjustMaybe f (I# (i)) imp = adjustMaybeIntMap f i imp
venn = vennIntMap
venn' = vennIntMap'
vennMaybe = vennMaybeIntMap
instance OrderedMap IntMap Int where
compareKey = compareKeyIntMap
fromAssocsAscWith = fromAssocsAscWithIntMap
fromAssocsDescWith = fromAssocsDescWithIntMap
fromAssocsAscMaybe = fromAssocsAscMaybeIntMap
fromAssocsDescMaybe = fromAssocsDescMaybeIntMap
foldKeysAsc f imp b0 = foldKeysAscIntMap (\i b -> f (I# (i)) b) imp b0
foldKeysDesc f imp b0 = foldKeysDescIntMap (\i b -> f (I# (i)) b) imp b0
foldAssocsAsc f imp b0 = foldAssocsAscIntMap (\i a b -> f (I# (i)) a b) imp b0
foldAssocsDesc f imp b0 = foldAssocsDescIntMap (\i a b -> f (I# (i)) a b) imp b0
foldElemsAsc = foldElemsAscIntMap
foldElemsDesc = foldElemsDescIntMap
foldElemsAsc' = foldElemsAscIntMap'
foldElemsDesc' = foldElemsDescIntMap'
foldKeysAsc' f imp b0 = foldKeysAscIntMap' (\i b -> f (I# (i)) b) imp b0
foldKeysDesc' f imp b0 = foldKeysDescIntMap' (\i b -> f (I# (i)) b) imp b0
foldAssocsAsc' f imp b0 = foldAssocsAscIntMap' (\i a b -> f (I# (i)) a b) imp b0
foldAssocsDesc' f imp b0 = foldAssocsDescIntMap' (\i a b -> f (I# (i)) a b) imp b0
mErr :: String
mErr = "Data.Trie.General.IntMap.Set-"
emptyIntMap :: IntMap a
emptyIntMap = E
singletonIntMap :: Key -> a -> IntMap a
singletonIntMap i a = Z i E a E
fromAssocsAscIntMap :: [(Int,a)] -> IntMap a
fromAssocsAscIntMap ias = fromAssocsAscLIntMap (length ias) ias
fromAssocsDescIntMap :: [(Int,a)] -> IntMap a
fromAssocsDescIntMap ias = fromAssocsDescLIntMap (length ias) ias
fromAssocsAscLIntMap :: Int -> [(Int,a)] -> IntMap a
fromAssocsAscLIntMap n ias = case suba (rep n) ias of
(# imp,[] #) -> imp
(# _,_ #) -> error (mErr ++ "fromAssocsAscLIntMap: List too long.")
where
suba ET as = (# E,as #)
suba (NT l r) as = suba_ N l r as
suba (ZT l r) as = suba_ Z l r as
suba (PT l r) as = suba_ P l r as
suba_ c l r as = case suba l as of
(# l_,as_ #) -> case as_ of
(((I# (ka),a):as__)) -> case suba r as__ of
(# r_,as___ #) -> let t = c ka l_ a r_
in t `seq` (# t,as___ #)
[] -> error (mErr ++ "fromAssocsAscLIntMap: List too short.")
fromAssocsDescLIntMap :: Int -> [(Int,a)] -> IntMap a
fromAssocsDescLIntMap n ias = case subd (rep n) ias of
(# imp,[] #) -> imp
(# _,_ #) -> error (mErr ++ "fromAssocsDescLIntMap: List too long.")
where
subd ET as = (# E,as #)
subd (NT l r) as = subd_ N l r as
subd (ZT l r) as = subd_ Z l r as
subd (PT l r) as = subd_ P l r as
subd_ c l r as = case subd r as of
(# r_,as_ #) -> case as_ of
(((I# (ka),a):as__)) -> case subd l as__ of
(# l_,as___ #) -> let t = c ka l_ a r_
in t `seq` (# t,as___ #)
[] -> error (mErr ++ "fromAssocsDescLIntMap: List too short.")
clump :: Eq k => [(k,a)] -> [(k,[a])]
clump [] = []
clump kas = list' [(k',as' [])]
where (k',as',list') = L.foldl' combine (fst $ head kas,id,id) kas
combine (k1,as,list) (k2,a) =
if k1 == k2
then (k1, as . (a:), list )
else (k2, (a:), list . ((k1,as []):) )
fromAssocsAscWithIntMap :: (a -> a -> a) -> [(Int,a)] -> IntMap a
fromAssocsAscWithIntMap f kas = fromAssocsAscIntMap [ (k,L.foldl1' f as) | (k,as) <- clump kas]
fromAssocsDescWithIntMap :: (a -> a -> a) -> [(Int,a)] -> IntMap a
fromAssocsDescWithIntMap f kas = fromAssocsDescIntMap [ (k,L.foldl1' f as) | (k,as) <- clump kas]
fromAssocsAscMaybeIntMap :: (a -> a -> Maybe a) -> [(Int,a)] -> IntMap a
fromAssocsAscMaybeIntMap f kas = fromAssocsAscIntMap $ MB.catMaybes [ fld k as | (k,as) <- clump kas]
where fld k as = (\a -> (k,a)) `fmap` foldM f (head as) (tail as)
fromAssocsDescMaybeIntMap :: (a -> a -> Maybe a) -> [(Int,a)] -> IntMap a
fromAssocsDescMaybeIntMap f kas = fromAssocsDescIntMap $ MB.catMaybes [ fld k as | (k,as) <- clump kas]
where fld k as = (\a -> (k,a)) `fmap` foldM f (head as) (tail as)
pairIntMap :: Key -> Key -> Maybe (a -> a -> IntMap a)
pairIntMap i0 i1 = case compareInt# i0 i1 of
LT -> Just (\a0 a1 -> P i1 (Z i0 E a0 E) a1 E)
EQ -> Nothing
GT -> Just (\a0 a1 -> P i0 (Z i1 E a1 E) a0 E)
nonEmptyIntMap :: IntMap a -> Maybe (IntMap a)
nonEmptyIntMap E = Nothing
nonEmptyIntMap imp = Just imp
statusIntMap :: IntMap a -> Status Int a
statusIntMap E = None
statusIntMap (Z i E a _) = One (I# (i)) a
statusIntMap _ = Many
addSizeIntMap :: IntMap a -> Int# -> Int#
addSizeIntMap E n = n
addSizeIntMap (N _ l _ r) n = case addHeight 2# l of
2# -> ((n)+#2#)
h -> fasN n h l r
addSizeIntMap (Z _ l _ r) n = case addHeight 1# l of
1# -> ((n)+#1#)
2# -> ((n)+#3#)
h -> fasZ n h l r
addSizeIntMap (P _ l _ r) n = case addHeight 2# r of
2# -> ((n)+#2#)
h -> fasP n h l r
fasN,fasZ,fasP :: Int# -> Int# -> IntMap e -> IntMap e -> Int#
fasN n 3# _ r = fas ((n)+#2#) 2# r
fasN n h l r = fas (fas ((n)+#1#) ((h)-#2#) l) ((h)-#1#) r
fasZ n h l r = fas (fas ((n)+#1#) ((h)-#1#) l) ((h)-#1#) r
fasP n 3# l _ = fas ((n)+#2#) 2# l
fasP n h l r = fas (fas ((n)+#1#) ((h)-#2#) r) ((h)-#1#) l
fas :: Int# -> Int# -> IntMap e -> Int#
fas _ 2# E = error "fas: Bug0"
fas n 2# (N _ _ _ _) = ((n)+#2#)
fas n 2# (Z _ _ _ _) = ((n)+#3#)
fas n 2# (P _ _ _ _) = ((n)+#2#)
fas n h (N _ l _ r) = fasN n h l r
fas n h (Z _ l _ r) = fasZ n h l r
fas n h (P _ l _ r) = fasP n h l r
fas _ _ E = error "fas: Bug1"
addHeight :: Int# -> IntMap e -> Int#
addHeight h E = h
addHeight h (N _ l _ _) = addHeight ((h)+#2#) l
addHeight h (Z _ l _ _) = addHeight ((h)+#1#) l
addHeight h (P _ _ _ r) = addHeight ((h)+#2#) r
lookupIntMap :: Key -> IntMap a -> Maybe a
lookupIntMap i0 t = rd t where
rd E = Nothing
rd (N i l a r) = rd_ i l a r
rd (Z i l a r) = rd_ i l a r
rd (P i l a r) = rd_ i l a r
rd_ i l a r = case compareInt# i0 i of
LT -> rd l
EQ -> Just a
GT -> rd r
lookupContIntMap :: (a -> Maybe b) -> Key -> IntMap a -> Maybe b
lookupContIntMap f i0 t = rd t where
rd E = Nothing
rd (N i l a r) = rd_ i l a r
rd (Z i l a r) = rd_ i l a r
rd (P i l a r) = rd_ i l a r
rd_ i l a r = case compareInt# i0 i of
LT -> rd l
EQ -> f a
GT -> rd r
hasKeyIntMap :: IntMap a -> Key -> Bool
hasKeyIntMap t i0 = rd t where
rd E = False
rd (N i l _ r) = rd_ i l r
rd (Z i l _ r) = rd_ i l r
rd (P i l _ r) = rd_ i l r
rd_ i l r = case compareInt# i0 i of
LT -> rd l
EQ -> True
GT -> rd r
assertWriteIntMap :: Key -> a -> IntMap a -> IntMap a
assertWriteIntMap i0 a0 = w where
w E = error "assertWrite: Key not found."
w (N i l a r) = case compareInt# i0 i of
LT -> let l' = w l in l' `seq` N i l' a r
EQ -> N i0 l a0 r
GT -> let r' = w r in r' `seq` N i l a r'
w (Z i l a r) = case compareInt# i0 i of
LT -> let l' = w l in l' `seq` Z i l' a r
EQ -> Z i0 l a0 r
GT -> let r' = w r in r' `seq` Z i l a r'
w (P i l a r) = case compareInt# i0 i of
LT -> let l' = w l in l' `seq` P i l' a r
EQ -> P i0 l a0 r
GT -> let r' = w r in r' `seq` P i l a r'
alterIntMap :: (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
alterIntMap f i t = case lookupIntMap i t of
Nothing -> case f Nothing of
Nothing -> t
Just a -> ins i a t
ja -> case f ja of
Nothing -> del i t
Just a' -> assertWriteIntMap i a' t
insertMaybeIntMap :: (a -> Maybe a) -> Key -> a -> IntMap a -> IntMap a
insertMaybeIntMap f i0 a0 t = case lookupIntMap i0 t of
Nothing -> ins i0 a0 t
Just a' -> case f a' of
Nothing -> del i0 t
Just a'' -> assertWriteIntMap i0 a'' t
deleteIntMap :: Key -> IntMap a -> IntMap a
deleteIntMap i t = if t `hasKeyIntMap` i then del i t else t
adjustWithIntMap :: (a -> a) -> Key -> IntMap a -> IntMap a
adjustWithIntMap f i t = case lookupIntMap i t of
Nothing -> t
Just a -> assertWriteIntMap i (f a) t
adjustWithIntMap' :: (a -> a) -> Key -> IntMap a -> IntMap a
adjustWithIntMap' f i t = case lookupIntMap i t of
Nothing -> t
Just a -> let a' = f a in a' `seq` assertWriteIntMap i a' t
adjustMaybeIntMap :: (a -> Maybe a) -> Key -> IntMap a -> IntMap a
adjustMaybeIntMap f i t = case lookupIntMap i t of
Nothing -> t
Just a -> case f a of
Nothing -> del i t
Just a' -> assertWriteIntMap i a' t
isSubsetOfIntMap :: IntMap a -> IntMap b -> Bool
isSubsetOfIntMap = s where
s E _ = True
s _ E = False
s (N ka la _ ra) (N kb lb _ rb) = s' ka la ra kb lb rb
s (N ka la _ ra) (Z kb lb _ rb) = s' ka la ra kb lb rb
s (N ka la _ ra) (P kb lb _ rb) = s' ka la ra kb lb rb
s (Z ka la _ ra) (N kb lb _ rb) = s' ka la ra kb lb rb
s (Z ka la _ ra) (Z kb lb _ rb) = s' ka la ra kb lb rb
s (Z ka la _ ra) (P kb lb _ rb) = s' ka la ra kb lb rb
s (P ka la _ ra) (N kb lb _ rb) = s' ka la ra kb lb rb
s (P ka la _ ra) (Z kb lb _ rb) = s' ka la ra kb lb rb
s (P ka la _ ra) (P kb lb _ rb) = s' ka la ra kb lb rb
s' ka la ra kb lb rb =
case compareInt# ka kb of
LT -> case forkL ka lb of
(# False,_ ,_,_ ,_ #) -> False
(# True ,llb,_,lrb,_ #) -> (s la llb) && case forkR ra kb of
(# rla,_,rra,_ #) -> (s rla lrb) && (s rra rb)
EQ -> (s la lb) && (s ra rb)
GT -> case forkL ka rb of
(# False,_ ,_,_ ,_ #) -> False
(# True ,rlb,_,rrb,_ #) -> (s ra rrb) && case forkR la kb of
(# lla,_,lra,_ #) -> (s lra rlb) && (s lla lb)
forkL ka tb = forkL_ tb 0# where
forkL_ E h = (# False,E,h,E,h #)
forkL_ (N k l b r) h = forkL__ k l ((h)-#2#) b r ((h)-#1#)
forkL_ (Z k l b r) h = forkL__ k l ((h)-#1#) b r ((h)-#1#)
forkL_ (P k l b r) h = forkL__ k l ((h)-#1#) b r ((h)-#2#)
forkL__ k l hl b r hr = case compareInt# ka k of
LT -> case forkL_ l hl of
(# False,t0,ht0,t1,ht1 #) -> (# False,t0,ht0,t1,ht1 #)
(# True ,t0,ht0,t1,ht1 #) -> case spliceH k t1 ht1 b r hr of
(# t1_,ht1_ #) -> (# True,t0,ht0,t1_,ht1_ #)
EQ -> (# True,l,hl,r,hr #)
GT -> case forkL_ r hr of
(# False,t0,ht0,t1,ht1 #) -> (# False,t0,ht0,t1,ht1 #)
(# True ,t0,ht0,t1,ht1 #) -> case spliceH k l hl b t0 ht0 of
(# t0_,ht0_ #) -> (# True,t0_,ht0_,t1,ht1 #)
forkR ta kb = forkR_ ta 0# where
forkR_ E h = (# E,h,E,h #)
forkR_ (N k l a r) h = forkR__ k l ((h)-#2#) a r ((h)-#1#)
forkR_ (Z k l a r) h = forkR__ k l ((h)-#1#) a r ((h)-#1#)
forkR_ (P k l a r) h = forkR__ k l ((h)-#1#) a r ((h)-#2#)
forkR__ k l hl a r hr = case compareInt# k kb of
LT -> case forkR_ r hr of
(# t0,ht0,t1,ht1 #) -> case spliceH k l hl a t0 ht0 of
(# t0_,ht0_ #) -> (# t0_,ht0_,t1,ht1 #)
EQ -> (# l,hl,r,hr #)
GT -> case forkR_ l hl of
(# t0,ht0,t1,ht1 #) -> case spliceH k t1 ht1 a r hr of
(# t1_,ht1_ #) -> (# t0,ht0,t1_,ht1_ #)
isSubmapOfIntMap :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isSubmapOfIntMap p = s where
s E _ = True
s _ E = False
s (N ka la a ra) (N kb lb b rb) = s' ka la a ra kb lb b rb
s (N ka la a ra) (Z kb lb b rb) = s' ka la a ra kb lb b rb
s (N ka la a ra) (P kb lb b rb) = s' ka la a ra kb lb b rb
s (Z ka la a ra) (N kb lb b rb) = s' ka la a ra kb lb b rb
s (Z ka la a ra) (Z kb lb b rb) = s' ka la a ra kb lb b rb
s (Z ka la a ra) (P kb lb b rb) = s' ka la a ra kb lb b rb
s (P ka la a ra) (N kb lb b rb) = s' ka la a ra kb lb b rb
s (P ka la a ra) (Z kb lb b rb) = s' ka la a ra kb lb b rb
s (P ka la a ra) (P kb lb b rb) = s' ka la a ra kb lb b rb
s' ka la a ra kb lb b rb =
case compareInt# ka kb of
LT -> case forkL ka a lb of
(# False,_ ,_,_ ,_ #) -> False
(# True ,llb,_,lrb,_ #) -> (s la llb) && case forkR ra kb b of
(# False,_ ,_,_ ,_ #) -> False
(# True ,rla,_,rra,_ #) -> (s rla lrb) && (s rra rb)
EQ -> (p a b) && (s la lb) && (s ra rb)
GT -> case forkL ka a rb of
(# False,_ ,_,_ ,_ #) -> False
(# True ,rlb,_,rrb,_ #) -> (s ra rrb) && case forkR la kb b of
(# False,_ ,_,_ ,_ #) -> False
(# True, lla,_,lra,_ #) -> (s lra rlb) && (s lla lb)
forkL ka a tb = forkL_ tb 0# where
forkL_ E h = (# False,E,h,E,h #)
forkL_ (N k l b r) h = forkL__ k l ((h)-#2#) b r ((h)-#1#)
forkL_ (Z k l b r) h = forkL__ k l ((h)-#1#) b r ((h)-#1#)
forkL_ (P k l b r) h = forkL__ k l ((h)-#1#) b r ((h)-#2#)
forkL__ k l hl b r hr = case compareInt# ka k of
LT -> case forkL_ l hl of
(# False,t0,ht0,t1,ht1 #) -> (# False,t0,ht0,t1,ht1 #)
(# True ,t0,ht0,t1,ht1 #) -> case spliceH k t1 ht1 b r hr of
(# t1_,ht1_ #) -> (# True,t0,ht0,t1_,ht1_ #)
EQ -> let bool = p a b in bool `seq` (# bool,l,hl,r,hr #)
GT -> case forkL_ r hr of
(# False,t0,ht0,t1,ht1 #) -> (# False,t0,ht0,t1,ht1 #)
(# True ,t0,ht0,t1,ht1 #) -> case spliceH k l hl b t0 ht0 of
(# t0_,ht0_ #) -> (# True,t0_,ht0_,t1,ht1 #)
forkR ta kb b = forkR_ ta 0# where
forkR_ E h = (# True,E,h,E,h #)
forkR_ (N k l a r) h = forkR__ k l ((h)-#2#) a r ((h)-#1#)
forkR_ (Z k l a r) h = forkR__ k l ((h)-#1#) a r ((h)-#1#)
forkR_ (P k l a r) h = forkR__ k l ((h)-#1#) a r ((h)-#2#)
forkR__ k l hl a r hr = case compareInt# k kb of
LT -> case forkR_ r hr of
(# False,t0,ht0,t1,ht1 #) -> (# False,t0,ht0,t1,ht1 #)
(# True ,t0,ht0,t1,ht1 #) -> case spliceH k l hl a t0 ht0 of
(# t0_,ht0_ #) -> (# True,t0_,ht0_,t1,ht1 #)
EQ -> let bool = p a b in bool `seq` (# bool,l,hl,r,hr #)
GT -> case forkR_ l hl of
(# False,t0,ht0,t1,ht1 #) -> (# False,t0,ht0,t1,ht1 #)
(# True ,t0,ht0,t1,ht1 #) -> case spliceH k t1 ht1 a r hr of
(# t1_,ht1_ #) -> (# True,t0,ht0,t1_,ht1_ #)
mapIntMap :: (a -> b) -> IntMap a -> IntMap b
mapIntMap f = mapit where
mapit E = E
mapit (N i l a r) = let l_ = mapit l
r_ = mapit r
in l_ `seq` r_ `seq` N i l_ (f a) r_
mapit (Z i l a r) = let l_ = mapit l
r_ = mapit r
in l_ `seq` r_ `seq` Z i l_ (f a) r_
mapit (P i l a r) = let l_ = mapit l
r_ = mapit r
in l_ `seq` r_ `seq` P i l_ (f a) r_
mapIntMap' :: (a -> b) -> IntMap a -> IntMap b
mapIntMap' f = mapit where
mapit E = E
mapit (N i l a r) = let l_ = mapit l
r_ = mapit r
b = f a
in b `seq` l_ `seq` r_ `seq` N i l_ b r_
mapit (Z i l a r) = let l_ = mapit l
r_ = mapit r
b = f a
in b `seq` l_ `seq` r_ `seq` Z i l_ b r_
mapit (P i l a r) = let l_ = mapit l
r_ = mapit r
b = f a
in b `seq` l_ `seq` r_ `seq` P i l_ b r_
mapMaybeIntMap :: (a -> Maybe b) -> IntMap a -> IntMap b
mapMaybeIntMap f t0 = case mapMaybe_ 0# t0 of (# t_,_ #) -> t_
where mapMaybe_ h t = case t of
E -> (# E,h #)
N i l a r -> m i l ((h)-#2#) a r ((h)-#1#)
Z i l a r -> m i l ((h)-#1#) a r ((h)-#1#)
P i l a r -> m i l ((h)-#1#) a r ((h)-#2#)
where m i l hl a r hr = case mapMaybe_ hl l of
(# l_,hl_ #) -> case mapMaybe_ hr r of
(# r_,hr_ #) -> case f a of
Just b -> spliceH i l_ hl_ b r_ hr_
Nothing -> joinH l_ hl_ r_ hr_
mapWithKeyIntMap :: (Key -> a -> b) -> IntMap a -> IntMap b
mapWithKeyIntMap f = mapit where
mapit E = E
mapit (N i l a r) = let l_ = mapit l
r_ = mapit r
in l_ `seq` r_ `seq` N i l_ (f i a) r_
mapit (Z i l a r) = let l_ = mapit l
r_ = mapit r
in l_ `seq` r_ `seq` Z i l_ (f i a) r_
mapit (P i l a r) = let l_ = mapit l
r_ = mapit r
in l_ `seq` r_ `seq` P i l_ (f i a) r_
mapWithKeyIntMap' :: (Key -> a -> b) -> IntMap a -> IntMap b
mapWithKeyIntMap' f = mapit where
mapit E = E
mapit (N i l a r) = let l_ = mapit l
r_ = mapit r
b = f i a
in b `seq` l_ `seq` r_ `seq` N i l_ b r_
mapit (Z i l a r) = let l_ = mapit l
r_ = mapit r
b = f i a
in b `seq` l_ `seq` r_ `seq` Z i l_ b r_
mapit (P i l a r) = let l_ = mapit l
r_ = mapit r
b = f i a
in b `seq` l_ `seq` r_ `seq` P i l_ b r_
filterIntMap :: (a -> Bool) -> IntMap a -> IntMap a
filterIntMap p t0 = case filter_ 0# t0 of (# _,t_,_ #) -> t_
where filter_ h t = case t of
E -> (# False,E,h #)
N i l e r -> f i l ((h)-#2#) e r ((h)-#1#)
Z i l e r -> f i l ((h)-#1#) e r ((h)-#1#)
P i l e r -> f i l ((h)-#1#) e r ((h)-#2#)
where f i l hl e r hr = case filter_ hl l of
(# bl,l_,hl_ #) -> case filter_ hr r of
(# br,r_,hr_ #) -> if p e
then if bl || br
then case spliceH i l_ hl_ e r_ hr_ of
(# t_,h_ #) -> (# True,t_,h_ #)
else (# False,t,h #)
else case joinH l_ hl_ r_ hr_ of
(# t_,h_ #) -> (# True,t_,h_ #)
foldElemsAscIntMap :: (a -> b -> b) -> b -> IntMap a -> b
foldElemsAscIntMap f bb mp = foldU mp bb where
foldU E b = b
foldU (N _ l a r) b = foldV l a r b
foldU (Z _ l a r) b = foldV l a r b
foldU (P _ l a r) b = foldV l a r b
foldV l a r b = foldU l (f a (foldU r b))
foldElemsDescIntMap :: (a -> b -> b) -> b -> IntMap a -> b
foldElemsDescIntMap f bb mp = foldU mp bb where
foldU E b = b
foldU (N _ l a r) b = foldV l a r b
foldU (Z _ l a r) b = foldV l a r b
foldU (P _ l a r) b = foldV l a r b
foldV l a r b = foldU r (f a (foldU l b))
foldKeysAscIntMap :: (Key -> b -> b) -> b -> IntMap a -> b
foldKeysAscIntMap f bb mp = foldU mp bb where
foldU E b = b
foldU (N k l _ r) b = foldV k l r b
foldU (Z k l _ r) b = foldV k l r b
foldU (P k l _ r) b = foldV k l r b
foldV k l r b = foldU l (f k (foldU r b))
foldKeysDescIntMap :: (Key -> b -> b) -> b -> IntMap a -> b
foldKeysDescIntMap f bb mp = foldU mp bb where
foldU E b = b
foldU (N k l _ r) b = foldV k l r b
foldU (Z k l _ r) b = foldV k l r b
foldU (P k l _ r) b = foldV k l r b
foldV k l r b = foldU r (f k (foldU l b))
foldAssocsAscIntMap :: (Key -> a -> b -> b) -> b -> IntMap a -> b
foldAssocsAscIntMap f bb mp = foldU mp bb where
foldU E b = b
foldU (N k l a r) b = foldV k l a r b
foldU (Z k l a r) b = foldV k l a r b
foldU (P k l a r) b = foldV k l a r b
foldV k l a r b = foldU l (f k a (foldU r b))
foldAssocsDescIntMap :: (Key -> a -> b -> b) -> b -> IntMap a -> b
foldAssocsDescIntMap f bb mp = foldU mp bb where
foldU E b = b
foldU (N k l a r) b = foldV k l a r b
foldU (Z k l a r) b = foldV k l a r b
foldU (P k l a r) b = foldV k l a r b
foldV k l a r b = foldU r (f k a (foldU l b))
foldElemsAscIntMap' :: (a -> b -> b) -> b -> IntMap a -> b
foldElemsAscIntMap' f bb mp = foldU mp bb where
foldU E b = b
foldU (N _ l a r) b = foldV l a r b
foldU (Z _ l a r) b = foldV l a r b
foldU (P _ l a r) b = foldV l a r b
foldV l a r b = let b' = foldU r b
b'' = f a b'
in b' `seq` b'' `seq` foldU l b''
foldElemsDescIntMap' :: (a -> b -> b) -> b -> IntMap a -> b
foldElemsDescIntMap' f bb mp = foldU mp bb where
foldU E b = b
foldU (N _ l a r) b = foldV l a r b
foldU (Z _ l a r) b = foldV l a r b
foldU (P _ l a r) b = foldV l a r b
foldV l a r b = let b' = foldU l b
b'' = f a b'
in b' `seq` b'' `seq` foldU r b''
foldKeysAscIntMap' :: (Key -> b -> b) -> b -> IntMap a -> b
foldKeysAscIntMap' f bb mp = foldU mp bb where
foldU E b = b
foldU (N k l _ r) b = foldV k l r b
foldU (Z k l _ r) b = foldV k l r b
foldU (P k l _ r) b = foldV k l r b
foldV k l r b = let b' = foldU r b
b'' = f k b'
in b' `seq` b'' `seq` foldU l b''
foldKeysDescIntMap' :: (Key -> b -> b) -> b -> IntMap a -> b
foldKeysDescIntMap' f bb mp = foldU mp bb where
foldU E b = b
foldU (N k l _ r) b = foldV k l r b
foldU (Z k l _ r) b = foldV k l r b
foldU (P k l _ r) b = foldV k l r b
foldV k l r b = let b' = foldU l b
b'' = f k b'
in b' `seq` b'' `seq` foldU r b''
foldAssocsAscIntMap' :: (Key -> a -> b -> b) -> b -> IntMap a -> b
foldAssocsAscIntMap' f bb mp = foldU mp bb where
foldU E b = b
foldU (N k l a r) b = foldV k l a r b
foldU (Z k l a r) b = foldV k l a r b
foldU (P k l a r) b = foldV k l a r b
foldV k l a r b = let b' = foldU r b
b'' = f k a b'
in b' `seq` b'' `seq` foldU l b''
foldAssocsDescIntMap' :: (Key -> a -> b -> b) -> b -> IntMap a -> b
foldAssocsDescIntMap' f bb mp = foldU mp bb where
foldU E b = b
foldU (N k l a r) b = foldV k l a r b
foldU (Z k l a r) b = foldV k l a r b
foldU (P k l a r) b = foldV k l a r b
foldV k l a r b = let b' = foldU l b
b'' = f k a b'
in b' `seq` b'' `seq` foldU r b''
foldElemsUIntIntMap :: (a -> Int# -> Int#) -> Int# -> IntMap a -> Int#
foldElemsUIntIntMap f bb mp = foldU mp bb where
foldU E b = b
foldU (N _ l a r) b = foldV l a r b
foldU (Z _ l a r) b = foldV l a r b
foldU (P _ l a r) b = foldV l a r b
foldV l a r b = foldU l (f a (foldU r b))
validIntMap :: IntMap a -> Maybe String
validIntMap imp = if (isBalanced imp) then if (isSorted imp) then Nothing
else Just "IntMap: Tree is not sorted."
else Just "IntMap: Tree is not balanced."
isBalanced :: IntMap a -> Bool
isBalanced t = not (cH t ==# 1#)
cH :: IntMap a -> Int#
cH E = 0#
cH (N _ l _ r) = cH_ 1# l r
cH (Z _ l _ r) = cH_ 0# l r
cH (P _ l _ r) = cH_ 1# r l
cH_ :: Int# -> IntMap a -> IntMap a -> Int#
cH_ delta l r = let hl = cH l
in if hl ==# 1# then hl
else let hr = cH r
in if hr ==# 1# then hr
else if ((hr)-#(hl)) ==# delta then ((hr)+#1#)
else 1#
isSorted :: IntMap a -> Bool
isSorted E = True
isSorted (N i l _ r) = isSorted_ i l r
isSorted (Z i l _ r) = isSorted_ i l r
isSorted (P i l _ r) = isSorted_ i l r
isSorted_ :: Int# -> IntMap a -> IntMap a -> Bool
isSorted_ i l r = (isSortedU l i) && (isSortedL i r)
isSortedU :: IntMap a -> Int# -> Bool
isSortedU E _ = True
isSortedU (N i l _ r) ul = isSortedU_ i l r ul
isSortedU (Z i l _ r) ul = isSortedU_ i l r ul
isSortedU (P i l _ r) ul = isSortedU_ i l r ul
isSortedU_ :: Int# -> IntMap a -> IntMap a -> Int# -> Bool
isSortedU_ i l r ul = case compareInt# i ul of
LT -> (isSortedU l i) && (isSortedLU i r ul)
_ -> False
isSortedL :: Int# -> IntMap a -> Bool
isSortedL _ E = True
isSortedL ll (N i l _ r) = isSortedL_ ll i l r
isSortedL ll (Z i l _ r) = isSortedL_ ll i l r
isSortedL ll (P i l _ r) = isSortedL_ ll i l r
isSortedL_ :: Int# -> Int# -> IntMap a -> IntMap a -> Bool
isSortedL_ ll i l r = case compareInt# i ll of
GT -> (isSortedLU ll l i) && (isSortedL i r)
_ -> False
isSortedLU :: Int# -> IntMap a -> Int# -> Bool
isSortedLU _ E _ = True
isSortedLU ll (N i l _ r) ul = isSortedLU_ ll i l r ul
isSortedLU ll (Z i l _ r) ul = isSortedLU_ ll i l r ul
isSortedLU ll (P i l _ r) ul = isSortedLU_ ll i l r ul
isSortedLU_ :: Int# -> Int# -> IntMap a -> IntMap a -> Int# -> Bool
isSortedLU_ ll i l r ul = case compareInt# i ll of
GT -> case compareInt# i ul of
LT -> (isSortedLU ll l i) && (isSortedLU i r ul)
_ -> False
_ -> False
compareKeyIntMap :: IntMap a -> Int -> Int -> Ordering
compareKeyIntMap _ = compare
urk :: String
urk = "Urk .. Bug in IntMap!"
insertWithIntMap :: (a -> a) -> Key -> a -> IntMap a -> IntMap a
insertWithIntMap _ k0 a0 E = Z k0 E a0 E
insertWithIntMap f k0 a0 (N k l a r) = putN f k0 a0 k l a r
insertWithIntMap f k0 a0 (Z k l a r) = putZ f k0 a0 k l a r
insertWithIntMap f k0 a0 (P k l a r) = putP f k0 a0 k l a r
pushH :: (a -> a) -> Key -> a -> Int# -> IntMap a -> (# IntMap a, Int# #)
pushH _ k0 a0 h E = (# Z k0 E a0 E, ((h)+#1#) #)
pushH f k0 a0 h (N k l a r) = let t_ = putN f k0 a0 k l a r in t_ `seq` (# t_,h #)
pushH f k0 a0 h (Z k l a r) = let t_ = putZ f k0 a0 k l a r in
case t_ of
E -> error urk
Z _ _ _ _ -> (# t_, h #)
_ -> (# t_,((h)+#1#) #)
pushH f k0 a0 h (P k l a r) = let t_ = putP f k0 a0 k l a r in t_ `seq` (# t_,h #)
putN :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putN f k0 a0 k l a r = case compareInt# k0 k of
LT -> putNL f k0 a0 k l a r
EQ -> let a' = f a in N k0 l a' r
GT -> putNR f k0 a0 k l a r
putZ :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putZ f k0 a0 k l a r = case compareInt# k0 k of
LT -> putZL f k0 a0 k l a r
EQ -> let a' = f a in Z k0 l a' r
GT -> putZR f k0 a0 k l a r
putP :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putP f k0 a0 k l a r = case compareInt# k0 k of
LT -> putPL f k0 a0 k l a r
EQ -> let a' = f a in P k0 l a' r
GT -> putPR f k0 a0 k l a r
putNL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putNL _ k0 a0 k E a r = Z k (Z k0 E a0 E) a r
putNL f k0 a0 k (N lk ll la lr) a r = let l' = putN f k0 a0 lk ll la lr
in l' `seq` N k l' a r
putNL f k0 a0 k (P lk ll la lr) a r = let l' = putP f k0 a0 lk ll la lr
in l' `seq` N k l' a r
putNL f k0 a0 k (Z lk ll la lr) a r = let l' = putZ f k0 a0 lk ll la lr
in case l' of
E -> error urk
Z _ _ _ _ -> N k l' a r
_ -> Z k l' a r
putZL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putZL _ k0 a0 k E a r = P k (Z k0 E a0 E) a r
putZL f k0 a0 k (N lk ll la lr) a r = let l' = putN f k0 a0 lk ll la lr
in l' `seq` Z k l' a r
putZL f k0 a0 k (P lk ll la lr) a r = let l' = putP f k0 a0 lk ll la lr
in l' `seq` Z k l' a r
putZL f k0 a0 k (Z lk ll la lr) a r = let l' = putZ f k0 a0 lk ll la lr
in case l' of
E -> error urk
Z _ _ _ _ -> Z k l' a r
_ -> P k l' a r
putZR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putZR _ k0 a0 k l a E = N k l a (Z k0 E a0 E)
putZR f k0 a0 k l a (N rk rl ra rr) = let r' = putN f k0 a0 rk rl ra rr
in r' `seq` Z k l a r'
putZR f k0 a0 k l a (P rk rl ra rr) = let r' = putP f k0 a0 rk rl ra rr
in r' `seq` Z k l a r'
putZR f k0 a0 k l a (Z rk rl ra rr) = let r' = putZ f k0 a0 rk rl ra rr
in case r' of
E -> error urk
Z _ _ _ _ -> Z k l a r'
_ -> N k l a r'
putPR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putPR _ k0 a0 k l a E = Z k l a (Z k0 E a0 E)
putPR f k0 a0 k l a (N rk rl ra rr) = let r' = putN f k0 a0 rk rl ra rr
in r' `seq` P k l a r'
putPR f k0 a0 k l a (P rk rl ra rr) = let r' = putP f k0 a0 rk rl ra rr
in r' `seq` P k l a r'
putPR f k0 a0 k l a (Z rk rl ra rr) = let r' = putZ f k0 a0 rk rl ra rr
in case r' of
E -> error urk
Z _ _ _ _ -> P k l a r'
_ -> Z k l a r'
putNR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putNR _ _ _ _ _ _ E = error urk
putNR f k0 a0 k l a (N rk rl ra rr) = let r' = putN f k0 a0 rk rl ra rr
in r' `seq` N k l a r'
putNR f k0 a0 k l a (P rk rl ra rr) = let r' = putP f k0 a0 rk rl ra rr
in r' `seq` N k l a r'
putNR f k0 a0 k l a (Z rk rl ra rr) = case compareInt# k0 rk of
LT -> putNRL f k0 a0 k l a rk rl ra rr
EQ -> let ra' = f ra in N k l a (Z k0 rl ra' rr)
GT -> putNRR f k0 a0 k l a rk rl ra rr
putPL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putPL _ _ _ _ E _ _ = error urk
putPL f k0 a0 k (N lk ll la lr) a r = let l' = putN f k0 a0 lk ll la lr
in l' `seq` P k l' a r
putPL f k0 a0 k (P lk ll la lr) a r = let l' = putP f k0 a0 lk ll la lr
in l' `seq` P k l' a r
putPL f k0 a0 k (Z lk ll la lr) a r = case compareInt# k0 lk of
LT -> putPLL f k0 a0 k lk ll la lr a r
EQ -> let la' = f la in P k (Z k0 ll la' lr) a r
GT -> putPLR f k0 a0 k lk ll la lr a r
putNRR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putNRR _ k0 a0 k l a rk rl ra E = Z rk (Z k l a rl) ra (Z k0 E a0 E)
putNRR f k0 a0 k l a rk rl ra (N rrk rrl rra rrr) = let rr' = putN f k0 a0 rrk rrl rra rrr
in rr' `seq` N k l a (Z rk rl ra rr')
putNRR f k0 a0 k l a rk rl ra (P rrk rrl rra rrr) = let rr' = putP f k0 a0 rrk rrl rra rrr
in rr' `seq` N k l a (Z rk rl ra rr')
putNRR f k0 a0 k l a rk rl ra (Z rrk rrl rra rrr) = let rr' = putZ f k0 a0 rrk rrl rra rrr
in case rr' of
E -> error urk
Z _ _ _ _ -> N k l a (Z rk rl ra rr')
_ -> Z rk (Z k l a rl) ra rr'
putPLL :: (a -> a) -> Key -> a -> Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> IntMap a
putPLL _ k0 a0 k lk E la lr a r = Z lk (Z k0 E a0 E) la (Z k lr a r)
putPLL f k0 a0 k lk (N llk lll lla llr) la lr a r = let ll' = putN f k0 a0 llk lll lla llr
in ll' `seq` P k (Z lk ll' la lr) a r
putPLL f k0 a0 k lk (P llk lll lla llr) la lr a r = let ll' = putP f k0 a0 llk lll lla llr
in ll' `seq` P k (Z lk ll' la lr) a r
putPLL f k0 a0 k lk (Z llk lll lla llr) la lr a r = let ll' = putZ f k0 a0 llk lll lla llr
in case ll' of
E -> error urk
Z _ _ _ _ -> P k (Z lk ll' la lr) a r
_ -> Z lk ll' la (Z k lr a r)
putNRL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
putNRL _ k0 a0 k l a rk E ra rr = Z k0 (Z k l a E) a0 (Z rk E ra rr)
putNRL f k0 a0 k l a rk (N rlk rll rla rlr) ra rr = let rl' = putN f k0 a0 rlk rll rla rlr
in rl' `seq` N k l a (Z rk rl' ra rr)
putNRL f k0 a0 k l a rk (P rlk rll rla rlr) ra rr = let rl' = putP f k0 a0 rlk rll rla rlr
in rl' `seq` N k l a (Z rk rl' ra rr)
putNRL f k0 a0 k l a rk (Z rlk rll rla rlr) ra rr = let rl' = putZ f k0 a0 rlk rll rla rlr
in case rl' of
E -> error urk
Z _ _ _ _ -> N k l a (Z rk rl' ra rr)
N rlk' rll' rla' rlr' -> Z rlk' (P k l a rll') rla' (Z rk rlr' ra rr)
P rlk' rll' rla' rlr' -> Z rlk' (Z k l a rll') rla' (N rk rlr' ra rr)
putPLR :: (a -> a) -> Key -> a -> Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> IntMap a
putPLR _ k0 a0 k lk ll la E a r = Z k0 (Z lk ll la E) a0 (Z k E a r)
putPLR f k0 a0 k lk ll la (N lrk lrl lra lrr) a r = let lr' = putN f k0 a0 lrk lrl lra lrr
in lr' `seq` P k (Z lk ll la lr') a r
putPLR f k0 a0 k lk ll la (P lrk lrl lra lrr) a r = let lr' = putP f k0 a0 lrk lrl lra lrr
in lr' `seq` P k (Z lk ll la lr') a r
putPLR f k0 a0 k lk ll la (Z lrk lrl lra lrr) a r = let lr' = putZ f k0 a0 lrk lrl lra lrr
in case lr' of
E -> error urk
Z _ _ _ _ -> P k (Z lk ll la lr') a r
N lrk' lrl' lra' lrr' -> Z lrk' (P lk ll la lrl') lra' (Z k lrr' a r)
P lrk' lrl' lra' lrr' -> Z lrk' (Z lk ll la lrl') lra' (N k lrr' a r)
pushH'
:: (a -> a) -> Key -> a -> Int# -> IntMap a -> (# IntMap a, Int# #)
pushH' _ k0 a0 h E =
(# Z k0 E a0 E, ((h)+#1#) #)
pushH' f k0 a0 h (N k l a r) = let t_ = pputN f k0 a0 k l a r in t_ `seq`
(# t_,h #)
pushH' f k0 a0 h (Z k l a r) = let t_ = pputZ f k0 a0 k l a r in
case t_ of
E -> error urk
Z _ _ _ _ -> (# t_, h #)
_ -> (# t_,((h)+#1#) #)
pushH' f k0 a0 h (P k l a r) = let t_ = pputP f k0 a0 k l a r in t_ `seq`
(# t_,h #)
pputN :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputN f k0 a0 k l a r = case compareInt# k0 k of
LT -> pputNL f k0 a0 k l a r
EQ -> let a' = f a in a' `seq` N k0 l a' r
GT -> pputNR f k0 a0 k l a r
pputZ :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputZ f k0 a0 k l a r = case compareInt# k0 k of
LT -> pputZL f k0 a0 k l a r
EQ -> let a' = f a in a' `seq` Z k0 l a' r
GT -> pputZR f k0 a0 k l a r
pputP :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputP f k0 a0 k l a r = case compareInt# k0 k of
LT -> pputPL f k0 a0 k l a r
EQ -> let a' = f a in a' `seq` P k0 l a' r
GT -> pputPR f k0 a0 k l a r
pputNL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputNL _ k0 a0 k E a r = Z k (Z k0 E a0 E) a r
pputNL f k0 a0 k (N lk ll la lr) a r = let l' = pputN f k0 a0 lk ll la lr
in l' `seq` N k l' a r
pputNL f k0 a0 k (P lk ll la lr) a r = let l' = pputP f k0 a0 lk ll la lr
in l' `seq` N k l' a r
pputNL f k0 a0 k (Z lk ll la lr) a r = let l' = pputZ f k0 a0 lk ll la lr
in case l' of
E -> error urk
Z _ _ _ _ -> N k l' a r
_ -> Z k l' a r
pputZL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputZL _ k0 a0 k E a r = P k (Z k0 E a0 E) a r
pputZL f k0 a0 k (N lk ll la lr) a r = let l' = pputN f k0 a0 lk ll la lr
in l' `seq` Z k l' a r
pputZL f k0 a0 k (P lk ll la lr) a r = let l' = pputP f k0 a0 lk ll la lr
in l' `seq` Z k l' a r
pputZL f k0 a0 k (Z lk ll la lr) a r = let l' = pputZ f k0 a0 lk ll la lr
in case l' of
E -> error urk
Z _ _ _ _ -> Z k l' a r
_ -> P k l' a r
pputZR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputZR _ k0 a0 k l a E = N k l a (Z k0 E a0 E)
pputZR f k0 a0 k l a (N rk rl ra rr) = let r' = pputN f k0 a0 rk rl ra rr
in r' `seq` Z k l a r'
pputZR f k0 a0 k l a (P rk rl ra rr) = let r' = pputP f k0 a0 rk rl ra rr
in r' `seq` Z k l a r'
pputZR f k0 a0 k l a (Z rk rl ra rr) = let r' = pputZ f k0 a0 rk rl ra rr
in case r' of
E -> error urk
Z _ _ _ _ -> Z k l a r'
_ -> N k l a r'
pputPR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputPR _ k0 a0 k l a E = Z k l a (Z k0 E a0 E)
pputPR f k0 a0 k l a (N rk rl ra rr) = let r' = pputN f k0 a0 rk rl ra rr
in r' `seq` P k l a r'
pputPR f k0 a0 k l a (P rk rl ra rr) = let r' = pputP f k0 a0 rk rl ra rr
in r' `seq` P k l a r'
pputPR f k0 a0 k l a (Z rk rl ra rr) = let r' = pputZ f k0 a0 rk rl ra rr
in case r' of
E -> error urk
Z _ _ _ _ -> P k l a r'
_ -> Z k l a r'
pputNR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputNR _ _ _ _ _ _ E = error urk
pputNR f k0 a0 k l a (N rk rl ra rr) = let r' = pputN f k0 a0 rk rl ra rr
in r' `seq` N k l a r'
pputNR f k0 a0 k l a (P rk rl ra rr) = let r' = pputP f k0 a0 rk rl ra rr
in r' `seq` N k l a r'
pputNR f k0 a0 k l a (Z rk rl ra rr) = case compareInt# k0 rk of
LT -> pputNRL f k0 a0 k l a rk rl ra rr
EQ -> let ra' = f ra in ra' `seq` N k l a (Z k0 rl ra' rr)
GT -> pputNRR f k0 a0 k l a rk rl ra rr
pputPL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputPL _ _ _ _ E _ _ = error urk
pputPL f k0 a0 k (N lk ll la lr) a r = let l' = pputN f k0 a0 lk ll la lr
in l' `seq` P k l' a r
pputPL f k0 a0 k (P lk ll la lr) a r = let l' = pputP f k0 a0 lk ll la lr
in l' `seq` P k l' a r
pputPL f k0 a0 k (Z lk ll la lr) a r = case compareInt# k0 lk of
LT -> pputPLL f k0 a0 k lk ll la lr a r
EQ -> let la' = f la in la' `seq` P k (Z k0 ll la' lr) a r
GT -> pputPLR f k0 a0 k lk ll la lr a r
pputNRR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputNRR _ k0 a0 k l a rk rl ra E = Z rk (Z k l a rl) ra (Z k0 E a0 E)
pputNRR f k0 a0 k l a rk rl ra (N rrk rrl rra rrr) = let rr' = pputN f k0 a0 rrk rrl rra rrr
in rr' `seq` N k l a (Z rk rl ra rr')
pputNRR f k0 a0 k l a rk rl ra (P rrk rrl rra rrr) = let rr' = pputP f k0 a0 rrk rrl rra rrr
in rr' `seq` N k l a (Z rk rl ra rr')
pputNRR f k0 a0 k l a rk rl ra (Z rrk rrl rra rrr) = let rr' = pputZ f k0 a0 rrk rrl rra rrr
in case rr' of
E -> error urk
Z _ _ _ _ -> N k l a (Z rk rl ra rr')
_ -> Z rk (Z k l a rl) ra rr'
pputPLL :: (a -> a) -> Key -> a -> Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> IntMap a
pputPLL _ k0 a0 k lk E la lr a r = Z lk (Z k0 E a0 E) la (Z k lr a r)
pputPLL f k0 a0 k lk (N llk lll lla llr) la lr a r = let ll' = pputN f k0 a0 llk lll lla llr
in ll' `seq` P k (Z lk ll' la lr) a r
pputPLL f k0 a0 k lk (P llk lll lla llr) la lr a r = let ll' = pputP f k0 a0 llk lll lla llr
in ll' `seq` P k (Z lk ll' la lr) a r
pputPLL f k0 a0 k lk (Z llk lll lla llr) la lr a r = let ll' = pputZ f k0 a0 llk lll lla llr
in case ll' of
E -> error urk
Z _ _ _ _ -> P k (Z lk ll' la lr) a r
_ -> Z lk ll' la (Z k lr a r)
pputNRL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
pputNRL _ k0 a0 k l a rk E ra rr = Z k0 (Z k l a E) a0 (Z rk E ra rr)
pputNRL f k0 a0 k l a rk (N rlk rll rla rlr) ra rr = let rl' = pputN f k0 a0 rlk rll rla rlr
in rl' `seq` N k l a (Z rk rl' ra rr)
pputNRL f k0 a0 k l a rk (P rlk rll rla rlr) ra rr = let rl' = pputP f k0 a0 rlk rll rla rlr
in rl' `seq` N k l a (Z rk rl' ra rr)
pputNRL f k0 a0 k l a rk (Z rlk rll rla rlr) ra rr = let rl' = pputZ f k0 a0 rlk rll rla rlr
in case rl' of
E -> error urk
Z _ _ _ _ -> N k l a (Z rk rl' ra rr)
N rlk' rll' rla' rlr' -> Z rlk' (P k l a rll') rla' (Z rk rlr' ra rr)
P rlk' rll' rla' rlr' -> Z rlk' (Z k l a rll') rla' (N rk rlr' ra rr)
pputPLR :: (a -> a) -> Key -> a -> Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> IntMap a
pputPLR _ k0 a0 k lk ll la E a r = Z k0 (Z lk ll la E) a0 (Z k E a r)
pputPLR f k0 a0 k lk ll la (N lrk lrl lra lrr) a r = let lr' = pputN f k0 a0 lrk lrl lra lrr
in lr' `seq` P k (Z lk ll la lr') a r
pputPLR f k0 a0 k lk ll la (P lrk lrl lra lrr) a r = let lr' = pputP f k0 a0 lrk lrl lra lrr
in lr' `seq` P k (Z lk ll la lr') a r
pputPLR f k0 a0 k lk ll la (Z lrk lrl lra lrr) a r = let lr' = pputZ f k0 a0 lrk lrl lra lrr
in case lr' of
E -> error urk
Z _ _ _ _ -> P k (Z lk ll la lr') a r
N lrk' lrl' lra' lrr' -> Z lrk' (P lk ll la lrl') lra' (Z k lrr' a r)
P lrk' lrl' lra' lrr' -> Z lrk' (Z lk ll la lrl') lra' (N k lrr' a r)
insertWithIntMap'
:: (a -> a) -> Key -> a -> IntMap a -> IntMap a
insertWithIntMap' _ k0 a0 E = a0 `seq` Z k0 E a0 E
insertWithIntMap' f k0 a0 (N k l a r) = ppputN f k0 a0 k l a r
insertWithIntMap' f k0 a0 (Z k l a r) = ppputZ f k0 a0 k l a r
insertWithIntMap' f k0 a0 (P k l a r) = ppputP f k0 a0 k l a r
ppputN :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputN f k0 a0 k l a r = case compareInt# k0 k of
LT -> ppputNL f k0 a0 k l a r
EQ -> let a' = f a in a' `seq` N k0 l a' r
GT -> ppputNR f k0 a0 k l a r
ppputZ :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputZ f k0 a0 k l a r = case compareInt# k0 k of
LT -> ppputZL f k0 a0 k l a r
EQ -> let a' = f a in a' `seq` Z k0 l a' r
GT -> ppputZR f k0 a0 k l a r
ppputP :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputP f k0 a0 k l a r = case compareInt# k0 k of
LT -> ppputPL f k0 a0 k l a r
EQ -> let a' = f a in a' `seq` P k0 l a' r
GT -> ppputPR f k0 a0 k l a r
ppputNL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputNL _ k0 a0 k E a r = a0 `seq` Z k (Z k0 E a0 E) a r
ppputNL f k0 a0 k (N lk ll la lr) a r = let l' = ppputN f k0 a0 lk ll la lr
in l' `seq` N k l' a r
ppputNL f k0 a0 k (P lk ll la lr) a r = let l' = ppputP f k0 a0 lk ll la lr
in l' `seq` N k l' a r
ppputNL f k0 a0 k (Z lk ll la lr) a r = let l' = ppputZ f k0 a0 lk ll la lr
in case l' of
E -> error urk
Z _ _ _ _ -> N k l' a r
_ -> Z k l' a r
ppputZL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputZL _ k0 a0 k E a r = a0 `seq` P k (Z k0 E a0 E) a r
ppputZL f k0 a0 k (N lk ll la lr) a r = let l' = ppputN f k0 a0 lk ll la lr
in l' `seq` Z k l' a r
ppputZL f k0 a0 k (P lk ll la lr) a r = let l' = ppputP f k0 a0 lk ll la lr
in l' `seq` Z k l' a r
ppputZL f k0 a0 k (Z lk ll la lr) a r = let l' = ppputZ f k0 a0 lk ll la lr
in case l' of
E -> error urk
Z _ _ _ _ -> Z k l' a r
_ -> P k l' a r
ppputZR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputZR _ k0 a0 k l a E = a0 `seq` N k l a (Z k0 E a0 E)
ppputZR f k0 a0 k l a (N rk rl ra rr) = let r' = ppputN f k0 a0 rk rl ra rr
in r' `seq` Z k l a r'
ppputZR f k0 a0 k l a (P rk rl ra rr) = let r' = ppputP f k0 a0 rk rl ra rr
in r' `seq` Z k l a r'
ppputZR f k0 a0 k l a (Z rk rl ra rr) = let r' = ppputZ f k0 a0 rk rl ra rr
in case r' of
E -> error urk
Z _ _ _ _ -> Z k l a r'
_ -> N k l a r'
ppputPR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputPR _ k0 a0 k l a E = a0 `seq` Z k l a (Z k0 E a0 E)
ppputPR f k0 a0 k l a (N rk rl ra rr) = let r' = ppputN f k0 a0 rk rl ra rr
in r' `seq` P k l a r'
ppputPR f k0 a0 k l a (P rk rl ra rr) = let r' = ppputP f k0 a0 rk rl ra rr
in r' `seq` P k l a r'
ppputPR f k0 a0 k l a (Z rk rl ra rr) = let r' = ppputZ f k0 a0 rk rl ra rr
in case r' of
E -> error urk
Z _ _ _ _ -> P k l a r'
_ -> Z k l a r'
ppputNR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputNR _ _ _ _ _ _ E = error urk
ppputNR f k0 a0 k l a (N rk rl ra rr) = let r' = ppputN f k0 a0 rk rl ra rr
in r' `seq` N k l a r'
ppputNR f k0 a0 k l a (P rk rl ra rr) = let r' = ppputP f k0 a0 rk rl ra rr
in r' `seq` N k l a r'
ppputNR f k0 a0 k l a (Z rk rl ra rr) = case compareInt# k0 rk of
LT -> ppputNRL f k0 a0 k l a rk rl ra rr
EQ -> let ra' = f ra in ra' `seq` N k l a (Z k0 rl ra' rr)
GT -> ppputNRR f k0 a0 k l a rk rl ra rr
ppputPL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputPL _ _ _ _ E _ _ = error urk
ppputPL f k0 a0 k (N lk ll la lr) a r = let l' = ppputN f k0 a0 lk ll la lr
in l' `seq` P k l' a r
ppputPL f k0 a0 k (P lk ll la lr) a r = let l' = ppputP f k0 a0 lk ll la lr
in l' `seq` P k l' a r
ppputPL f k0 a0 k (Z lk ll la lr) a r = case compareInt# k0 lk of
LT -> ppputPLL f k0 a0 k lk ll la lr a r
EQ -> let la' = f la in la' `seq` P k (Z k0 ll la' lr) a r
GT -> ppputPLR f k0 a0 k lk ll la lr a r
ppputNRR :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputNRR _ k0 a0 k l a rk rl ra E = a0 `seq` Z rk (Z k l a rl) ra (Z k0 E a0 E)
ppputNRR f k0 a0 k l a rk rl ra (N rrk rrl rra rrr) = let rr' = ppputN f k0 a0 rrk rrl rra rrr
in rr' `seq` N k l a (Z rk rl ra rr')
ppputNRR f k0 a0 k l a rk rl ra (P rrk rrl rra rrr) = let rr' = ppputP f k0 a0 rrk rrl rra rrr
in rr' `seq` N k l a (Z rk rl ra rr')
ppputNRR f k0 a0 k l a rk rl ra (Z rrk rrl rra rrr) = let rr' = ppputZ f k0 a0 rrk rrl rra rrr
in case rr' of
E -> error urk
Z _ _ _ _ -> N k l a (Z rk rl ra rr')
_ -> Z rk (Z k l a rl) ra rr'
ppputPLL :: (a -> a) -> Key -> a -> Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> IntMap a
ppputPLL _ k0 a0 k lk E la lr a r = a0 `seq` Z lk (Z k0 E a0 E) la (Z k lr a r)
ppputPLL f k0 a0 k lk (N llk lll lla llr) la lr a r = let ll' = ppputN f k0 a0 llk lll lla llr
in ll' `seq` P k (Z lk ll' la lr) a r
ppputPLL f k0 a0 k lk (P llk lll lla llr) la lr a r = let ll' = ppputP f k0 a0 llk lll lla llr
in ll' `seq` P k (Z lk ll' la lr) a r
ppputPLL f k0 a0 k lk (Z llk lll lla llr) la lr a r = let ll' = ppputZ f k0 a0 llk lll lla llr
in case ll' of
E -> error urk
Z _ _ _ _ -> P k (Z lk ll' la lr) a r
_ -> Z lk ll' la (Z k lr a r)
ppputNRL :: (a -> a) -> Key -> a -> Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
ppputNRL _ k0 a0 k l a rk E ra rr = a0 `seq` Z k0 (Z k l a E) a0 (Z rk E ra rr)
ppputNRL f k0 a0 k l a rk (N rlk rll rla rlr) ra rr = let rl' = ppputN f k0 a0 rlk rll rla rlr
in rl' `seq` N k l a (Z rk rl' ra rr)
ppputNRL f k0 a0 k l a rk (P rlk rll rla rlr) ra rr = let rl' = ppputP f k0 a0 rlk rll rla rlr
in rl' `seq` N k l a (Z rk rl' ra rr)
ppputNRL f k0 a0 k l a rk (Z rlk rll rla rlr) ra rr = let rl' = ppputZ f k0 a0 rlk rll rla rlr
in case rl' of
E -> error urk
Z _ _ _ _ -> N k l a (Z rk rl' ra rr)
N rlk' rll' rla' rlr' -> Z rlk' (P k l a rll') rla' (Z rk rlr' ra rr)
P rlk' rll' rla' rlr' -> Z rlk' (Z k l a rll') rla' (N rk rlr' ra rr)
ppputPLR :: (a -> a) -> Key -> a -> Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> IntMap a
ppputPLR _ k0 a0 k lk ll la E a r = a0 `seq` Z k0 (Z lk ll la E) a0 (Z k E a r)
ppputPLR f k0 a0 k lk ll la (N lrk lrl lra lrr) a r = let lr' = ppputN f k0 a0 lrk lrl lra lrr
in lr' `seq` P k (Z lk ll la lr') a r
ppputPLR f k0 a0 k lk ll la (P lrk lrl lra lrr) a r = let lr' = ppputP f k0 a0 lrk lrl lra lrr
in lr' `seq` P k (Z lk ll la lr') a r
ppputPLR f k0 a0 k lk ll la (Z lrk lrl lra lrr) a r = let lr' = ppputZ f k0 a0 lrk lrl lra lrr
in case lr' of
E -> error urk
Z _ _ _ _ -> P k (Z lk ll la lr') a r
N lrk' lrl' lra' lrr' -> Z lrk' (P lk ll la lrl') lra' (Z k lrr' a r)
P lrk' lrl' lra' lrr' -> Z lrk' (Z lk ll la lrl') lra' (N k lrr' a r)
ins :: Key -> a -> IntMap a -> IntMap a
ins k0 a0 E = Z k0 E a0 E
ins k0 a0 (N k l a r) = insN k0 a0 k l a r
ins k0 a0 (Z k l a r) = insZ k0 a0 k l a r
ins k0 a0 (P k l a r) = insP k0 a0 k l a r
insH :: Key -> a -> Int# -> IntMap a -> (# IntMap a, Int# #)
insH k0 a0 h E = (# Z k0 E a0 E, ((h)+#1#) #)
insH k0 a0 h (N k l a r) = let t_ = insN k0 a0 k l a r in t_ `seq` (# t_,h #)
insH k0 a0 h (Z k l a r) = let t_ = insZ k0 a0 k l a r in
case t_ of
N _ _ _ _ -> (# t_,((h)+#1#) #)
P _ _ _ _ -> (# t_,((h)+#1#) #)
_ -> (# t_, h #)
insH k0 a0 h (P k l a r) = let t_ = insP k0 a0 k l a r in t_ `seq` (# t_,h #)
insN :: Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insN k0 a0 k l a r = case compareInt# k0 k of
LT -> insNL k0 a0 k l a r
EQ -> N k l a0 r
GT -> insNR k0 a0 k l a r
insZ :: Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insZ k0 a0 k l a r = case compareInt# k0 k of
LT -> insZL k0 a0 k l a r
EQ -> Z k l a0 r
GT -> insZR k0 a0 k l a r
insP :: Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insP k0 a0 k l a r = case compareInt# k0 k of
LT -> insPL k0 a0 k l a r
EQ -> P k l a0 r
GT -> insPR k0 a0 k l a r
insNL :: Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insNL k0 a0 k E a r = Z k (Z k0 E a0 E) a r
insNL k0 a0 k (N lk ll la lr) a r = let l' = insN k0 a0 lk ll la lr
in l' `seq` N k l' a r
insNL k0 a0 k (P lk ll la lr) a r = let l' = insP k0 a0 lk ll la lr
in l' `seq` N k l' a r
insNL k0 a0 k (Z lk ll la lr) a r = let l' = insZ k0 a0 lk ll la lr
in case l' of
E -> error urk
Z _ _ _ _ -> N k l' a r
_ -> Z k l' a r
insZL :: Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insZL k0 a0 k E a r = P k (Z k0 E a0 E) a r
insZL k0 a0 k (N lk ll la lr) a r = let l' = insN k0 a0 lk ll la lr
in l' `seq` Z k l' a r
insZL k0 a0 k (P lk ll la lr) a r = let l' = insP k0 a0 lk ll la lr
in l' `seq` Z k l' a r
insZL k0 a0 k (Z lk ll la lr) a r = let l' = insZ k0 a0 lk ll la lr
in case l' of
E -> error urk
Z _ _ _ _ -> Z k l' a r
_ -> P k l' a r
insZR :: Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insZR k0 a0 k l a E = N k l a (Z k0 E a0 E)
insZR k0 a0 k l a (N rk rl ra rr) = let r' = insN k0 a0 rk rl ra rr
in r' `seq` Z k l a r'
insZR k0 a0 k l a (P rk rl ra rr) = let r' = insP k0 a0 rk rl ra rr
in r' `seq` Z k l a r'
insZR k0 a0 k l a (Z rk rl ra rr) = let r' = insZ k0 a0 rk rl ra rr
in case r' of
E -> error urk
Z _ _ _ _ -> Z k l a r'
_ -> N k l a r'
insPR :: Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insPR k0 a0 k l a E = Z k l a (Z k0 E a0 E)
insPR k0 a0 k l a (N rk rl ra rr) = let r' = insN k0 a0 rk rl ra rr
in r' `seq` P k l a r'
insPR k0 a0 k l a (P rk rl ra rr) = let r' = insP k0 a0 rk rl ra rr
in r' `seq` P k l a r'
insPR k0 a0 k l a (Z rk rl ra rr) = let r' = insZ k0 a0 rk rl ra rr
in case r' of
E -> error urk
Z _ _ _ _ -> P k l a r'
_ -> Z k l a r'
insNR :: Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insNR _ _ _ _ _ E = error urk
insNR k0 a0 k l a (N rk rl ra rr) = let r' = insN k0 a0 rk rl ra rr
in r' `seq` N k l a r'
insNR k0 a0 k l a (P rk rl ra rr) = let r' = insP k0 a0 rk rl ra rr
in r' `seq` N k l a r'
insNR k0 a0 k l a (Z rk rl ra rr) = case compareInt# k0 rk of
LT -> insNRL k0 a0 k l a rk rl ra rr
EQ -> N k l a (Z rk rl a0 rr)
GT -> insNRR k0 a0 k l a rk rl ra rr
insPL :: Key -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insPL _ _ _ E _ _ = error urk
insPL k0 a0 k (N lk ll la lr) a r = let l' = insN k0 a0 lk ll la lr
in l' `seq` P k l' a r
insPL k0 a0 k (P lk ll la lr) a r = let l' = insP k0 a0 lk ll la lr
in l' `seq` P k l' a r
insPL k0 a0 k (Z lk ll la lr) a r = case compareInt# k0 lk of
LT -> insPLL k0 a0 k lk ll la lr a r
EQ -> P k (Z lk ll a0 lr) a r
GT -> insPLR k0 a0 k lk ll la lr a r
insNRR :: Key -> a -> Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insNRR k0 a0 k l a rk rl ra E = Z rk (Z k l a rl) ra (Z k0 E a0 E)
insNRR k0 a0 k l a rk rl ra (N rrk rrl rra rrr) = let rr' = insN k0 a0 rrk rrl rra rrr
in rr' `seq` N k l a (Z rk rl ra rr')
insNRR k0 a0 k l a rk rl ra (P rrk rrl rra rrr) = let rr' = insP k0 a0 rrk rrl rra rrr
in rr' `seq` N k l a (Z rk rl ra rr')
insNRR k0 a0 k l a rk rl ra (Z rrk rrl rra rrr) = let rr' = insZ k0 a0 rrk rrl rra rrr
in case rr' of
E -> error urk
Z _ _ _ _ -> N k l a (Z rk rl ra rr')
_ -> Z rk (Z k l a rl) ra rr'
insPLL :: Key -> a -> Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> IntMap a
insPLL k0 a0 k lk E la lr a r = Z lk (Z k0 E a0 E) la (Z k lr a r)
insPLL k0 a0 k lk (N llk lll lla llr) la lr a r = let ll' = insN k0 a0 llk lll lla llr
in ll' `seq` P k (Z lk ll' la lr) a r
insPLL k0 a0 k lk (P llk lll lla llr) la lr a r = let ll' = insP k0 a0 llk lll lla llr
in ll' `seq` P k (Z lk ll' la lr) a r
insPLL k0 a0 k lk (Z llk lll lla llr) la lr a r = let ll' = insZ k0 a0 llk lll lla llr
in case ll' of
E -> error urk
Z _ _ _ _ -> P k (Z lk ll' la lr) a r
_ -> Z lk ll' la (Z k lr a r)
insNRL :: Key -> a -> Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> IntMap a
insNRL k0 a0 k l a rk E ra rr = Z k0 (Z k l a E) a0 (Z rk E ra rr)
insNRL k0 a0 k l a rk (N rlk rll rla rlr) ra rr = let rl' = insN k0 a0 rlk rll rla rlr
in rl' `seq` N k l a (Z rk rl' ra rr)
insNRL k0 a0 k l a rk (P rlk rll rla rlr) ra rr = let rl' = insP k0 a0 rlk rll rla rlr
in rl' `seq` N k l a (Z rk rl' ra rr)
insNRL k0 a0 k l a rk (Z rlk rll rla rlr) ra rr = let rl' = insZ k0 a0 rlk rll rla rlr
in case rl' of
E -> error urk
Z _ _ _ _ -> N k l a (Z rk rl' ra rr)
N rlk' rll' rla' rlr' -> Z rlk' (P k l a rll') rla' (Z rk rlr' ra rr)
P rlk' rll' rla' rlr' -> Z rlk' (Z k l a rll') rla' (N rk rlr' ra rr)
insPLR :: Key -> a -> Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> IntMap a
insPLR k0 a0 k lk ll la E a r = Z k0 (Z lk ll la E) a0 (Z k E a r)
insPLR k0 a0 k lk ll la (N lrk lrl lra lrr) a r = let lr' = insN k0 a0 lrk lrl lra lrr
in lr' `seq` P k (Z lk ll la lr') a r
insPLR k0 a0 k lk ll la (P lrk lrl lra lrr) a r = let lr' = insP k0 a0 lrk lrl lra lrr
in lr' `seq` P k (Z lk ll la lr') a r
insPLR k0 a0 k lk ll la (Z lrk lrl lra lrr) a r = let lr' = insZ k0 a0 lrk lrl lra lrr
in case lr' of
E -> error urk
Z _ _ _ _ -> P k (Z lk ll la lr') a r
N lrk' lrl' lra' lrr' -> Z lrk' (P lk ll la lrl') lra' (Z k lrr' a r)
P lrk' lrl' lra' lrr' -> Z lrk' (Z lk ll la lrl') lra' (N k lrr' a r)
unionIntMap :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
unionIntMap f t0_ t1_ = u0 t0_ t1_ where
u0 E t1 = t1
u0 t0 E = t0
u0 t0@(N _ l0 _ _ ) t1@(N _ l1 _ _ ) = uH (addHeight 2# l0) t0 (addHeight 2# l1) t1
u0 t0@(N _ l0 _ _ ) t1@(Z _ l1 _ _ ) = uH (addHeight 2# l0) t0 (addHeight 1# l1) t1
u0 t0@(N _ l0 _ _ ) t1@(P _ _ _ r1) = uH (addHeight 2# l0) t0 (addHeight 2# r1) t1
u0 t0@(Z _ l0 _ _ ) t1@(N _ l1 _ _ ) = uH (addHeight 1# l0) t0 (addHeight 2# l1) t1
u0 t0@(Z _ l0 _ _ ) t1@(Z _ l1 _ _ ) = uH (addHeight 1# l0) t0 (addHeight 1# l1) t1
u0 t0@(Z _ l0 _ _ ) t1@(P _ _ _ r1) = uH (addHeight 1# l0) t0 (addHeight 2# r1) t1
u0 t0@(P _ _ _ r0) t1@(N _ l1 _ _ ) = uH (addHeight 2# r0) t0 (addHeight 2# l1) t1
u0 t0@(P _ _ _ r0) t1@(Z _ l1 _ _ ) = uH (addHeight 2# r0) t0 (addHeight 1# l1) t1
u0 t0@(P _ _ _ r0) t1@(P _ _ _ r1) = uH (addHeight 2# r0) t0 (addHeight 2# r1) t1
uH h0 t0 h1 t1 = case u h0 t0 h1 t1 of (# t,_ #) -> t
u 0# _ h1 t1 = (# t1,h1 #)
u h0 t0 0# _ = (# t0,h0 #)
u 1# (Z k0 _ a0 _ ) 1# t1@(Z k1 _ a1 _ ) = case compareInt# k0 k1 of
LT -> (# N k0 E a0 t1, 2# #)
EQ -> (# Z k0 E (f a0 a1) E , 1# #)
GT -> (# P k0 t1 a0 E , 2# #)
u 1# (Z k0 _ a0 _ ) ht1 t1 = pushAB k0 a0 ht1 t1
u ht0 t0 1# (Z k1 _ a1 _ ) = pushBA k1 a1 ht0 t0
u 2# (N k0 _ a0 (Z k0_ _ a0_ _)) ht1 t1 = pushAB2 k0 a0 k0_ a0_ ht1 t1
u 2# (P k0_ (Z k0 _ a0 _) a0_ _) ht1 t1 = pushAB2 k0 a0 k0_ a0_ ht1 t1
u ht0 t0 2# (N k1 _ a1 (Z k1_ _ a1_ _)) = pushBA2 k1 a1 k1_ a1_ ht0 t0
u ht0 t0 2# (P k1_ (Z k1 _ a1 _) a1_ _) = pushBA2 k1 a1 k1_ a1_ ht0 t0
u 2# (Z k0_ (Z k0 _ a0 _) a0_ (Z k0__ _ a0__ _)) ht1 t1 = pushAB3 k0 a0 k0_ a0_ k0__ a0__ ht1 t1
u ht0 t0 2# (Z k1_ (Z k1 _ a1 _) a1_ (Z k1__ _ a1__ _)) = pushBA3 k1 a1 k1_ a1_ k1__ a1__ ht0 t0
u h0 (N k0 l0 a0 r0) h1 (N k1 l1 a1 r1) = u_ k0 ((h0)-#2#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#2#) l1 a1 ((h1)-#1#) r1
u h0 (N k0 l0 a0 r0) h1 (Z k1 l1 a1 r1) = u_ k0 ((h0)-#2#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#1#) r1
u h0 (N k0 l0 a0 r0) h1 (P k1 l1 a1 r1) = u_ k0 ((h0)-#2#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#2#) r1
u h0 (Z k0 l0 a0 r0) h1 (N k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#2#) l1 a1 ((h1)-#1#) r1
u h0 (Z k0 l0 a0 r0) h1 (Z k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#1#) r1
u h0 (Z k0 l0 a0 r0) h1 (P k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#2#) r1
u h0 (P k0 l0 a0 r0) h1 (N k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#2#) r0 k1 ((h1)-#2#) l1 a1 ((h1)-#1#) r1
u h0 (P k0 l0 a0 r0) h1 (Z k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#2#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#1#) r1
u h0 (P k0 l0 a0 r0) h1 (P k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#2#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#2#) r1
u _ _ _ _ = error (mErr ++ "unionIntMap: Bad IntMap.")
u_ k0 hl0 l0 a0 hr0 r0 k1 hl1 l1 a1 hr1 r1 =
case compareInt# k0 k1 of
LT -> case forkR hr0 r0 k1 a1 of
(# hrl0,rl0,a1_,hrr0,rr0 #) -> case forkL k0 a0 hl1 l1 of
(# hll1,ll1,a0_,hlr1,lr1 #) ->
case u hl0 l0 hll1 ll1 of
(# l,hl #) -> case u hrl0 rl0 hlr1 lr1 of
(# m,hm #) -> case u hrr0 rr0 hr1 r1 of
(# r,hr #) -> case spliceH k1 m hm a1_ r hr of
(# t,ht #) -> spliceH k0 l hl a0_ t ht
EQ -> case u hl0 l0 hl1 l1 of
(# l,hl #) -> case u hr0 r0 hr1 r1 of
(# r,hr #) -> spliceH k0 l hl (f a0 a1) r hr
GT -> case forkL k0 a0 hr1 r1 of
(# hrl1,rl1,a0_,hrr1,rr1 #) -> case forkR hl0 l0 k1 a1 of
(# hll0,ll0,a1_,hlr0,lr0 #) ->
case u hll0 ll0 hl1 l1 of
(# l,hl #) -> case u hlr0 lr0 hrl1 rl1 of
(# m,hm #) -> case u hr0 r0 hrr1 rr1 of
(# r,hr #) -> case spliceH k1 l hl a1_ m hm of
(# t,ht #) -> spliceH k0 t ht a0_ r hr
forkL k0 a0 ht1 t1 = forkL_ ht1 t1 where
forkL_ h E = (# h,E,a0,h,E #)
forkL_ h (N k l a r) = forkL__ k ((h)-#2#) l a ((h)-#1#) r
forkL_ h (Z k l a r) = forkL__ k ((h)-#1#) l a ((h)-#1#) r
forkL_ h (P k l a r) = forkL__ k ((h)-#1#) l a ((h)-#2#) r
forkL__ k hl l a hr r = case compareInt# k0 k of
LT -> case forkL_ hl l of
(# hl0,l0,a0_,hl1,l1 #) -> case spliceH k l1 hl1 a r hr of
(# l1_,hl1_ #) -> (# hl0,l0,a0_,hl1_,l1_ #)
EQ -> (# hl,l,f a0 a,hr,r #)
GT -> case forkL_ hr r of
(# hl0,l0,a0_,hl1,l1 #) -> case spliceH k l hl a l0 hl0 of
(# l0_,hl0_ #) -> (# hl0_,l0_,a0_,hl1,l1 #)
forkR ht0 t0 k1 a1 = forkR_ ht0 t0 where
forkR_ h E = (# h,E,a1,h,E #)
forkR_ h (N k l a r) = forkR__ k ((h)-#2#) l a ((h)-#1#) r
forkR_ h (Z k l a r) = forkR__ k ((h)-#1#) l a ((h)-#1#) r
forkR_ h (P k l a r) = forkR__ k ((h)-#1#) l a ((h)-#2#) r
forkR__ k hl l a hr r = case compareInt# k k1 of
LT -> case forkR_ hr r of
(# hl0,l0,a1_,hl1,l1 #) -> case spliceH k l hl a l0 hl0 of
(# l0_,hl0_ #) -> (# hl0_,l0_,a1_,hl1,l1 #)
EQ -> (# hl,l,f a a1,hr,r #)
GT -> case forkR_ hl l of
(# hl0,l0,a1_,hl1,l1 #) -> case spliceH k l1 hl1 a r hr of
(# l1_,hl1_ #) -> (# hl0,l0,a1_,hl1_,l1_ #)
pushAB k0 a0 ht1 t1 = pushH (\a1 -> f a0 a1) k0 a0 ht1 t1
pushBA k1 a1 ht0 t0 = pushH (\a0 -> f a0 a1) k1 a1 ht0 t0
pushAB2 k0 a0 k0_ a0_ ht1 t1 = case pushAB k0_ a0_ ht1 t1 of
(# t,h #) -> pushAB k0 a0 h t
pushBA2 k1 a1 k1_ a1_ ht0 t0 = case pushBA k1_ a1_ ht0 t0 of
(# t,h #) -> pushBA k1 a1 h t
pushAB3 k0 a0 k0_ a0_ k0__ a0__ ht1 t1 = case pushAB k0__ a0__ ht1 t1 of
(# t,h #) -> pushAB2 k0 a0 k0_ a0_ h t
pushBA3 k1 a1 k1_ a1_ k1__ a1__ ht0 t0 = case pushBA k1__ a1__ ht0 t0 of
(# t,h #) -> pushBA2 k1 a1 k1_ a1_ h t
unionIntMap' :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
unionIntMap' f t0_ t1_ = u0 t0_ t1_ where
u0 E t1 = t1
u0 t0 E = t0
u0 t0@(N _ l0 _ _ ) t1@(N _ l1 _ _ ) = uH (addHeight 2# l0) t0 (addHeight 2# l1) t1
u0 t0@(N _ l0 _ _ ) t1@(Z _ l1 _ _ ) = uH (addHeight 2# l0) t0 (addHeight 1# l1) t1
u0 t0@(N _ l0 _ _ ) t1@(P _ _ _ r1) = uH (addHeight 2# l0) t0 (addHeight 2# r1) t1
u0 t0@(Z _ l0 _ _ ) t1@(N _ l1 _ _ ) = uH (addHeight 1# l0) t0 (addHeight 2# l1) t1
u0 t0@(Z _ l0 _ _ ) t1@(Z _ l1 _ _ ) = uH (addHeight 1# l0) t0 (addHeight 1# l1) t1
u0 t0@(Z _ l0 _ _ ) t1@(P _ _ _ r1) = uH (addHeight 1# l0) t0 (addHeight 2# r1) t1
u0 t0@(P _ _ _ r0) t1@(N _ l1 _ _ ) = uH (addHeight 2# r0) t0 (addHeight 2# l1) t1
u0 t0@(P _ _ _ r0) t1@(Z _ l1 _ _ ) = uH (addHeight 2# r0) t0 (addHeight 1# l1) t1
u0 t0@(P _ _ _ r0) t1@(P _ _ _ r1) = uH (addHeight 2# r0) t0 (addHeight 2# r1) t1
uH h0 t0 h1 t1 = case u h0 t0 h1 t1 of (# t,_ #) -> t
u 0# _ h1 t1 = (# t1,h1 #)
u h0 t0 0# _ = (# t0,h0 #)
u 1# (Z k0 _ a0 _ ) 1# t1@(Z k1 _ a1 _ ) = case compareInt# k0 k1 of
LT -> (# N k0 E a0 t1, 2# #)
EQ -> let a_ = f a0 a1 in a_ `seq`
(# Z k0 E a_ E , 1# #)
GT -> (# P k0 t1 a0 E , 2# #)
u 1# (Z k0 _ a0 _ ) ht1 t1 = pushAB k0 a0 ht1 t1
u ht0 t0 1# (Z k1 _ a1 _ ) = pushBA k1 a1 ht0 t0
u 2# (N k0 _ a0 (Z k0_ _ a0_ _)) ht1 t1 = pushAB2 k0 a0 k0_ a0_ ht1 t1
u 2# (P k0_ (Z k0 _ a0 _) a0_ _) ht1 t1 = pushAB2 k0 a0 k0_ a0_ ht1 t1
u ht0 t0 2# (N k1 _ a1 (Z k1_ _ a1_ _)) = pushBA2 k1 a1 k1_ a1_ ht0 t0
u ht0 t0 2# (P k1_ (Z k1 _ a1 _) a1_ _) = pushBA2 k1 a1 k1_ a1_ ht0 t0
u 2# (Z k0_ (Z k0 _ a0 _) a0_ (Z k0__ _ a0__ _)) ht1 t1 = pushAB3 k0 a0 k0_ a0_ k0__ a0__ ht1 t1
u ht0 t0 2# (Z k1_ (Z k1 _ a1 _) a1_ (Z k1__ _ a1__ _)) = pushBA3 k1 a1 k1_ a1_ k1__ a1__ ht0 t0
u h0 (N k0 l0 a0 r0) h1 (N k1 l1 a1 r1) = u_ k0 ((h0)-#2#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#2#) l1 a1 ((h1)-#1#) r1
u h0 (N k0 l0 a0 r0) h1 (Z k1 l1 a1 r1) = u_ k0 ((h0)-#2#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#1#) r1
u h0 (N k0 l0 a0 r0) h1 (P k1 l1 a1 r1) = u_ k0 ((h0)-#2#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#2#) r1
u h0 (Z k0 l0 a0 r0) h1 (N k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#2#) l1 a1 ((h1)-#1#) r1
u h0 (Z k0 l0 a0 r0) h1 (Z k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#1#) r1
u h0 (Z k0 l0 a0 r0) h1 (P k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#2#) r1
u h0 (P k0 l0 a0 r0) h1 (N k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#2#) r0 k1 ((h1)-#2#) l1 a1 ((h1)-#1#) r1
u h0 (P k0 l0 a0 r0) h1 (Z k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#2#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#1#) r1
u h0 (P k0 l0 a0 r0) h1 (P k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#2#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#2#) r1
u _ _ _ _ = error (mErr ++ "unionIntMap: Bad IntMap.")
u_ k0 hl0 l0 a0 hr0 r0 k1 hl1 l1 a1 hr1 r1 =
case compareInt# k0 k1 of
LT -> case forkR hr0 r0 k1 a1 of
(# hrl0,rl0,a1_,hrr0,rr0 #) -> case forkL k0 a0 hl1 l1 of
(# hll1,ll1,a0_,hlr1,lr1 #) ->
case u hl0 l0 hll1 ll1 of
(# l,hl #) -> case u hrl0 rl0 hlr1 lr1 of
(# m,hm #) -> case u hrr0 rr0 hr1 r1 of
(# r,hr #) -> case spliceH k1 m hm a1_ r hr of
(# t,ht #) -> spliceH k0 l hl a0_ t ht
EQ -> case u hl0 l0 hl1 l1 of
(# l,hl #) -> case u hr0 r0 hr1 r1 of
(# r,hr #) -> let a_ = f a0 a1 in a_ `seq` spliceH k0 l hl a_ r hr
GT -> case forkL k0 a0 hr1 r1 of
(# hrl1,rl1,a0_,hrr1,rr1 #) -> case forkR hl0 l0 k1 a1 of
(# hll0,ll0,a1_,hlr0,lr0 #) ->
case u hll0 ll0 hl1 l1 of
(# l,hl #) -> case u hlr0 lr0 hrl1 rl1 of
(# m,hm #) -> case u hr0 r0 hrr1 rr1 of
(# r,hr #) -> case spliceH k1 l hl a1_ m hm of
(# t,ht #) -> spliceH k0 t ht a0_ r hr
forkL k0 a0 ht1 t1 = forkL_ ht1 t1 where
forkL_ h E = (# h,E,a0,h,E #)
forkL_ h (N k l a r) = forkL__ k ((h)-#2#) l a ((h)-#1#) r
forkL_ h (Z k l a r) = forkL__ k ((h)-#1#) l a ((h)-#1#) r
forkL_ h (P k l a r) = forkL__ k ((h)-#1#) l a ((h)-#2#) r
forkL__ k hl l a hr r = case compareInt# k0 k of
LT -> case forkL_ hl l of
(# hl0,l0,a0_,hl1,l1 #) -> case spliceH k l1 hl1 a r hr of
(# l1_,hl1_ #) -> (# hl0,l0,a0_,hl1_,l1_ #)
EQ -> let a_ = f a0 a in a_ `seq`
(# hl,l,a_,hr,r #)
GT -> case forkL_ hr r of
(# hl0,l0,a0_,hl1,l1 #) -> case spliceH k l hl a l0 hl0 of
(# l0_,hl0_ #) -> (# hl0_,l0_,a0_,hl1,l1 #)
forkR ht0 t0 k1 a1 = forkR_ ht0 t0 where
forkR_ h E = (# h,E,a1,h,E #)
forkR_ h (N k l a r) = forkR__ k ((h)-#2#) l a ((h)-#1#) r
forkR_ h (Z k l a r) = forkR__ k ((h)-#1#) l a ((h)-#1#) r
forkR_ h (P k l a r) = forkR__ k ((h)-#1#) l a ((h)-#2#) r
forkR__ k hl l a hr r = case compareInt# k k1 of
LT -> case forkR_ hr r of
(# hl0,l0,a1_,hl1,l1 #) -> case spliceH k l hl a l0 hl0 of
(# l0_,hl0_ #) -> (# hl0_,l0_,a1_,hl1,l1 #)
EQ -> let a_ = f a a1 in a_ `seq`
(# hl,l,a_,hr,r #)
GT -> case forkR_ hl l of
(# hl0,l0,a1_,hl1,l1 #) -> case spliceH k l1 hl1 a r hr of
(# l1_,hl1_ #) -> (# hl0,l0,a1_,hl1_,l1_ #)
pushAB k0 a0 ht1 t1 = pushH' (\a1 -> f a0 a1) k0 a0 ht1 t1
pushBA k1 a1 ht0 t0 = pushH' (\a0 -> f a0 a1) k1 a1 ht0 t0
pushAB2 k0 a0 k0_ a0_ ht1 t1 = case pushAB k0_ a0_ ht1 t1 of
(# t,h #) -> pushAB k0 a0 h t
pushBA2 k1 a1 k1_ a1_ ht0 t0 = case pushBA k1_ a1_ ht0 t0 of
(# t,h #) -> pushBA k1 a1 h t
pushAB3 k0 a0 k0_ a0_ k0__ a0__ ht1 t1 = case pushAB k0__ a0__ ht1 t1 of
(# t,h #) -> pushAB2 k0 a0 k0_ a0_ h t
pushBA3 k1 a1 k1_ a1_ k1__ a1__ ht0 t0 = case pushBA k1__ a1__ ht0 t0 of
(# t,h #) -> pushBA2 k1 a1 k1_ a1_ h t
unionMaybeIntMap :: (a -> a -> Maybe a) -> IntMap a -> IntMap a -> IntMap a
unionMaybeIntMap f t0_ t1_ = u0 t0_ t1_ where
u0 E t1 = t1
u0 t0 E = t0
u0 t0@(N _ l0 _ _ ) t1@(N _ l1 _ _ ) = uH (addHeight 2# l0) t0 (addHeight 2# l1) t1
u0 t0@(N _ l0 _ _ ) t1@(Z _ l1 _ _ ) = uH (addHeight 2# l0) t0 (addHeight 1# l1) t1
u0 t0@(N _ l0 _ _ ) t1@(P _ _ _ r1) = uH (addHeight 2# l0) t0 (addHeight 2# r1) t1
u0 t0@(Z _ l0 _ _ ) t1@(N _ l1 _ _ ) = uH (addHeight 1# l0) t0 (addHeight 2# l1) t1
u0 t0@(Z _ l0 _ _ ) t1@(Z _ l1 _ _ ) = uH (addHeight 1# l0) t0 (addHeight 1# l1) t1
u0 t0@(Z _ l0 _ _ ) t1@(P _ _ _ r1) = uH (addHeight 1# l0) t0 (addHeight 2# r1) t1
u0 t0@(P _ _ _ r0) t1@(N _ l1 _ _ ) = uH (addHeight 2# r0) t0 (addHeight 2# l1) t1
u0 t0@(P _ _ _ r0) t1@(Z _ l1 _ _ ) = uH (addHeight 2# r0) t0 (addHeight 1# l1) t1
u0 t0@(P _ _ _ r0) t1@(P _ _ _ r1) = uH (addHeight 2# r0) t0 (addHeight 2# r1) t1
uH h0 t0 h1 t1 = case u h0 t0 h1 t1 of (# t,_ #) -> t
u 0# _ h1 t1 = (# t1,h1 #)
u h0 t0 0# _ = (# t0,h0 #)
u 1# (Z k0 _ a0 _ ) 1# t1@(Z k1 _ a1 _ ) = case compareInt# k0 k1 of
LT -> (# N k0 E a0 t1, 2# #)
EQ -> case f a0 a1 of
Just a -> (# Z k0 E a E , 1# #)
Nothing -> (# E , 0# #)
GT -> (# P k0 t1 a0 E , 2# #)
u 1# (Z k0 _ a0 _ ) ht1 t1 = pushAB k0 a0 ht1 t1
u ht0 t0 1# (Z k1 _ a1 _ ) = pushBA k1 a1 ht0 t0
u 2# (N k0 _ a0 (Z k0_ _ a0_ _)) ht1 t1 = pushAB2 k0 a0 k0_ a0_ ht1 t1
u 2# (P k0_ (Z k0 _ a0 _) a0_ _) ht1 t1 = pushAB2 k0 a0 k0_ a0_ ht1 t1
u ht0 t0 2# (N k1 _ a1 (Z k1_ _ a1_ _)) = pushBA2 k1 a1 k1_ a1_ ht0 t0
u ht0 t0 2# (P k1_ (Z k1 _ a1 _) a1_ _) = pushBA2 k1 a1 k1_ a1_ ht0 t0
u 2# (Z k0_ (Z k0 _ a0 _) a0_ (Z k0__ _ a0__ _)) ht1 t1 = pushAB3 k0 a0 k0_ a0_ k0__ a0__ ht1 t1
u ht0 t0 2# (Z k1_ (Z k1 _ a1 _) a1_ (Z k1__ _ a1__ _)) = pushBA3 k1 a1 k1_ a1_ k1__ a1__ ht0 t0
u h0 (N k0 l0 a0 r0) h1 (N k1 l1 a1 r1) = u_ k0 ((h0)-#2#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#2#) l1 a1 ((h1)-#1#) r1
u h0 (N k0 l0 a0 r0) h1 (Z k1 l1 a1 r1) = u_ k0 ((h0)-#2#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#1#) r1
u h0 (N k0 l0 a0 r0) h1 (P k1 l1 a1 r1) = u_ k0 ((h0)-#2#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#2#) r1
u h0 (Z k0 l0 a0 r0) h1 (N k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#2#) l1 a1 ((h1)-#1#) r1
u h0 (Z k0 l0 a0 r0) h1 (Z k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#1#) r1
u h0 (Z k0 l0 a0 r0) h1 (P k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#1#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#2#) r1
u h0 (P k0 l0 a0 r0) h1 (N k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#2#) r0 k1 ((h1)-#2#) l1 a1 ((h1)-#1#) r1
u h0 (P k0 l0 a0 r0) h1 (Z k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#2#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#1#) r1
u h0 (P k0 l0 a0 r0) h1 (P k1 l1 a1 r1) = u_ k0 ((h0)-#1#) l0 a0 ((h0)-#2#) r0 k1 ((h1)-#1#) l1 a1 ((h1)-#2#) r1
u _ _ _ _ = error (mErr ++ "unionMaybeIntMap: Bad IntMap.")
u_ k0 hl0 l0 a0 hr0 r0 k1 hl1 l1 a1 hr1 r1 =
case compareInt# k0 k1 of
LT -> case forkR hr0 r0 k1 a1 of
(# hrl0,rl0,mba1,hrr0,rr0 #) -> case forkL k0 a0 hl1 l1 of
(# hll1,ll1,mba0,hlr1,lr1 #) ->
case u hl0 l0 hll1 ll1 of
(# l,hl #) -> case u hrl0 rl0 hlr1 lr1 of
(# m,hm #) -> case u hrr0 rr0 hr1 r1 of
(# r,hr #) -> case (case mba1 of Just a -> spliceH k1 m hm a r hr
Nothing -> joinH m hm r hr
) of
(# t,ht #) -> case mba0 of Just a -> spliceH k0 l hl a t ht
Nothing -> joinH l hl t ht
EQ -> case u hl0 l0 hl1 l1 of
(# l,hl #) -> case u hr0 r0 hr1 r1 of
(# r,hr #) -> case f a0 a1 of Just a -> spliceH k0 l hl a r hr
Nothing -> joinH l hl r hr
GT -> case forkL k0 a0 hr1 r1 of
(# hrl1,rl1,mba0,hrr1,rr1 #) -> case forkR hl0 l0 k1 a1 of
(# hll0,ll0,mba1,hlr0,lr0 #) ->
case u hll0 ll0 hl1 l1 of
(# l,hl #) -> case u hlr0 lr0 hrl1 rl1 of
(# m,hm #) -> case u hr0 r0 hrr1 rr1 of
(# r,hr #) -> case (case mba1 of Just a -> spliceH k1 l hl a m hm
Nothing -> joinH l hl m hm
) of
(# t,ht #) -> case mba0 of Just a -> spliceH k0 t ht a r hr
Nothing -> joinH t ht r hr
forkL k0 a0 ht1 t1 = forkL_ ht1 t1 where
forkL_ h E = (# h,E,Just a0,h,E #)
forkL_ h (N k l a r) = forkL__ k ((h)-#2#) l a ((h)-#1#) r
forkL_ h (Z k l a r) = forkL__ k ((h)-#1#) l a ((h)-#1#) r
forkL_ h (P k l a r) = forkL__ k ((h)-#1#) l a ((h)-#2#) r
forkL__ k hl l a hr r = case compareInt# k0 k of
LT -> case forkL_ hl l of
(# hl0,l0,a0_,hl1,l1 #) -> case spliceH k l1 hl1 a r hr of
(# l1_,hl1_ #) -> (# hl0,l0,a0_,hl1_,l1_ #)
EQ -> let mba = f a0 a in mba `seq` (# hl,l,mba,hr,r #)
GT -> case forkL_ hr r of
(# hl0,l0,a0_,hl1,l1 #) -> case spliceH k l hl a l0 hl0 of
(# l0_,hl0_ #) -> (# hl0_,l0_,a0_,hl1,l1 #)
forkR ht0 t0 k1 a1 = forkR_ ht0 t0 where
forkR_ h E = (# h,E,Just a1,h,E #)
forkR_ h (N k l a r) = forkR__ k ((h)-#2#) l a ((h)-#1#) r
forkR_ h (Z k l a r) = forkR__ k ((h)-#1#) l a ((h)-#1#) r
forkR_ h (P k l a r) = forkR__ k ((h)-#1#) l a ((h)-#2#) r
forkR__ k hl l a hr r = case compareInt# k k1 of
LT -> case forkR_ hr r of
(# hl0,l0,a1_,hl1,l1 #) -> case spliceH k l hl a l0 hl0 of
(# l0_,hl0_ #) -> (# hl0_,l0_,a1_,hl1,l1 #)
EQ -> let mba = f a a1 in mba `seq` (# hl,l,mba,hr,r #)
GT -> case forkR_ hl l of
(# hl0,l0,a1_,hl1,l1 #) -> case spliceH k l1 hl1 a r hr of
(# l1_,hl1_ #) -> (# hl0,l0,a1_,hl1_,l1_ #)
pushAB k0 a0 ht1 t1 = pushMaybeH (\a1 -> f a0 a1) k0 a0 ht1 t1
pushBA k1 a1 ht0 t0 = pushMaybeH (\a0 -> f a0 a1) k1 a1 ht0 t0
pushAB2 k0 a0 k0_ a0_ ht1 t1 = case pushAB k0_ a0_ ht1 t1 of
(# t,h #) -> pushAB k0 a0 h t
pushBA2 k1 a1 k1_ a1_ ht0 t0 = case pushBA k1_ a1_ ht0 t0 of
(# t,h #) -> pushBA k1 a1 h t
pushAB3 k0 a0 k0_ a0_ k0__ a0__ ht1 t1 = case pushAB k0__ a0__ ht1 t1 of
(# t,h #) -> pushAB2 k0 a0 k0_ a0_ h t
pushBA3 k1 a1 k1_ a1_ k1__ a1__ ht0 t0 = case pushBA k1__ a1__ ht0 t0 of
(# t,h #) -> pushBA2 k1 a1 k1_ a1_ h t
pushMaybeH :: (a -> Maybe a) -> Key -> a -> Int# -> IntMap a -> (# IntMap a,Int# #)
pushMaybeH f k0 a0 ht1 t1 = case lookupIntMap k0 t1 of
Nothing -> insH k0 a0 ht1 t1
Just a -> case f a of
Nothing -> delH k0 ht1 t1
Just a_ -> let t_ = assertWriteIntMap k0 a_ t1 in t_ `seq`
(# t_,ht1 #)
data IAList a = Empt
| Cons !Int# a (IAList a)
deriving(Eq,Ord)
asIAList :: IntMap a -> IAList a
asIAList imp = f imp Empt where
f E ial = ial
f (N k l a r) ial = f' k l a r ial
f (Z k l a r) ial = f' k l a r ial
f (P k l a r) ial = f' k l a r ial
f' k l a r ial = let ial' = f r ial
ial'' = ial' `seq` Cons k a ial'
in ial'' `seq` f l ial''
intersectionIntMap :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
intersectionIntMap f ta0 tb0 = i0 ta0 tb0 where
i0 E _ = E
i0 _ E = E
i0 ta@(N _ la _ _ ) tb@(N _ lb _ _ ) = iH (addHeight 2# la) ta (addHeight 2# lb) tb
i0 ta@(N _ la _ _ ) tb@(Z _ lb _ _ ) = iH (addHeight 2# la) ta (addHeight 1# lb) tb
i0 ta@(N _ la _ _ ) tb@(P _ _ _ rb) = iH (addHeight 2# la) ta (addHeight 2# rb) tb
i0 ta@(Z _ la _ _ ) tb@(N _ lb _ _ ) = iH (addHeight 1# la) ta (addHeight 2# lb) tb
i0 ta@(Z _ la _ _ ) tb@(Z _ lb _ _ ) = iH (addHeight 1# la) ta (addHeight 1# lb) tb
i0 ta@(Z _ la _ _ ) tb@(P _ _ _ rb) = iH (addHeight 1# la) ta (addHeight 2# rb) tb
i0 ta@(P _ _ _ ra) tb@(N _ lb _ _ ) = iH (addHeight 2# ra) ta (addHeight 2# lb) tb
i0 ta@(P _ _ _ ra) tb@(Z _ lb _ _ ) = iH (addHeight 2# ra) ta (addHeight 1# lb) tb
i0 ta@(P _ _ _ ra) tb@(P _ _ _ rb) = iH (addHeight 2# ra) ta (addHeight 2# rb) tb
iH hta ta htb tb = case i hta ta htb tb Empt 0# of
(# ial,n #) -> case subst (rep (I# (n))) ial of
(# imp,rm #) -> case rm of
Empt -> imp
_ -> error (mErr ++ "intersectionIntMap: Bad IAList.")
i 0# _ _ _ cs n = (# cs,n #)
i _ _ 0# _ cs n = (# cs,n #)
i 1# (Z ka _ ea _ ) 1# (Z kb _ eb _ ) cs n = if ka ==# kb then (# Cons ka (f ea eb) cs, ((n)+#1#) #)
else (# cs,n #)
i 1# (Z ka _ ea _ ) _ tb cs n = lookAB ka ea tb cs n
i _ ta 1# (Z kb _ eb _ ) cs n = lookBA kb eb ta cs n
i 2# (N ka0 _ ea0 (Z ka1 _ ea1 _)) _ tb cs n = lookAB2 ka0 ea0 ka1 ea1 tb cs n
i 2# (P ka1 (Z ka0 _ ea0 _) ea1 _ ) _ tb cs n = lookAB2 ka0 ea0 ka1 ea1 tb cs n
i _ ta 2# (N kb0 _ eb0 (Z kb1 _ eb1 _)) cs n = lookBA2 kb0 eb0 kb1 eb1 ta cs n
i _ ta 2# (P kb1 (Z kb0 _ eb0 _) eb1 _ ) cs n = lookBA2 kb0 eb0 kb1 eb1 ta cs n
i 2# (Z ka1 (Z ka0 _ ea0 _) ea1 (Z ka2 _ ea2 _)) _ tb cs n = lookAB3 ka0 ea0 ka1 ea1 ka2 ea2 tb cs n
i _ ta 2# (Z kb1 (Z kb0 _ eb0 _) eb1 (Z kb2 _ eb2 _)) cs n = lookBA3 kb0 eb0 kb1 eb1 kb2 eb2 ta cs n
i ha (N ka la ea ra) hb (N kb lb eb rb) cs n = i_ ka ((ha)-#2#) la ea ((ha)-#1#) ra kb ((hb)-#2#) lb eb ((hb)-#1#) rb cs n
i ha (N ka la ea ra) hb (Z kb lb eb rb) cs n = i_ ka ((ha)-#2#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#1#) rb cs n
i ha (N ka la ea ra) hb (P kb lb eb rb) cs n = i_ ka ((ha)-#2#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#2#) rb cs n
i ha (Z ka la ea ra) hb (N kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#1#) ra kb ((hb)-#2#) lb eb ((hb)-#1#) rb cs n
i ha (Z ka la ea ra) hb (Z kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#1#) rb cs n
i ha (Z ka la ea ra) hb (P kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#2#) rb cs n
i ha (P ka la ea ra) hb (N kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#2#) ra kb ((hb)-#2#) lb eb ((hb)-#1#) rb cs n
i ha (P ka la ea ra) hb (Z kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#2#) ra kb ((hb)-#1#) lb eb ((hb)-#1#) rb cs n
i ha (P ka la ea ra) hb (P kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#2#) ra kb ((hb)-#1#) lb eb ((hb)-#2#) rb cs n
i _ _ _ _ _ _ = error (mErr ++ "intersectionIntMap: Bad IntMap.")
i_ ka hla la ea hra ra kb hlb lb eb hrb rb cs n = case compareInt# ka kb of
LT -> case fork kb hra ra of
(# hrla,rla,mba,hrra,rra #) -> case fork ka hlb lb of
(# hllb,llb,mbb,hlrb,lrb #) -> case i hrra rra hrb rb cs n of
(# cs_,n_ #) -> case (case mbb of
Nothing -> i hrla rla hlrb lrb cs_ n_
Just b -> i hrla rla hlrb lrb (Cons ka (f ea b) cs_) ((n_)+#1#)
) of
(# cs__,n__ #) -> case mba of
Nothing -> i hla la hllb llb cs__ n__
Just a -> i hla la hllb llb (Cons kb (f a eb) cs__) ((n__)+#1#)
EQ -> case i hra ra hrb rb cs n of
(# cs_,n_ #) -> i hla la hlb lb (Cons ka (f ea eb) cs_) ((n_)+#1#)
GT -> case fork ka hrb rb of
(# hrlb,rlb,mbb,hrrb,rrb #) -> case fork kb hla la of
(# hlla,lla,mba,hlra,lra #) -> case i hra ra hrrb rrb cs n of
(# cs_,n_ #) -> case (case mba of
Nothing -> i hlra lra hrlb rlb cs_ n_
Just a -> i hlra lra hrlb rlb (Cons kb (f a eb) cs_) ((n_)+#1#)
) of
(# cs__,n__ #) -> case mbb of
Nothing -> i hlla lla hlb lb cs__ n__
Just b -> i hlla lla hlb lb (Cons ka (f ea b) cs__) ((n__)+#1#)
fork k0 ht t = fork_ ht t where
fork_ h E = (# h,E,Nothing,h,E #)
fork_ h (N k l x r) = fork__ k ((h)-#2#) l x ((h)-#1#) r
fork_ h (Z k l x r) = fork__ k ((h)-#1#) l x ((h)-#1#) r
fork_ h (P k l x r) = fork__ k ((h)-#1#) l x ((h)-#2#) r
fork__ k hl l x hr r = case compareInt# k0 k of
LT -> case fork_ hl l of
(# hl0,l0,mbx,hl1,l1 #) -> case spliceH k l1 hl1 x r hr of
(# l1_,hl1_ #) -> (# hl0,l0,mbx,hl1_,l1_ #)
EQ -> (# hl,l,Just x,hr,r #)
GT -> case fork_ hr r of
(# hl0,l0,mbx,hl1,l1 #) -> case spliceH k l hl x l0 hl0 of
(# l0_,hl0_ #) -> (# hl0_,l0_,mbx,hl1,l1 #)
lookAB ka ea tb cs n = rd tb where
rd E = (# cs,n #)
rd (N k l b r) = rd_ k l b r
rd (Z k l b r) = rd_ k l b r
rd (P k l b r) = rd_ k l b r
rd_ k l b r = case compareInt# ka k of
LT -> rd l
EQ -> (# Cons ka (f ea b) cs, ((n)+#1#) #)
GT -> rd r
lookBA kb eb ta cs n = rd ta where
rd E = (# cs,n #)
rd (N k l a r) = rd_ k l a r
rd (Z k l a r) = rd_ k l a r
rd (P k l a r) = rd_ k l a r
rd_ k l a r = case compareInt# kb k of
LT -> rd l
EQ -> (# Cons kb (f a eb) cs, ((n)+#1#) #)
GT -> rd r
lookAB2 ka0 ea0 ka1 ea1 tb cs n = case lookAB ka1 ea1 tb cs n of
(# cs_,n_ #) -> lookAB ka0 ea0 tb cs_ n_
lookBA2 kb0 eb0 kb1 eb1 ta cs n = case lookBA kb1 eb1 ta cs n of
(# cs_,n_ #) -> lookBA kb0 eb0 ta cs_ n_
lookAB3 ka0 ea0 ka1 ea1 ka2 ea2 tb cs n = case lookAB ka2 ea2 tb cs n of
(# cs_,n_ #) -> lookAB2 ka0 ea0 ka1 ea1 tb cs_ n_
lookBA3 kb0 eb0 kb1 eb1 kb2 eb2 ta cs n = case lookBA kb2 eb2 ta cs n of
(# cs_,n_ #) -> lookBA2 kb0 eb0 kb1 eb1 ta cs_ n_
intersectionIntMap' :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
intersectionIntMap' f ta0 tb0 = i0 ta0 tb0 where
i0 E _ = E
i0 _ E = E
i0 ta@(N _ la _ _ ) tb@(N _ lb _ _ ) = iH (addHeight 2# la) ta (addHeight 2# lb) tb
i0 ta@(N _ la _ _ ) tb@(Z _ lb _ _ ) = iH (addHeight 2# la) ta (addHeight 1# lb) tb
i0 ta@(N _ la _ _ ) tb@(P _ _ _ rb) = iH (addHeight 2# la) ta (addHeight 2# rb) tb
i0 ta@(Z _ la _ _ ) tb@(N _ lb _ _ ) = iH (addHeight 1# la) ta (addHeight 2# lb) tb
i0 ta@(Z _ la _ _ ) tb@(Z _ lb _ _ ) = iH (addHeight 1# la) ta (addHeight 1# lb) tb
i0 ta@(Z _ la _ _ ) tb@(P _ _ _ rb) = iH (addHeight 1# la) ta (addHeight 2# rb) tb
i0 ta@(P _ _ _ ra) tb@(N _ lb _ _ ) = iH (addHeight 2# ra) ta (addHeight 2# lb) tb
i0 ta@(P _ _ _ ra) tb@(Z _ lb _ _ ) = iH (addHeight 2# ra) ta (addHeight 1# lb) tb
i0 ta@(P _ _ _ ra) tb@(P _ _ _ rb) = iH (addHeight 2# ra) ta (addHeight 2# rb) tb
iH hta ta htb tb = case i hta ta htb tb Empt 0# of
(# ial,n #) -> case subst (rep (I# (n))) ial of
(# imp,rm #) -> case rm of
Empt -> imp
_ -> error (mErr ++ "intersectionIntMap': Bad IAList.")
i 0# _ _ _ cs n = (# cs,n #)
i _ _ 0# _ cs n = (# cs,n #)
i 1# (Z ka _ ea _ ) 1# (Z kb _ eb _ ) cs n = if ka ==# kb then let c = f ea eb in c `seq`
(# Cons ka c cs, ((n)+#1#) #)
else (# cs,n #)
i 1# (Z ka _ ea _ ) _ tb cs n = lookAB ka ea tb cs n
i _ ta 1# (Z kb _ eb _ ) cs n = lookBA kb eb ta cs n
i 2# (N ka0 _ ea0 (Z ka1 _ ea1 _)) _ tb cs n = lookAB2 ka0 ea0 ka1 ea1 tb cs n
i 2# (P ka1 (Z ka0 _ ea0 _) ea1 _ ) _ tb cs n = lookAB2 ka0 ea0 ka1 ea1 tb cs n
i _ ta 2# (N kb0 _ eb0 (Z kb1 _ eb1 _)) cs n = lookBA2 kb0 eb0 kb1 eb1 ta cs n
i _ ta 2# (P kb1 (Z kb0 _ eb0 _) eb1 _ ) cs n = lookBA2 kb0 eb0 kb1 eb1 ta cs n
i 2# (Z ka1 (Z ka0 _ ea0 _) ea1 (Z ka2 _ ea2 _)) _ tb cs n = lookAB3 ka0 ea0 ka1 ea1 ka2 ea2 tb cs n
i _ ta 2# (Z kb1 (Z kb0 _ eb0 _) eb1 (Z kb2 _ eb2 _)) cs n = lookBA3 kb0 eb0 kb1 eb1 kb2 eb2 ta cs n
i ha (N ka la ea ra) hb (N kb lb eb rb) cs n = i_ ka ((ha)-#2#) la ea ((ha)-#1#) ra kb ((hb)-#2#) lb eb ((hb)-#1#) rb cs n
i ha (N ka la ea ra) hb (Z kb lb eb rb) cs n = i_ ka ((ha)-#2#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#1#) rb cs n
i ha (N ka la ea ra) hb (P kb lb eb rb) cs n = i_ ka ((ha)-#2#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#2#) rb cs n
i ha (Z ka la ea ra) hb (N kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#1#) ra kb ((hb)-#2#) lb eb ((hb)-#1#) rb cs n
i ha (Z ka la ea ra) hb (Z kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#1#) rb cs n
i ha (Z ka la ea ra) hb (P kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#2#) rb cs n
i ha (P ka la ea ra) hb (N kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#2#) ra kb ((hb)-#2#) lb eb ((hb)-#1#) rb cs n
i ha (P ka la ea ra) hb (Z kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#2#) ra kb ((hb)-#1#) lb eb ((hb)-#1#) rb cs n
i ha (P ka la ea ra) hb (P kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#2#) ra kb ((hb)-#1#) lb eb ((hb)-#2#) rb cs n
i _ _ _ _ _ _ = error (mErr ++ "intersectionIntMap': Bad IntMap.")
i_ ka hla la ea hra ra kb hlb lb eb hrb rb cs n = case compareInt# ka kb of
LT -> case fork kb hra ra of
(# hrla,rla,mba,hrra,rra #) -> case fork ka hlb lb of
(# hllb,llb,mbb,hlrb,lrb #) -> case i hrra rra hrb rb cs n of
(# cs_,n_ #) -> case (case mbb of
Nothing -> i hrla rla hlrb lrb cs_ n_
Just b -> let c = f ea b in c `seq`
i hrla rla hlrb lrb (Cons ka c cs_) ((n_)+#1#)
) of
(# cs__,n__ #) -> case mba of
Nothing -> i hla la hllb llb cs__ n__
Just a -> let c = f a eb in c `seq`
i hla la hllb llb (Cons kb c cs__) ((n__)+#1#)
EQ -> case i hra ra hrb rb cs n of
(# cs_,n_ #) -> let c = f ea eb in c `seq`
i hla la hlb lb (Cons ka c cs_) ((n_)+#1#)
GT -> case fork ka hrb rb of
(# hrlb,rlb,mbb,hrrb,rrb #) -> case fork kb hla la of
(# hlla,lla,mba,hlra,lra #) -> case i hra ra hrrb rrb cs n of
(# cs_,n_ #) -> case (case mba of
Nothing -> i hlra lra hrlb rlb cs_ n_
Just a -> let c = f a eb in c `seq`
i hlra lra hrlb rlb (Cons kb c cs_) ((n_)+#1#)
) of
(# cs__,n__ #) -> case mbb of
Nothing -> i hlla lla hlb lb cs__ n__
Just b -> let c = f ea b in c `seq`
i hlla lla hlb lb (Cons ka c cs__) ((n__)+#1#)
fork k0 ht t = fork_ ht t where
fork_ h E = (# h,E,Nothing,h,E #)
fork_ h (N k l x r) = fork__ k ((h)-#2#) l x ((h)-#1#) r
fork_ h (Z k l x r) = fork__ k ((h)-#1#) l x ((h)-#1#) r
fork_ h (P k l x r) = fork__ k ((h)-#1#) l x ((h)-#2#) r
fork__ k hl l x hr r = case compareInt# k0 k of
LT -> case fork_ hl l of
(# hl0,l0,mbx,hl1,l1 #) -> case spliceH k l1 hl1 x r hr of
(# l1_,hl1_ #) -> (# hl0,l0,mbx,hl1_,l1_ #)
EQ -> (# hl,l,Just x,hr,r #)
GT -> case fork_ hr r of
(# hl0,l0,mbx,hl1,l1 #) -> case spliceH k l hl x l0 hl0 of
(# l0_,hl0_ #) -> (# hl0_,l0_,mbx,hl1,l1 #)
lookAB ka ea tb cs n = rd tb where
rd E = (# cs,n #)
rd (N k l b r) = rd_ k l b r
rd (Z k l b r) = rd_ k l b r
rd (P k l b r) = rd_ k l b r
rd_ k l b r = case compareInt# ka k of
LT -> rd l
EQ -> let c = f ea b in c `seq` (# Cons ka c cs, ((n)+#1#) #)
GT -> rd r
lookBA kb eb ta cs n = rd ta where
rd E = (# cs,n #)
rd (N k l a r) = rd_ k l a r
rd (Z k l a r) = rd_ k l a r
rd (P k l a r) = rd_ k l a r
rd_ k l a r = case compareInt# kb k of
LT -> rd l
EQ -> let c = f a eb in c `seq` (# Cons kb c cs, ((n)+#1#) #)
GT -> rd r
lookAB2 ka0 ea0 ka1 ea1 tb cs n = case lookAB ka1 ea1 tb cs n of
(# cs_,n_ #) -> lookAB ka0 ea0 tb cs_ n_
lookBA2 kb0 eb0 kb1 eb1 ta cs n = case lookBA kb1 eb1 ta cs n of
(# cs_,n_ #) -> lookBA kb0 eb0 ta cs_ n_
lookAB3 ka0 ea0 ka1 ea1 ka2 ea2 tb cs n = case lookAB ka2 ea2 tb cs n of
(# cs_,n_ #) -> lookAB2 ka0 ea0 ka1 ea1 tb cs_ n_
lookBA3 kb0 eb0 kb1 eb1 kb2 eb2 ta cs n = case lookBA kb2 eb2 ta cs n of
(# cs_,n_ #) -> lookBA2 kb0 eb0 kb1 eb1 ta cs_ n_
intersectionMaybeIntMap :: (a -> b -> Maybe c) -> IntMap a -> IntMap b -> IntMap c
intersectionMaybeIntMap f ta0 tb0 = i0 ta0 tb0 where
i0 E _ = E
i0 _ E = E
i0 ta@(N _ la _ _ ) tb@(N _ lb _ _ ) = iH (addHeight 2# la) ta (addHeight 2# lb) tb
i0 ta@(N _ la _ _ ) tb@(Z _ lb _ _ ) = iH (addHeight 2# la) ta (addHeight 1# lb) tb
i0 ta@(N _ la _ _ ) tb@(P _ _ _ rb) = iH (addHeight 2# la) ta (addHeight 2# rb) tb
i0 ta@(Z _ la _ _ ) tb@(N _ lb _ _ ) = iH (addHeight 1# la) ta (addHeight 2# lb) tb
i0 ta@(Z _ la _ _ ) tb@(Z _ lb _ _ ) = iH (addHeight 1# la) ta (addHeight 1# lb) tb
i0 ta@(Z _ la _ _ ) tb@(P _ _ _ rb) = iH (addHeight 1# la) ta (addHeight 2# rb) tb
i0 ta@(P _ _ _ ra) tb@(N _ lb _ _ ) = iH (addHeight 2# ra) ta (addHeight 2# lb) tb
i0 ta@(P _ _ _ ra) tb@(Z _ lb _ _ ) = iH (addHeight 2# ra) ta (addHeight 1# lb) tb
i0 ta@(P _ _ _ ra) tb@(P _ _ _ rb) = iH (addHeight 2# ra) ta (addHeight 2# rb) tb
iH hta ta htb tb = case i hta ta htb tb Empt 0# of
(# ial,n #) -> case subst (rep (I# (n))) ial of
(# imp,rm #) -> case rm of
Empt -> imp
_ -> error (mErr ++ "intersectionMaybeIntMap: Bad IAList.")
i 0# _ _ _ cs n = (# cs,n #)
i _ _ 0# _ cs n = (# cs,n #)
i 1# (Z ka _ ea _ ) 1# (Z kb _ eb _ ) cs n = if ka ==# kb then case f ea eb of
Just c -> (# Cons ka c cs, ((n)+#1#) #)
Nothing -> (# cs,n #)
else (# cs,n #)
i 1# (Z ka _ ea _ ) _ tb cs n = lookAB ka ea tb cs n
i _ ta 1# (Z kb _ eb _ ) cs n = lookBA kb eb ta cs n
i 2# (N ka0 _ ea0 (Z ka1 _ ea1 _)) _ tb cs n = lookAB2 ka0 ea0 ka1 ea1 tb cs n
i 2# (P ka1 (Z ka0 _ ea0 _) ea1 _ ) _ tb cs n = lookAB2 ka0 ea0 ka1 ea1 tb cs n
i _ ta 2# (N kb0 _ eb0 (Z kb1 _ eb1 _)) cs n = lookBA2 kb0 eb0 kb1 eb1 ta cs n
i _ ta 2# (P kb1 (Z kb0 _ eb0 _) eb1 _ ) cs n = lookBA2 kb0 eb0 kb1 eb1 ta cs n
i 2# (Z ka1 (Z ka0 _ ea0 _) ea1 (Z ka2 _ ea2 _)) _ tb cs n = lookAB3 ka0 ea0 ka1 ea1 ka2 ea2 tb cs n
i _ ta 2# (Z kb1 (Z kb0 _ eb0 _) eb1 (Z kb2 _ eb2 _)) cs n = lookBA3 kb0 eb0 kb1 eb1 kb2 eb2 ta cs n
i ha (N ka la ea ra) hb (N kb lb eb rb) cs n = i_ ka ((ha)-#2#) la ea ((ha)-#1#) ra kb ((hb)-#2#) lb eb ((hb)-#1#) rb cs n
i ha (N ka la ea ra) hb (Z kb lb eb rb) cs n = i_ ka ((ha)-#2#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#1#) rb cs n
i ha (N ka la ea ra) hb (P kb lb eb rb) cs n = i_ ka ((ha)-#2#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#2#) rb cs n
i ha (Z ka la ea ra) hb (N kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#1#) ra kb ((hb)-#2#) lb eb ((hb)-#1#) rb cs n
i ha (Z ka la ea ra) hb (Z kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#1#) rb cs n
i ha (Z ka la ea ra) hb (P kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#1#) ra kb ((hb)-#1#) lb eb ((hb)-#2#) rb cs n
i ha (P ka la ea ra) hb (N kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#2#) ra kb ((hb)-#2#) lb eb ((hb)-#1#) rb cs n
i ha (P ka la ea ra) hb (Z kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#2#) ra kb ((hb)-#1#) lb eb ((hb)-#1#) rb cs n
i ha (P ka la ea ra) hb (P kb lb eb rb) cs n = i_ ka ((ha)-#1#) la ea ((ha)-#2#) ra kb ((hb)-#1#) lb eb ((hb)-#2#) rb cs n
i _ _ _ _ _ _ = error (mErr ++ "intersectionMaybeIntMap: Bad IntMap.")
i_ ka hla la ea hra ra kb hlb lb eb hrb rb cs n = case compareInt# ka kb of
LT -> case fork kb hra ra of
(# hrla,rla,mba,hrra,rra #) -> case fork ka hlb lb of
(# hllb,llb,mbb,hlrb,lrb #) -> case i hrra rra hrb rb cs n of
(# cs_,n_ #) -> case (case mbb of
Nothing -> i hrla rla hlrb lrb cs_ n_
Just b -> case f ea b of
Just c -> i hrla rla hlrb lrb (Cons ka c cs_) ((n_)+#1#)
Nothing -> i hrla rla hlrb lrb cs_ n_
) of
(# cs__,n__ #) -> case mba of
Nothing -> i hla la hllb llb cs__ n__
Just a -> case f a eb of
Just c -> i hla la hllb llb (Cons kb c cs__) ((n__)+#1#)
Nothing -> i hla la hllb llb cs__ n__
EQ -> case i hra ra hrb rb cs n of
(# cs_,n_ #) -> case f ea eb of
Just c -> i hla la hlb lb (Cons ka c cs_) ((n_)+#1#)
Nothing -> i hla la hlb lb cs_ n_
GT -> case fork ka hrb rb of
(# hrlb,rlb,mbb,hrrb,rrb #) -> case fork kb hla la of
(# hlla,lla,mba,hlra,lra #) -> case i hra ra hrrb rrb cs n of
(# cs_,n_ #) -> case (case mba of
Nothing -> i hlra lra hrlb rlb cs_ n_
Just a -> case f a eb of
Just c -> i hlra lra hrlb rlb (Cons kb c cs_) ((n_)+#1#)
Nothing -> i hlra lra hrlb rlb cs_ n_
) of
(# cs__,n__ #) -> case mbb of
Nothing -> i hlla lla hlb lb cs__ n__
Just b -> case f ea b of
Just c -> i hlla lla hlb lb (Cons ka c cs__) ((n__)+#1#)
Nothing -> i hlla lla hlb lb cs__ n__
fork k0 ht t = fork_ ht t where
fork_ h E = (# h,E,Nothing,h,E #)
fork_ h (N k l x r) = fork__ k ((h)-#2#) l x ((h)-#1#) r
fork_ h (Z k l x r) = fork__ k ((h)-#1#) l x ((h)-#1#) r
fork_ h (P k l x r) = fork__ k ((h)-#1#) l x ((h)-#2#) r
fork__ k hl l x hr r = case compareInt# k0 k of
LT -> case fork_ hl l of
(# hl0,l0,mbx,hl1,l1 #) -> case spliceH k l1 hl1 x r hr of
(# l1_,hl1_ #) -> (# hl0,l0,mbx,hl1_,l1_ #)
EQ -> (# hl,l,Just x,hr,r #)
GT -> case fork_ hr r of
(# hl0,l0,mbx,hl1,l1 #) -> case spliceH k l hl x l0 hl0 of
(# l0_,hl0_ #) -> (# hl0_,l0_,mbx,hl1,l1 #)
lookAB ka ea tb cs n = rd tb where
rd E = (# cs,n #)
rd (N k l b r) = rd_ k l b r
rd (Z k l b r) = rd_ k l b r
rd (P k l b r) = rd_ k l b r
rd_ k l b r = case compareInt# ka k of
LT -> rd l
EQ -> case f ea b of
Just c -> (# Cons ka c cs, ((n)+#1#) #)
Nothing -> (# cs,n #)
GT -> rd r
lookBA kb eb ta cs n = rd ta where
rd E = (# cs,n #)
rd (N k l a r) = rd_ k l a r
rd (Z k l a r) = rd_ k l a r
rd (P k l a r) = rd_ k l a r
rd_ k l a r = case compareInt# kb k of
LT -> rd l
EQ -> case f a eb of
Just c -> (# Cons kb c cs, ((n)+#1#) #)
Nothing -> (# cs,n #)
GT -> rd r
lookAB2 ka0 ea0 ka1 ea1 tb cs n = case lookAB ka1 ea1 tb cs n of
(# cs_,n_ #) -> lookAB ka0 ea0 tb cs_ n_
lookBA2 kb0 eb0 kb1 eb1 ta cs n = case lookBA kb1 eb1 ta cs n of
(# cs_,n_ #) -> lookBA kb0 eb0 ta cs_ n_
lookAB3 ka0 ea0 ka1 ea1 ka2 ea2 tb cs n = case lookAB ka2 ea2 tb cs n of
(# cs_,n_ #) -> lookAB2 ka0 ea0 ka1 ea1 tb cs_ n_
lookBA3 kb0 eb0 kb1 eb1 kb2 eb2 ta cs n = case lookBA kb2 eb2 ta cs n of
(# cs_,n_ #) -> lookBA2 kb0 eb0 kb1 eb1 ta cs_ n_
data Tmp = ET | NT Tmp Tmp | ZT Tmp Tmp | PT Tmp Tmp
rep :: Int -> Tmp
rep n | odd n = repOdd n
rep n = repEvn n
repOdd :: Int -> Tmp
repOdd n = let sub = rep (n `shiftR` 1) in ZT sub sub
repEvn :: Int -> Tmp
repEvn n | n .&. (n1) == 0 = repP2 n
repEvn n = let nl = n `shiftR` 1
nr = nl 1
in if odd nr
then let l = repEvn nl
r = repOdd nr
in l `seq` r `seq` ZT l r
else let l = repOdd nl
r = repEvn nr
in l `seq` r `seq` ZT l r
repP2 :: Int -> Tmp
repP2 0 = ET
repP2 1 = ZT ET ET
repP2 n = let nl = n `shiftR` 1
nr = nl 1
l = repP2 nl
r = repP2M1 nr
in l `seq` r `seq` PT l r
repP2M1 :: Int -> Tmp
repP2M1 0 = ET
repP2M1 n = let sub = repP2M1 (n `shiftR` 1) in sub `seq` ZT sub sub
subst :: Tmp -> IAList a -> (# IntMap a, IAList a #)
subst ET as = (# E,as #)
subst (NT l r) as = subst_ N l r as
subst (ZT l r) as = subst_ Z l r as
subst (PT l r) as = subst_ P l r as
subst_ :: (Key -> IntMap a -> a -> IntMap a -> IntMap a) -> Tmp -> Tmp -> IAList a -> (# IntMap a, IAList a #)
subst_ c l r as = case subst l as of
(# l_,as_ #) -> case as_ of
Cons ka a as__ -> case subst r as__ of
(# r_,as___ #) -> let t = c ka l_ a r_
in t `seq` (# t,as___ #)
Empt -> error (mErr ++ "subst: List too short.")
differenceIntMap :: IntMap a -> IntMap b -> IntMap a
differenceIntMap ta0 tb0 = d0 ta0 tb0 where
d0 E _ = E
d0 _ E = ta0
d0 (N _ la _ _ ) _ = dH (addHeight 2# la)
d0 (Z _ la _ _ ) _ = dH (addHeight 1# la)
d0 (P _ _ _ ra) _ = dH (addHeight 2# ra)
dH hta0 = case d hta0 ta0 tb0 of (# t,_ #) -> t
d ha E _ = (# E ,ha #)
d ha ta E = (# ta,ha #)
d ha (N ka la a ra) (N kb lb _ rb) = d_ ka ((ha)-#2#) la a ((ha)-#1#) ra kb lb rb
d ha (N ka la a ra) (Z kb lb _ rb) = d_ ka ((ha)-#2#) la a ((ha)-#1#) ra kb lb rb
d ha (N ka la a ra) (P kb lb _ rb) = d_ ka ((ha)-#2#) la a ((ha)-#1#) ra kb lb rb
d ha (Z ka la a ra) (N kb lb _ rb) = d_ ka ((ha)-#1#) la a ((ha)-#1#) ra kb lb rb
d ha (Z ka la a ra) (Z kb lb _ rb) = d_ ka ((ha)-#1#) la a ((ha)-#1#) ra kb lb rb
d ha (Z ka la a ra) (P kb lb _ rb) = d_ ka ((ha)-#1#) la a ((ha)-#1#) ra kb lb rb
d ha (P ka la a ra) (N kb lb _ rb) = d_ ka ((ha)-#1#) la a ((ha)-#2#) ra kb lb rb
d ha (P ka la a ra) (Z kb lb _ rb) = d_ ka ((ha)-#1#) la a ((ha)-#2#) ra kb lb rb
d ha (P ka la a ra) (P kb lb _ rb) = d_ ka ((ha)-#1#) la a ((ha)-#2#) ra kb lb rb
d_ ka hla la a hra ra kb lb rb =
case compareInt# ka kb of
LT -> case fork hra ra kb of
(# hrla,rla,hrra,rra #) -> case spliceH ka la hla a rla hrla of
(# la_,hla_ #) -> case d hla_ la_ lb of
(# l,hl #) -> case d hrra rra rb of
(# r,hr #) -> joinH l hl r hr
EQ -> case d hra ra rb of
(# r,hr #) -> case d hla la lb of
(# l,hl #) -> joinH l hl r hr
GT -> case fork hla la kb of
(# hlla,lla,hlra,lra #) -> case spliceH ka lra hlra a ra hra of
(# ra_,hra_ #) -> case d hra_ ra_ rb of
(# r,hr #) -> case d hlla lla lb of
(# l,hl #) -> joinH l hl r hr
fork hta ta kb = fork_ hta ta where
fork_ h E = (# h,E,h,E #)
fork_ h (N k l a r) = fork__ k ((h)-#2#) l a ((h)-#1#) r
fork_ h (Z k l a r) = fork__ k ((h)-#1#) l a ((h)-#1#) r
fork_ h (P k l a r) = fork__ k ((h)-#1#) l a ((h)-#2#) r
fork__ k hl l a hr r = case compareInt# k kb of
LT -> case fork_ hr r of
(# hx0,x0,hx1,x1 #) -> case spliceH k l hl a x0 hx0 of
(# x0_,hx0_ #) -> (# hx0_,x0_,hx1,x1 #)
EQ -> (# hl,l,hr,r #)
GT -> case fork_ hl l of
(# hx0,x0,hx1,x1 #) -> case spliceH k x1 hx1 a r hr of
(# x1_,hx1_ #) -> (# hx0,x0,hx1_,x1_ #)
differenceMaybeIntMap :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
differenceMaybeIntMap f ta0 tb0 = d0 ta0 tb0 where
d0 E _ = E
d0 _ E = ta0
d0 (N _ la _ _ ) _ = dH (addHeight 2# la)
d0 (Z _ la _ _ ) _ = dH (addHeight 1# la)
d0 (P _ _ _ ra) _ = dH (addHeight 2# ra)
dH hta0 = case d hta0 ta0 tb0 of (# t,_ #) -> t
d ha E _ = (# E ,ha #)
d ha ta E = (# ta,ha #)
d ha (N ka la a ra) (N kb lb b rb) = d_ ka ((ha)-#2#) la a ((ha)-#1#) ra kb lb b rb
d ha (N ka la a ra) (Z kb lb b rb) = d_ ka ((ha)-#2#) la a ((ha)-#1#) ra kb lb b rb
d ha (N ka la a ra) (P kb lb b rb) = d_ ka ((ha)-#2#) la a ((ha)-#1#) ra kb lb b rb
d ha (Z ka la a ra) (N kb lb b rb) = d_ ka ((ha)-#1#) la a ((ha)-#1#) ra kb lb b rb
d ha (Z ka la a ra) (Z kb lb b rb) = d_ ka ((ha)-#1#) la a ((ha)-#1#) ra kb lb b rb
d ha (Z ka la a ra) (P kb lb b rb) = d_ ka ((ha)-#1#) la a ((ha)-#1#) ra kb lb b rb
d ha (P ka la a ra) (N kb lb b rb) = d_ ka ((ha)-#1#) la a ((ha)-#2#) ra kb lb b rb
d ha (P ka la a ra) (Z kb lb b rb) = d_ ka ((ha)-#1#) la a ((ha)-#2#) ra kb lb b rb
d ha (P ka la a ra) (P kb lb b rb) = d_ ka ((ha)-#1#) la a ((ha)-#2#) ra kb lb b rb
d_ ka hla la a hra ra kb lb b rb =
case compareInt# ka kb of
LT -> case fork hra ra kb b of
(# hrla,rla,mba,hrra,rra #) -> case spliceH ka la hla a rla hrla of
(# la_,hla_ #) -> case d hla_ la_ lb of
(# l,hl #) -> case d hrra rra rb of
(# r,hr #) -> case mba of
Nothing -> joinH l hl r hr
Just a' -> spliceH kb l hl a' r hr
EQ -> case d hra ra rb of
(# r,hr #) -> case d hla la lb of
(# l,hl #) -> case f a b of
Nothing -> joinH l hl r hr
Just a' -> spliceH kb l hl a' r hr
GT -> case fork hla la kb b of
(# hlla,lla,mba,hlra,lra #) -> case spliceH ka lra hlra a ra hra of
(# ra_,hra_ #) -> case d hra_ ra_ rb of
(# r,hr #) -> case d hlla lla lb of
(# l,hl #) -> case mba of
Nothing -> joinH l hl r hr
Just a' -> spliceH kb l hl a' r hr
fork hta ta kb b = fork_ hta ta where
fork_ h E = (# h,E,Nothing,h,E #)
fork_ h (N k l a r) = fork__ k ((h)-#2#) l a ((h)-#1#) r
fork_ h (Z k l a r) = fork__ k ((h)-#1#) l a ((h)-#1#) r
fork_ h (P k l a r) = fork__ k ((h)-#1#) l a ((h)-#2#) r
fork__ k hl l a hr r = case compareInt# k kb of
LT -> case fork_ hr r of
(# hx0,x0,mba,hx1,x1 #) -> case spliceH k l hl a x0 hx0 of
(# x0_,hx0_ #) -> (# hx0_,x0_,mba,hx1,x1 #)
EQ -> let mba = f a b in mba `seq` (# hl,l,mba,hr,r #)
GT -> case fork_ hl l of
(# hx0,x0,mba,hx1,x1 #) -> case spliceH k x1 hx1 a r hr of
(# x1_,hx1_ #) -> (# hx0,x0,mba,hx1_,x1_ #)
joinH :: IntMap a -> Int# -> IntMap a -> Int# -> (# IntMap a,Int# #)
joinH l hl r hr =
case compareInt# hl hr of
LT -> case l of
E -> (# r,hr #)
N li ll la lr -> case popRN li ll la lr of
(# l_,iv,v #) -> case l_ of
Z _ _ _ _ -> spliceHL iv l_ ((hl)-#1#) v r hr
_ -> spliceHL iv l_ hl v r hr
Z li ll la lr -> case popRZ li ll la lr of
(# l_,iv,v #) -> case l_ of
E -> pushHL l r hr
_ -> spliceHL iv l_ hl v r hr
P li ll la lr -> case popRP li ll la lr of
(# l_,iv,v #) -> case l_ of
Z _ _ _ _ -> spliceHL iv l_ ((hl)-#1#) v r hr
_ -> spliceHL iv l_ hl v r hr
EQ -> case l of
E -> (# l,hl #)
N li ll la lr -> case popRN li ll la lr of
(# l_,iv,v #) -> case l_ of
Z _ _ _ _ -> spliceHL iv l_ ((hl)-#1#) v r hr
_ -> (# Z iv l_ v r, ((hr)+#1#) #)
Z li ll la lr -> case popRZ li ll la lr of
(# l_,iv,v #) -> case l_ of
E -> pushHL l r hr
_ -> (# Z iv l_ v r, ((hr)+#1#) #)
P li ll la lr -> case popRP li ll la lr of
(# l_,iv,v #) -> case l_ of
Z _ _ _ _ -> spliceHL iv l_ ((hl)-#1#) v r hr
_ -> (# Z iv l_ v r, ((hr)+#1#) #)
GT -> case r of
E -> (# l,hl #)
N ri rl ra rr -> case popLN ri rl ra rr of
(# iv,v,r_ #) -> case r_ of
Z _ _ _ _ -> spliceHR iv l hl v r_ ((hr)-#1#)
_ -> spliceHR iv l hl v r_ hr
Z ri rl ra rr -> case popLZ ri rl ra rr of
(# iv,v,r_ #) -> case r_ of
E -> pushHR l hl r
_ -> spliceHR iv l hl v r_ hr
P ri rl ra rr -> case popLP ri rl ra rr of
(# iv,v,r_ #) -> case r_ of
Z _ _ _ _ -> spliceHR iv l hl v r_ ((hr)-#1#)
_ -> spliceHR iv l hl v r_ hr
spliceH :: Key -> IntMap a -> Int# -> a -> IntMap a -> Int# -> (# IntMap a,Int# #)
spliceH ib l hl b r hr =
case compareInt# hl hr of
LT -> spliceHL ib l hl b r hr
EQ -> (# Z ib l b r, ((hl)+#1#) #)
GT -> spliceHR ib l hl b r hr
spliceHL :: Key -> IntMap a -> Int# -> a -> IntMap a -> Int# -> (# IntMap a,Int# #)
spliceHL ib s hs b t ht = let d = ((ht)-#(hs))
in if d ==# 1# then (# N ib s b t, ((ht)+#1#) #)
else sHL ht d t
where
sHL _ _ E = error "spliceHL_: Bug0"
sHL hr d (N ri rl ra rr) = let r_ = sLN ((d)-#2#) ri rl ra rr
in r_ `seq` (# r_,hr #)
sHL hr d (Z ri rl ra rr) = let r_ = sLZ ((d)-#1#) ri rl ra rr
in case r_ of
E -> error "spliceHL: Bug1"
Z _ _ _ _ -> (# r_, hr #)
_ -> (# r_,((hr)+#1#) #)
sHL hr d (P ri rl ra rr) = let r_ = sLP ((d)-#1#) ri rl ra rr
in r_ `seq` (# r_,hr #)
sLN 0# i l a r = Z i (Z ib s b l) a r
sLN 1# i l a r = Z i (N ib s b l) a r
sLN d i (N li ll la lr) a r = let l_ = sLN ((d)-#2#) li ll la lr in l_ `seq` N i l_ a r
sLN d i (Z li ll la lr) a r = let l_ = sLZ ((d)-#1#) li ll la lr
in case l_ of
Z _ _ _ _ -> N i l_ a r
P _ _ _ _ -> Z i l_ a r
_ -> error "spliceHL: Bug2"
sLN d i (P li ll la lr) a r = let l_ = sLP ((d)-#1#) li ll la lr in l_ `seq` N i l_ a r
sLN _ _ E _ _ = error "spliceHL: Bug3"
sLZ 1# i l a r = P i (N ib s b l) a r
sLZ d i (N li ll la lr) a r = let l_ = sLN ((d)-#2#) li ll la lr in l_ `seq` Z i l_ a r
sLZ d i (Z li ll la lr) a r = let l_ = sLZ ((d)-#1#) li ll la lr
in case l_ of
Z _ _ _ _ -> Z i l_ a r
P _ _ _ _ -> P i l_ a r
_ -> error "spliceHL: Bug4"
sLZ d i (P li ll la lr) a r = let l_ = sLP ((d)-#1#) li ll la lr in l_ `seq` Z i l_ a r
sLZ _ _ E _ _ = error "spliceHL: Bug5"
sLP 1# i (N li ll la lr) a r = Z li (P ib s b ll) la (Z i lr a r)
sLP 1# i (Z li ll la lr) a r = Z li (Z ib s b ll) la (Z i lr a r)
sLP 1# i (P li ll la lr) a r = Z li (Z ib s b ll) la (N i lr a r)
sLP d i (N li ll la lr) a r = let l_ = sLN ((d)-#2#) li ll la lr in l_ `seq` P i l_ a r
sLP d i (Z li ll la lr) a r = sLPZ ((d)-#1#) i li ll la lr a r
sLP d i (P li ll la lr) a r = let l_ = sLP ((d)-#1#) li ll la lr in l_ `seq` P i l_ a r
sLP _ _ E _ _ = error "spliceHL: Bug6"
sLPZ 1# i li ll la lr a r = Z li (N ib s b ll) la (Z i lr a r)
sLPZ d i li (N lli lll lle llr) la lr a r = let ll_ = sLN ((d)-#2#) lli lll lle llr
in ll_ `seq` P i (Z li ll_ la lr) a r
sLPZ d i li (Z lli lll lle llr) la lr a r = let ll_ = sLZ ((d)-#1#) lli lll lle llr
in case ll_ of
Z _ _ _ _ -> P i (Z li ll_ la lr) a r
P _ _ _ _ -> Z li ll_ la (Z i lr a r)
_ -> error "spliceHL: Bug7"
sLPZ d i li (P lli lll lle llr) la lr a r = let ll_ = sLP ((d)-#1#) lli lll lle llr
in ll_ `seq` P i (Z li ll_ la lr) a r
sLPZ _ _ _ E _ _ _ _ = error "spliceHL: Bug8"
spliceHR :: Key -> IntMap a -> Int# -> a -> IntMap a -> Int# -> (# IntMap a,Int# #)
spliceHR ib s hs b t ht = let d = ((hs)-#(ht))
in if d ==# 1# then (# P ib s b t, ((hs)+#1#) #)
else sHR hs d s
where
sHR _ _ E = error "spliceHL: Bug0"
sHR hl d (N li ll la lr) = let l_ = sRN ((d)-#1#) li ll la lr
in l_ `seq` (# l_,hl #)
sHR hl d (Z li ll la lr) = let l_ = sRZ ((d)-#1#) li ll la lr
in case l_ of
E -> error "spliceHL: Bug1"
Z _ _ _ _ -> (# l_, hl #)
_ -> (# l_,((hl)+#1#) #)
sHR hl d (P li ll la lr) = let l_ = sRP ((d)-#2#) li ll la lr
in l_ `seq` (# l_,hl #)
sRP 0# i l a r = Z i l a (Z ib r b t)
sRP 1# i l a r = Z i l a (P ib r b t)
sRP d i l a (N ri rl ra rr) = let r_ = sRN ((d)-#1#) ri rl ra rr in r_ `seq` P i l a r_
sRP d i l a (Z ri rl ra rr) = let r_ = sRZ ((d)-#1#) ri rl ra rr
in case r_ of
Z _ _ _ _ -> P i l a r_
N _ _ _ _ -> Z i l a r_
_ -> error "spliceHL: Bug2"
sRP d i l a (P ri rl ra rr) = let r_ = sRP ((d)-#2#) ri rl ra rr in r_ `seq` P i l a r_
sRP _ _ _ _ E = error "spliceHL: Bug3"
sRZ 1# i l a r = N i l a (P ib r b t)
sRZ d i l a (N ri rl ra rr) = let r_ = sRN ((d)-#1#) ri rl ra rr in r_ `seq` Z i l a r_
sRZ d i l a (Z ri rl ra rr) = let r_ = sRZ ((d)-#1#) ri rl ra rr
in case r_ of
Z _ _ _ _ -> Z i l a r_
N _ _ _ _ -> N i l a r_
_ -> error "spliceHL: Bug4"
sRZ d i l a (P ri rl ra rr) = let r_ = sRP ((d)-#2#) ri rl ra rr in r_ `seq` Z i l a r_
sRZ _ _ _ _ E = error "spliceHL: Bug5"
sRN 1# i l a (N ri rl ra rr) = Z ri (P i l a rl) ra (Z ib rr b t)
sRN 1# i l a (Z ri rl ra rr) = Z ri (Z i l a rl) ra (Z ib rr b t)
sRN 1# i l a (P ri rl ra rr) = Z ri (Z i l a rl) ra (N ib rr b t)
sRN d i l a (N ri rl ra rr) = let r_ = sRN ((d)-#1#) ri rl ra rr in r_ `seq` N i l a r_
sRN d i l a (Z ri rl ra rr) = sRNZ ((d)-#1#) i l a ri rl ra rr
sRN d i l a (P ri rl ra rr) = let r_ = sRP ((d)-#2#) ri rl ra rr in r_ `seq` N i l a r_
sRN _ _ _ _ E = error "spliceHL: Bug6"
sRNZ 1# i l a ri rl ra rr = Z ri (Z i l a rl) ra (P ib rr b t)
sRNZ d i l a ri rl ra (N rri rrl rre rrr) = let rr_ = sRN ((d)-#1#) rri rrl rre rrr
in rr_ `seq` N i l a (Z ri rl ra rr_)
sRNZ d i l a ri rl ra (Z rri rrl rre rrr) = let rr_ = sRZ ((d)-#1#) rri rrl rre rrr
in case rr_ of
Z _ _ _ _ -> N i l a (Z ri rl ra rr_)
N _ _ _ _ -> Z ri (Z i l a rl) ra rr_
_ -> error "spliceHL: Bug7"
sRNZ d i l a ri rl ra (P rri rrl rre rrr) = let rr_ = sRP ((d)-#2#) rri rrl rre rrr
in rr_ `seq` N i l a (Z ri rl ra rr_)
sRNZ _ _ _ _ _ _ _ E = error "spliceHL: Bug8"
pushHL :: IntMap a -> IntMap a -> Int# -> (# IntMap a,Int# #)
pushHL t0 t h = case t of
E -> (# t0, ((h)+#1#) #)
N i l a r -> let t_ = potNL i l a r in t_ `seq` (# t_,h #)
P i l a r -> let t_ = potPL i l a r in t_ `seq` (# t_,h #)
Z i l a r -> let t_ = potZL i l a r
in case t_ of
Z _ _ _ _ -> (# t_, h #)
P _ _ _ _ -> (# t_, ((h)+#1#) #)
_ -> error "pushHL: Bug0"
where
potNL i E a r = Z i t0 a r
potNL i (N li ll la lr) a r = let l_ = potNL li ll la lr
in l_ `seq` N i l_ a r
potNL i (P li ll la lr) a r = let l_ = potPL li ll la lr
in l_ `seq` N i l_ a r
potNL i (Z li ll la lr) a r = let l_ = potZL li ll la lr
in case l_ of
Z _ _ _ _ -> N i l_ a r
P _ _ _ _ -> Z i l_ a r
_ -> error "pushHL: Bug1"
potZL i E a r = P i t0 a r
potZL i (N li ll la lr) a r = let l_ = potNL li ll la lr
in l_ `seq` Z i l_ a r
potZL i (P li ll la lr) a r = let l_ = potPL li ll la lr
in l_ `seq` Z i l_ a r
potZL i (Z li ll la lr) a r = let l_ = potZL li ll la lr
in case l_ of
Z _ _ _ _ -> Z i l_ a r
N _ _ _ _ -> error "pushHL: Bug2"
_ -> P i l_ a r
potPL _ E _ _ = error "pushHL: Bug3"
potPL i (N li ll la lr) a r = let l_ = potNL li ll la lr
in l_ `seq` P i l_ a r
potPL i (P li ll la lr) a r = let l_ = potPL li ll la lr
in l_ `seq` P i l_ a r
potPL i (Z li ll la lr) a r = potPLL i li ll la lr a r
potPLL i li E la lr a r = Z li t0 la (Z i lr a r)
potPLL i li (N lli lll lla llr) la lr a r = let ll_ = potNL lli lll lla llr
in ll_ `seq` P i (Z li ll_ la lr) a r
potPLL i li (P lli lll lla llr) la lr a r = let ll_ = potPL lli lll lla llr
in ll_ `seq` P i (Z li ll_ la lr) a r
potPLL i li (Z lli lll lla llr) la lr a r = let ll_ = potZL lli lll lla llr
in case ll_ of
Z _ _ _ _ -> P i (Z li ll_ la lr) a r
N _ _ _ _ -> error "pushHL: Bug4"
_ -> Z li ll_ la (Z i lr a r)
pushHR :: IntMap a -> Int# -> IntMap a -> (# IntMap a,Int# #)
pushHR t h t0 = case t of
E -> (# t0, ((h)+#1#) #)
N i l a r -> let t_ = potNR i l a r in t_ `seq` (# t_,h #)
P i l a r -> let t_ = potPR i l a r in t_ `seq` (# t_,h #)
Z i l a r -> let t_ = potZR i l a r
in case t_ of
Z _ _ _ _ -> (# t_, h #)
N _ _ _ _ -> (# t_, ((h)+#1#) #)
_ -> error "pushHR: Bug0"
where
potZR i l a E = N i l a t0
potZR i l a (N ri rl ra rr) = let r_ = potNR ri rl ra rr
in r_ `seq` Z i l a r_
potZR i l a (P ri rl ra rr) = let r_ = potPR ri rl ra rr
in r_ `seq` Z i l a r_
potZR i l a (Z ri rl ra rr) = let r_ = potZR ri rl ra rr
in case r_ of
Z _ _ _ _ -> Z i l a r_
N _ _ _ _ -> N i l a r_
_ -> error "pushHR: Bug1"
potPR i l a E = Z i l a t0
potPR i l a (N ri rl ra rr) = let r_ = potNR ri rl ra rr
in r_ `seq` P i l a r_
potPR i l a (P ri rl ra rr) = let r_ = potPR ri rl ra rr
in r_ `seq` P i l a r_
potPR i l a (Z ri rl ra rr) = let r_ = potZR ri rl ra rr
in case r_ of
Z _ _ _ _ -> P i l a r_
N _ _ _ _ -> Z i l a r_
_ -> error "pushHR: Bug2"
potNR _ _ _ E = error "pushHR: Bug3"
potNR i l a (N ri rl ra rr) = let r_ = potNR ri rl ra rr
in r_ `seq` N i l a r_
potNR i l a (P ri rl ra rr) = let r_ = potPR ri rl ra rr
in r_ `seq` N i l a r_
potNR i l a (Z ri rl ra rr) = potNRR i l a ri rl ra rr
potNRR i l a ri rl ra E = Z ri (Z i l a rl) ra t0
potNRR i l a ri rl ra (N rri rrl rra rrr) = let rr_ = potNR rri rrl rra rrr
in rr_ `seq` N i l a (Z ri rl ra rr_)
potNRR i l a ri rl ra (P rri rrl rra rrr) = let rr_ = potPR rri rrl rra rrr
in rr_ `seq` N i l a (Z ri rl ra rr_)
potNRR i l a ri rl ra (Z rri rrl rra rrr) = let rr_ = potZR rri rrl rra rrr
in case rr_ of
Z _ _ _ _ -> N i l a (Z ri rl ra rr_)
N _ _ _ _ -> Z ri (Z i l a rl) ra rr_
_ -> error "pushHR: Bug4"
del :: Key -> IntMap a -> IntMap a
del _ E = error "del: Key not found."
del k0 (N k l a r) = delN k0 k l a r
del k0 (Z k l a r) = delZ k0 k l a r
del k0 (P k l a r) = delP k0 k l a r
delH :: Key -> Int# -> IntMap a -> (# IntMap a,Int# #)
delH _ _ E = error "delH: Key not found."
delH k0 ht (N k l a r) = let t_ = delN k0 k l a r in
case t_ of
Z _ _ _ _ -> (# t_,((ht)-#1#) #)
_ -> (# t_, ht #)
delH k0 ht (Z k l a r) = let t_ = delZ k0 k l a r in
case t_ of
E -> (# t_,((ht)-#1#) #)
_ -> (# t_, ht #)
delH k0 ht (P k l a r) = let t_ = delP k0 k l a r in
case t_ of
Z _ _ _ _ -> (# t_,((ht)-#1#) #)
_ -> (# t_, ht #)
delN :: Key -> Key -> IntMap a -> a -> IntMap a -> IntMap a
delN k0 k l a r = case compareInt# k0 k of
LT -> delNL k0 k l a r
EQ -> subN l r
GT -> delNR k0 k l a r
delZ :: Key -> Key -> IntMap a -> a -> IntMap a -> IntMap a
delZ k0 k l a r = case compareInt# k0 k of
LT -> delZL k0 k l a r
EQ -> subZR l r
GT -> delZR k0 k l a r
delP :: Key -> Key -> IntMap a -> a -> IntMap a -> IntMap a
delP k0 k l a r = case compareInt# k0 k of
LT -> delPL k0 k l a r
EQ -> subP l r
GT -> delPR k0 k l a r
delNL :: Key -> Key -> IntMap a -> a -> IntMap a -> IntMap a
delNL _ _ E _ _ = error "assertDelete: Key not found."
delNL k0 k (N lk ll la lr) a r = case compareInt# k0 lk of
LT -> chkLN k (delNL k0 lk ll la lr) a r
EQ -> chkLN k (subN ll lr) a r
GT -> chkLN k (delNR k0 lk ll la lr) a r
delNL k0 k (Z lk ll la lr) a r = case compareInt# k0 lk of
LT -> let l_ = delZL k0 lk ll la lr in l_ `seq` N k l_ a r
EQ -> chkLN_ k (subZR ll lr) a r
GT -> let l_ = delZR k0 lk ll la lr in l_ `seq` N k l_ a r
delNL k0 k (P lk ll la lr) a r = case compareInt# k0 lk of
LT -> chkLN k (delPL k0 lk ll la lr) a r
EQ -> chkLN k (subP ll lr) a r
GT -> chkLN k (delPR k0 lk ll la lr) a r
delNR :: Key -> Key -> IntMap a -> a -> IntMap a -> IntMap a
delNR _ _ _ _ E = error "delNR: Bug0"
delNR k0 k l a (N rk rl ra rr) = case compareInt# k0 rk of
LT -> chkRN k l a (delNL k0 rk rl ra rr)
EQ -> chkRN k l a (subN rl rr)
GT -> chkRN k l a (delNR k0 rk rl ra rr)
delNR k0 k l a (Z rk rl ra rr) = case compareInt# k0 rk of
LT -> let r_ = delZL k0 rk rl ra rr in r_ `seq` N k l a r_
EQ -> chkRN_ k l a (subZL rl rr)
GT -> let r_ = delZR k0 rk rl ra rr in r_ `seq` N k l a r_
delNR k0 k l a (P rk rl ra rr) = case compareInt# k0 rk of
LT -> chkRN k l a (delPL k0 rk rl ra rr)
EQ -> chkRN k l a (subP rl rr)
GT -> chkRN k l a (delPR k0 rk rl ra rr)
delZL :: Key -> Key -> IntMap a -> a -> IntMap a -> IntMap a
delZL _ _ E _ _ = error "assertDelete: Key not found."
delZL k0 k (N lk ll la lr) a r = case compareInt# k0 lk of
LT -> chkLZ k (delNL k0 lk ll la lr) a r
EQ -> chkLZ k (subN ll lr) a r
GT -> chkLZ k (delNR k0 lk ll la lr) a r
delZL k0 k (Z lk ll la lr) a r = case compareInt# k0 lk of
LT -> let l_ = delZL k0 lk ll la lr in l_ `seq` Z k l_ a r
EQ -> chkLZ_ k (subZR ll lr) a r
GT -> let l_ = delZR k0 lk ll la lr in l_ `seq` Z k l_ a r
delZL k0 k (P lk ll la lr) a r = case compareInt# k0 lk of
LT -> chkLZ k (delPL k0 lk ll la lr) a r
EQ -> chkLZ k (subP ll lr) a r
GT -> chkLZ k (delPR k0 lk ll la lr) a r
delZR :: Key -> Key -> IntMap a -> a -> IntMap a -> IntMap a
delZR _ _ _ _ E = error "assertDelete: Key not found."
delZR k0 k l a (N rk rl ra rr) = case compareInt# k0 rk of
LT -> chkRZ k l a (delNL k0 rk rl ra rr)
EQ -> chkRZ k l a (subN rl rr)
GT -> chkRZ k l a (delNR k0 rk rl ra rr)
delZR k0 k l a (Z rk rl ra rr) = case compareInt# k0 rk of
LT -> let r_ = delZL k0 rk rl ra rr in r_ `seq` Z k l a r_
EQ -> chkRZ_ k l a (subZL rl rr)
GT -> let r_ = delZR k0 rk rl ra rr in r_ `seq` Z k l a r_
delZR k0 k l a (P rk rl ra rr) = case compareInt# k0 rk of
LT -> chkRZ k l a (delPL k0 rk rl ra rr)
EQ -> chkRZ k l a (subP rl rr)
GT -> chkRZ k l a (delPR k0 rk rl ra rr)
delPL :: Key -> Key -> IntMap a -> a -> IntMap a -> IntMap a
delPL _ _ E _ _ = error "delPL: Bug0"
delPL k0 k (N lk ll la lr) a r = case compareInt# k0 lk of
LT -> chkLP k (delNL k0 lk ll la lr) a r
EQ -> chkLP k (subN ll lr) a r
GT -> chkLP k (delNR k0 lk ll la lr) a r
delPL k0 k (Z lk ll la lr) a r = case compareInt# k0 lk of
LT -> let l_ = delZL k0 lk ll la lr in l_ `seq` P k l_ a r
EQ -> chkLP_ k (subZR ll lr) a r
GT -> let l_ = delZR k0 lk ll la lr in l_ `seq` P k l_ a r
delPL k0 k (P lk ll la lr) a r = case compareInt# k0 lk of
LT -> chkLP k (delPL k0 lk ll la lr) a r
EQ -> chkLP k (subP ll lr) a r
GT -> chkLP k (delPR k0 lk ll la lr) a r
delPR :: Key -> Key -> IntMap a -> a -> IntMap a -> IntMap a
delPR _ _ _ _ E = error "assertDelete: Key not found."
delPR k0 k l a (N rk rl ra rr) = case compareInt# k0 rk of
LT -> chkRP k l a (delNL k0 rk rl ra rr)
EQ -> chkRP k l a (subN rl rr)
GT -> chkRP k l a (delNR k0 rk rl ra rr)
delPR k0 k l a (Z rk rl ra rr) = case compareInt# k0 rk of
LT -> let r_ = delZL k0 rk rl ra rr in r_ `seq` P k l a r_
EQ -> chkRP_ k l a (subZL rl rr)
GT -> let r_ = delZR k0 rk rl ra rr in r_ `seq` P k l a r_
delPR k0 k l a (P rk rl ra rr) = case compareInt# k0 rk of
LT -> chkRP k l a (delPL k0 rk rl ra rr)
EQ -> chkRP k l a (subP rl rr)
GT -> chkRP k l a (delPR k0 rk rl ra rr)
popLN :: Key -> IntMap a -> a -> IntMap a -> (# Key,a,IntMap a #)
popLN k E a r = (# k,a,r #)
popLN k (N lk ll la lr) a r = case popLN lk ll la lr of
(# iv,v,l #) -> let t = chkLN k l a r in t `seq` (# iv,v,t #)
popLN k (Z lk ll la lr) a r = popLNZ k lk ll la lr a r
popLN k (P lk ll la lr) a r = case popLP lk ll la lr of
(# iv,v,l #) -> let t = chkLN k l a r in t `seq` (# iv,v,t #)
popLZ :: Key -> IntMap a -> a -> IntMap a -> (# Key,a,IntMap a #)
popLZ k E a _ = (# k,a,E #)
popLZ k (N lk ll la lr) a r = popLZN k lk ll la lr a r
popLZ k (Z lk ll la lr) a r = popLZZ k lk ll la lr a r
popLZ k (P lk ll la lr) a r = popLZP k lk ll la lr a r
popLP :: Key -> IntMap a -> a -> IntMap a -> (# Key,a,IntMap a #)
popLP _ E _ _ = error "popLP: Bug!"
popLP k (N lk ll la lr) a r = case popLN lk ll la lr of
(# iv,v,l #) -> let t = chkLP k l a r in t `seq` (# iv,v,t #)
popLP k (Z lk ll la lr) a r = popLPZ k lk ll la lr a r
popLP k (P lk ll la lr) a r = case popLP lk ll la lr of
(# iv,v,l #) -> let t = chkLP k l a r in t `seq` (# iv,v,t #)
popLNZ :: Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> (# Key,a,IntMap a #)
popLNZ k lk E la _ a r = let t = rebalN k E a r
in t `seq` (# lk,la,t #)
popLNZ k lk (N llk lll lla llr) la lr a r = case popLZN lk llk lll lla llr la lr of
(# iv,v,l #) -> (# iv,v,N k l a r #)
popLNZ k lk (Z llk lll lla llr) la lr a r = case popLZZ lk llk lll lla llr la lr of
(# iv,v,l #) -> (# iv,v,N k l a r #)
popLNZ k lk (P llk lll lla llr) la lr a r = case popLZP lk llk lll lla llr la lr of
(# iv,v,l #) -> (# iv,v,N k l a r #)
popLZZ :: Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> (# Key,a,IntMap a #)
popLZZ k lk E la _ a r = (# lk,la,N k E a r #)
popLZZ k lk (N llk lll lla llr) la lr a r = case popLZN lk llk lll lla llr la lr of
(# iv,v,l #) -> (# iv,v,Z k l a r #)
popLZZ k lk (Z llk lll lla llr) la lr a r = case popLZZ lk llk lll lla llr la lr of
(# iv,v,l #) -> (# iv,v,Z k l a r #)
popLZZ k lk (P llk lll lla llr) la lr a r = case popLZP lk llk lll lla llr la lr of
(# iv,v,l #) -> (# iv,v,Z k l a r #)
popLPZ :: Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> (# Key,a,IntMap a #)
popLPZ k lk E la _ a _ = (# lk,la,Z k E a E #)
popLPZ k lk (N llk lll lla llr) la lr a r = case popLZN lk llk lll lla llr la lr of
(# iv,v,l #) -> (# iv,v,P k l a r #)
popLPZ k lk (Z llk lll lla llr) la lr a r = case popLZZ lk llk lll lla llr la lr of
(# iv,v,l #) -> (# iv,v,P k l a r #)
popLPZ k lk (P llk lll lla llr) la lr a r = case popLZP lk llk lll lla llr la lr of
(# iv,v,l #) -> (# iv,v,P k l a r #)
popLZN :: Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> (# Key,a,IntMap a #)
popLZN k lk ll la lr a r = case popLN lk ll la lr of
(# iv,v,l #) -> let t = chkLZ k l a r in t `seq` (# iv,v,t #)
popLZP :: Key -> Key -> IntMap a -> a -> IntMap a -> a -> IntMap a -> (# Key,a,IntMap a #)
popLZP k lk ll la lr a r = case popLP lk ll la lr of
(# iv,v,l #) -> let t = chkLZ k l a r in t `seq` (# iv,v,t #)
popRN :: Key -> IntMap a -> a -> IntMap a -> (# IntMap a, Key, a #)
popRN _ _ _ E = error "popRN: Bug!"
popRN k l a (N rk rl ra rr) = case popRN rk rl ra rr of
(# r,iv,v #) -> let t = chkRN k l a r in t `seq` (# t,iv,v #)
popRN k l a (Z rk rl ra rr) = popRNZ k l a rk rl ra rr
popRN k l a (P rk rl ra rr) = case popRP rk rl ra rr of
(# r,iv,v #) -> let t = chkRN k l a r in t `seq` (# t,iv,v #)
popRZ :: Key -> IntMap a -> a -> IntMap a -> (# IntMap a, Key, a #)
popRZ k _ a E = (# E,k,a #)
popRZ k l a (N rk rl ra rr) = popRZN k l a rk rl ra rr
popRZ k l a (Z rk rl ra rr) = popRZZ k l a rk rl ra rr
popRZ k l a (P rk rl ra rr) = popRZP k l a rk rl ra rr
popRP :: Key -> IntMap a -> a -> IntMap a -> (# IntMap a, Key, a #)
popRP k l a E = (# l,k,a #)
popRP k l a (N rk rl ra rr) = case popRN rk rl ra rr of
(# r,iv,v #) -> let t = chkRP k l a r in t `seq` (# t,iv,v #)
popRP k l a (Z rk rl ra rr) = popRPZ k l a rk rl ra rr
popRP k l a (P rk rl ra rr) = case popRP rk rl ra rr of
(# r,iv,v #) -> let t = chkRP k l a r in t `seq` (# t,iv,v #)
popRNZ :: Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> (# IntMap a, Key, a #)
popRNZ k _ a rk _ ra E = (# Z k E a E,rk,ra #)
popRNZ k l a rk rl ra (N rrk rrl rra rrr) = case popRZN rk rl ra rrk rrl rra rrr of
(# r,iv,v #) -> (# N k l a r,iv,v #)
popRNZ k l a rk rl ra (Z rrk rrl rra rrr) = case popRZZ rk rl ra rrk rrl rra rrr of
(# r,iv,v #) -> (# N k l a r,iv,v #)
popRNZ k l a rk rl ra (P rrk rrl rra rrr) = case popRZP rk rl ra rrk rrl rra rrr of
(# r,iv,v #) -> (# N k l a r,iv,v #)
popRZZ :: Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> (# IntMap a, Key, a #)
popRZZ k l a rk _ ra E = (# P k l a E,rk,ra #)
popRZZ k l a rk rl ra (N rrk rrl rra rrr) = case popRZN rk rl ra rrk rrl rra rrr of
(# r,iv,v #) -> (# Z k l a r,iv,v #)
popRZZ k l a rk rl ra (Z rrk rrl rra rrr) = case popRZZ rk rl ra rrk rrl rra rrr of
(# r,iv,v #) -> (# Z k l a r,iv,v #)
popRZZ k l a rk rl ra (P rrk rrl rra rrr) = case popRZP rk rl ra rrk rrl rra rrr of
(# r,iv,v #) -> (# Z k l a r,iv,v #)
popRPZ :: Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> (# IntMap a, Key, a #)
popRPZ k l a rk _ ra E = let t = rebalP k l a E
in t `seq` (# t,rk,ra #)
popRPZ k l a rk rl ra (N rrk rrl rra rrr) = case popRZN rk rl ra rrk rrl rra rrr of
(# r,iv,v #) -> (# P k l a r,iv,v #)
popRPZ k l a rk rl ra (Z rrk rrl rra rrr) = case popRZZ rk rl ra rrk rrl rra rrr of
(# r,iv,v #) -> (# P k l a r,iv,v #)
popRPZ k l a rk rl ra (P rrk rrl rra rrr) = case popRZP rk rl ra rrk rrl rra rrr of
(# r,iv,v #) -> (# P k l a r,iv,v #)
popRZN :: Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> (# IntMap a, Key, a #)
popRZN k l a rk rl ra rr = case popRN rk rl ra rr of
(# r,iv,v #) -> let t = chkRZ k l a r in t `seq` (# t,iv,v #)
popRZP :: Key -> IntMap a -> a -> Key -> IntMap a -> a -> IntMap a -> (# IntMap a, Key, a #)
popRZP k l a rk rl ra rr = case popRP rk rl ra rr of
(# r,iv,v #) -> let t = chkRZ k l a r in t `seq` (# t,iv,v #)
rebalN :: Key -> IntMap a -> a -> IntMap a -> IntMap a
rebalN _ _ _ E = error "rebalN: Bug0"
rebalN k l a (N rk rl ra rr) = Z rk (Z k l a rl) ra rr
rebalN k l a (Z rk rl ra rr) = P rk (N k l a rl) ra rr
rebalN _ _ _ (P _ E _ _ ) = error "rebalN: Bug1"
rebalN k l a (P rk (N rlk rll rla rlr) ra rr) = Z rlk (P k l a rll) rla (Z rk rlr ra rr)
rebalN k l a (P rk (Z rlk rll rla rlr) ra rr) = Z rlk (Z k l a rll) rla (Z rk rlr ra rr)
rebalN k l a (P rk (P rlk rll rla rlr) ra rr) = Z rlk (Z k l a rll) rla (N rk rlr ra rr)
rebalP :: Key -> IntMap a -> a -> IntMap a -> IntMap a
rebalP _ E _ _ = error "rebalP: Bug0"
rebalP k (P lk ll la lr ) a r = Z lk ll la (Z k lr a r)
rebalP k (Z lk ll la lr ) a r = N lk ll la (P k lr a r)
rebalP _ (N _ _ _ E ) _ _ = error "rebalP: Bug1"
rebalP k (N lk ll la (P lrk lrl lra lrr)) a r = Z lrk (Z lk ll la lrl) lra (N k lrr a r)
rebalP k (N lk ll la (Z lrk lrl lra lrr)) a r = Z lrk (Z lk ll la lrl) lra (Z k lrr a r)
rebalP k (N lk ll la (N lrk lrl lra lrr)) a r = Z lrk (P lk ll la lrl) lra (Z k lrr a r)
chkLN :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkLN k l a r = case l of
E -> error "chkLN: Bug0"
N _ _ _ _ -> N k l a r
Z _ _ _ _ -> rebalN k l a r
P _ _ _ _ -> N k l a r
chkLZ :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkLZ k l a r = case l of
E -> error "chkLZ: Bug0"
N _ _ _ _ -> Z k l a r
Z _ _ _ _ -> N k l a r
P _ _ _ _ -> Z k l a r
chkLP :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkLP k l a r = case l of
E -> error "chkLP: Bug0"
N _ _ _ _ -> P k l a r
Z _ _ _ _ -> Z k l a r
P _ _ _ _ -> P k l a r
chkRN :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkRN k l a r = case r of
E -> error "chkRN: Bug0"
N _ _ _ _ -> N k l a r
Z _ _ _ _ -> Z k l a r
P _ _ _ _ -> N k l a r
chkRZ :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkRZ k l a r = case r of
E -> error "chkRZ: Bug0"
N _ _ _ _ -> Z k l a r
Z _ _ _ _ -> P k l a r
P _ _ _ _ -> Z k l a r
chkRP :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkRP k l a r = case r of
E -> error "chkRP: Bug0"
N _ _ _ _ -> P k l a r
Z _ _ _ _ -> rebalP k l a r
P _ _ _ _ -> P k l a r
subN :: IntMap a -> IntMap a -> IntMap a
subN _ E = error "subN: Bug0"
subN l (N rk rl ra rr) = case popLN rk rl ra rr of (# iv,v,r_ #) -> chkRN iv l v r_
subN l (Z rk rl ra rr) = case popLZ rk rl ra rr of (# iv,v,r_ #) -> chkRN_ iv l v r_
subN l (P rk rl ra rr) = case popLP rk rl ra rr of (# iv,v,r_ #) -> chkRN iv l v r_
subZR :: IntMap a -> IntMap a -> IntMap a
subZR _ E = E
subZR l (N rk rl ra rr) = case popLN rk rl ra rr of (# iv,v,r_ #) -> chkRZ iv l v r_
subZR l (Z rk rl ra rr) = case popLZ rk rl ra rr of (# iv,v,r_ #) -> chkRZ_ iv l v r_
subZR l (P rk rl ra rr) = case popLP rk rl ra rr of (# iv,v,r_ #) -> chkRZ iv l v r_
subZL :: IntMap a -> IntMap a -> IntMap a
subZL E _ = E
subZL (N lk ll la lr) r = case popRN lk ll la lr of (# l_,iv,v #) -> chkLZ iv l_ v r
subZL (Z lk ll la lr) r = case popRZ lk ll la lr of (# l_,iv,v #) -> chkLZ_ iv l_ v r
subZL (P lk ll la lr) r = case popRP lk ll la lr of (# l_,iv,v #) -> chkLZ iv l_ v r
subP :: IntMap a -> IntMap a -> IntMap a
subP E _ = error "subP: Bug0"
subP (N lk ll la lr) r = case popRN lk ll la lr of (# l_,iv,v #) -> chkLP iv l_ v r
subP (Z lk ll la lr) r = case popRZ lk ll la lr of (# l_,iv,v #) -> chkLP_ iv l_ v r
subP (P lk ll la lr) r = case popRP lk ll la lr of (# l_,iv,v #) -> chkLP iv l_ v r
chkLN_ :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkLN_ k l a r = case l of
E -> rebalN k l a r
_ -> N k l a r
chkLZ_ :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkLZ_ k l a r = case l of
E -> N k l a r
_ -> Z k l a r
chkLP_ :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkLP_ k l a r = case l of
E -> Z k l a r
_ -> P k l a r
chkRN_ :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkRN_ k l a r = case r of
E -> Z k l a r
_ -> N k l a r
chkRZ_ :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkRZ_ k l a r = case r of
E -> P k l a r
_ -> Z k l a r
chkRP_ :: Key -> IntMap a -> a -> IntMap a -> IntMap a
chkRP_ k l a r = case r of
E -> rebalP k l a r
_ -> P k l a r
instance (Eq a) => Eq (IntMap a) where
imp0 == imp1 = asIAList imp0 == asIAList imp1
instance Ord a => Ord (IntMap a) where
compare imp0 imp1 = compare (asIAList imp0) (asIAList imp1)
instance Show a => Show (IntMap a) where
showsPrec d mp = showParen (d > 10) $
showString "fromAssocsAsc " . shows (assocsAsc mp)
instance R.Read a => R.Read (IntMap a) where
readPrec = R.parens $ R.prec 10 $ do R.Ident "fromAssocsAsc" <- R.lexP
xs <- R.readPrec
return (fromAssocsAsc xs)
readListPrec = R.readListPrecDefault
instance Typeable1 IntMap where
typeOf1 _ = mkTyConApp (mkTyCon "Data.GMap.IntMap.IntMap") []
instance Typeable a => Typeable (IntMap a) where
typeOf = typeOfDefault
instance Functor IntMap where
fmap = mapIntMap
instance M.Monoid a => M.Monoid (IntMap a) where
mempty = emptyIntMap
mappend map0 map1 = unionIntMap M.mappend map0 map1
mconcat maps = L.foldr (unionIntMap M.mappend) emptyIntMap maps
instance F.Foldable IntMap where
fold mp = foldElemsAscIntMap M.mappend M.mempty mp
foldMap f mp = foldElemsAscIntMap (\a b -> M.mappend (f a) b) M.mempty mp
foldr f b0 mp = foldElemsAscIntMap f b0 mp
foldl f b0 mp = foldElemsDescIntMap (flip f) b0 mp
vennIntMap :: (a -> b -> c) -> IntMap a -> IntMap b -> (IntMap a, IntMap c, IntMap b)
vennIntMap f = gu where
gu E t1 = (E ,E,t1)
gu t0 E = (t0,E,E )
gu t0@(N _ l0 _ _ ) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 2# l0) t1 (addHeight 2# l1)
gu t0@(N _ l0 _ _ ) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 2# l0) t1 (addHeight 1# l1)
gu t0@(N _ l0 _ _ ) t1@(P _ _ _ r1) = gu_ t0 (addHeight 2# l0) t1 (addHeight 2# r1)
gu t0@(Z _ l0 _ _ ) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 1# l0) t1 (addHeight 2# l1)
gu t0@(Z _ l0 _ _ ) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 1# l0) t1 (addHeight 1# l1)
gu t0@(Z _ l0 _ _ ) t1@(P _ _ _ r1) = gu_ t0 (addHeight 1# l0) t1 (addHeight 2# r1)
gu t0@(P _ _ _ r0) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 2# r0) t1 (addHeight 2# l1)
gu t0@(P _ _ _ r0) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 2# r0) t1 (addHeight 1# l1)
gu t0@(P _ _ _ r0) t1@(P _ _ _ r1) = gu_ t0 (addHeight 2# r0) t1 (addHeight 2# r1)
gu_ t0 h0 t1 h1 = case vennH f Empt 0# t0 h0 t1 h1 of
(# tab,_,cs,cl,tba,_ #) -> case subst (rep (I# cl)) cs of (# tc,_ #) -> (tab,tc,tba)
vennH :: (a -> b -> c) -> IAList c -> Int# -> IntMap a -> Int# -> IntMap b -> Int# -> (# IntMap a,Int#,IAList c,Int#,IntMap b,Int# #)
vennH f = v where
v cs cl E ha tb hb = (# E ,ha,cs,cl,tb,hb #)
v cs cl ta ha E hb = (# ta,ha,cs,cl,E ,hb #)
v cs cl (N ka la a ra) ha (N kb lb b rb) hb = v_ cs cl ka la (ha-#2#) a ra (ha-#1#) kb lb (hb-#2#) b rb (hb-#1#)
v cs cl (N ka la a ra) ha (Z kb lb b rb) hb = v_ cs cl ka la (ha-#2#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#1#)
v cs cl (N ka la a ra) ha (P kb lb b rb) hb = v_ cs cl ka la (ha-#2#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#2#)
v cs cl (Z ka la a ra) ha (N kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#1#) kb lb (hb-#2#) b rb (hb-#1#)
v cs cl (Z ka la a ra) ha (Z kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#1#)
v cs cl (Z ka la a ra) ha (P kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#2#)
v cs cl (P ka la a ra) ha (N kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#2#) kb lb (hb-#2#) b rb (hb-#1#)
v cs cl (P ka la a ra) ha (Z kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#2#) kb lb (hb-#1#) b rb (hb-#1#)
v cs cl (P ka la a ra) ha (P kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#2#) kb lb (hb-#1#) b rb (hb-#2#)
v_ cs cl ka la hla a ra hra kb lb hlb b rb hrb =
case compareInt# ka kb of
LT -> case forkVenn ka lb hlb of
(# llb,hllb,mybb,rlb,hrlb #) -> case forkVenn kb ra hra of
(# lra,hlra,myba,rra,hrra #) ->
case v cs cl rra hrra rb hrb of
(# rab,hrab,cs0,cl0,rba,hrba #) -> case (case myba of
Nothing -> case v cs0 cl0 lra hlra rlb hrlb of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case spliceH kb mba hmba b rba hrba of
(# mrba,hmrba #) -> (# mab,hmab,cs1,cl1,mrba,hmrba #)
Just a_ -> case (let c = f a_ b
in v (Cons kb c cs0) (cl0+#1#) lra hlra rlb hrlb
) of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case joinH mba hmba rba hrba of
(# mrba,hmrba #) -> (# mab,hmab,cs1,cl1,mrba,hmrba #)
) of
(# mab,hmab,cs1,cl1,mrba,hmrba #) -> case joinH mab hmab rab hrab of
(# mrab,hmrab #) -> case (case mybb of
Nothing -> case v cs1 cl1 la hla llb hllb of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case spliceH ka lab hlab a mrab hmrab of
(# ab,hab #) -> (# ab,hab,cs2,cl2,lba,hlba #)
Just b_ -> case (let c = f a b_
in v (Cons ka c cs1) (cl1+#1#) la hla llb hllb
) of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case joinH lab hlab mrab hmrab of
(# ab,hab #) -> (# ab,hab,cs2,cl2,lba,hlba #)
) of
(# ab,hab,cs2,cl2,lba,hlba #) -> case joinH lba hlba mrba hmrba of
(# ba,hba #) -> (# ab,hab,cs2,cl2,ba,hba #)
EQ -> case v cs cl ra hra rb hrb of
(# rab,hrab,cs0,cl0,rba,hrba #) -> case (let c = f a b
in v (Cons ka c cs0) (cl0+#1#) la hla lb hlb
) of
(# lab,hlab,cs1,cl1,lba,hlba #) -> case joinH lab hlab rab hrab of
(# ab,hab #) -> case joinH lba hlba rba hrba of
(# ba,hba #) -> (# ab,hab,cs1,cl1,ba,hba #)
GT -> case forkVenn ka rb hrb of
(# lrb,hlrb,mybb,rrb,hrrb #) -> case forkVenn kb la hla of
(# lla,hlla,myba,rla,hrla #) ->
case v cs cl ra hra rrb hrrb of
(# rab,hrab,cs0,cl0,rba,hrba #) -> case (case mybb of
Nothing -> case v cs0 cl0 rla hrla lrb hlrb of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case spliceH ka mab hmab a rab hrab of
(# mrab,hmrab #) -> (# mrab,hmrab,cs1,cl1,mba,hmba #)
Just b_ -> case (let c = f a b_
in v (Cons ka c cs0) (cl0+#1#) rla hrla lrb hlrb
) of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case joinH mab hmab rab hrab of
(# mrab,hmrab #) -> (# mrab,hmrab,cs1,cl1,mba,hmba #)
) of
(# mrab,hmrab,cs1,cl1,mba,hmba #) -> case joinH mba hmba rba hrba of
(# mrba,hmrba #) -> case (case myba of
Nothing -> case v cs1 cl1 lla hlla lb hlb of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case spliceH kb lba hlba b mrba hmrba of
(# ba,hba #) -> (# lab,hlab,cs2,cl2,ba,hba #)
Just a_ -> case (let c = f a_ b
in v (Cons kb c cs1) (cl1+#1#) lla hlla lb hlb
) of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case joinH lba hlba mrba hmrba of
(# ba,hba #) -> (# lab,hlab,cs2,cl2,ba,hba #)
) of
(# lab,hlab,cs2,cl2,ba,hba #) -> case joinH lab hlab mrab hmrab of
(# ab,hab #) -> (# ab,hab,cs2,cl2,ba,hba #)
vennIntMap' :: (a -> b -> c) -> IntMap a -> IntMap b -> (IntMap a, IntMap c, IntMap b)
vennIntMap' f = gu where
gu E t1 = (E ,E,t1)
gu t0 E = (t0,E,E )
gu t0@(N _ l0 _ _ ) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 2# l0) t1 (addHeight 2# l1)
gu t0@(N _ l0 _ _ ) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 2# l0) t1 (addHeight 1# l1)
gu t0@(N _ l0 _ _ ) t1@(P _ _ _ r1) = gu_ t0 (addHeight 2# l0) t1 (addHeight 2# r1)
gu t0@(Z _ l0 _ _ ) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 1# l0) t1 (addHeight 2# l1)
gu t0@(Z _ l0 _ _ ) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 1# l0) t1 (addHeight 1# l1)
gu t0@(Z _ l0 _ _ ) t1@(P _ _ _ r1) = gu_ t0 (addHeight 1# l0) t1 (addHeight 2# r1)
gu t0@(P _ _ _ r0) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 2# r0) t1 (addHeight 2# l1)
gu t0@(P _ _ _ r0) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 2# r0) t1 (addHeight 1# l1)
gu t0@(P _ _ _ r0) t1@(P _ _ _ r1) = gu_ t0 (addHeight 2# r0) t1 (addHeight 2# r1)
gu_ t0 h0 t1 h1 = case vennH' f Empt 0# t0 h0 t1 h1 of
(# tab,_,cs,cl,tba,_ #) -> case subst (rep (I# cl)) cs of (# tc,_ #) -> (tab,tc,tba)
vennH' :: (a -> b -> c) -> IAList c -> Int# -> IntMap a -> Int# -> IntMap b -> Int# -> (# IntMap a,Int#,IAList c,Int#,IntMap b,Int# #)
vennH' f = v where
v cs cl E ha tb hb = (# E ,ha,cs,cl,tb,hb #)
v cs cl ta ha E hb = (# ta,ha,cs,cl,E ,hb #)
v cs cl (N ka la a ra) ha (N kb lb b rb) hb = v_ cs cl ka la (ha-#2#) a ra (ha-#1#) kb lb (hb-#2#) b rb (hb-#1#)
v cs cl (N ka la a ra) ha (Z kb lb b rb) hb = v_ cs cl ka la (ha-#2#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#1#)
v cs cl (N ka la a ra) ha (P kb lb b rb) hb = v_ cs cl ka la (ha-#2#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#2#)
v cs cl (Z ka la a ra) ha (N kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#1#) kb lb (hb-#2#) b rb (hb-#1#)
v cs cl (Z ka la a ra) ha (Z kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#1#)
v cs cl (Z ka la a ra) ha (P kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#2#)
v cs cl (P ka la a ra) ha (N kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#2#) kb lb (hb-#2#) b rb (hb-#1#)
v cs cl (P ka la a ra) ha (Z kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#2#) kb lb (hb-#1#) b rb (hb-#1#)
v cs cl (P ka la a ra) ha (P kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#2#) kb lb (hb-#1#) b rb (hb-#2#)
v_ cs cl ka la hla a ra hra kb lb hlb b rb hrb =
case compareInt# ka kb of
LT -> case forkVenn ka lb hlb of
(# llb,hllb,mybb,rlb,hrlb #) -> case forkVenn kb ra hra of
(# lra,hlra,myba,rra,hrra #) ->
case v cs cl rra hrra rb hrb of
(# rab,hrab,cs0,cl0,rba,hrba #) -> case (case myba of
Nothing -> case v cs0 cl0 lra hlra rlb hrlb of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case spliceH kb mba hmba b rba hrba of
(# mrba,hmrba #) -> (# mab,hmab,cs1,cl1,mrba,hmrba #)
Just a_ -> case (let c = f a_ b
in c `seq` v (Cons kb c cs0) (cl0+#1#) lra hlra rlb hrlb
) of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case joinH mba hmba rba hrba of
(# mrba,hmrba #) -> (# mab,hmab,cs1,cl1,mrba,hmrba #)
) of
(# mab,hmab,cs1,cl1,mrba,hmrba #) -> case joinH mab hmab rab hrab of
(# mrab,hmrab #) -> case (case mybb of
Nothing -> case v cs1 cl1 la hla llb hllb of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case spliceH ka lab hlab a mrab hmrab of
(# ab,hab #) -> (# ab,hab,cs2,cl2,lba,hlba #)
Just b_ -> case (let c = f a b_
in c `seq` v (Cons ka c cs1) (cl1+#1#) la hla llb hllb
) of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case joinH lab hlab mrab hmrab of
(# ab,hab #) -> (# ab,hab,cs2,cl2,lba,hlba #)
) of
(# ab,hab,cs2,cl2,lba,hlba #) -> case joinH lba hlba mrba hmrba of
(# ba,hba #) -> (# ab,hab,cs2,cl2,ba,hba #)
EQ -> case v cs cl ra hra rb hrb of
(# rab,hrab,cs0,cl0,rba,hrba #) -> case (let c = f a b
in c `seq` v (Cons ka c cs0) (cl0+#1#) la hla lb hlb
) of
(# lab,hlab,cs1,cl1,lba,hlba #) -> case joinH lab hlab rab hrab of
(# ab,hab #) -> case joinH lba hlba rba hrba of
(# ba,hba #) -> (# ab,hab,cs1,cl1,ba,hba #)
GT -> case forkVenn ka rb hrb of
(# lrb,hlrb,mybb,rrb,hrrb #) -> case forkVenn kb la hla of
(# lla,hlla,myba,rla,hrla #) ->
case v cs cl ra hra rrb hrrb of
(# rab,hrab,cs0,cl0,rba,hrba #) -> case (case mybb of
Nothing -> case v cs0 cl0 rla hrla lrb hlrb of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case spliceH ka mab hmab a rab hrab of
(# mrab,hmrab #) -> (# mrab,hmrab,cs1,cl1,mba,hmba #)
Just b_ -> case (let c = f a b_
in c `seq` v (Cons ka c cs0) (cl0+#1#) rla hrla lrb hlrb
) of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case joinH mab hmab rab hrab of
(# mrab,hmrab #) -> (# mrab,hmrab,cs1,cl1,mba,hmba #)
) of
(# mrab,hmrab,cs1,cl1,mba,hmba #) -> case joinH mba hmba rba hrba of
(# mrba,hmrba #) -> case (case myba of
Nothing -> case v cs1 cl1 lla hlla lb hlb of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case spliceH kb lba hlba b mrba hmrba of
(# ba,hba #) -> (# lab,hlab,cs2,cl2,ba,hba #)
Just a_ -> case (let c = f a_ b
in c `seq` v (Cons kb c cs1) (cl1+#1#) lla hlla lb hlb
) of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case joinH lba hlba mrba hmrba of
(# ba,hba #) -> (# lab,hlab,cs2,cl2,ba,hba #)
) of
(# lab,hlab,cs2,cl2,ba,hba #) -> case joinH lab hlab mrab hmrab of
(# ab,hab #) -> (# ab,hab,cs2,cl2,ba,hba #)
vennMaybeIntMap :: (a -> b -> Maybe c) -> IntMap a -> IntMap b -> (IntMap a, IntMap c, IntMap b)
vennMaybeIntMap f = gu where
gu E t1 = (E ,E,t1)
gu t0 E = (t0,E,E )
gu t0@(N _ l0 _ _ ) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 2# l0) t1 (addHeight 2# l1)
gu t0@(N _ l0 _ _ ) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 2# l0) t1 (addHeight 1# l1)
gu t0@(N _ l0 _ _ ) t1@(P _ _ _ r1) = gu_ t0 (addHeight 2# l0) t1 (addHeight 2# r1)
gu t0@(Z _ l0 _ _ ) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 1# l0) t1 (addHeight 2# l1)
gu t0@(Z _ l0 _ _ ) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 1# l0) t1 (addHeight 1# l1)
gu t0@(Z _ l0 _ _ ) t1@(P _ _ _ r1) = gu_ t0 (addHeight 1# l0) t1 (addHeight 2# r1)
gu t0@(P _ _ _ r0) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 2# r0) t1 (addHeight 2# l1)
gu t0@(P _ _ _ r0) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 2# r0) t1 (addHeight 1# l1)
gu t0@(P _ _ _ r0) t1@(P _ _ _ r1) = gu_ t0 (addHeight 2# r0) t1 (addHeight 2# r1)
gu_ t0 h0 t1 h1 = case vennMaybeH f Empt 0# t0 h0 t1 h1 of
(# tab,_,cs,cl,tba,_ #) -> case subst (rep (I# cl)) cs of (# tc,_ #) -> (tab,tc,tba)
vennMaybeH :: (a -> b -> Maybe c) -> IAList c -> Int# -> IntMap a -> Int# -> IntMap b -> Int# -> (# IntMap a,Int#,IAList c,Int#,IntMap b,Int# #)
vennMaybeH f = v where
v cs cl E ha tb hb = (# E ,ha,cs,cl,tb,hb #)
v cs cl ta ha E hb = (# ta,ha,cs,cl,E ,hb #)
v cs cl (N ka la a ra) ha (N kb lb b rb) hb = v_ cs cl ka la (ha-#2#) a ra (ha-#1#) kb lb (hb-#2#) b rb (hb-#1#)
v cs cl (N ka la a ra) ha (Z kb lb b rb) hb = v_ cs cl ka la (ha-#2#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#1#)
v cs cl (N ka la a ra) ha (P kb lb b rb) hb = v_ cs cl ka la (ha-#2#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#2#)
v cs cl (Z ka la a ra) ha (N kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#1#) kb lb (hb-#2#) b rb (hb-#1#)
v cs cl (Z ka la a ra) ha (Z kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#1#)
v cs cl (Z ka la a ra) ha (P kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#1#) kb lb (hb-#1#) b rb (hb-#2#)
v cs cl (P ka la a ra) ha (N kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#2#) kb lb (hb-#2#) b rb (hb-#1#)
v cs cl (P ka la a ra) ha (Z kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#2#) kb lb (hb-#1#) b rb (hb-#1#)
v cs cl (P ka la a ra) ha (P kb lb b rb) hb = v_ cs cl ka la (ha-#1#) a ra (ha-#2#) kb lb (hb-#1#) b rb (hb-#2#)
v_ cs cl ka la hla a ra hra kb lb hlb b rb hrb =
case compareInt# ka kb of
LT -> case forkVenn ka lb hlb of
(# llb,hllb,mybb,rlb,hrlb #) -> case forkVenn kb ra hra of
(# lra,hlra,myba,rra,hrra #) ->
case v cs cl rra hrra rb hrb of
(# rab,hrab,cs0,cl0,rba,hrba #) -> case (case myba of
Nothing -> case v cs0 cl0 lra hlra rlb hrlb of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case spliceH kb mba hmba b rba hrba of
(# mrba,hmrba #) -> (# mab,hmab,cs1,cl1,mrba,hmrba #)
Just a_ -> case (case f a_ b of
Nothing -> v cs0 cl0 lra hlra rlb hrlb
Just c -> v (Cons kb c cs0) (cl0+#1#) lra hlra rlb hrlb
) of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case joinH mba hmba rba hrba of
(# mrba,hmrba #) -> (# mab,hmab,cs1,cl1,mrba,hmrba #)
) of
(# mab,hmab,cs1,cl1,mrba,hmrba #) -> case joinH mab hmab rab hrab of
(# mrab,hmrab #) -> case (case mybb of
Nothing -> case v cs1 cl1 la hla llb hllb of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case spliceH ka lab hlab a mrab hmrab of
(# ab,hab #) -> (# ab,hab,cs2,cl2,lba,hlba #)
Just b_ -> case (case f a b_ of
Nothing -> v cs1 cl1 la hla llb hllb
Just c -> v (Cons ka c cs1) (cl1+#1#) la hla llb hllb
) of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case joinH lab hlab mrab hmrab of
(# ab,hab #) -> (# ab,hab,cs2,cl2,lba,hlba #)
) of
(# ab,hab,cs2,cl2,lba,hlba #) -> case joinH lba hlba mrba hmrba of
(# ba,hba #) -> (# ab,hab,cs2,cl2,ba,hba #)
EQ -> case v cs cl ra hra rb hrb of
(# rab,hrab,cs0,cl0,rba,hrba #) -> case (case f a b of
Nothing -> v cs0 cl0 la hla lb hlb
Just c -> v (Cons ka c cs0) (cl0+#1#) la hla lb hlb
) of
(# lab,hlab,cs1,cl1,lba,hlba #) -> case joinH lab hlab rab hrab of
(# ab,hab #) -> case joinH lba hlba rba hrba of
(# ba,hba #) -> (# ab,hab,cs1,cl1,ba,hba #)
GT -> case forkVenn ka rb hrb of
(# lrb,hlrb,mybb,rrb,hrrb #) -> case forkVenn kb la hla of
(# lla,hlla,myba,rla,hrla #) ->
case v cs cl ra hra rrb hrrb of
(# rab,hrab,cs0,cl0,rba,hrba #) -> case (case mybb of
Nothing -> case v cs0 cl0 rla hrla lrb hlrb of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case spliceH ka mab hmab a rab hrab of
(# mrab,hmrab #) -> (# mrab,hmrab,cs1,cl1,mba,hmba #)
Just b_ -> case (case f a b_ of
Nothing -> v cs0 cl0 rla hrla lrb hlrb
Just c -> v (Cons ka c cs0) (cl0+#1#) rla hrla lrb hlrb
) of
(# mab,hmab,cs1,cl1,mba,hmba #) -> case joinH mab hmab rab hrab of
(# mrab,hmrab #) -> (# mrab,hmrab,cs1,cl1,mba,hmba #)
) of
(# mrab,hmrab,cs1,cl1,mba,hmba #) -> case joinH mba hmba rba hrba of
(# mrba,hmrba #) -> case (case myba of
Nothing -> case v cs1 cl1 lla hlla lb hlb of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case spliceH kb lba hlba b mrba hmrba of
(# ba,hba #) -> (# lab,hlab,cs2,cl2,ba,hba #)
Just a_ -> case (case f a_ b of
Nothing -> v cs1 cl1 lla hlla lb hlb
Just c -> v (Cons kb c cs1) (cl1+#1#) lla hlla lb hlb
) of
(# lab,hlab,cs2,cl2,lba,hlba #) -> case joinH lba hlba mrba hmrba of
(# ba,hba #) -> (# lab,hlab,cs2,cl2,ba,hba #)
) of
(# lab,hlab,cs2,cl2,ba,hba #) -> case joinH lab hlab mrab hmrab of
(# ab,hab #) -> (# ab,hab,cs2,cl2,ba,hba #)
forkVenn :: Key -> IntMap a -> Int# -> (# IntMap a,Int#,Maybe a,IntMap a,Int# #)
forkVenn k ta hta = f ta hta where
f E h = (# E,h,Nothing,E,h #)
f (N ka l a r) h = f_ ka l (h-#2#) a r (h-#1#)
f (Z ka l a r) h = f_ ka l (h-#1#) a r (h-#1#)
f (P ka l a r) h = f_ ka l (h-#1#) a r (h-#2#)
f_ ka l hl a r hr = case compareInt# k ka of
LT -> case f l hl of
(# ll,hll,mba,lr,hlr #) -> case spliceH ka lr hlr a r hr of
(# r_,hr_ #) -> (# ll,hll,mba,r_,hr_ #)
EQ -> (# l,hl,Just a,r,hr #)
GT -> case f r hr of
(# rl,hrl,mbc,rr,hrr #) -> case spliceH ka l hl a rl hrl of
(# l_,hl_ #) -> (# l_,hl_,mbc,rr,hrr #)
disjointUnionIntMap :: IntMap a -> IntMap a -> IntMap a
disjointUnionIntMap = gu where
gu E t1 = t1
gu t0 E = t0
gu t0@(N _ l0 _ _ ) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 2# l0) t1 (addHeight 2# l1)
gu t0@(N _ l0 _ _ ) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 2# l0) t1 (addHeight 1# l1)
gu t0@(N _ l0 _ _ ) t1@(P _ _ _ r1) = gu_ t0 (addHeight 2# l0) t1 (addHeight 2# r1)
gu t0@(Z _ l0 _ _ ) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 1# l0) t1 (addHeight 2# l1)
gu t0@(Z _ l0 _ _ ) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 1# l0) t1 (addHeight 1# l1)
gu t0@(Z _ l0 _ _ ) t1@(P _ _ _ r1) = gu_ t0 (addHeight 1# l0) t1 (addHeight 2# r1)
gu t0@(P _ _ _ r0) t1@(N _ l1 _ _ ) = gu_ t0 (addHeight 2# r0) t1 (addHeight 2# l1)
gu t0@(P _ _ _ r0) t1@(Z _ l1 _ _ ) = gu_ t0 (addHeight 2# r0) t1 (addHeight 1# l1)
gu t0@(P _ _ _ r0) t1@(P _ _ _ r1) = gu_ t0 (addHeight 2# r0) t1 (addHeight 2# r1)
gu_ t0 h0 t1 h1 = case disjointUnionH t0 h0 t1 h1 of (# t,_ #) -> t
disjointUnionH :: IntMap a -> Int# -> IntMap a -> Int# -> (# IntMap a,Int# #)
disjointUnionH = u where
u E _ t1 h1 = (# t1,h1 #)
u t0 h0 E _ = (# t0,h0 #)
u (N k0 l0 e0 r0) h0 (N k1 l1 e1 r1) h1 = u_ k0 l0 (h0-#2#) e0 r0 (h0-#1#) k1 l1 (h1-#2#) e1 r1 (h1-#1#)
u (N k0 l0 e0 r0) h0 (Z k1 l1 e1 r1) h1 = u_ k0 l0 (h0-#2#) e0 r0 (h0-#1#) k1 l1 (h1-#1#) e1 r1 (h1-#1#)
u (N k0 l0 e0 r0) h0 (P k1 l1 e1 r1) h1 = u_ k0 l0 (h0-#2#) e0 r0 (h0-#1#) k1 l1 (h1-#1#) e1 r1 (h1-#2#)
u (Z k0 l0 e0 r0) h0 (N k1 l1 e1 r1) h1 = u_ k0 l0 (h0-#1#) e0 r0 (h0-#1#) k1 l1 (h1-#2#) e1 r1 (h1-#1#)
u (Z k0 l0 e0 r0) h0 (Z k1 l1 e1 r1) h1 = u_ k0 l0 (h0-#1#) e0 r0 (h0-#1#) k1 l1 (h1-#1#) e1 r1 (h1-#1#)
u (Z k0 l0 e0 r0) h0 (P k1 l1 e1 r1) h1 = u_ k0 l0 (h0-#1#) e0 r0 (h0-#1#) k1 l1 (h1-#1#) e1 r1 (h1-#2#)
u (P k0 l0 e0 r0) h0 (N k1 l1 e1 r1) h1 = u_ k0 l0 (h0-#1#) e0 r0 (h0-#2#) k1 l1 (h1-#2#) e1 r1 (h1-#1#)
u (P k0 l0 e0 r0) h0 (Z k1 l1 e1 r1) h1 = u_ k0 l0 (h0-#1#) e0 r0 (h0-#2#) k1 l1 (h1-#1#) e1 r1 (h1-#1#)
u (P k0 l0 e0 r0) h0 (P k1 l1 e1 r1) h1 = u_ k0 l0 (h0-#1#) e0 r0 (h0-#2#) k1 l1 (h1-#1#) e1 r1 (h1-#2#)
u_ k0 l0 hl0 e0 r0 hr0 k1 l1 hl1 e1 r1 hr1 =
case compareInt# k0 k1 of
LT -> case fork k1 r0 hr0 of
(# rl0,hrl0,rr0,hrr0 #) -> case fork k0 l1 hl1 of
(# ll1,hll1,lr1,hlr1 #) ->
case u l0 hl0 ll1 hll1 of
(# l,hl #) -> case u rl0 hrl0 lr1 hlr1 of
(# m,hm #) -> case u rr0 hrr0 r1 hr1 of
(# r,hr #) -> case spliceH k1 m hm e1 r hr of
(# t,ht #) -> spliceH k0 l hl e0 t ht
EQ -> error "disjointUnionH: Trees intersect" `seq` (# E,0# #)
GT -> case fork k0 r1 hr1 of
(# rl1,hrl1,rr1,hrr1 #) -> case fork k1 l0 hl0 of
(# ll0,hll0,lr0,hlr0 #) ->
case u ll0 hll0 l1 hl1 of
(# l,hl #) -> case u lr0 hlr0 rl1 hrl1 of
(# m,hm #) -> case u r0 hr0 rr1 hrr1 of
(# r,hr #) -> case spliceH k1 l hl e1 m hm of
(# t,ht #) -> spliceH k0 t ht e0 r hr
fork k0 t1 ht1 = fork_ t1 ht1 where
fork_ E _ = (# E,0#,E,0# #)
fork_ (N k l e r) h = fork__ k l (h-#2#) e r (h-#1#)
fork_ (Z k l e r) h = fork__ k l (h-#1#) e r (h-#1#)
fork_ (P k l e r) h = fork__ k l (h-#1#) e r (h-#2#)
fork__ k l hl e r hr = case compareInt# k0 k of
LT -> case fork_ l hl of
(# l0,hl0,l1,hl1 #) -> case spliceH k l1 hl1 e r hr of
(# l1_,hl1_ #) -> (# l0,hl0,l1_,hl1_ #)
EQ -> error "disjointUnionH: Trees intersect" `seq` (# E,0#,E,0# #)
GT -> case fork_ r hr of
(# l0,hl0,l1,hl1 #) -> case spliceH k l hl e l0 hl0 of
(# l0_,hl0_ #) -> (# l0_,hl0_,l1,hl1 #)