[auto ekmett@gmail.com**20090406081012 Ignore-this: 4f7f8977b0bdd46e33300cc82fe16887 ] { addfile ./doc/html/monoids/Data-Set-Unboxed.html addfile ./doc/html/monoids/src/Data-Set-Unboxed.html hunk ./doc/html/monoids/Data-Monoid-Lexical-SourcePosition.html 162 -> ! !! ! !! ! !! ! !! ! !! ! !! + +Data.Set.Unboxed
 monoids-0.1.33: Monoids, specialized containers and a general map/reduce frameworkSource codeContentsIndex
Data.Set.Unboxed
Contents
Set type +
Operators +
Query +
Construction +
Combine +
Filter +
Map +
Fold +
Min/Max +
Conversion +
List +
Ordered list +
Debugging +
Synopsis
class US a where
data USet a
(\\) :: (US a, Ord a) => USet a -> USet a -> USet a
null :: US a => USet a -> Bool
size :: US a => USet a -> Int
member :: (US a, Ord a) => a -> USet a -> Bool
notMember :: (US a, Ord a) => a -> USet a -> Bool
isSubsetOf :: (US a, Ord a) => USet a -> USet a -> Bool
isProperSubsetOf :: (US a, Ord a) => USet a -> USet a -> Bool
empty :: US a => USet a
singleton :: US a => a -> USet a
insert :: (US a, Ord a) => a -> USet a -> USet a
delete :: (US a, Ord a) => a -> USet a -> USet a
union :: (US a, Ord a) => USet a -> USet a -> USet a
unions :: (US a, Ord a) => [USet a] -> USet a
difference :: (US a, Ord a) => USet a -> USet a -> USet a
intersection :: (US a, Ord a) => USet a -> USet a -> USet a
filter :: (US a, Ord a) => (a -> Bool) -> USet a -> USet a
partition :: (US a, Ord a) => (a -> Bool) -> USet a -> (USet a, USet a)
split :: (US a, Ord a) => a -> USet a -> (USet a, USet a)
splitMember :: (US a, Ord a) => a -> USet a -> (USet a, Bool, USet a)
map :: (US a, US b, Ord a, Ord b) => (a -> b) -> USet a -> USet b
mapMonotonic :: (US a, US b) => (a -> b) -> USet a -> USet b
fold :: US a => (a -> b -> b) -> b -> USet a -> b
findMin :: US a => USet a -> a
findMax :: US a => USet a -> a
deleteMin :: US a => USet a -> USet a
deleteMax :: US a => USet a -> USet a
deleteFindMin :: US a => USet a -> (a, USet a)
deleteFindMax :: US a => USet a -> (a, USet a)
maxView :: US a => USet a -> Maybe (a, USet a)
minView :: US a => USet a -> Maybe (a, USet a)
elems :: US a => USet a -> [a]
toList :: US a => USet a -> [a]
fromList :: (US a, Ord a) => [a] -> USet a
toAscList :: US a => USet a -> [a]
fromAscList :: (US a, Eq a) => [a] -> USet a
fromDistinctAscList :: US a => [a] -> USet a
showTree :: (US a, Show a) => USet a -> String
showTreeWith :: (US a, Show a) => Bool -> Bool -> USet a -> String
valid :: (US a, Ord a) => USet a -> Bool
Set type +
class US a Source
Associated Types
data USet a Source
Methods
show/hide Instances
Operators +
(\\) :: (US a, Ord a) => USet a -> USet a -> USet aSource
O(n+m). See difference. +
Query +
null :: US a => USet a -> BoolSource
O(1). Is this the empty set? +
size :: US a => USet a -> IntSource
O(1). The number of elements in the set. +
member :: (US a, Ord a) => a -> USet a -> BoolSource
O(log n). Is the element in the set? +
notMember :: (US a, Ord a) => a -> USet a -> BoolSource
O(log n). Is the element not in the set? +
isSubsetOf :: (US a, Ord a) => USet a -> USet a -> BoolSource
O(n+m). Is this a subset? + (s1 isSubsetOf s2) tells whether s1 is a subset of s2. +
isProperSubsetOf :: (US a, Ord a) => USet a -> USet a -> BoolSource
O(n+m). Is this a proper subset? (ie. a subset but not equal). +
Construction +
empty :: US a => USet aSource
O(1). The empty set. +
singleton :: US a => a -> USet aSource
O(1). Create a singleton set. +
insert :: (US a, Ord a) => a -> USet a -> USet aSource
O(log n). Insert an element in a set. + If the set already contains an element equal to the given value, + it is replaced with the new value. +
delete :: (US a, Ord a) => a -> USet a -> USet aSource
O(log n). Delete an element from a set. +
Combine +
union :: (US a, Ord a) => USet a -> USet a -> USet aSource
O(n+m). The union of two sets, preferring the first set when + equal elements are encountered. + The implementation uses the efficient hedge-union algorithm. + Hedge-union is more efficient on (bigset union smallset). +
unions :: (US a, Ord a) => [USet a] -> USet aSource
The union of a list of sets: (unions == foldl union empty). +
difference :: (US a, Ord a) => USet a -> USet a -> USet aSource
O(n+m). Difference of two sets. + The implementation uses an efficient hedge algorithm comparable with hedge-union. +
intersection :: (US a, Ord a) => USet a -> USet a -> USet aSource

O(n+m). The intersection of two sets. + Elements of the result come from the first set, so for example +

 import qualified Data.Set as S
+ data AB = A | B deriving Show
+ instance Ord AB where compare _ _ = EQ
+ instance Eq AB where _ == _ = True
+ main = print (S.singleton A `S.intersection` S.singleton B,
+               S.singleton B `S.intersection` S.singleton A)
+

prints (fromList [A],fromList [B]). +

Filter +
filter :: (US a, Ord a) => (a -> Bool) -> USet a -> USet aSource
O(n). Filter all elements that satisfy the predicate. +
partition :: (US a, Ord a) => (a -> Bool) -> USet a -> (USet a, USet a)Source
O(n). Partition the set into two sets, one with all elements that satisfy + the predicate and one with all elements that don't satisfy the predicate. + See also split. +
split :: (US a, Ord a) => a -> USet a -> (USet a, USet a)Source
O(log n). The expression (split x set) is a pair (set1,set2) + where set1 comprises the elements of set less than x and set2 + comprises the elements of set greater than x. +
splitMember :: (US a, Ord a) => a -> USet a -> (USet a, Bool, USet a)Source
O(log n). Performs a split but also returns whether the pivot + element was found in the original set. +
Map +
map :: (US a, US b, Ord a, Ord b) => (a -> b) -> USet a -> USet bSource

O(n*log n). + map f s is the set obtained by applying f to each element of s. +

It's worth noting that the size of the result may be smaller if, + for some (x,y), x /= y && f x == f y +

mapMonotonic :: (US a, US b) => (a -> b) -> USet a -> USet bSource

O(n). The +

mapMonotonic f s == map f s, but works only when f is monotonic. + The precondition is not checked. + Semi-formally, we have: +

 and [x < y ==> f x < f y | x <- ls, y <- ls] 
+                     ==> mapMonotonic f s == map f s
+     where ls = toList s
+
Fold +
fold :: US a => (a -> b -> b) -> b -> USet a -> bSource
O(n). Fold over the elements of a set in an unspecified order. +
Min/Max +
findMin :: US a => USet a -> aSource
O(log n). The minimal element of a set. +
findMax :: US a => USet a -> aSource
O(log n). The maximal element of a set. +
deleteMin :: US a => USet a -> USet aSource
O(log n). Delete the minimal element. +
deleteMax :: US a => USet a -> USet aSource
O(log n). Delete the maximal element. +
deleteFindMin :: US a => USet a -> (a, USet a)Source

O(log n). Delete and find the minimal element. +

 deleteFindMin set = (findMin set, deleteMin set)
+
deleteFindMax :: US a => USet a -> (a, USet a)Source

O(log n). Delete and find the maximal element. +

 deleteFindMax set = (findMax set, deleteMax set)
+
maxView :: US a => USet a -> Maybe (a, USet a)Source
O(log n). Retrieves the maximal key of the set, and the set + stripped of that element, or Nothing if passed an empty set. +
minView :: US a => USet a -> Maybe (a, USet a)Source
O(log n). Retrieves the minimal key of the set, and the set + stripped of that element, or Nothing if passed an empty set. +
Conversion +
List +
elems :: US a => USet a -> [a]Source
O(n). The elements of a set. +
toList :: US a => USet a -> [a]Source
O(n). Convert the set to a list of elements. +
fromList :: (US a, Ord a) => [a] -> USet aSource
O(n*log n). Create a set from a list of elements. +
Ordered list +
toAscList :: US a => USet a -> [a]Source
O(n). Convert the set to an ascending list of elements. +
fromAscList :: (US a, Eq a) => [a] -> USet aSource
O(n). Build a set from an ascending list in linear time. + The precondition (input list is ascending) is not checked. +
fromDistinctAscList :: US a => [a] -> USet aSource
O(n). Build a set from an ascending list of distinct elements in linear time. + The precondition (input list is strictly ascending) is not checked. +
Debugging +
showTree :: (US a, Show a) => USet a -> StringSource
O(n). Show the tree that implements the set. The tree is shown + in a compressed, hanging format. +
showTreeWith :: (US a, Show a) => Bool -> Bool -> USet a -> StringSource

O(n). The expression (showTreeWith hang wide map) shows + the tree that implements the set. If hang is + True, a hanging tree is shown otherwise a rotated tree is shown. If + wide is True, an extra wide version is shown. +

 Set> putStrLn $ showTreeWith True False $ fromDistinctAscList [1..5]
+ 4
+ +--2
+ |  +--1
+ |  +--3
+ +--5
+ 
+ Set> putStrLn $ showTreeWith True True $ fromDistinctAscList [1..5]
+ 4
+ |
+ +--2
+ |  |
+ |  +--1
+ |  |
+ |  +--3
+ |
+ +--5
+ 
+ Set> putStrLn $ showTreeWith False True $ fromDistinctAscList [1..5]
+ +--5
+ |
+ 4
+ |
+ |  +--3
+ |  |
+ +--2
+    |
+    +--1
+
valid :: (US a, Ord a) => USet a -> BoolSource
O(n). Test if the internal set structure is valid. +
Produced by Haddock version 2.3.0
hunk ./doc/html/monoids/doc-index.html 415 ->1 (Function)
Data.Set.Unboxed2 (Function)deleteFindMaxData.Set.UnboxeddeleteFindMinData.Set.UnboxeddeleteMaxData.Set.UnboxeddeleteMinData.Set.UnboxeddifferenceData.Set.UnboxedelemsData.Set.UnboxedData.Set.Unboxed4 (Function)1 (Function)2 (Function)Data.Set.UnboxedfindMaxData.Set.UnboxedfindMinData.Set.Unboxed1 (Function)2 (Function)Data.Set.UnboxedfromAscListData.Set.Unboxed1 (Function)Data.Set.Unboxed2 (Function)1 (Function)Data.Set.Unboxed2 (Function)1 (Function)Data.Set.Unboxed2 (Function)1 (Function)Data.Set.Unboxed2 (Function)isProperSubsetOfData.Set.UnboxedisSubsetOfData.Set.UnboxedmapData.Set.UnboxedmapMonotonicData.Set.UnboxedmaxViewData.Set.Unboxed1 (Function)Data.Set.Unboxed2 (Function)minViewData.Set.UnboxednotMemberData.Set.UnboxedData.Set.Unboxed3 (Function)partitionData.Set.UnboxedshowTreeData.Set.UnboxedshowTreeWithData.Set.UnboxedData.Set.Unboxed3 (Function)1 (Function)Data.Set.Unboxed2 (Function)splitData.Set.UnboxedsplitMemberData.Set.UnboxedtoAscListData.Set.Unboxed1 (Function)2 (Function)Data.Set.UnboxedData.Set.Unboxed3 (Function)unionsData.Set.UnboxedUSData.Set.UnboxedUSetData.Set.UnboxedvalidData.Set.UnboxedData.Set.Unboxed3 (Function)show/hideSet
Data.Set.Unboxed
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-} +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, BangPatterns #-}
hunk ./doc/html/monoids/src/Data-Monoid-Lexical-SourcePosition.html 55
-        = Pos file {-# UNPACK #-} !SourceLine !SourceColumn -- ^ An absolute position in a file is known, or an overriding #line directive has been seen
-        | Lines {-# UNPACK #-} !SourceLine !SourceColumn    -- ^ We've seen some carriage returns.
-        | Columns {-# UNPACK #-} !SourceColumn              -- ^ We've only seen part of a line.
-        | Tab {-# UNPACK #-} !SourceColumn !SourceColumn    -- ^ We have an unhandled tab to deal with.
+        = Pos file {-# UNPACK #-} !SourceLine {-# UNPACK #-} !SourceColumn -- ^ An absolute position in a file is known, or an overriding #line directive has been seen
+        | Lines {-# UNPACK #-} !SourceLine {-# UNPACK #-} !SourceColumn    -- ^ We've seen some carriage returns.
+        | Columns {-# UNPACK #-} !SourceColumn                             -- ^ We've only seen part of a line.
+        | Tab {-# UNPACK #-} !SourceColumn {-# UNPACK #-} !SourceColumn    -- ^ We have an unhandled tab to deal with.
hunk ./doc/html/monoids/src/Data-Monoid-Lexical-SourcePosition.html 63
-nextTab x = x + (8 - (x-1) `mod` 8)
+nextTab !x = x + (8 - (x-1) `mod` 8)
hunk ./doc/html/monoids/src/Data-Set-Unboxed.html 1
+
+
+
+
+Data/Set/Unboxed.hs
+
+
+
+
{-# LANGUAGE TypeFamilies, CPP, ViewPatterns #-}
+
+{------------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Set.Unboxed
+-- Copyright   :  (c) Edward Kmett 2009
+--                (c) Daan Leijen 2002
+-- License     :  BSD-style
+-- Maintainer  :  ekmett@gmail.com
+-- Stability   :  experimental
+-- Portability :  non-portable (type families, view patterns)
+--
+-- An efficient implementation of sets.
+--
+-- Since many function names (but not the type name) clash with
+-- "Prelude" names, this module is usually imported @qualified@, e.g.
+--
+-- >  import Data.Set.Unboxed (USet)
+-- >  import qualified Data.Set.Unboxed as USet
+--
+-- The implementation of 'USet' is based on /size balanced/ binary trees (or
+-- trees of /bounded balance/) as described by:
+--
+--    * Stephen Adams, \"/Efficient sets: a balancing act/\",
+--  Journal of Functional Programming 3(4):553-562, October 1993,
+--  <http://www.swiss.ai.mit.edu/~adams/BB/>.
+--
+--    * J. Nievergelt and E.M. Reingold,
+--  \"/Binary search trees of bounded balance/\",
+--  SIAM journal of computing 2(1), March 1973.
+--
+-- Note that the implementation is /left-biased/ -- the elements of a
+-- first argument are always preferred to the second, for example in
+-- 'union' or 'insert'.  Of course, left-biasing can only be observed
+-- when equality is an equivalence relation instead of structural
+-- equality.
+--
+-- Modified from "Data.Set" to use type families for automatic boxing.
+-----------------------------------------------------------------------------
+-}
+
+module Data.Set.Unboxed ( 
+            -- * Set type
+              USet          -- instance Eq,Ord,Show,Read,Data,Typeable
+            , US
+
+            -- * Operators
+            , (\\)
+
+            -- * Query
+            , null
+            , size
+            , member
+            , notMember
+            , isSubsetOf
+            , isProperSubsetOf
+            
+            -- * Construction
+            , empty
+            , singleton
+            , insert
+            , delete
+            
+            -- * Combine
+            , union, unions
+            , difference
+            , intersection
+            
+            -- * Filter
+            , filter
+            , partition
+            , split
+            , splitMember
+
+            -- * Map
+            , map
+            , mapMonotonic
+
+            -- * Fold
+            , fold
+
+            -- * Min\/Max
+            , findMin
+            , findMax
+            , deleteMin
+            , deleteMax
+            , deleteFindMin
+            , deleteFindMax
+            , maxView
+            , minView
+
+            -- * Conversion
+
+            -- ** List
+            , elems
+            , toList
+            , fromList
+            
+            -- ** Ordered list
+            , toAscList
+            , fromAscList
+            , fromDistinctAscList
+                        
+            -- * Debugging
+            , showTree
+            , showTreeWith
+            , valid
+            ) where
+
+import Prelude hiding (filter,foldr,null,map)
+import qualified Data.List as List
+import Data.Monoid (Monoid(..))
+import Data.Generator.Combinators (Generator,Elem,foldMap, mapReduce)
+#ifndef __GLASGOW_HASKELL__
+import Data.Typeable (Typeable, typeOf, typeOfDefault)
+#endif
+import Data.Typeable (Typeable1(..), TyCon, mkTyCon, mkTyConApp)
+import Data.Word
+import Data.Int
+
+{-
+-- just for testing
+import Test.QuickCheck 
+import Data.List (nub,sort)
+import qualified Data.List as List
+-}
+
+#if __GLASGOW_HASKELL__
+import Text.Read
+import Data.Data (Data(..), mkNorepType, gcast1)
+#endif
+
+{--------------------------------------------------------------------
+  Operators
+--------------------------------------------------------------------}
+infixl 9 \\ --
+
+-- | /O(n+m)/. See 'difference'.
+(\\) :: (US a, Ord a) => USet a -> USet a -> USet a
+m1 \\ m2 = difference m1 m2
+
+{--------------------------------------------------------------------
+  Sets are size balanced trees
+--------------------------------------------------------------------}
+type Size     = Int
+
+-- | A set of values @a@.
+data Set a    = Tip 
+              | Bin {-# UNPACK #-} !Size a !(USet a) !(USet a) 
+
+-- smart unboxed types
+class US a where
+    data USet a
+    view :: USet a -> Set a
+    {-# INLINE view #-}
+    tip :: USet a
+    {-# INLINE tip #-}
+    bin :: Size -> a -> USet a -> USet a -> USet a
+    {-# INLINE bin #-}
+
+
+instance (US a, Ord a) => Monoid (USet a) where
+    mempty  = empty
+    mappend = union
+    mconcat = unions
+
+{-
+instance US a => Generator (USet a) where
+    type Elem (USet a) = a
+    mapReduce _ (view -> Tip) = mempty
+    mapReduce f (view -> Bin _s k l r) = mapReduce f l `mappend` f k `mappend` mapReduce f r
+-}
+
+#if __GLASGOW_HASKELL__
+
+{--------------------------------------------------------------------
+  A Data instance  
+--------------------------------------------------------------------}
+
+-- This instance preserves data abstraction at the cost of inefficiency.
+-- We omit reflection services for the sake of data abstraction.
+
+{-
+instance (US a, Data a, Ord a) => Data (USet a) where
+  gfoldl f z set = z fromList `f` (toList set)
+  toConstr _     = error "toConstr"
+  gunfold _ _    = error "gunfold"
+  dataTypeOf _   = mkNorepType "Data.Set.Set"
+  dataCast1 f    = gcast1 f
+-}
+
+#endif
+
+{--------------------------------------------------------------------
+  Query
+--------------------------------------------------------------------}
+-- | /O(1)/. Is this the empty set?
+null :: US a => USet a -> Bool
+null (view -> Tip) = True
+null (view -> Bin {}) = False
+
+-- | /O(1)/. The number of elements in the set.
+size :: US a => USet a -> Int
+size (view -> Tip) = 0
+size (view -> Bin sz _ _ _) = sz
+
+-- | /O(log n)/. Is the element in the set?
+member :: (US a, Ord a) => a -> USet a -> Bool
+member x (view -> Tip) = False
+member x (view -> Bin _ y l r) = 
+    case compare x y of
+        LT -> member x l
+        GT -> member x r
+        EQ -> True       
+
+-- | /O(log n)/. Is the element not in the set?
+notMember :: (US a, Ord a) => a -> USet a -> Bool
+notMember x t = not $ member x t
+
+{--------------------------------------------------------------------
+  Construction
+--------------------------------------------------------------------}
+-- | /O(1)/. The empty set.
+empty :: US a => USet a
+empty = tip
+
+-- | /O(1)/. Create a singleton set.
+singleton :: US a => a -> USet a
+singleton x = bin 1 x tip tip
+
+{--------------------------------------------------------------------
+  Insertion, Deletion
+--------------------------------------------------------------------}
+-- | /O(log n)/. Insert an element in a set.
+-- If the set already contains an element equal to the given value,
+-- it is replaced with the new value.
+insert :: (US a, Ord a) => a -> USet a -> USet a
+insert x (view -> Tip)          = singleton x
+insert x (view -> Bin sz y l r) = case compare x y of
+   LT -> balance y (insert x l) r
+   GT -> balance y l (insert x r)
+   EQ -> bin sz x l r
+
+-- | /O(log n)/. Delete an element from a set.
+delete :: (US a, Ord a) => a -> USet a -> USet a
+delete x (view -> Tip)         = tip
+delete x (view -> Bin _ y l r) = case compare x y of
+    LT -> balance y (delete x l) r
+    GT -> balance y l (delete x r)
+    EQ -> glue l r
+
+{--------------------------------------------------------------------
+  Subset
+--------------------------------------------------------------------}
+-- | /O(n+m)/. Is this a proper subset? (ie. a subset but not equal).
+isProperSubsetOf :: (US a, Ord a) => USet a -> USet a -> Bool
+isProperSubsetOf s1 s2
+    = (size s1 < size s2) && (isSubsetOf s1 s2)
+
+-- | /O(n+m)/. Is this a subset?
+-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.
+isSubsetOf :: (US a, Ord a) => USet a -> USet a -> Bool
+isSubsetOf t1 t2 = (size t1 <= size t2) && (isSubsetOfX t1 t2)
+
+isSubsetOfX :: (US a, Ord a) => USet a -> USet a -> Bool
+isSubsetOfX (view -> Tip) _         = True
+isSubsetOfX _ (view -> Tip)         = False
+isSubsetOfX (view -> Bin _ x l r) t = found && isSubsetOfX l lt && isSubsetOfX r gt
+  where
+    (lt,found,gt) = splitMember x t
+
+
+{--------------------------------------------------------------------
+  Minimal, Maximal
+--------------------------------------------------------------------}
+-- | /O(log n)/. The minimal element of a set.
+findMin :: US a => USet a -> a
+findMin (view -> Bin _ x (view -> Tip) _) = x
+findMin (view -> Bin _ _ l _)   = findMin l
+findMin (view -> Tip)           = error "Set.findMin: empty set has no minimal element"
+
+-- | /O(log n)/. The maximal element of a set.
+findMax :: US a => USet a -> a
+findMax (view -> Bin _ x _ (view -> Tip))  = x
+findMax (view -> Bin _ _ _ r)    = findMax r
+findMax (view -> Tip)            = error "Set.findMax: empty set has no maximal element"
+
+-- | /O(log n)/. Delete the minimal element.
+deleteMin :: US a => USet a -> USet a
+deleteMin (view -> Bin _ _ (view -> Tip) r) = r
+deleteMin (view -> Bin _ x l r)   = balance x (deleteMin l) r
+deleteMin (view -> Tip)           = tip
+
+-- | /O(log n)/. Delete the maximal element.
+deleteMax :: US a => USet a -> USet a
+deleteMax (view -> Bin _ _ l (view -> Tip)) = l
+deleteMax (view -> Bin _ x l r)   = balance x l (deleteMax r)
+deleteMax (view -> Tip)           = tip
+
+{--------------------------------------------------------------------
+  Union. 
+--------------------------------------------------------------------}
+-- | The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@).
+unions :: (US a, Ord a) => [USet a] -> USet a
+unions ts
+  = foldlStrict union empty ts
+
+
+-- | /O(n+m)/. The union of two sets, preferring the first set when
+-- equal elements are encountered.
+-- The implementation uses the efficient /hedge-union/ algorithm.
+-- Hedge-union is more efficient on (bigset `union` smallset).
+union :: (US a, Ord a) => USet a -> USet a -> USet a
+union (view -> Tip) t2  = t2
+union t1 (view -> Tip)  = t1
+union t1 t2 = hedgeUnion (const LT) (const GT) t1 t2
+
+hedgeUnion :: (US a, Ord a) => (a -> Ordering) -> (a -> Ordering) -> USet a -> USet a -> USet a
+hedgeUnion _     _     t1 (view -> Tip)                    = t1
+hedgeUnion cmplo cmphi (view -> Tip) (view -> Bin _ x l r) = join x (filterGt cmplo l) (filterLt cmphi r)
+hedgeUnion cmplo cmphi (view -> Bin _ x l r) t2            = join x (hedgeUnion cmplo cmpx l (trim cmplo cmpx t2)) (hedgeUnion cmpx cmphi r (trim cmpx cmphi t2))
+  where
+    cmpx = compare x
+
+{--------------------------------------------------------------------
+  Difference
+--------------------------------------------------------------------}
+-- | /O(n+m)/. Difference of two sets. 
+-- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.
+difference :: (US a, Ord a) => USet a -> USet a -> USet a
+difference (view -> Tip) _   = tip
+difference t1 (view -> Tip)  = t1
+difference t1 t2   = hedgeDiff (const LT) (const GT) t1 t2
+
+hedgeDiff :: (US a, Ord a) => (a -> Ordering) -> (a -> Ordering) -> USet a -> USet a -> USet a
+hedgeDiff _ _ (view -> Tip) _ = tip
+hedgeDiff cmplo cmphi (view -> Bin _ x l r) (view -> Tip) = join x (filterGt cmplo l) (filterLt cmphi r)
+hedgeDiff cmplo cmphi t (view -> Bin _ x l r) = merge (hedgeDiff cmplo cmpx (trim cmplo cmpx t) l) (hedgeDiff cmpx cmphi (trim cmpx cmphi t) r)
+  where
+    cmpx = compare x
+
+{--------------------------------------------------------------------
+  Intersection
+--------------------------------------------------------------------}
+-- | /O(n+m)/. The intersection of two sets.
+-- Elements of the result come from the first set, so for example
+--
+-- > import qualified Data.Set as S
+-- > data AB = A | B deriving Show
+-- > instance Ord AB where compare _ _ = EQ
+-- > instance Eq AB where _ == _ = True
+-- > main = print (S.singleton A `S.intersection` S.singleton B,
+-- >               S.singleton B `S.intersection` S.singleton A)
+--
+-- prints @(fromList [A],fromList [B])@.
+intersection :: (US a, Ord a) => USet a -> USet a -> USet a
+intersection (view -> Tip) _ = tip
+intersection _ (view -> Tip) = tip
+intersection t1@(view -> Bin s1 x1 l1 r1) t2@(view -> Bin s2 x2 l2 r2) =
+   if s1 >= s2 then
+      let (lt,found,gt) = splitLookup x2 t1
+          tl            = intersection lt l2
+          tr            = intersection gt r2
+      in case found of
+      Just x -> join x tl tr
+      Nothing -> merge tl tr
+   else let (lt,found,gt) = splitMember x1 t2
+            tl            = intersection l1 lt
+            tr            = intersection r1 gt
+        in if found then join x1 tl tr
+           else merge tl tr
+
+{--------------------------------------------------------------------
+  Filter and partition
+--------------------------------------------------------------------}
+-- | /O(n)/. Filter all elements that satisfy the predicate.
+filter :: (US a, Ord a) => (a -> Bool) -> USet a -> USet a
+filter _ (view -> Tip) = tip
+filter p (view -> Bin _ x l r)
+  | p x       = join x (filter p l) (filter p r)
+  | otherwise = merge (filter p l) (filter p r)
+
+-- | /O(n)/. Partition the set into two sets, one with all elements that satisfy
+-- the predicate and one with all elements that don't satisfy the predicate.
+-- See also 'split'.
+partition :: (US a, Ord a) => (a -> Bool) -> USet a -> (USet a,USet a)
+partition _ (view -> Tip) = (tip,tip)
+partition p (view -> Bin _ x l r)
+  | p x       = (join x l1 r1,merge l2 r2)
+  | otherwise = (merge l1 r1,join x l2 r2)
+  where
+    (l1,l2) = partition p l
+    (r1,r2) = partition p r
+
+{----------------------------------------------------------------------
+  Map
+----------------------------------------------------------------------}
+
+-- | /O(n*log n)/. 
+-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
+-- 
+-- It's worth noting that the size of the result may be smaller if,
+-- for some @(x,y)@, @x \/= y && f x == f y@
+
+map :: (US a, US b, Ord a, Ord b) => (a->b) -> USet a -> USet b
+map f = fromList . List.map f . toList
+
+-- | /O(n)/. The 
+--
+-- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is monotonic.
+-- /The precondition is not checked./
+-- Semi-formally, we have:
+-- 
+-- > and [x < y ==> f x < f y | x <- ls, y <- ls] 
+-- >                     ==> mapMonotonic f s == map f s
+-- >     where ls = toList s
+
+mapMonotonic :: (US a, US b) => (a->b) -> USet a -> USet b
+mapMonotonic _ (view -> Tip) = tip
+mapMonotonic f (view -> Bin sz x l r) = bin sz (f x) (mapMonotonic f l) (mapMonotonic f r)
+
+
+{--------------------------------------------------------------------
+  Fold
+--------------------------------------------------------------------}
+-- | /O(n)/. Fold over the elements of a set in an unspecified order.
+fold :: US a => (a -> b -> b) -> b -> USet a -> b
+fold f z s = foldr f z s
+
+-- | /O(n)/. Post-order fold.
+foldr :: US a => (a -> b -> b) -> b -> USet a -> b
+foldr _ z (view -> Tip)         = z
+foldr f z (view -> Bin _ x l r) = foldr f (f x (foldr f z r)) l
+
+{--------------------------------------------------------------------
+  List variations 
+--------------------------------------------------------------------}
+-- | /O(n)/. The elements of a set.
+elems :: US a => USet a -> [a]
+elems = toList
+
+{--------------------------------------------------------------------
+  Lists 
+--------------------------------------------------------------------}
+-- | /O(n)/. Convert the set to a list of elements.
+toList :: US a => USet a -> [a]
+toList = toAscList
+
+-- | /O(n)/. Convert the set to an ascending list of elements.
+toAscList :: US a => USet a -> [a]
+toAscList = foldr (:) []
+
+
+-- | /O(n*log n)/. Create a set from a list of elements.
+fromList :: (US a, Ord a) => [a] -> USet a 
+fromList = foldlStrict ins empty
+  where
+    ins t x = insert x t
+
+{--------------------------------------------------------------------
+  Building trees from ascending/descending lists can be done in linear time.
+  
+  Note that if [xs] is ascending that: 
+    fromAscList xs == fromList xs
+--------------------------------------------------------------------}
+-- | /O(n)/. Build a set from an ascending list in linear time.
+-- /The precondition (input list is ascending) is not checked./
+fromAscList :: (US a, Eq a) => [a] -> USet a 
+fromAscList xs
+  = fromDistinctAscList (combineEq xs)
+  where
+  -- [combineEq xs] combines equal elements with [const] in an ordered list [xs]
+  combineEq xs'
+    = case xs' of
+        []     -> []
+        [x]    -> [x]
+        (x:xx) -> combineEq' x xx
+
+  combineEq' z [] = [z]
+  combineEq' z (x:xs')
+    | z==x      =   combineEq' z xs'
+    | otherwise = z:combineEq' x xs'
+
+
+-- | /O(n)/. Build a set from an ascending list of distinct elements in linear time.
+-- /The precondition (input list is strictly ascending) is not checked./
+fromDistinctAscList :: US a => [a] -> USet a 
+fromDistinctAscList xs
+  = build const (length xs) xs
+  where
+    -- 1) use continutations so that we use heap space instead of stack space.
+    -- 2) special case for n==5 to build bushier trees. 
+    build c 0 xs'  = c tip xs'
+    build c 5 xs'  = case xs' of
+                       (x1:x2:x3:x4:x5:xx) 
+                            -> c (bin_ x4 (bin_ x2 (singleton x1) (singleton x3)) (singleton x5)) xx
+                       _ -> error "fromDistinctAscList build 5"
+    build c n xs'  = seq nr $ build (buildR nr c) nl xs'
+                   where
+                     nl = n `div` 2
+                     nr = n - nl - 1
+
+    buildR n c l (x:ys) = build (buildB l x c) n ys
+    buildR _ _ _ []     = error "fromDistinctAscList buildR []"
+    buildB l x c r zs   = c (bin_ x l r) zs
+
+{--------------------------------------------------------------------
+  Eq converts the set to a list. In a lazy setting, this 
+  actually seems one of the faster methods to compare two trees 
+  and it is certainly the simplest :-)
+--------------------------------------------------------------------}
+instance (US a, Eq a) => Eq (USet a) where
+  t1 == t2  = (size t1 == size t2) && (toAscList t1 == toAscList t2)
+
+{--------------------------------------------------------------------
+  Ord 
+--------------------------------------------------------------------}
+
+instance (US a, Ord a) => Ord (USet a) where
+    compare s1 s2 = compare (toAscList s1) (toAscList s2) 
+
+{--------------------------------------------------------------------
+  Show
+--------------------------------------------------------------------}
+instance (US a, Show a) => Show (USet a) where
+  showsPrec p xs = showParen (p > 10) $
+    showString "fromList " . shows (toList xs)
+
+{-
+XXX unused code
+
+showSet :: (Show a) => [a] -> ShowS
+showSet []     
+  = showString "{}" 
+showSet (x:xs) 
+  = showChar '{' . shows x . showTail xs
+  where
+    showTail []       = showChar '}'
+    showTail (x':xs') = showChar ',' . shows x' . showTail xs'
+-}
+
+{--------------------------------------------------------------------
+  Read
+--------------------------------------------------------------------}
+instance (US a, Read a, Ord a) => Read (USet a) where
+#ifdef __GLASGOW_HASKELL__
+  readPrec = parens $ prec 10 $ do
+    Ident "fromList" <- lexP
+    xs <- readPrec
+    return (fromList xs)
+
+  readListPrec = readListPrecDefault
+#else
+  readsPrec p = readParen (p > 10) $ \ r -> do
+    ("fromList",s) <- lex r
+    (xs,t) <- reads s
+    return (fromList xs,t)
+#endif
+
+{--------------------------------------------------------------------
+  Typeable/Data
+--------------------------------------------------------------------}
+
+-- #include "Typeable.h"
+-- INSTANCE_TYPEABLE1(Set,setTc,"Set")
+
+{--------------------------------------------------------------------
+  Utility functions that return sub-ranges of the original
+  tree. Some functions take a comparison function as argument to
+  allow comparisons against infinite values. A function [cmplo x]
+  should be read as [compare lo x].
+
+  [trim cmplo cmphi t]  A tree that is either empty or where [cmplo x == LT]
+                        and [cmphi x == GT] for the value [x] of the root.
+  [filterGt cmp t]      A tree where for all values [k]. [cmp k == LT]
+  [filterLt cmp t]      A tree where for all values [k]. [cmp k == GT]
+
+  [split k t]           Returns two trees [l] and [r] where all values
+                        in [l] are <[k] and all keys in [r] are >[k].
+  [splitMember k t]     Just like [split] but also returns whether [k]
+                        was found in the tree.
+--------------------------------------------------------------------}
+
+{--------------------------------------------------------------------
+  [trim lo hi t] trims away all subtrees that surely contain no
+  values between the range [lo] to [hi]. The returned tree is either
+  empty or the key of the root is between @lo@ and @hi@.
+--------------------------------------------------------------------}
+trim :: US a => (a -> Ordering) -> (a -> Ordering) -> USet a -> USet a
+trim _     _     (view -> Tip) = tip
+trim cmplo cmphi t@(view -> Bin _ x l r)
+  = case cmplo x of
+      LT -> case cmphi x of
+              GT -> t
+              _  -> trim cmplo cmphi l
+      _  -> trim cmplo cmphi r
+
+{--------------------------------------------------------------------
+  [filterGt x t] filter all values >[x] from tree [t]
+  [filterLt x t] filter all values <[x] from tree [t]
+--------------------------------------------------------------------}
+filterGt :: US a => (a -> Ordering) -> USet a -> USet a
+filterGt _ (view -> Tip) = tip
+filterGt cmp (view -> Bin _ x l r)
+  = case cmp x of
+      LT -> join x (filterGt cmp l) r
+      GT -> filterGt cmp r
+      EQ -> r
+      
+filterLt :: US a => (a -> Ordering) -> USet a -> USet a
+filterLt _ (view -> Tip) = tip
+filterLt cmp (view -> Bin _ x l r)
+  = case cmp x of
+      LT -> filterLt cmp l
+      GT -> join x l (filterLt cmp r)
+      EQ -> l
+
+
+{--------------------------------------------------------------------
+  Split
+--------------------------------------------------------------------}
+-- | /O(log n)/. The expression (@'split' x set@) is a pair @(set1,set2)@
+-- where @set1@ comprises the elements of @set@ less than @x@ and @set2@
+-- comprises the elements of @set@ greater than @x@.
+split :: (US a, Ord a) => a -> USet a -> (USet a,USet a)
+split _ (view -> Tip) = (tip,tip)
+split x (view -> Bin _ y l r)
+  = case compare x y of
+      LT -> let (lt,gt) = split x l in (lt,join y gt r)
+      GT -> let (lt,gt) = split x r in (join y l lt,gt)
+      EQ -> (l,r)
+
+-- | /O(log n)/. Performs a 'split' but also returns whether the pivot
+-- element was found in the original set.
+splitMember :: (US a, Ord a) => a -> USet a -> (USet a,Bool,USet a)
+splitMember x t = let (l,m,r) = splitLookup x t in
+     (l,maybe False (const True) m,r)
+
+-- | /O(log n)/. Performs a 'split' but also returns the pivot
+-- element that was found in the original set.
+splitLookup :: (US a, Ord a) => a -> USet a -> (USet a,Maybe a,USet a)
+splitLookup _ (view -> Tip) = (tip,Nothing,tip)
+splitLookup x (view -> Bin _ y l r)
+   = case compare x y of
+       LT -> let (lt,found,gt) = splitLookup x l in (lt,found,join y gt r)
+       GT -> let (lt,found,gt) = splitLookup x r in (join y l lt,found,gt)
+       EQ -> (l,Just y,r)
+
+{--------------------------------------------------------------------
+  Utility functions that maintain the balance properties of the tree.
+  All constructors assume that all values in [l] < [x] and all values
+  in [r] > [x], and that [l] and [r] are valid trees.
+  
+  In order of sophistication:
+    [Bin sz x l r]    The type constructor.
+    [bin_ x l r]      Maintains the correct size, assumes that both [l]
+                      and [r] are balanced with respect to each other.
+    [balance x l r]   Restores the balance and size.
+                      Assumes that the original tree was balanced and
+                      that [l] or [r] has changed by at most one element.
+    [join x l r]      Restores balance and size. 
+
+  Furthermore, we can construct a new tree from two trees. Both operations
+  assume that all values in [l] < all values in [r] and that [l] and [r]
+  are valid:
+    [glue l r]        Glues [l] and [r] together. Assumes that [l] and
+                      [r] are already balanced with respect to each other.
+    [merge l r]       Merges two trees and restores balance.
+
+  Note: in contrast to Adam's paper, we use (<=) comparisons instead
+  of (<) comparisons in [join], [merge] and [balance]. 
+  Quickcheck (on [difference]) showed that this was necessary in order 
+  to maintain the invariants. It is quite unsatisfactory that I haven't 
+  been able to find out why this is actually the case! Fortunately, it 
+  doesn't hurt to be a bit more conservative.
+--------------------------------------------------------------------}
+
+{--------------------------------------------------------------------
+  Join 
+--------------------------------------------------------------------}
+join :: US a => a -> USet a -> USet a -> USet a
+join x (view -> Tip) r  = insertMin x r
+join x l (view -> Tip)  = insertMax x l
+join x l@(view -> Bin sizeL y ly ry) r@(view -> Bin sizeR z lz rz)
+  | delta*sizeL <= sizeR  = balance z (join x l lz) rz
+  | delta*sizeR <= sizeL  = balance y ly (join x ry r)
+  | otherwise             = bin_ x l r
+
+
+-- insertMin and insertMax don't perform potentially expensive comparisons.
+insertMax,insertMin :: US a => a -> USet a -> USet a 
+insertMax x t
+  = case view t of
+      Tip -> singleton x
+      Bin _ y l r
+          -> balance y l (insertMax x r)
+             
+insertMin x t
+  = case view t of
+      Tip -> singleton x
+      Bin _ y l r
+          -> balance y (insertMin x l) r
+             
+{--------------------------------------------------------------------
+  [merge l r]: merges two trees.
+--------------------------------------------------------------------}
+merge :: US a => USet a -> USet a -> USet a
+merge (view -> Tip) r   = r
+merge l (view -> Tip)   = l
+merge l@(view -> Bin sizeL x lx rx) r@(view -> Bin sizeR y ly ry)
+  | delta*sizeL <= sizeR = balance y (merge l ly) ry
+  | delta*sizeR <= sizeL = balance x lx (merge rx r)
+  | otherwise            = glue l r
+
+{--------------------------------------------------------------------
+  [glue l r]: glues two trees together.
+  Assumes that [l] and [r] are already balanced with respect to each other.
+--------------------------------------------------------------------}
+glue :: US a => USet a -> USet a -> USet a
+glue (view -> Tip) r = r
+glue l (view -> Tip) = l
+glue l r   
+  | size l > size r = let (m,l') = deleteFindMax l in balance m l' r
+  | otherwise       = let (m,r') = deleteFindMin r in balance m l r'
+
+
+-- | /O(log n)/. Delete and find the minimal element.
+-- 
+-- > deleteFindMin set = (findMin set, deleteMin set)
+
+deleteFindMin :: US a => USet a -> (a,USet a)
+deleteFindMin t 
+  = case view t of
+      Bin _ x (view -> Tip) r -> (x,r)
+      Bin _ x l r   -> let (xm,l') = deleteFindMin l in (xm,balance x l' r)
+      Tip           -> (error "Set.deleteFindMin: can not return the minimal element of an empty set", tip)
+
+-- | /O(log n)/. Delete and find the maximal element.
+-- 
+-- > deleteFindMax set = (findMax set, deleteMax set)
+deleteFindMax :: US a => USet a -> (a,USet a)
+deleteFindMax t
+  = case view t of
+      Bin _ x l (view -> Tip) -> (x,l)
+      Bin _ x l r   -> let (xm,r') = deleteFindMax r in (xm,balance x l r')
+      Tip           -> (error "Set.deleteFindMax: can not return the maximal element of an empty set", tip)
+
+-- | /O(log n)/. Retrieves the minimal key of the set, and the set
+-- stripped of that element, or 'Nothing' if passed an empty set.
+minView :: US a => USet a -> Maybe (a, USet a)
+minView (view -> Tip) = Nothing
+minView x = Just (deleteFindMin x)
+
+-- | /O(log n)/. Retrieves the maximal key of the set, and the set
+-- stripped of that element, or 'Nothing' if passed an empty set.
+maxView :: US a => USet a -> Maybe (a, USet a)
+maxView (view -> Tip) = Nothing
+maxView x = Just (deleteFindMax x)
+
+{--------------------------------------------------------------------
+  [balance x l r] balances two trees with value x.
+  The sizes of the trees should balance after decreasing the
+  size of one of them. (a rotation).
+
+  [delta] is the maximal relative difference between the sizes of
+          two trees, it corresponds with the [w] in Adams' paper,
+          or equivalently, [1/delta] corresponds with the $\alpha$
+          in Nievergelt's paper. Adams shows that [delta] should
+          be larger than 3.745 in order to garantee that the
+          rotations can always restore balance.         
+
+  [ratio] is the ratio between an outer and inner sibling of the
+          heavier subtree in an unbalanced setting. It determines
+          whether a double or single rotation should be performed
+          to restore balance. It is correspondes with the inverse
+          of $\alpha$ in Adam's article.
+
+  Note that:
+  - [delta] should be larger than 4.646 with a [ratio] of 2.
+  - [delta] should be larger than 3.745 with a [ratio] of 1.534.
+  
+  - A lower [delta] leads to a more 'perfectly' balanced tree.
+  - A higher [delta] performs less rebalancing.
+
+  - Balancing is automatic for random data and a balancing
+    scheme is only necessary to avoid pathological worst cases.
+    Almost any choice will do in practice
+    
+  - Allthough it seems that a rather large [delta] may perform better 
+    than smaller one, measurements have shown that the smallest [delta]
+    of 4 is actually the fastest on a wide range of operations. It
+    especially improves performance on worst-case scenarios like
+    a sequence of ordered insertions.
+
+  Note: in contrast to Adams' paper, we use a ratio of (at least) 2
+  to decide whether a single or double rotation is needed. Allthough
+  he actually proves that this ratio is needed to maintain the
+  invariants, his implementation uses a (invalid) ratio of 1. 
+  He is aware of the problem though since he has put a comment in his 
+  original source code that he doesn't care about generating a 
+  slightly inbalanced tree since it doesn't seem to matter in practice. 
+  However (since we use quickcheck :-) we will stick to strictly balanced 
+  trees.
+--------------------------------------------------------------------}
+delta,ratio :: Int
+delta = 4
+ratio = 2
+
+balance :: US a => a -> USet a -> USet a -> USet a
+balance x l r
+  | sizeL + sizeR <= 1    = bin sizeX x l r
+  | sizeR >= delta*sizeL  = rotateL x l r
+  | sizeL >= delta*sizeR  = rotateR x l r
+  | otherwise             = bin sizeX x l r
+  where
+    sizeL = size l
+    sizeR = size r
+    sizeX = sizeL + sizeR + 1
+
+-- rotate
+rotateL :: US a => a -> USet a -> USet a -> USet a
+rotateL x l r@(view -> Bin _ _ ly ry)
+  | size ly < ratio*size ry = singleL x l r
+  | otherwise               = doubleL x l r
+rotateL _ _ (view -> Tip) = error "rotateL Tip"
+
+rotateR :: US a => a -> USet a -> USet a -> USet a
+rotateR x l@(view -> Bin _ _ ly ry) r
+  | size ry < ratio*size ly = singleR x l r
+  | otherwise               = doubleR x l r
+rotateR _ (view -> Tip) _ = error "rotateL Tip"
+
+-- basic rotations
+singleL, singleR :: US a => a -> USet a -> USet a -> USet a
+singleL x1 t1 (view -> Bin _ x2 t2 t3)  = bin_ x2 (bin_ x1 t1 t2) t3
+singleL _  _  (view -> Tip)             = error "singleL"
+singleR x1 (view -> Bin _ x2 t1 t2) t3  = bin_ x2 t1 (bin_ x1 t2 t3)
+singleR _ (view -> Tip)             _   = error "singleR"
+
+doubleL, doubleR :: US a => a -> USet a -> USet a -> USet a
+doubleL x1 t1 (view -> Bin _ x2 (view -> Bin _ x3 t2 t3) t4) = bin_ x3 (bin_ x1 t1 t2) (bin_ x2 t3 t4)
+doubleL _ _ _ = error "doubleL"
+doubleR x1 (view -> Bin _ x2 t1 (view -> Bin _ x3 t2 t3)) t4 = bin_ x3 (bin_ x2 t1 t2) (bin_ x1 t3 t4)
+doubleR _ _ _ = error "doubleR"
+
+
+{--------------------------------------------------------------------
+  The bin constructor maintains the size of the tree
+--------------------------------------------------------------------}
+bin_ :: US a => a -> USet a -> USet a -> USet a
+bin_ x l r
+  = bin (size l + size r + 1) x l r
+
+
+{--------------------------------------------------------------------
+  Utilities
+--------------------------------------------------------------------}
+foldlStrict :: (a -> b -> a) -> a -> [b] -> a
+foldlStrict f z xs
+  = case xs of
+      []     -> z
+      (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
+
+
+{--------------------------------------------------------------------
+  Debugging
+--------------------------------------------------------------------}
+-- | /O(n)/. Show the tree that implements the set. The tree is shown
+-- in a compressed, hanging format.
+showTree :: (US a, Show a) => USet a -> String
+showTree s
+  = showTreeWith True False s
+
+
+{- | /O(n)/. The expression (@showTreeWith hang wide map@) shows
+ the tree that implements the set. If @hang@ is
+ @True@, a /hanging/ tree is shown otherwise a rotated tree is shown. If
+ @wide@ is 'True', an extra wide version is shown.
+
+> Set> putStrLn $ showTreeWith True False $ fromDistinctAscList [1..5]
+> 4
+> +--2
+> |  +--1
+> |  +--3
+> +--5
+> 
+> Set> putStrLn $ showTreeWith True True $ fromDistinctAscList [1..5]
+> 4
+> |
+> +--2
+> |  |
+> |  +--1
+> |  |
+> |  +--3
+> |
+> +--5
+> 
+> Set> putStrLn $ showTreeWith False True $ fromDistinctAscList [1..5]
+> +--5
+> |
+> 4
+> |
+> |  +--3
+> |  |
+> +--2
+>    |
+>    +--1
+
+-}
+showTreeWith :: (US a, Show a) => Bool -> Bool -> USet a -> String
+showTreeWith hang wide t
+  | hang      = (showsTreeHang wide [] t) ""
+  | otherwise = (showsTree wide [] [] t) ""
+
+showsTree :: (US a, Show a) => Bool -> [String] -> [String] -> USet a -> ShowS
+showsTree wide lbars rbars t
+  = case view t of
+      Tip -> showsBars lbars . showString "|\n"
+      Bin _ x (view -> Tip) (view -> Tip)
+          -> showsBars lbars . shows x . showString "\n" 
+      Bin _ x l r
+          -> showsTree wide (withBar rbars) (withEmpty rbars) r .
+             showWide wide rbars .
+             showsBars lbars . shows x . showString "\n" .
+             showWide wide lbars .
+             showsTree wide (withEmpty lbars) (withBar lbars) l
+
+showsTreeHang :: (US a, Show a) => Bool -> [String] -> USet a -> ShowS
+showsTreeHang wide bars t
+  = case view t of
+      Tip -> showsBars bars . showString "|\n" 
+      Bin _ x (view -> Tip) (view -> Tip) 
+          -> showsBars bars . shows x . showString "\n" 
+      Bin _ x l r
+          -> showsBars bars . shows x . showString "\n" . 
+             showWide wide bars .
+             showsTreeHang wide (withBar bars) l .
+             showWide wide bars .
+             showsTreeHang wide (withEmpty bars) r
+
+showWide :: Bool -> [String] -> String -> String
+showWide wide bars 
+  | wide      = showString (concat (reverse bars)) . showString "|\n" 
+  | otherwise = id
+
+showsBars :: [String] -> ShowS
+showsBars bars
+  = case bars of
+      [] -> id
+      _  -> showString (concat (reverse (tail bars))) . showString node
+
+node :: String
+node           = "+--"
+
+withBar, withEmpty :: [String] -> [String]
+withBar bars   = "|  ":bars
+withEmpty bars = "   ":bars
+
+{--------------------------------------------------------------------
+  Assertions
+--------------------------------------------------------------------}
+-- | /O(n)/. Test if the internal set structure is valid.
+valid :: (US a, Ord a) => USet a -> Bool
+valid t
+  = balanced t && ordered t && validsize t
+
+ordered :: (US a, Ord a) => USet a -> Bool
+ordered t
+  = bounded (const True) (const True) t
+  where
+    bounded lo hi t'
+      = case view t' of
+          Tip         -> True
+          Bin _ x l r -> (lo x) && (hi x) && bounded lo (<x) l && bounded (>x) hi r
+
+balanced :: US a => USet a -> Bool
+balanced t
+  = case view t of
+      Tip         -> True
+      Bin _ _ l r -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) &&
+                     balanced l && balanced r
+
+validsize :: US a => USet a -> Bool
+validsize t
+  = (realsize t == Just (size t))
+  where
+    realsize t'
+      = case view t' of
+          Tip          -> Just 0
+          Bin sz _ l r -> case (realsize l,realsize r) of
+                            (Just n,Just m)  | n+m+1 == sz  -> Just sz
+                            _                -> Nothing
+
+{-
+{--------------------------------------------------------------------
+  Testing
+--------------------------------------------------------------------}
+testTree :: [Int] -> USet Int
+testTree xs   = fromList xs
+test1 = testTree [1..20]
+test2 = testTree [30,29..10]
+test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
+
+{--------------------------------------------------------------------
+  QuickCheck
+--------------------------------------------------------------------}
+
+{-
+qcheck prop
+  = check config prop
+  where
+    config = Config
+      { configMaxTest = 500
+      , configMaxFail = 5000
+      , configSize    = \n -> (div n 2 + 3)
+      , configEvery   = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
+      }
+-}
+
+
+{--------------------------------------------------------------------
+  Arbitrary, reasonably balanced trees
+--------------------------------------------------------------------}
+instance (US a, Enum a) => Arbitrary (USet a) where
+  arbitrary = sized (arbtree 0 maxkey)
+            where maxkey  = 10000
+
+arbtree :: (US a, Enum a) => Int -> Int -> Int -> Gen (USet a)
+arbtree lo hi n
+  | n <= 0        = return tip
+  | lo >= hi      = return tip
+  | otherwise     = do{ i  <- choose (lo,hi)
+                      ; m  <- choose (1,30)
+                      ; let (ml,mr)  | m==(1::Int)= (1,2)
+                                     | m==2       = (2,1)
+                                     | m==3       = (1,1)
+                                     | otherwise  = (2,2)
+                      ; l  <- arbtree lo (i-1) (n `div` ml)
+                      ; r  <- arbtree (i+1) hi (n `div` mr)
+                      ; return (bin_ (toEnum i) l r)
+                      }  
+
+
+{--------------------------------------------------------------------
+  Valid tree's
+--------------------------------------------------------------------}
+forValid :: (US a, Enum a,Show a,Testable b) => (USet a -> b) -> Property
+forValid f
+  = forAll arbitrary $ \t -> 
+--    classify (balanced t) "balanced" $
+    classify (size t == 0) "empty" $
+    classify (size t > 0  && size t <= 10) "small" $
+    classify (size t > 10 && size t <= 64) "medium" $
+    classify (size t > 64) "large" $
+    balanced t ==> f t
+
+forValidIntTree :: Testable a => (USet Int -> a) -> Property
+forValidIntTree f
+  = forValid f
+
+forValidUnitTree :: Testable a => (USet Int -> a) -> Property
+forValidUnitTree f
+  = forValid f
+
+
+prop_Valid 
+  = forValidUnitTree $ \t -> valid t
+
+{--------------------------------------------------------------------
+  Single, Insert, Delete
+--------------------------------------------------------------------}
+prop_Single :: Int -> Bool
+prop_Single x
+  = (insert x empty == singleton x)
+
+prop_InsertValid :: Int -> Property
+prop_InsertValid k
+  = forValidUnitTree $ \t -> valid (insert k t)
+
+prop_InsertDelete :: Int -> USet Int -> Property
+prop_InsertDelete k t
+  = not (member k t) ==> delete k (insert k t) == t
+
+prop_DeleteValid :: Int -> Property
+prop_DeleteValid k
+  = forValidUnitTree $ \t -> 
+    valid (delete k (insert k t))
+
+{--------------------------------------------------------------------
+  Balance
+--------------------------------------------------------------------}
+prop_Join :: Int -> Property 
+prop_Join x
+  = forValidUnitTree $ \t ->
+    let (l,r) = split x t
+    in valid (join x l r)
+
+prop_Merge :: Int -> Property 
+prop_Merge x
+  = forValidUnitTree $ \t ->
+    let (l,r) = split x t
+    in valid (merge l r)
+
+
+{--------------------------------------------------------------------
+  Union
+--------------------------------------------------------------------}
+prop_UnionValid :: Property
+prop_UnionValid
+  = forValidUnitTree $ \t1 ->
+    forValidUnitTree $ \t2 ->
+    valid (union t1 t2)
+
+prop_UnionInsert :: Int -> USet Int -> Bool
+prop_UnionInsert x t
+  = union t (singleton x) == insert x t
+
+prop_UnionAssoc :: USet Int -> USet Int -> USet Int -> Bool
+prop_UnionAssoc t1 t2 t3
+  = union t1 (union t2 t3) == union (union t1 t2) t3
+
+prop_UnionComm :: USet Int -> USet Int -> Bool
+prop_UnionComm t1 t2
+  = (union t1 t2 == union t2 t1)
+
+
+prop_DiffValid
+  = forValidUnitTree $ \t1 ->
+    forValidUnitTree $ \t2 ->
+    valid (difference t1 t2)
+
+prop_Diff :: [Int] -> [Int] -> Bool
+prop_Diff xs ys
+  =  toAscList (difference (fromList xs) (fromList ys))
+    == List.sort ((List.\\) (nub xs)  (nub ys))
+
+prop_IntValid
+  = forValidUnitTree $ \t1 ->
+    forValidUnitTree $ \t2 ->
+    valid (intersection t1 t2)
+
+prop_Int :: [Int] -> [Int] -> Bool
+prop_Int xs ys
+  =  toAscList (intersection (fromList xs) (fromList ys))
+    == List.sort (nub ((List.intersect) (xs)  (ys)))
+
+{--------------------------------------------------------------------
+  Lists
+--------------------------------------------------------------------}
+prop_Ordered
+  = forAll (choose (5,100)) $ \n ->
+    let xs = [0..n::Int]
+    in fromAscList xs == fromList xs
+
+prop_List :: [Int] -> Bool
+prop_List xs
+  = (sort (nub xs) == toList (fromList xs))
+-}
+
+
+newtype Boxed a = Boxed a
+instance US (Boxed a) where
+    data USet (Boxed a) = BoxedTip | BoxedBin {-# UNPACK #-} !Size (Boxed a) !(USet (Boxed a)) !(USet (Boxed a))
+    view BoxedTip = Tip
+    view (BoxedBin s i l r) = Bin s i l r
+    tip = BoxedTip
+    bin = BoxedBin
+
+instance US Char where
+    data USet Char = CharTip | CharBin {-# UNPACK #-} !Size {-# UNPACK #-} !Char !(USet Char) !(USet Char)
+    view CharTip = Tip
+    view (CharBin s i l r) = Bin s i l r
+    tip = CharTip
+    bin = CharBin
+instance US Int where
+    data USet Int = IntTip | IntBin {-# UNPACK #-} !Size {-# UNPACK #-} !Int !(USet Int) !(USet Int)
+    view IntTip = Tip
+    view (IntBin s i l r) = Bin s i l r
+    tip = IntTip
+    bin = IntBin
+
+instance US Integer where
+    data USet Integer = IntegerTip | IntegerBin {-# UNPACK #-} !Size {-# UNPACK #-} !Integer !(USet Integer) !(USet Integer)
+    view IntegerTip = Tip
+    view (IntegerBin s i l r) = Bin s i l r
+    tip = IntegerTip
+    bin = IntegerBin
+
+instance US Int8 where
+    data USet Int8 = Int8Tip | Int8Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Int8 !(USet Int8) !(USet Int8)
+    view Int8Tip = Tip
+    view (Int8Bin s i l r) = Bin s i l r
+    tip = Int8Tip
+    bin = Int8Bin
+
+instance US Int16 where
+    data USet Int16 = Int16Tip | Int16Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Int16 !(USet Int16) !(USet Int16)
+    view Int16Tip = Tip
+    view (Int16Bin s i l r) = Bin s i l r
+    tip = Int16Tip
+    bin = Int16Bin
+
+instance US Int32 where
+    data USet Int32 = Int32Tip | Int32Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Int32 !(USet Int32) !(USet Int32)
+    view Int32Tip = Tip
+    view (Int32Bin s i l r) = Bin s i l r
+    tip = Int32Tip
+    bin = Int32Bin
+
+instance US Int64 where
+    data USet Int64 = Int64Tip | Int64Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Int64 !(USet Int64) !(USet Int64)
+    view Int64Tip = Tip
+    view (Int64Bin s i l r) = Bin s i l r
+    tip = Int64Tip
+    bin = Int64Bin
+
+instance US Word8 where
+    data USet Word8 = Word8Tip | Word8Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Word8 !(USet Word8) !(USet Word8)
+    view Word8Tip = Tip
+    view (Word8Bin s i l r) = Bin s i l r
+    tip = Word8Tip
+    bin = Word8Bin
+
+instance US Word16 where
+    data USet Word16 = Word16Tip | Word16Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Word16 !(USet Word16) !(USet Word16)
+    view Word16Tip = Tip
+    view (Word16Bin s i l r) = Bin s i l r
+    tip = Word16Tip
+    bin = Word16Bin
+
+instance US Word32 where
+    data USet Word32 = Word32Tip | Word32Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Word32 !(USet Word32) !(USet Word32)
+    view Word32Tip = Tip
+    view (Word32Bin s i l r) = Bin s i l r
+    tip = Word32Tip
+    bin = Word32Bin
+
+instance US Word64 where
+    data USet Word64 = Word64Tip | Word64Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Word64 !(USet Word64) !(USet Word64)
+    view Word64Tip = Tip
+    view (Word64Bin s i l r) = Bin s i l r
+    tip = Word64Tip
+    bin = Word64Bin
+
+instance US Double where
+    data USet Double = DoubleTip | DoubleBin {-# UNPACK #-} !Size {-# UNPACK #-} !Double !(USet Double) !(USet Double)
+    view DoubleTip = Tip
+    view (DoubleBin s i l r) = Bin s i l r
+    tip = DoubleTip
+    bin = DoubleBin
+
+instance US Float where
+    data USet Float = FloatTip | FloatBin {-# UNPACK #-} !Size {-# UNPACK #-} !Float !(USet Float) !(USet Float)
+    view FloatTip = Tip
+    view (FloatBin s i l r) = Bin s i l r
+    tip = FloatTip
+    bin = FloatBin
+
+
+ }