Remove a number of modules now in a "containers" package
authorIan Lynagh <igloo@earth.li>
Wed, 1 Aug 2007 22:38:58 +0000 (22:38 +0000)
committerIan Lynagh <igloo@earth.li>
Wed, 1 Aug 2007 22:38:58 +0000 (22:38 +0000)
libraries/base/Data/Foldable.hs [deleted file]
libraries/base/Data/Graph.hs [deleted file]
libraries/base/Data/IntMap.hs [deleted file]
libraries/base/Data/IntSet.hs [deleted file]
libraries/base/Data/Map.hs [deleted file]
libraries/base/Data/Sequence.hs [deleted file]
libraries/base/Data/Set.hs [deleted file]
libraries/base/Data/Traversable.hs [deleted file]
libraries/base/Data/Tree.hs [deleted file]
libraries/base/base.cabal

diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs
deleted file mode 100644 (file)
index 096a347..0000000
+++ /dev/null
@@ -1,301 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Foldable
--- Copyright   :  Ross Paterson 2005
--- License     :  BSD-style (see the LICENSE file in the distribution)
---
--- Maintainer  :  ross@soi.city.ac.uk
--- Stability   :  experimental
--- Portability :  portable
---
--- Class of data structures that can be folded to a summary value.
---
--- Many of these functions generalize "Prelude", "Control.Monad" and
--- "Data.List" functions of the same names from lists to any 'Foldable'
--- functor.  To avoid ambiguity, either import those modules hiding
--- these names or qualify uses of these function names with an alias
--- for this module.
-
-module Data.Foldable (
-       -- * Folds
-       Foldable(..),
-       -- ** Special biased folds
-       foldr',
-       foldl',
-       foldrM,
-       foldlM,
-       -- ** Folding actions
-       -- *** Applicative actions
-       traverse_,
-       for_,
-       sequenceA_,
-       asum,
-       -- *** Monadic actions
-       mapM_,
-       forM_,
-       sequence_,
-       msum,
-       -- ** Specialized folds
-       toList,
-       concat,
-       concatMap,
-       and,
-       or,
-       any,
-       all,
-       sum,
-       product,
-       maximum,
-       maximumBy,
-       minimum,
-       minimumBy,
-       -- ** Searches
-       elem,
-       notElem,
-       find
-       ) where
-
-import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_,
-               elem, notElem, concat, concatMap, and, or, any, all,
-               sum, product, maximum, minimum)
-import qualified Prelude (foldl, foldr, foldl1, foldr1)
-import Control.Applicative
-import Control.Monad (MonadPlus(..))
-import Data.Maybe (fromMaybe, listToMaybe)
-import Data.Monoid
-import Data.Array
-
-#ifdef __NHC__
-import Control.Arrow (ArrowZero(..)) -- work around nhc98 typechecker problem
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Exts (build)
-#endif
-
--- | Data structures that can be folded.
---
--- Minimal complete definition: 'foldMap' or 'foldr'.
---
--- For example, given a data type
---
--- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
---
--- a suitable instance would be
---
--- > instance Foldable Tree
--- >    foldMap f Empty = mempty
--- >    foldMap f (Leaf x) = f x
--- >    foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r
---
--- This is suitable even for abstract types, as the monoid is assumed
--- to satisfy the monoid laws.
---
-class Foldable t where
-       -- | Combine the elements of a structure using a monoid.
-       fold :: Monoid m => t m -> m
-       fold = foldMap id
-
-       -- | Map each element of the structure to a monoid,
-       -- and combine the results.
-       foldMap :: Monoid m => (a -> m) -> t a -> m
-       foldMap f = foldr (mappend . f) mempty
-
-       -- | Right-associative fold of a structure.
-       --
-       -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@
-       foldr :: (a -> b -> b) -> b -> t a -> b
-       foldr f z t = appEndo (foldMap (Endo . f) t) z
-
-       -- | Left-associative fold of a structure.
-       --
-       -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@
-       foldl :: (a -> b -> a) -> a -> t b -> a
-       foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z
-
-       -- | A variant of 'foldr' that has no base case,
-       -- and thus may only be applied to non-empty structures.
-       --
-       -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@
-       foldr1 :: (a -> a -> a) -> t a -> a
-       foldr1 f xs = fromMaybe (error "foldr1: empty structure")
-                       (foldr mf Nothing xs)
-         where mf x Nothing = Just x
-               mf x (Just y) = Just (f x y)
-
-       -- | A variant of 'foldl' that has no base case,
-       -- and thus may only be applied to non-empty structures.
-       --
-       -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@
-       foldl1 :: (a -> a -> a) -> t a -> a
-       foldl1 f xs = fromMaybe (error "foldl1: empty structure")
-                       (foldl mf Nothing xs)
-         where mf Nothing y = Just y
-               mf (Just x) y = Just (f x y)
-
--- instances for Prelude types
-
-instance Foldable Maybe where
-       foldr f z Nothing = z
-       foldr f z (Just x) = f x z
-
-       foldl f z Nothing = z
-       foldl f z (Just x) = f z x
-
-instance Foldable [] where
-       foldr = Prelude.foldr
-       foldl = Prelude.foldl
-       foldr1 = Prelude.foldr1
-       foldl1 = Prelude.foldl1
-
-instance Ix i => Foldable (Array i) where
-       foldr f z = Prelude.foldr f z . elems
-
--- | Fold over the elements of a structure,
--- associating to the right, but strictly.
-foldr' :: Foldable t => (a -> b -> b) -> b -> t a -> b
-foldr' f z xs = foldl f' id xs z
-  where f' k x z = k $! f x z
-
--- | Monadic fold over the elements of a structure,
--- associating to the right, i.e. from right to left.
-foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b
-foldrM f z xs = foldl f' return xs z
-  where f' k x z = f x z >>= k
-
--- | Fold over the elements of a structure,
--- associating to the left, but strictly.
-foldl' :: Foldable t => (a -> b -> a) -> a -> t b -> a
-foldl' f z xs = foldr f' id xs z
-  where f' x k z = k $! f z x
-
--- | Monadic fold over the elements of a structure,
--- associating to the left, i.e. from left to right.
-foldlM :: (Foldable t, Monad m) => (a -> b -> m a) -> a -> t b -> m a
-foldlM f z xs = foldr f' return xs z
-  where f' x k z = f z x >>= k
-
--- | Map each element of a structure to an action, evaluate
--- these actions from left to right, and ignore the results.
-traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()
-traverse_ f = foldr ((*>) . f) (pure ())
-
--- | 'for_' is 'traverse_' with its arguments flipped.
-for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()
-{-# INLINE for_ #-}
-for_ = flip traverse_
-
--- | Map each element of a structure to a monadic action, evaluate
--- these actions from left to right, and ignore the results.
-mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()
-mapM_ f = foldr ((>>) . f) (return ())
-
--- | 'forM_' is 'mapM_' with its arguments flipped.
-forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()
-{-# INLINE forM_ #-}
-forM_ = flip mapM_
-
--- | Evaluate each action in the structure from left to right,
--- and ignore the results.
-sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()
-sequenceA_ = foldr (*>) (pure ())
-
--- | Evaluate each monadic action in the structure from left to right,
--- and ignore the results.
-sequence_ :: (Foldable t, Monad m) => t (m a) -> m ()
-sequence_ = foldr (>>) (return ())
-
--- | The sum of a collection of actions, generalizing 'concat'.
-asum :: (Foldable t, Alternative f) => t (f a) -> f a
-{-# INLINE asum #-}
-asum = foldr (<|>) empty
-
--- | The sum of a collection of actions, generalizing 'concat'.
-msum :: (Foldable t, MonadPlus m) => t (m a) -> m a
-{-# INLINE msum #-}
-msum = foldr mplus mzero
-
--- These use foldr rather than foldMap to avoid repeated concatenation.
-
--- | List of elements of a structure.
-toList :: Foldable t => t a -> [a]
-#ifdef __GLASGOW_HASKELL__
-toList t = build (\ c n -> foldr c n t)
-#else
-toList = foldr (:) []
-#endif
-
--- | The concatenation of all the elements of a container of lists.
-concat :: Foldable t => t [a] -> [a]
-concat = fold
-
--- | Map a function over all the elements of a container and concatenate
--- the resulting lists.
-concatMap :: Foldable t => (a -> [b]) -> t a -> [b]
-concatMap = foldMap
-
--- | 'and' returns the conjunction of a container of Bools.  For the
--- result to be 'True', the container must be finite; 'False', however,
--- results from a 'False' value finitely far from the left end.
-and :: Foldable t => t Bool -> Bool
-and = getAll . foldMap All
-
--- | 'or' returns the disjunction of a container of Bools.  For the
--- result to be 'False', the container must be finite; 'True', however,
--- results from a 'True' value finitely far from the left end.
-or :: Foldable t => t Bool -> Bool
-or = getAny . foldMap Any
-
--- | Determines whether any element of the structure satisfies the predicate.
-any :: Foldable t => (a -> Bool) -> t a -> Bool
-any p = getAny . foldMap (Any . p)
-
--- | Determines whether all elements of the structure satisfy the predicate.
-all :: Foldable t => (a -> Bool) -> t a -> Bool
-all p = getAll . foldMap (All . p)
-
--- | The 'sum' function computes the sum of the numbers of a structure.
-sum :: (Foldable t, Num a) => t a -> a
-sum = getSum . foldMap Sum
-
--- | The 'product' function computes the product of the numbers of a structure.
-product :: (Foldable t, Num a) => t a -> a
-product = getProduct . foldMap Product
-
--- | The largest element of a non-empty structure.
-maximum :: (Foldable t, Ord a) => t a -> a
-maximum = foldr1 max
-
--- | The largest element of a non-empty structure with respect to the
--- given comparison function.
-maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
-maximumBy cmp = foldr1 max'
-  where max' x y = case cmp x y of
-                       GT -> x
-                       _  -> y
-
--- | The least element of a non-empty structure.
-minimum :: (Foldable t, Ord a) => t a -> a
-minimum = foldr1 min
-
--- | The least element of a non-empty structure with respect to the
--- given comparison function.
-minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
-minimumBy cmp = foldr1 min'
-  where min' x y = case cmp x y of
-                       GT -> y
-                       _  -> x
-
--- | Does the element occur in the structure?
-elem :: (Foldable t, Eq a) => a -> t a -> Bool
-elem = any . (==)
-
--- | 'notElem' is the negation of 'elem'.
-notElem :: (Foldable t, Eq a) => a -> t a -> Bool
-notElem x = not . elem x
-
--- | The 'find' function takes a predicate and a structure and returns
--- the leftmost element of the structure matching the predicate, or
--- 'Nothing' if there is no such element.
-find :: Foldable t => (a -> Bool) -> t a -> Maybe a
-find p = listToMaybe . concatMap (\ x -> if p x then [x] else [])
diff --git a/libraries/base/Data/Graph.hs b/libraries/base/Data/Graph.hs
deleted file mode 100644 (file)
index 701675c..0000000
+++ /dev/null
@@ -1,432 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Graph
--- Copyright   :  (c) The University of Glasgow 2002
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  portable
---
--- A version of the graph algorithms described in:
---
---   /Lazy Depth-First Search and Linear Graph Algorithms in Haskell/,
---   by David King and John Launchbury.
---
------------------------------------------------------------------------------
-
-module Data.Graph(
-
-       -- * External interface
-
-       -- At present the only one with a "nice" external interface
-       stronglyConnComp, stronglyConnCompR, SCC(..), flattenSCC, flattenSCCs,
-
-       -- * Graphs
-
-       Graph, Table, Bounds, Edge, Vertex,
-
-       -- ** Building graphs
-
-       graphFromEdges, graphFromEdges', buildG, transposeG,
-       -- reverseE,
-
-       -- ** Graph properties
-
-       vertices, edges,
-       outdegree, indegree,
-
-       -- * Algorithms
-
-       dfs, dff,
-       topSort,
-       components,
-       scc,
-       bcc,
-       -- tree, back, cross, forward,
-       reachable, path,
-
-       module Data.Tree
-
-    ) where
-
-#if __GLASGOW_HASKELL__
-# define USE_ST_MONAD 1
-#endif
-
--- Extensions
-#if USE_ST_MONAD
-import Control.Monad.ST
-import Data.Array.ST (STArray, newArray, readArray, writeArray)
-#else
-import Data.IntSet (IntSet)
-import qualified Data.IntSet as Set
-#endif
-import Data.Tree (Tree(Node), Forest)
-
--- std interfaces
-import Data.Maybe
-import Data.Array
-import Data.List
-
-#ifdef __HADDOCK__
-import Prelude
-#endif
-
--------------------------------------------------------------------------
---                                                                     -
---     External interface
---                                                                     -
--------------------------------------------------------------------------
-
--- | Strongly connected component.
-data SCC vertex = AcyclicSCC vertex    -- ^ A single vertex that is not
-                                       -- in any cycle.
-               | CyclicSCC  [vertex]   -- ^ A maximal set of mutually
-                                       -- reachable vertices.
-
--- | The vertices of a list of strongly connected components.
-flattenSCCs :: [SCC a] -> [a]
-flattenSCCs = concatMap flattenSCC
-
--- | The vertices of a strongly connected component.
-flattenSCC :: SCC vertex -> [vertex]
-flattenSCC (AcyclicSCC v) = [v]
-flattenSCC (CyclicSCC vs) = vs
-
--- | The strongly connected components of a directed graph, topologically
--- sorted.
-stronglyConnComp
-       :: Ord key
-       => [(node, key, [key])]
-               -- ^ The graph: a list of nodes uniquely identified by keys,
-               -- with a list of keys of nodes this node has edges to.
-               -- The out-list may contain keys that don't correspond to
-               -- nodes of the graph; such edges are ignored.
-       -> [SCC node]
-
-stronglyConnComp edges0
-  = map get_node (stronglyConnCompR edges0)
-  where
-    get_node (AcyclicSCC (n, _, _)) = AcyclicSCC n
-    get_node (CyclicSCC triples)     = CyclicSCC [n | (n,_,_) <- triples]
-
--- | The strongly connected components of a directed graph, topologically
--- sorted.  The function is the same as 'stronglyConnComp', except that
--- all the information about each node retained.
--- This interface is used when you expect to apply 'SCC' to
--- (some of) the result of 'SCC', so you don't want to lose the
--- dependency information.
-stronglyConnCompR
-       :: Ord key
-       => [(node, key, [key])]
-               -- ^ The graph: a list of nodes uniquely identified by keys,
-               -- with a list of keys of nodes this node has edges to.
-               -- The out-list may contain keys that don't correspond to
-               -- nodes of the graph; such edges are ignored.
-       -> [SCC (node, key, [key])]     -- ^ Topologically sorted
-
-stronglyConnCompR [] = []  -- added to avoid creating empty array in graphFromEdges -- SOF
-stronglyConnCompR edges0
-  = map decode forest
-  where
-    (graph, vertex_fn,_) = graphFromEdges edges0
-    forest            = scc graph
-    decode (Node v []) | mentions_itself v = CyclicSCC [vertex_fn v]
-                      | otherwise         = AcyclicSCC (vertex_fn v)
-    decode other = CyclicSCC (dec other [])
-                where
-                  dec (Node v ts) vs = vertex_fn v : foldr dec vs ts
-    mentions_itself v = v `elem` (graph ! v)
-
--------------------------------------------------------------------------
---                                                                     -
---     Graphs
---                                                                     -
--------------------------------------------------------------------------
-
--- | Abstract representation of vertices.
-type Vertex  = Int
--- | Table indexed by a contiguous set of vertices.
-type Table a = Array Vertex a
--- | Adjacency list representation of a graph, mapping each vertex to its
--- list of successors.
-type Graph   = Table [Vertex]
--- | The bounds of a 'Table'.
-type Bounds  = (Vertex, Vertex)
--- | An edge from the first vertex to the second.
-type Edge    = (Vertex, Vertex)
-
--- | All vertices of a graph.
-vertices :: Graph -> [Vertex]
-vertices  = indices
-
--- | All edges of a graph.
-edges    :: Graph -> [Edge]
-edges g   = [ (v, w) | v <- vertices g, w <- g!v ]
-
-mapT    :: (Vertex -> a -> b) -> Table a -> Table b
-mapT f t = array (bounds t) [ (,) v (f v (t!v)) | v <- indices t ]
-
--- | Build a graph from a list of edges.
-buildG :: Bounds -> [Edge] -> Graph
-buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 edges0
-
--- | The graph obtained by reversing all edges.
-transposeG  :: Graph -> Graph
-transposeG g = buildG (bounds g) (reverseE g)
-
-reverseE    :: Graph -> [Edge]
-reverseE g   = [ (w, v) | (v, w) <- edges g ]
-
--- | A table of the count of edges from each node.
-outdegree :: Graph -> Table Int
-outdegree  = mapT numEdges
-             where numEdges _ ws = length ws
-
--- | A table of the count of edges into each node.
-indegree :: Graph -> Table Int
-indegree  = outdegree . transposeG
-
--- | Identical to 'graphFromEdges', except that the return value
--- does not include the function which maps keys to vertices.  This
--- version of 'graphFromEdges' is for backwards compatibility.
-graphFromEdges'
-       :: Ord key
-       => [(node, key, [key])]
-       -> (Graph, Vertex -> (node, key, [key]))
-graphFromEdges' x = (a,b) where
-    (a,b,_) = graphFromEdges x
-
--- | Build a graph from a list of nodes uniquely identified by keys,
--- with a list of keys of nodes this node should have edges to.
--- The out-list may contain keys that don't correspond to
--- nodes of the graph; they are ignored.
-graphFromEdges
-       :: Ord key
-       => [(node, key, [key])]
-       -> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex)
-graphFromEdges edges0
-  = (graph, \v -> vertex_map ! v, key_vertex)
-  where
-    max_v                  = length edges0 - 1
-    bounds0         = (0,max_v) :: (Vertex, Vertex)
-    sorted_edges    = sortBy lt edges0
-    edges1         = zipWith (,) [0..] sorted_edges
-
-    graph          = array bounds0 [(,) v (mapMaybe key_vertex ks) | (,) v (_,    _, ks) <- edges1]
-    key_map        = array bounds0 [(,) v k                       | (,) v (_,    k, _ ) <- edges1]
-    vertex_map     = array bounds0 edges1
-
-    (_,k1,_) `lt` (_,k2,_) = k1 `compare` k2
-
-    -- key_vertex :: key -> Maybe Vertex
-    --         returns Nothing for non-interesting vertices
-    key_vertex k   = findVertex 0 max_v
-                  where
-                    findVertex a b | a > b
-                             = Nothing
-                    findVertex a b = case compare k (key_map ! mid) of
-                                  LT -> findVertex a (mid-1)
-                                  EQ -> Just mid
-                                  GT -> findVertex (mid+1) b
-                             where
-                               mid = (a + b) `div` 2
-
--------------------------------------------------------------------------
---                                                                     -
---     Depth first search
---                                                                     -
--------------------------------------------------------------------------
-
--- | A spanning forest of the graph, obtained from a depth-first search of
--- the graph starting from each vertex in an unspecified order.
-dff          :: Graph -> Forest Vertex
-dff g         = dfs g (vertices g)
-
--- | A spanning forest of the part of the graph reachable from the listed
--- vertices, obtained from a depth-first search of the graph starting at
--- each of the listed vertices in order.
-dfs          :: Graph -> [Vertex] -> Forest Vertex
-dfs g vs      = prune (bounds g) (map (generate g) vs)
-
-generate     :: Graph -> Vertex -> Tree Vertex
-generate g v  = Node v (map (generate g) (g!v))
-
-prune        :: Bounds -> Forest Vertex -> Forest Vertex
-prune bnds ts = run bnds (chop ts)
-
-chop         :: Forest Vertex -> SetM s (Forest Vertex)
-chop []       = return []
-chop (Node v ts : us)
-              = do
-                visited <- contains v
-                if visited then
-                  chop us
-                 else do
-                  include v
-                  as <- chop ts
-                  bs <- chop us
-                  return (Node v as : bs)
-
--- A monad holding a set of vertices visited so far.
-#if USE_ST_MONAD
-
--- Use the ST monad if available, for constant-time primitives.
-
-newtype SetM s a = SetM { runSetM :: STArray s Vertex Bool -> ST s a }
-
-instance Monad (SetM s) where
-    return x     = SetM $ const (return x)
-    SetM v >>= f = SetM $ \ s -> do { x <- v s; runSetM (f x) s }
-
-run          :: Bounds -> (forall s. SetM s a) -> a
-run bnds act  = runST (newArray bnds False >>= runSetM act)
-
-contains     :: Vertex -> SetM s Bool
-contains v    = SetM $ \ m -> readArray m v
-
-include      :: Vertex -> SetM s ()
-include v     = SetM $ \ m -> writeArray m v True
-
-#else /* !USE_ST_MONAD */
-
--- Portable implementation using IntSet.
-
-newtype SetM s a = SetM { runSetM :: IntSet -> (a, IntSet) }
-
-instance Monad (SetM s) where
-    return x     = SetM $ \ s -> (x, s)
-    SetM v >>= f = SetM $ \ s -> case v s of (x, s') -> runSetM (f x) s'
-
-run          :: Bounds -> SetM s a -> a
-run _ act     = fst (runSetM act Set.empty)
-
-contains     :: Vertex -> SetM s Bool
-contains v    = SetM $ \ m -> (Set.member v m, m)
-
-include      :: Vertex -> SetM s ()
-include v     = SetM $ \ m -> ((), Set.insert v m)
-
-#endif /* !USE_ST_MONAD */
-
--------------------------------------------------------------------------
---                                                                     -
---     Algorithms
---                                                                     -
--------------------------------------------------------------------------
-
-------------------------------------------------------------
--- Algorithm 1: depth first search numbering
-------------------------------------------------------------
-
-preorder            :: Tree a -> [a]
-preorder (Node a ts) = a : preorderF ts
-
-preorderF           :: Forest a -> [a]
-preorderF ts         = concat (map preorder ts)
-
-tabulate        :: Bounds -> [Vertex] -> Table Int
-tabulate bnds vs = array bnds (zipWith (,) vs [1..])
-
-preArr          :: Bounds -> Forest Vertex -> Table Int
-preArr bnds      = tabulate bnds . preorderF
-
-------------------------------------------------------------
--- Algorithm 2: topological sorting
-------------------------------------------------------------
-
-postorder :: Tree a -> [a]
-postorder (Node a ts) = postorderF ts ++ [a]
-
-postorderF   :: Forest a -> [a]
-postorderF ts = concat (map postorder ts)
-
-postOrd      :: Graph -> [Vertex]
-postOrd       = postorderF . dff
-
--- | A topological sort of the graph.
--- The order is partially specified by the condition that a vertex /i/
--- precedes /j/ whenever /j/ is reachable from /i/ but not vice versa.
-topSort      :: Graph -> [Vertex]
-topSort       = reverse . postOrd
-
-------------------------------------------------------------
--- Algorithm 3: connected components
-------------------------------------------------------------
-
--- | The connected components of a graph.
--- Two vertices are connected if there is a path between them, traversing
--- edges in either direction.
-components   :: Graph -> Forest Vertex
-components    = dff . undirected
-
-undirected   :: Graph -> Graph
-undirected g  = buildG (bounds g) (edges g ++ reverseE g)
-
--- Algorithm 4: strongly connected components
-
--- | The strongly connected components of a graph.
-scc  :: Graph -> Forest Vertex
-scc g = dfs g (reverse (postOrd (transposeG g)))
-
-------------------------------------------------------------
--- Algorithm 5: Classifying edges
-------------------------------------------------------------
-
-tree              :: Bounds -> Forest Vertex -> Graph
-tree bnds ts       = buildG bnds (concat (map flat ts))
- where flat (Node v ts) = [ (v, w) | Node w _us <- ts ] ++ concat (map flat ts)
-
-back              :: Graph -> Table Int -> Graph
-back g post        = mapT select g
- where select v ws = [ w | w <- ws, post!v < post!w ]
-
-cross             :: Graph -> Table Int -> Table Int -> Graph
-cross g pre post   = mapT select g
- where select v ws = [ w | w <- ws, post!v > post!w, pre!v > pre!w ]
-
-forward           :: Graph -> Graph -> Table Int -> Graph
-forward g tree pre = mapT select g
- where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree!v
-
-------------------------------------------------------------
--- Algorithm 6: Finding reachable vertices
-------------------------------------------------------------
-
--- | A list of vertices reachable from a given vertex.
-reachable    :: Graph -> Vertex -> [Vertex]
-reachable g v = preorderF (dfs g [v])
-
--- | Is the second vertex reachable from the first?
-path         :: Graph -> Vertex -> Vertex -> Bool
-path g v w    = w `elem` (reachable g v)
-
-------------------------------------------------------------
--- Algorithm 7: Biconnected components
-------------------------------------------------------------
-
--- | The biconnected components of a graph.
--- An undirected graph is biconnected if the deletion of any vertex
--- leaves it connected.
-bcc :: Graph -> Forest [Vertex]
-bcc g = (concat . map bicomps . map (do_label g dnum)) forest
- where forest = dff g
-       dnum   = preArr (bounds g) forest
-
-do_label :: Graph -> Table Int -> Tree Vertex -> Tree (Vertex,Int,Int)
-do_label g dnum (Node v ts) = Node (v,dnum!v,lv) us
- where us = map (do_label g dnum) ts
-       lv = minimum ([dnum!v] ++ [dnum!w | w <- g!v]
-                     ++ [lu | Node (u,du,lu) xs <- us])
-
-bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex]
-bicomps (Node (v,_,_) ts)
-      = [ Node (v:vs) us | (l,Node vs us) <- map collect ts]
-
-collect :: Tree (Vertex,Int,Int) -> (Int, Tree [Vertex])
-collect (Node (v,dv,lv) ts) = (lv, Node (v:vs) cs)
- where collected = map collect ts
-       vs = concat [ ws | (lw, Node ws us) <- collected, lw<dv]
-       cs = concat [ if lw<dv then us else [Node (v:ws) us]
-                        | (lw, Node ws us) <- collected ]
diff --git a/libraries/base/Data/IntMap.hs b/libraries/base/Data/IntMap.hs
deleted file mode 100644 (file)
index 9b897a3..0000000
+++ /dev/null
@@ -1,1549 +0,0 @@
-{-# OPTIONS -cpp -fglasgow-exts -fno-bang-patterns #-} 
------------------------------------------------------------------------------
--- |
--- Module      :  Data.IntMap
--- Copyright   :  (c) Daan Leijen 2002
--- License     :  BSD-style
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- An efficient implementation of maps from integer keys to values.
---
--- Since many function names (but not the type name) clash with
--- "Prelude" names, this module is usually imported @qualified@, e.g.
---
--- >  import Data.IntMap (IntMap)
--- >  import qualified Data.IntMap as IntMap
---
--- The implementation is based on /big-endian patricia trees/.  This data
--- structure performs especially well on binary operations like 'union'
--- and 'intersection'.  However, my benchmarks show that it is also
--- (much) faster on insertions and deletions when compared to a generic
--- size-balanced map implementation (see "Data.Map" and "Data.FiniteMap").
---
---    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",
---     Workshop on ML, September 1998, pages 77-86,
---     <http://www.cse.ogi.edu/~andy/pub/finite.htm>
---
---    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve
---     Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),
---     October 1968, pages 514-534.
---
--- Many operations have a worst-case complexity of /O(min(n,W))/.
--- This means that the operation can become linear in the number of
--- elements with a maximum of /W/ -- the number of bits in an 'Int'
--- (32 or 64).
------------------------------------------------------------------------------
-
-module Data.IntMap  ( 
-            -- * Map type
-              IntMap, Key          -- instance Eq,Show
-
-            -- * Operators
-            , (!), (\\)
-
-            -- * Query
-            , null
-            , size
-            , member
-            , notMember
-           , lookup
-            , findWithDefault
-            
-            -- * Construction
-            , empty
-            , singleton
-
-            -- ** Insertion
-            , insert
-            , insertWith, insertWithKey, insertLookupWithKey
-            
-            -- ** Delete\/Update
-            , delete
-            , adjust
-            , adjustWithKey
-            , update
-            , updateWithKey
-            , updateLookupWithKey
-            , alter
-  
-            -- * Combine
-
-            -- ** Union
-            , union         
-            , unionWith          
-            , unionWithKey
-            , unions
-            , unionsWith
-
-            -- ** Difference
-            , difference
-            , differenceWith
-            , differenceWithKey
-            
-            -- ** Intersection
-            , intersection           
-            , intersectionWith
-            , intersectionWithKey
-
-            -- * Traversal
-            -- ** Map
-            , map
-            , mapWithKey
-            , mapAccum
-            , mapAccumWithKey
-            
-            -- ** Fold
-            , fold
-            , foldWithKey
-
-            -- * Conversion
-            , elems
-            , keys
-           , keysSet
-            , assocs
-            
-            -- ** Lists
-            , toList
-            , fromList
-            , fromListWith
-            , fromListWithKey
-
-            -- ** Ordered lists
-            , toAscList
-            , fromAscList
-            , fromAscListWith
-            , fromAscListWithKey
-            , fromDistinctAscList
-
-            -- * Filter 
-            , filter
-            , filterWithKey
-            , partition
-            , partitionWithKey
-
-            , mapMaybe
-            , mapMaybeWithKey
-            , mapEither
-            , mapEitherWithKey
-
-            , split         
-            , splitLookup   
-
-            -- * Submap
-            , isSubmapOf, isSubmapOfBy
-            , isProperSubmapOf, isProperSubmapOfBy
-            
-            -- * Min\/Max
-
-            , maxView
-            , minView
-            , findMin   
-            , findMax
-            , deleteMin
-            , deleteMax
-            , deleteFindMin
-            , deleteFindMax
-            , updateMin
-            , updateMax
-            , updateMinWithKey
-            , updateMaxWithKey 
-            , minViewWithKey
-            , maxViewWithKey
-
-            -- * Debugging
-            , showTree
-            , showTreeWith
-            ) where
-
-
-import Prelude hiding (lookup,map,filter,foldr,foldl,null)
-import Data.Bits 
-import qualified Data.IntSet as IntSet
-import Data.Monoid (Monoid(..))
-import Data.Typeable
-import Data.Foldable (Foldable(foldMap))
-import Control.Monad ( liftM )
-import Control.Arrow (ArrowZero)
-{-
--- just for testing
-import qualified Prelude
-import Debug.QuickCheck 
-import List (nub,sort)
-import qualified List
--}  
-
-#if __GLASGOW_HASKELL__
-import Text.Read
-import Data.Generics.Basics (Data(..), mkNorepType)
-import Data.Generics.Instances ()
-#endif
-
-#if __GLASGOW_HASKELL__ >= 503
-import GHC.Exts ( Word(..), Int(..), shiftRL# )
-#elif __GLASGOW_HASKELL__
-import Word
-import GlaExts ( Word(..), Int(..), shiftRL# )
-#else
-import Data.Word
-#endif
-
-infixl 9 \\{-This comment teaches CPP correct behaviour -}
-
--- A "Nat" is a natural machine word (an unsigned Int)
-type Nat = Word
-
-natFromInt :: Key -> Nat
-natFromInt i = fromIntegral i
-
-intFromNat :: Nat -> Key
-intFromNat w = fromIntegral w
-
-shiftRL :: Nat -> Key -> Nat
-#if __GLASGOW_HASKELL__
-{--------------------------------------------------------------------
-  GHC: use unboxing to get @shiftRL@ inlined.
---------------------------------------------------------------------}
-shiftRL (W# x) (I# i)
-  = W# (shiftRL# x i)
-#else
-shiftRL x i   = shiftR x i
-#endif
-
-{--------------------------------------------------------------------
-  Operators
---------------------------------------------------------------------}
-
--- | /O(min(n,W))/. Find the value at a key.
--- Calls 'error' when the element can not be found.
-
-(!) :: IntMap a -> Key -> a
-m ! k    = find' k m
-
--- | /O(n+m)/. See 'difference'.
-(\\) :: IntMap a -> IntMap b -> IntMap a
-m1 \\ m2 = difference m1 m2
-
-{--------------------------------------------------------------------
-  Types  
---------------------------------------------------------------------}
--- | A map of integers to values @a@.
-data IntMap a = Nil
-              | Tip {-# UNPACK #-} !Key a
-              | Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(IntMap a) !(IntMap a) 
-
-type Prefix = Int
-type Mask   = Int
-type Key    = Int
-
-instance Monoid (IntMap a) where
-    mempty  = empty
-    mappend = union
-    mconcat = unions
-
-instance Foldable IntMap where
-    foldMap f Nil = mempty
-    foldMap f (Tip _k v) = f v
-    foldMap f (Bin _ _ l r) = foldMap f l `mappend` foldMap 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 Data a => Data (IntMap a) where
-  gfoldl f z im = z fromList `f` (toList im)
-  toConstr _    = error "toConstr"
-  gunfold _ _   = error "gunfold"
-  dataTypeOf _  = mkNorepType "Data.IntMap.IntMap"
-  dataCast1 f   = gcast1 f
-
-#endif
-
-{--------------------------------------------------------------------
-  Query
---------------------------------------------------------------------}
--- | /O(1)/. Is the map empty?
-null :: IntMap a -> Bool
-null Nil   = True
-null other = False
-
--- | /O(n)/. Number of elements in the map.
-size :: IntMap a -> Int
-size t
-  = case t of
-      Bin p m l r -> size l + size r
-      Tip k x -> 1
-      Nil     -> 0
-
--- | /O(min(n,W))/. Is the key a member of the map?
-member :: Key -> IntMap a -> Bool
-member k m
-  = case lookup k m of
-      Nothing -> False
-      Just x  -> True
-    
--- | /O(log n)/. Is the key not a member of the map?
-notMember :: Key -> IntMap a -> Bool
-notMember k m = not $ member k m
-
--- | /O(min(n,W))/. Lookup the value at a key in the map.
-lookup :: (Monad m) => Key -> IntMap a -> m a
-lookup k t = case lookup' k t of
-    Just x -> return x
-    Nothing -> fail "Data.IntMap.lookup: Key not found"
-
-lookup' :: Key -> IntMap a -> Maybe a
-lookup' k t
-  = let nk = natFromInt k  in seq nk (lookupN nk t)
-
-lookupN :: Nat -> IntMap a -> Maybe a
-lookupN k t
-  = case t of
-      Bin p m l r 
-        | zeroN k (natFromInt m) -> lookupN k l
-        | otherwise              -> lookupN k r
-      Tip kx x 
-        | (k == natFromInt kx)  -> Just x
-        | otherwise             -> Nothing
-      Nil -> Nothing
-
-find' :: Key -> IntMap a -> a
-find' k m
-  = case lookup k m of
-      Nothing -> error ("IntMap.find: key " ++ show k ++ " is not an element of the map")
-      Just x  -> x
-
-
--- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@
--- returns the value at key @k@ or returns @def@ when the key is not an
--- element of the map.
-findWithDefault :: a -> Key -> IntMap a -> a
-findWithDefault def k m
-  = case lookup k m of
-      Nothing -> def
-      Just x  -> x
-
-{--------------------------------------------------------------------
-  Construction
---------------------------------------------------------------------}
--- | /O(1)/. The empty map.
-empty :: IntMap a
-empty
-  = Nil
-
--- | /O(1)/. A map of one element.
-singleton :: Key -> a -> IntMap a
-singleton k x
-  = Tip k x
-
-{--------------------------------------------------------------------
-  Insert
---------------------------------------------------------------------}
--- | /O(min(n,W))/. Insert a new key\/value pair in the map.
--- If the key is already present in the map, the associated value is
--- replaced with the supplied value, i.e. 'insert' is equivalent to
--- @'insertWith' 'const'@.
-insert :: Key -> a -> IntMap a -> IntMap a
-insert k x t
-  = case t of
-      Bin p m l r 
-        | nomatch k p m -> join k (Tip k x) p t
-        | zero k m      -> Bin p m (insert k x l) r
-        | otherwise     -> Bin p m l (insert k x r)
-      Tip ky y 
-        | k==ky         -> Tip k x
-        | otherwise     -> join k (Tip k x) ky t
-      Nil -> Tip k x
-
--- right-biased insertion, used by 'union'
--- | /O(min(n,W))/. Insert with a combining function.
--- @'insertWith' f key value mp@ 
--- will insert the pair (key, value) into @mp@ if key does
--- not exist in the map. If the key does exist, the function will
--- insert @f new_value old_value@.
-insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
-insertWith f k x t
-  = insertWithKey (\k x y -> f x y) k x t
-
--- | /O(min(n,W))/. Insert with a combining function.
--- @'insertWithKey' f key value mp@ 
--- will insert the pair (key, value) into @mp@ if key does
--- not exist in the map. If the key does exist, the function will
--- insert @f key new_value old_value@.
-insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
-insertWithKey f k x t
-  = case t of
-      Bin p m l r 
-        | nomatch k p m -> join k (Tip k x) p t
-        | zero k m      -> Bin p m (insertWithKey f k x l) r
-        | otherwise     -> Bin p m l (insertWithKey f k x r)
-      Tip ky y 
-        | k==ky         -> Tip k (f k x y)
-        | otherwise     -> join k (Tip k x) ky t
-      Nil -> Tip k x
-
-
--- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
--- is a pair where the first element is equal to (@'lookup' k map@)
--- and the second element equal to (@'insertWithKey' f k x map@).
-insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
-insertLookupWithKey f k x t
-  = case t of
-      Bin p m l r 
-        | nomatch k p m -> (Nothing,join k (Tip k x) p t)
-        | zero k m      -> let (found,l') = insertLookupWithKey f k x l in (found,Bin p m l' r)
-        | otherwise     -> let (found,r') = insertLookupWithKey f k x r in (found,Bin p m l r')
-      Tip ky y 
-        | k==ky         -> (Just y,Tip k (f k x y))
-        | otherwise     -> (Nothing,join k (Tip k x) ky t)
-      Nil -> (Nothing,Tip k x)
-
-
-{--------------------------------------------------------------------
-  Deletion
-  [delete] is the inlined version of [deleteWith (\k x -> Nothing)]
---------------------------------------------------------------------}
--- | /O(min(n,W))/. Delete a key and its value from the map. When the key is not
--- a member of the map, the original map is returned.
-delete :: Key -> IntMap a -> IntMap a
-delete k t
-  = case t of
-      Bin p m l r 
-        | nomatch k p m -> t
-        | zero k m      -> bin p m (delete k l) r
-        | otherwise     -> bin p m l (delete k r)
-      Tip ky y 
-        | k==ky         -> Nil
-        | otherwise     -> t
-      Nil -> Nil
-
--- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
--- a member of the map, the original map is returned.
-adjust ::  (a -> a) -> Key -> IntMap a -> IntMap a
-adjust f k m
-  = adjustWithKey (\k x -> f x) k m
-
--- | /O(min(n,W))/. Adjust a value at a specific key. When the key is not
--- a member of the map, the original map is returned.
-adjustWithKey ::  (Key -> a -> a) -> Key -> IntMap a -> IntMap a
-adjustWithKey f k m
-  = updateWithKey (\k x -> Just (f k x)) k m
-
--- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
--- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
--- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
-update ::  (a -> Maybe a) -> Key -> IntMap a -> IntMap a
-update f k m
-  = updateWithKey (\k x -> f x) k m
-
--- | /O(min(n,W))/. The expression (@'update' f k map@) updates the value @x@
--- at @k@ (if it is in the map). If (@f k x@) is 'Nothing', the element is
--- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
-updateWithKey ::  (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
-updateWithKey f k t
-  = case t of
-      Bin p m l r 
-        | nomatch k p m -> t
-        | zero k m      -> bin p m (updateWithKey f k l) r
-        | otherwise     -> bin p m l (updateWithKey f k r)
-      Tip ky y 
-        | k==ky         -> case (f k y) of
-                             Just y' -> Tip ky y'
-                             Nothing -> Nil
-        | otherwise     -> t
-      Nil -> Nil
-
--- | /O(min(n,W))/. Lookup and update.
-updateLookupWithKey ::  (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
-updateLookupWithKey f k t
-  = case t of
-      Bin p m l r 
-        | nomatch k p m -> (Nothing,t)
-        | zero k m      -> let (found,l') = updateLookupWithKey f k l in (found,bin p m l' r)
-        | otherwise     -> let (found,r') = updateLookupWithKey f k r in (found,bin p m l r')
-      Tip ky y 
-        | k==ky         -> case (f k y) of
-                             Just y' -> (Just y,Tip ky y')
-                             Nothing -> (Just y,Nil)
-        | otherwise     -> (Nothing,t)
-      Nil -> (Nothing,Nil)
-
-
-
--- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
--- 'alter' can be used to insert, delete, or update a value in a 'Map'.
--- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@
-alter f k t
-  = case t of
-      Bin p m l r 
-        | nomatch k p m -> case f Nothing of 
-                             Nothing -> t
-                             Just x -> join k (Tip k x) p t
-        | zero k m      -> bin p m (alter f k l) r
-        | otherwise     -> bin p m l (alter f k r)
-      Tip ky y          
-        | k==ky         -> case f (Just y) of
-                             Just x -> Tip ky x
-                             Nothing -> Nil
-        | otherwise     -> case f Nothing of
-                             Just x -> join k (Tip k x) ky t
-                             Nothing -> Tip ky y
-      Nil               -> case f Nothing of
-                             Just x -> Tip k x
-                             Nothing -> Nil
-
-
-{--------------------------------------------------------------------
-  Union
---------------------------------------------------------------------}
--- | The union of a list of maps.
-unions :: [IntMap a] -> IntMap a
-unions xs
-  = foldlStrict union empty xs
-
--- | The union of a list of maps, with a combining operation
-unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a
-unionsWith f ts
-  = foldlStrict (unionWith f) empty ts
-
--- | /O(n+m)/. The (left-biased) union of two maps. 
--- It prefers the first map when duplicate keys are encountered,
--- i.e. (@'union' == 'unionWith' 'const'@).
-union :: IntMap a -> IntMap a -> IntMap a
-union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = union1
-  | shorter m2 m1  = union2
-  | p1 == p2       = Bin p1 m1 (union l1 l2) (union r1 r2)
-  | otherwise      = join p1 t1 p2 t2
-  where
-    union1  | nomatch p2 p1 m1  = join p1 t1 p2 t2
-            | zero p2 m1        = Bin p1 m1 (union l1 t2) r1
-            | otherwise         = Bin p1 m1 l1 (union r1 t2)
-
-    union2  | nomatch p1 p2 m2  = join p1 t1 p2 t2
-            | zero p1 m2        = Bin p2 m2 (union t1 l2) r2
-            | otherwise         = Bin p2 m2 l2 (union t1 r2)
-
-union (Tip k x) t = insert k x t
-union t (Tip k x) = insertWith (\x y -> y) k x t  -- right bias
-union Nil t       = t
-union t Nil       = t
-
--- | /O(n+m)/. The union with a combining function. 
-unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
-unionWith f m1 m2
-  = unionWithKey (\k x y -> f x y) m1 m2
-
--- | /O(n+m)/. The union with a combining function. 
-unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
-unionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = union1
-  | shorter m2 m1  = union2
-  | p1 == p2       = Bin p1 m1 (unionWithKey f l1 l2) (unionWithKey f r1 r2)
-  | otherwise      = join p1 t1 p2 t2
-  where
-    union1  | nomatch p2 p1 m1  = join p1 t1 p2 t2
-            | zero p2 m1        = Bin p1 m1 (unionWithKey f l1 t2) r1
-            | otherwise         = Bin p1 m1 l1 (unionWithKey f r1 t2)
-
-    union2  | nomatch p1 p2 m2  = join p1 t1 p2 t2
-            | zero p1 m2        = Bin p2 m2 (unionWithKey f t1 l2) r2
-            | otherwise         = Bin p2 m2 l2 (unionWithKey f t1 r2)
-
-unionWithKey f (Tip k x) t = insertWithKey f k x t
-unionWithKey f t (Tip k x) = insertWithKey (\k x y -> f k y x) k x t  -- right bias
-unionWithKey f Nil t  = t
-unionWithKey f t Nil  = t
-
-{--------------------------------------------------------------------
-  Difference
---------------------------------------------------------------------}
--- | /O(n+m)/. Difference between two maps (based on keys). 
-difference :: IntMap a -> IntMap b -> IntMap a
-difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = difference1
-  | shorter m2 m1  = difference2
-  | p1 == p2       = bin p1 m1 (difference l1 l2) (difference r1 r2)
-  | otherwise      = t1
-  where
-    difference1 | nomatch p2 p1 m1  = t1
-                | zero p2 m1        = bin p1 m1 (difference l1 t2) r1
-                | otherwise         = bin p1 m1 l1 (difference r1 t2)
-
-    difference2 | nomatch p1 p2 m2  = t1
-                | zero p1 m2        = difference t1 l2
-                | otherwise         = difference t1 r2
-
-difference t1@(Tip k x) t2 
-  | member k t2  = Nil
-  | otherwise    = t1
-
-difference Nil t       = Nil
-difference t (Tip k x) = delete k t
-difference t Nil       = t
-
--- | /O(n+m)/. Difference with a combining function. 
-differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
-differenceWith f m1 m2
-  = differenceWithKey (\k x y -> f x y) m1 m2
-
--- | /O(n+m)/. Difference with a combining function. When two equal keys are
--- encountered, the combining function is applied to the key and both values.
--- If it returns 'Nothing', the element is discarded (proper set difference).
--- If it returns (@'Just' y@), the element is updated with a new value @y@. 
-differenceWithKey :: (Key -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
-differenceWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = difference1
-  | shorter m2 m1  = difference2
-  | p1 == p2       = bin p1 m1 (differenceWithKey f l1 l2) (differenceWithKey f r1 r2)
-  | otherwise      = t1
-  where
-    difference1 | nomatch p2 p1 m1  = t1
-                | zero p2 m1        = bin p1 m1 (differenceWithKey f l1 t2) r1
-                | otherwise         = bin p1 m1 l1 (differenceWithKey f r1 t2)
-
-    difference2 | nomatch p1 p2 m2  = t1
-                | zero p1 m2        = differenceWithKey f t1 l2
-                | otherwise         = differenceWithKey f t1 r2
-
-differenceWithKey f t1@(Tip k x) t2 
-  = case lookup k t2 of
-      Just y  -> case f k x y of
-                   Just y' -> Tip k y'
-                   Nothing -> Nil
-      Nothing -> t1
-
-differenceWithKey f Nil t       = Nil
-differenceWithKey f t (Tip k y) = updateWithKey (\k x -> f k x y) k t
-differenceWithKey f t Nil       = t
-
-
-{--------------------------------------------------------------------
-  Intersection
---------------------------------------------------------------------}
--- | /O(n+m)/. The (left-biased) intersection of two maps (based on keys). 
-intersection :: IntMap a -> IntMap b -> IntMap a
-intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = intersection1
-  | shorter m2 m1  = intersection2
-  | p1 == p2       = bin p1 m1 (intersection l1 l2) (intersection r1 r2)
-  | otherwise      = Nil
-  where
-    intersection1 | nomatch p2 p1 m1  = Nil
-                  | zero p2 m1        = intersection l1 t2
-                  | otherwise         = intersection r1 t2
-
-    intersection2 | nomatch p1 p2 m2  = Nil
-                  | zero p1 m2        = intersection t1 l2
-                  | otherwise         = intersection t1 r2
-
-intersection t1@(Tip k x) t2 
-  | member k t2  = t1
-  | otherwise    = Nil
-intersection t (Tip k x) 
-  = case lookup k t of
-      Just y  -> Tip k y
-      Nothing -> Nil
-intersection Nil t = Nil
-intersection t Nil = Nil
-
--- | /O(n+m)/. The intersection with a combining function. 
-intersectionWith :: (a -> b -> a) -> IntMap a -> IntMap b -> IntMap a
-intersectionWith f m1 m2
-  = intersectionWithKey (\k x y -> f x y) m1 m2
-
--- | /O(n+m)/. The intersection with a combining function. 
-intersectionWithKey :: (Key -> a -> b -> a) -> IntMap a -> IntMap b -> IntMap a
-intersectionWithKey f t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = intersection1
-  | shorter m2 m1  = intersection2
-  | p1 == p2       = bin p1 m1 (intersectionWithKey f l1 l2) (intersectionWithKey f r1 r2)
-  | otherwise      = Nil
-  where
-    intersection1 | nomatch p2 p1 m1  = Nil
-                  | zero p2 m1        = intersectionWithKey f l1 t2
-                  | otherwise         = intersectionWithKey f r1 t2
-
-    intersection2 | nomatch p1 p2 m2  = Nil
-                  | zero p1 m2        = intersectionWithKey f t1 l2
-                  | otherwise         = intersectionWithKey f t1 r2
-
-intersectionWithKey f t1@(Tip k x) t2 
-  = case lookup k t2 of
-      Just y  -> Tip k (f k x y)
-      Nothing -> Nil
-intersectionWithKey f t1 (Tip k y) 
-  = case lookup k t1 of
-      Just x  -> Tip k (f k x y)
-      Nothing -> Nil
-intersectionWithKey f Nil t = Nil
-intersectionWithKey f t Nil = Nil
-
-
-{--------------------------------------------------------------------
-  Min\/Max
---------------------------------------------------------------------}
-
--- | /O(log n)/. Update the value at the minimal key.
-updateMinWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
-updateMinWithKey f t
-    = case t of
-        Bin p m l r | m < 0 -> let t' = updateMinWithKeyUnsigned f l in Bin p m t' r
-        Bin p m l r         -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
-        Tip k y -> Tip k (f k y)
-        Nil -> error "maxView: empty map has no maximal element"
-
-updateMinWithKeyUnsigned f t
-    = case t of
-        Bin p m l r -> let t' = updateMinWithKeyUnsigned f r in Bin p m l t'
-        Tip k y -> Tip k (f k y)
-
--- | /O(log n)/. Update the value at the maximal key.
-updateMaxWithKey :: (Key -> a -> a) -> IntMap a -> IntMap a
-updateMaxWithKey f t
-    = case t of
-        Bin p m l r | m < 0 -> let t' = updateMaxWithKeyUnsigned f r in Bin p m r t'
-        Bin p m l r         -> let t' = updateMaxWithKeyUnsigned f l in Bin p m t' l
-        Tip k y -> Tip k (f k y)
-        Nil -> error "maxView: empty map has no maximal element"
-
-updateMaxWithKeyUnsigned f t
-    = case t of
-        Bin p m l r -> let t' = updateMaxWithKeyUnsigned f r in Bin p m l t'
-        Tip k y -> Tip k (f k y)
-
-
--- | /O(log n)/. Retrieves the maximal (key,value) couple of the map, and the map stripped from that element.
--- @fail@s (in the monad) when passed an empty map.
-maxViewWithKey :: (Monad m) => IntMap a -> m ((Key, a), IntMap a)
-maxViewWithKey t
-    = case t of
-        Bin p m l r | m < 0 -> let (result, t') = maxViewUnsigned l in return (result, bin p m t' r)
-        Bin p m l r         -> let (result, t') = maxViewUnsigned r in return (result, bin p m l t')
-        Tip k y -> return ((k,y), Nil)
-        Nil -> fail "maxView: empty map has no maximal element"
-
-maxViewUnsigned t 
-    = case t of
-        Bin p m l r -> let (result,t') = maxViewUnsigned r in (result,bin p m l t')
-        Tip k y -> ((k,y), Nil)
-
--- | /O(log n)/. Retrieves the minimal (key,value) couple of the map, and the map stripped from that element.
--- @fail@s (in the monad) when passed an empty map.
-minViewWithKey :: (Monad m) => IntMap a -> m ((Key, a), IntMap a)
-minViewWithKey t
-    = case t of
-        Bin p m l r | m < 0 -> let (result, t') = minViewUnsigned r in return (result, bin p m l t')
-        Bin p m l r         -> let (result, t') = minViewUnsigned l in return (result, bin p m t' r)
-        Tip k y -> return ((k,y),Nil)
-        Nil -> fail "minView: empty map has no minimal element"
-
-minViewUnsigned t 
-    = case t of
-        Bin p m l r -> let (result,t') = minViewUnsigned l in (result,bin p m t' r)
-        Tip k y -> ((k,y),Nil)
-
-
--- | /O(log n)/. Update the value at the maximal key.
-updateMax :: (a -> a) -> IntMap a -> IntMap a
-updateMax f = updateMaxWithKey (const f)
-
--- | /O(log n)/. Update the value at the minimal key.
-updateMin :: (a -> a) -> IntMap a -> IntMap a
-updateMin f = updateMinWithKey (const f)
-
-
--- Duplicate the Identity monad here because base < mtl.
-newtype Identity a = Identity { runIdentity :: a }
-instance Monad Identity where
-       return a = Identity a
-       m >>= k  = k (runIdentity m)
--- Similar to the Arrow instance.
-first f (x,y) = (f x,y)
-
-
--- | /O(log n)/. Retrieves the maximal key of the map, and the map stripped from that element.
--- @fail@s (in the monad) when passed an empty map.
-maxView t = liftM (first snd) (maxViewWithKey t)
-
--- | /O(log n)/. Retrieves the minimal key of the map, and the map stripped from that element.
--- @fail@s (in the monad) when passed an empty map.
-minView t = liftM (first snd) (minViewWithKey t)
-
--- | /O(log n)/. Delete and find the maximal element.
-deleteFindMax = runIdentity . maxView
-
--- | /O(log n)/. Delete and find the minimal element.
-deleteFindMin = runIdentity . minView
-
--- | /O(log n)/. The minimal key of the map.
-findMin = fst . runIdentity . minView
-
--- | /O(log n)/. The maximal key of the map.
-findMax = fst . runIdentity . maxView
-
--- | /O(log n)/. Delete the minimal key.
-deleteMin = snd . runIdentity . minView
-
--- | /O(log n)/. Delete the maximal key.
-deleteMax = snd . runIdentity . maxView
-
-
-{--------------------------------------------------------------------
-  Submap
---------------------------------------------------------------------}
--- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). 
--- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
-isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
-isProperSubmapOf m1 m2
-  = isProperSubmapOfBy (==) m1 m2
-
-{- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
- The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
- @m1@ and @m2@ are not equal,
- all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
- applied to their respective values. For example, the following 
- expressions are all 'True':
-  > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
-  > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
-
- But the following are all 'False':
-  > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
-  > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
-  > isProperSubmapOfBy (<)  (fromList [(1,1)])       (fromList [(1,1),(2,2)])
--}
-isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
-isProperSubmapOfBy pred t1 t2
-  = case submapCmp pred t1 t2 of 
-      LT -> True
-      ge -> False
-
-submapCmp pred t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = GT
-  | shorter m2 m1  = submapCmpLt
-  | p1 == p2       = submapCmpEq
-  | otherwise      = GT  -- disjoint
-  where
-    submapCmpLt | nomatch p1 p2 m2  = GT
-                | zero p1 m2        = submapCmp pred t1 l2
-                | otherwise         = submapCmp pred t1 r2
-    submapCmpEq = case (submapCmp pred l1 l2, submapCmp pred r1 r2) of
-                    (GT,_ ) -> GT
-                    (_ ,GT) -> GT
-                    (EQ,EQ) -> EQ
-                    other   -> LT
-
-submapCmp pred (Bin p m l r) t  = GT
-submapCmp pred (Tip kx x) (Tip ky y)  
-  | (kx == ky) && pred x y = EQ
-  | otherwise              = GT  -- disjoint
-submapCmp pred (Tip k x) t      
-  = case lookup k t of
-     Just y  | pred x y -> LT
-     other   -> GT -- disjoint
-submapCmp pred Nil Nil = EQ
-submapCmp pred Nil t   = LT
-
--- | /O(n+m)/. Is this a submap?
--- Defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
-isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
-isSubmapOf m1 m2
-  = isSubmapOfBy (==) m1 m2
-
-{- | /O(n+m)/. 
- The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if
- all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
- applied to their respective values. For example, the following 
- expressions are all 'True':
-  > isSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
-  > isSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
-  > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
-
- But the following are all 'False':
-  > isSubmapOfBy (==) (fromList [(1,2)]) (fromList [(1,1),(2,2)])
-  > isSubmapOfBy (<) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
-  > isSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
--}
-
-isSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
-isSubmapOfBy pred t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = False
-  | shorter m2 m1  = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy pred t1 l2
-                                                      else isSubmapOfBy pred t1 r2)                     
-  | otherwise      = (p1==p2) && isSubmapOfBy pred l1 l2 && isSubmapOfBy pred r1 r2
-isSubmapOfBy pred (Bin p m l r) t  = False
-isSubmapOfBy pred (Tip k x) t      = case lookup k t of
-                                   Just y  -> pred x y
-                                   Nothing -> False 
-isSubmapOfBy pred Nil t            = True
-
-{--------------------------------------------------------------------
-  Mapping
---------------------------------------------------------------------}
--- | /O(n)/. Map a function over all values in the map.
-map :: (a -> b) -> IntMap a -> IntMap b
-map f m
-  = mapWithKey (\k x -> f x) m
-
--- | /O(n)/. Map a function over all values in the map.
-mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
-mapWithKey f t  
-  = case t of
-      Bin p m l r -> Bin p m (mapWithKey f l) (mapWithKey f r)
-      Tip k x     -> Tip k (f k x)
-      Nil         -> Nil
-
--- | /O(n)/. The function @'mapAccum'@ threads an accumulating
--- argument through the map in ascending order of keys.
-mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
-mapAccum f a m
-  = mapAccumWithKey (\a k x -> f a x) a m
-
--- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating
--- argument through the map in ascending order of keys.
-mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
-mapAccumWithKey f a t
-  = mapAccumL f a t
-
--- | /O(n)/. The function @'mapAccumL'@ threads an accumulating
--- argument through the map in ascending order of keys.
-mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
-mapAccumL f a t
-  = case t of
-      Bin p m l r -> let (a1,l') = mapAccumL f a l
-                         (a2,r') = mapAccumL f a1 r
-                     in (a2,Bin p m l' r')
-      Tip k x     -> let (a',x') = f a k x in (a',Tip k x')
-      Nil         -> (a,Nil)
-
-
--- | /O(n)/. The function @'mapAccumR'@ threads an accumulating
--- argument throught the map in descending order of keys.
-mapAccumR :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
-mapAccumR f a t
-  = case t of
-      Bin p m l r -> let (a1,r') = mapAccumR f a r
-                         (a2,l') = mapAccumR f a1 l
-                     in (a2,Bin p m l' r')
-      Tip k x     -> let (a',x') = f a k x in (a',Tip k x')
-      Nil         -> (a,Nil)
-
-{--------------------------------------------------------------------
-  Filter
---------------------------------------------------------------------}
--- | /O(n)/. Filter all values that satisfy some predicate.
-filter :: (a -> Bool) -> IntMap a -> IntMap a
-filter p m
-  = filterWithKey (\k x -> p x) m
-
--- | /O(n)/. Filter all keys\/values that satisfy some predicate.
-filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a
-filterWithKey pred t
-  = case t of
-      Bin p m l r 
-        -> bin p m (filterWithKey pred l) (filterWithKey pred r)
-      Tip k x 
-        | pred k x  -> t
-        | otherwise -> Nil
-      Nil -> Nil
-
--- | /O(n)/. partition the map according to some predicate. The first
--- map contains all elements that satisfy the predicate, the second all
--- elements that fail the predicate. See also 'split'.
-partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
-partition p m
-  = partitionWithKey (\k x -> p x) m
-
--- | /O(n)/. partition the map according to some predicate. The first
--- map contains all elements that satisfy the predicate, the second all
--- elements that fail the predicate. See also 'split'.
-partitionWithKey :: (Key -> a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
-partitionWithKey pred t
-  = case t of
-      Bin p m l r 
-        -> let (l1,l2) = partitionWithKey pred l
-               (r1,r2) = partitionWithKey pred r
-           in (bin p m l1 r1, bin p m l2 r2)
-      Tip k x 
-        | pred k x  -> (t,Nil)
-        | otherwise -> (Nil,t)
-      Nil -> (Nil,Nil)
-
--- | /O(n)/. Map values and collect the 'Just' results.
-mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
-mapMaybe f m
-  = mapMaybeWithKey (\k x -> f x) m
-
--- | /O(n)/. Map keys\/values and collect the 'Just' results.
-mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b
-mapMaybeWithKey f (Bin p m l r)
-  = bin p m (mapMaybeWithKey f l) (mapMaybeWithKey f r)
-mapMaybeWithKey f (Tip k x) = case f k x of
-  Just y  -> Tip k y
-  Nothing -> Nil
-mapMaybeWithKey f Nil = Nil
-
--- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
-mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
-mapEither f m
-  = mapEitherWithKey (\k x -> f x) m
-
--- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
-mapEitherWithKey :: (Key -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
-mapEitherWithKey f (Bin p m l r)
-  = (bin p m l1 r1, bin p m l2 r2)
-  where
-    (l1,l2) = mapEitherWithKey f l
-    (r1,r2) = mapEitherWithKey f r
-mapEitherWithKey f (Tip k x) = case f k x of
-  Left y  -> (Tip k y, Nil)
-  Right z -> (Nil, Tip k z)
-mapEitherWithKey f Nil = (Nil, Nil)
-
--- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@
--- where all keys in @map1@ are lower than @k@ and all keys in
--- @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.
-split :: Key -> IntMap a -> (IntMap a,IntMap a)
-split k t
-  = case t of
-      Bin p m l r 
-          | m < 0 -> (if k >= 0 -- handle negative numbers.
-                      then let (lt,gt) = split' k l in (union r lt, gt)
-                      else let (lt,gt) = split' k r in (lt, union gt l))
-          | otherwise   -> split' k t
-      Tip ky y 
-        | k>ky      -> (t,Nil)
-        | k<ky      -> (Nil,t)
-        | otherwise -> (Nil,Nil)
-      Nil -> (Nil,Nil)
-
-split' :: Key -> IntMap a -> (IntMap a,IntMap a)
-split' k t
-  = case t of
-      Bin p m l r
-        | nomatch k p m -> if k>p then (t,Nil) else (Nil,t)
-        | zero k m  -> let (lt,gt) = split k l in (lt,union gt r)
-        | otherwise -> let (lt,gt) = split k r in (union l lt,gt)
-      Tip ky y 
-        | k>ky      -> (t,Nil)
-        | k<ky      -> (Nil,t)
-        | otherwise -> (Nil,Nil)
-      Nil -> (Nil,Nil)
-
--- | /O(log n)/. Performs a 'split' but also returns whether the pivot
--- key was found in the original map.
-splitLookup :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
-splitLookup k t
-  = case t of
-      Bin p m l r
-          | m < 0 -> (if k >= 0 -- handle negative numbers.
-                      then let (lt,found,gt) = splitLookup' k l in (union r lt,found, gt)
-                      else let (lt,found,gt) = splitLookup' k r in (lt,found, union gt l))
-          | otherwise   -> splitLookup' k t
-      Tip ky y 
-        | k>ky      -> (t,Nothing,Nil)
-        | k<ky      -> (Nil,Nothing,t)
-        | otherwise -> (Nil,Just y,Nil)
-      Nil -> (Nil,Nothing,Nil)
-
-splitLookup' :: Key -> IntMap a -> (IntMap a,Maybe a,IntMap a)
-splitLookup' k t
-  = case t of
-      Bin p m l r
-        | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t)
-        | zero k m  -> let (lt,found,gt) = splitLookup k l in (lt,found,union gt r)
-        | otherwise -> let (lt,found,gt) = splitLookup k r in (union l lt,found,gt)
-      Tip ky y 
-        | k>ky      -> (t,Nothing,Nil)
-        | k<ky      -> (Nil,Nothing,t)
-        | otherwise -> (Nil,Just y,Nil)
-      Nil -> (Nil,Nothing,Nil)
-
-{--------------------------------------------------------------------
-  Fold
---------------------------------------------------------------------}
--- | /O(n)/. Fold the values in the map, such that
--- @'fold' f z == 'Prelude.foldr' f z . 'elems'@.
--- For example,
---
--- > elems map = fold (:) [] map
---
-fold :: (a -> b -> b) -> b -> IntMap a -> b
-fold f z t
-  = foldWithKey (\k x y -> f x y) z t
-
--- | /O(n)/. Fold the keys and values in the map, such that
--- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
--- For example,
---
--- > keys map = foldWithKey (\k x ks -> k:ks) [] map
---
-foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
-foldWithKey f z t
-  = foldr f z t
-
-foldr :: (Key -> a -> b -> b) -> b -> IntMap a -> b
-foldr f z t
-  = case t of
-      Bin 0 m l r | m < 0 -> foldr' f (foldr' f z l) r  -- put negative numbers before.
-      Bin _ _ _ _ -> foldr' f z t
-      Tip k x     -> f k x z
-      Nil         -> z
-
-foldr' :: (Key -> a -> b -> b) -> b -> IntMap a -> b
-foldr' f z t
-  = case t of
-      Bin p m l r -> foldr' f (foldr' f z r) l
-      Tip k x     -> f k x z
-      Nil         -> z
-
-
-
-{--------------------------------------------------------------------
-  List variations 
---------------------------------------------------------------------}
--- | /O(n)/.
--- Return all elements of the map in the ascending order of their keys.
-elems :: IntMap a -> [a]
-elems m
-  = foldWithKey (\k x xs -> x:xs) [] m  
-
--- | /O(n)/. Return all keys of the map in ascending order.
-keys  :: IntMap a -> [Key]
-keys m
-  = foldWithKey (\k x ks -> k:ks) [] m
-
--- | /O(n*min(n,W))/. The set of all keys of the map.
-keysSet :: IntMap a -> IntSet.IntSet
-keysSet m = IntSet.fromDistinctAscList (keys m)
-
-
--- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
-assocs :: IntMap a -> [(Key,a)]
-assocs m
-  = toList m
-
-
-{--------------------------------------------------------------------
-  Lists 
---------------------------------------------------------------------}
--- | /O(n)/. Convert the map to a list of key\/value pairs.
-toList :: IntMap a -> [(Key,a)]
-toList t
-  = foldWithKey (\k x xs -> (k,x):xs) [] t
-
--- | /O(n)/. Convert the map to a list of key\/value pairs where the
--- keys are in ascending order.
-toAscList :: IntMap a -> [(Key,a)]
-toAscList t   
-  = -- NOTE: the following algorithm only works for big-endian trees
-    let (pos,neg) = span (\(k,x) -> k >=0) (foldr (\k x xs -> (k,x):xs) [] t) in neg ++ pos
-
--- | /O(n*min(n,W))/. Create a map from a list of key\/value pairs.
-fromList :: [(Key,a)] -> IntMap a
-fromList xs
-  = foldlStrict ins empty xs
-  where
-    ins t (k,x)  = insert k x t
-
--- | /O(n*min(n,W))/.  Create a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
-fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a 
-fromListWith f xs
-  = fromListWithKey (\k x y -> f x y) xs
-
--- | /O(n*min(n,W))/.  Build a map from a list of key\/value pairs with a combining function. See also fromAscListWithKey'.
-fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a 
-fromListWithKey f xs 
-  = foldlStrict ins empty xs
-  where
-    ins t (k,x) = insertWithKey f k x t
-
--- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
--- the keys are in ascending order.
-fromAscList :: [(Key,a)] -> IntMap a
-fromAscList xs
-  = fromList xs
-
--- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
--- the keys are in ascending order, with a combining function on equal keys.
-fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
-fromAscListWith f xs
-  = fromListWith f xs
-
--- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
--- the keys are in ascending order, with a combining function on equal keys.
-fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
-fromAscListWithKey f xs
-  = fromListWithKey f xs
-
--- | /O(n*min(n,W))/. Build a map from a list of key\/value pairs where
--- the keys are in ascending order and all distinct.
-fromDistinctAscList :: [(Key,a)] -> IntMap a
-fromDistinctAscList xs
-  = fromList xs
-
-
-{--------------------------------------------------------------------
-  Eq 
---------------------------------------------------------------------}
-instance Eq a => Eq (IntMap a) where
-  t1 == t2  = equal t1 t2
-  t1 /= t2  = nequal t1 t2
-
-equal :: Eq a => IntMap a -> IntMap a -> Bool
-equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
-  = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2) 
-equal (Tip kx x) (Tip ky y)
-  = (kx == ky) && (x==y)
-equal Nil Nil = True
-equal t1 t2   = False
-
-nequal :: Eq a => IntMap a -> IntMap a -> Bool
-nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
-  = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2) 
-nequal (Tip kx x) (Tip ky y)
-  = (kx /= ky) || (x/=y)
-nequal Nil Nil = False
-nequal t1 t2   = True
-
-{--------------------------------------------------------------------
-  Ord 
---------------------------------------------------------------------}
-
-instance Ord a => Ord (IntMap a) where
-    compare m1 m2 = compare (toList m1) (toList m2)
-
-{--------------------------------------------------------------------
-  Functor 
---------------------------------------------------------------------}
-
-instance Functor IntMap where
-    fmap = map
-
-{--------------------------------------------------------------------
-  Show 
---------------------------------------------------------------------}
-
-instance Show a => Show (IntMap a) where
-  showsPrec d m   = showParen (d > 10) $
-    showString "fromList " . shows (toList m)
-
-showMap :: (Show a) => [(Key,a)] -> ShowS
-showMap []     
-  = showString "{}" 
-showMap (x:xs) 
-  = showChar '{' . showElem x . showTail xs
-  where
-    showTail []     = showChar '}'
-    showTail (x:xs) = showChar ',' . showElem x . showTail xs
-    
-    showElem (k,x)  = shows k . showString ":=" . shows x
-
-{--------------------------------------------------------------------
-  Read
---------------------------------------------------------------------}
-instance (Read e) => Read (IntMap e) 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
---------------------------------------------------------------------}
-
-#include "Typeable.h"
-INSTANCE_TYPEABLE1(IntMap,intMapTc,"IntMap")
-
-{--------------------------------------------------------------------
-  Debugging
---------------------------------------------------------------------}
--- | /O(n)/. Show the tree that implements the map. The tree is shown
--- in a compressed, hanging format.
-showTree :: Show a => IntMap a -> String
-showTree s
-  = showTreeWith True False s
-
-
-{- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows
- the tree that implements the map. 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.
--}
-showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
-showTreeWith hang wide t
-  | hang      = (showsTreeHang wide [] t) ""
-  | otherwise = (showsTree wide [] [] t) ""
-
-showsTree :: Show a => Bool -> [String] -> [String] -> IntMap a -> ShowS
-showsTree wide lbars rbars t
-  = case t of
-      Bin p m l r
-          -> showsTree wide (withBar rbars) (withEmpty rbars) r .
-             showWide wide rbars .
-             showsBars lbars . showString (showBin p m) . showString "\n" .
-             showWide wide lbars .
-             showsTree wide (withEmpty lbars) (withBar lbars) l
-      Tip k x
-          -> showsBars lbars . showString " " . shows k . showString ":=" . shows x . showString "\n" 
-      Nil -> showsBars lbars . showString "|\n"
-
-showsTreeHang :: Show a => Bool -> [String] -> IntMap a -> ShowS
-showsTreeHang wide bars t
-  = case t of
-      Bin p m l r
-          -> showsBars bars . showString (showBin p m) . showString "\n" . 
-             showWide wide bars .
-             showsTreeHang wide (withBar bars) l .
-             showWide wide bars .
-             showsTreeHang wide (withEmpty bars) r
-      Tip k x
-          -> showsBars bars . showString " " . shows k . showString ":=" . shows x . showString "\n" 
-      Nil -> showsBars bars . showString "|\n" 
-      
-showBin p m
-  = "*" -- ++ show (p,m)
-
-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           = "+--"
-withBar bars   = "|  ":bars
-withEmpty bars = "   ":bars
-
-
-{--------------------------------------------------------------------
-  Helpers
---------------------------------------------------------------------}
-{--------------------------------------------------------------------
-  Join
---------------------------------------------------------------------}
-join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
-join p1 t1 p2 t2
-  | zero p1 m = Bin p m t1 t2
-  | otherwise = Bin p m t2 t1
-  where
-    m = branchMask p1 p2
-    p = mask p1 m
-
-{--------------------------------------------------------------------
-  @bin@ assures that we never have empty trees within a tree.
---------------------------------------------------------------------}
-bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
-bin p m l Nil = l
-bin p m Nil r = r
-bin p m l r   = Bin p m l r
-
-  
-{--------------------------------------------------------------------
-  Endian independent bit twiddling
---------------------------------------------------------------------}
-zero :: Key -> Mask -> Bool
-zero i m
-  = (natFromInt i) .&. (natFromInt m) == 0
-
-nomatch,match :: Key -> Prefix -> Mask -> Bool
-nomatch i p m
-  = (mask i m) /= p
-
-match i p m
-  = (mask i m) == p
-
-mask :: Key -> Mask -> Prefix
-mask i m
-  = maskW (natFromInt i) (natFromInt m)
-
-
-zeroN :: Nat -> Nat -> Bool
-zeroN i m = (i .&. m) == 0
-
-{--------------------------------------------------------------------
-  Big endian operations  
---------------------------------------------------------------------}
-maskW :: Nat -> Nat -> Prefix
-maskW i m
-  = intFromNat (i .&. (complement (m-1) `xor` m))
-
-shorter :: Mask -> Mask -> Bool
-shorter m1 m2
-  = (natFromInt m1) > (natFromInt m2)
-
-branchMask :: Prefix -> Prefix -> Mask
-branchMask p1 p2
-  = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
-  
-{----------------------------------------------------------------------
-  Finding the highest bit (mask) in a word [x] can be done efficiently in
-  three ways:
-  * convert to a floating point value and the mantissa tells us the 
-    [log2(x)] that corresponds with the highest bit position. The mantissa 
-    is retrieved either via the standard C function [frexp] or by some bit 
-    twiddling on IEEE compatible numbers (float). Note that one needs to 
-    use at least [double] precision for an accurate mantissa of 32 bit 
-    numbers.
-  * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
-  * use processor specific assembler instruction (asm).
-
-  The most portable way would be [bit], but is it efficient enough?
-  I have measured the cycle counts of the different methods on an AMD 
-  Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
-
-  highestBitMask: method  cycles
-                  --------------
-                   frexp   200
-                   float    33
-                   bit      11
-                   asm      12
-
-  highestBit:     method  cycles
-                  --------------
-                   frexp   195
-                   float    33
-                   bit      11
-                   asm      11
-
-  Wow, the bit twiddling is on today's RISC like machines even faster
-  than a single CISC instruction (BSR)!
-----------------------------------------------------------------------}
-
-{----------------------------------------------------------------------
-  [highestBitMask] returns a word where only the highest bit is set.
-  It is found by first setting all bits in lower positions than the 
-  highest bit and than taking an exclusive or with the original value.
-  Allthough the function may look expensive, GHC compiles this into
-  excellent C code that subsequently compiled into highly efficient
-  machine code. The algorithm is derived from Jorg Arndt's FXT library.
-----------------------------------------------------------------------}
-highestBitMask :: Nat -> Nat
-highestBitMask x
-  = case (x .|. shiftRL x 1) of 
-     x -> case (x .|. shiftRL x 2) of 
-      x -> case (x .|. shiftRL x 4) of 
-       x -> case (x .|. shiftRL x 8) of 
-        x -> case (x .|. shiftRL x 16) of 
-         x -> case (x .|. shiftRL x 32) of   -- for 64 bit platforms
-          x -> (x `xor` (shiftRL x 1))
-
-
-{--------------------------------------------------------------------
-  Utilities 
---------------------------------------------------------------------}
-foldlStrict f z xs
-  = case xs of
-      []     -> z
-      (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
-
-{-
-{--------------------------------------------------------------------
-  Testing
---------------------------------------------------------------------}
-testTree :: [Int] -> IntMap Int
-testTree xs   = fromList [(x,x*x*30696 `mod` 65521) | x <- 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 Arbitrary a => Arbitrary (IntMap a) where
-  arbitrary = do{ ks <- arbitrary
-                ; xs <- mapM (\k -> do{ x <- arbitrary; return (k,x)}) ks
-                ; return (fromList xs)
-                }
-
-
-{--------------------------------------------------------------------
-  Single, Insert, Delete
---------------------------------------------------------------------}
-prop_Single :: Key -> Int -> Bool
-prop_Single k x
-  = (insert k x empty == singleton k x)
-
-prop_InsertDelete :: Key -> Int -> IntMap Int -> Property
-prop_InsertDelete k x t
-  = not (member k t) ==> delete k (insert k x t) == t
-
-prop_UpdateDelete :: Key -> IntMap Int -> Bool  
-prop_UpdateDelete k t
-  = update (const Nothing) k t == delete k t
-
-
-{--------------------------------------------------------------------
-  Union
---------------------------------------------------------------------}
-prop_UnionInsert :: Key -> Int -> IntMap Int -> Bool
-prop_UnionInsert k x t
-  = union (singleton k x) t == insert k x t
-
-prop_UnionAssoc :: IntMap Int -> IntMap Int -> IntMap Int -> Bool
-prop_UnionAssoc t1 t2 t3
-  = union t1 (union t2 t3) == union (union t1 t2) t3
-
-prop_UnionComm :: IntMap Int -> IntMap Int -> Bool
-prop_UnionComm t1 t2
-  = (union t1 t2 == unionWith (\x y -> y) t2 t1)
-
-
-prop_Diff :: [(Key,Int)] -> [(Key,Int)] -> Bool
-prop_Diff xs ys
-  =  List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys))) 
-    == List.sort ((List.\\) (nub (Prelude.map fst xs))  (nub (Prelude.map fst ys)))
-
-prop_Int :: [(Key,Int)] -> [(Key,Int)] -> Bool
-prop_Int xs ys
-  =  List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys))) 
-    == List.sort (nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
-
-{--------------------------------------------------------------------
-  Lists
---------------------------------------------------------------------}
-prop_Ordered
-  = forAll (choose (5,100)) $ \n ->
-    let xs = [(x,()) | x <- [0..n::Int]] 
-    in fromAscList xs == fromList xs
-
-prop_List :: [Key] -> Bool
-prop_List xs
-  = (sort (nub xs) == [x | (x,()) <- toAscList (fromList [(x,()) | x <- xs])])
--}
diff --git a/libraries/base/Data/IntSet.hs b/libraries/base/Data/IntSet.hs
deleted file mode 100644 (file)
index 1622608..0000000
+++ /dev/null
@@ -1,1020 +0,0 @@
-{-# OPTIONS -cpp -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.IntSet
--- Copyright   :  (c) Daan Leijen 2002
--- License     :  BSD-style
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- An efficient implementation of integer sets.
---
--- Since many function names (but not the type name) clash with
--- "Prelude" names, this module is usually imported @qualified@, e.g.
---
--- >  import Data.IntSet (IntSet)
--- >  import qualified Data.IntSet as IntSet
---
--- The implementation is based on /big-endian patricia trees/.  This data
--- structure performs especially well on binary operations like 'union'
--- and 'intersection'.  However, my benchmarks show that it is also
--- (much) faster on insertions and deletions when compared to a generic
--- size-balanced set implementation (see "Data.Set").
---
---    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",
---     Workshop on ML, September 1998, pages 77-86,
---     <http://www.cse.ogi.edu/~andy/pub/finite.htm>
---
---    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve
---     Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),
---     October 1968, pages 514-534.
---
--- Many operations have a worst-case complexity of /O(min(n,W))/.
--- This means that the operation can become linear in the number of
--- elements with a maximum of /W/ -- the number of bits in an 'Int'
--- (32 or 64).
------------------------------------------------------------------------------
-
-module Data.IntSet  ( 
-            -- * Set type
-              IntSet          -- instance Eq,Show
-
-            -- * Operators
-            , (\\)
-
-            -- * Query
-            , null
-            , size
-            , member
-            , notMember
-            , isSubsetOf
-            , isProperSubsetOf
-            
-            -- * Construction
-            , empty
-            , singleton
-            , insert
-            , delete
-            
-            -- * Combine
-            , union, unions
-            , difference
-            , intersection
-            
-            -- * Filter
-            , filter
-            , partition
-            , split
-            , splitMember
-
-            -- * Min\/Max
-            , findMin   
-            , findMax
-            , deleteMin
-            , deleteMax
-            , deleteFindMin
-            , deleteFindMax
-            , maxView
-            , minView
-
-            -- * Map
-           , map
-
-            -- * Fold
-            , fold
-
-            -- * Conversion
-            -- ** List
-            , elems
-            , toList
-            , fromList
-            
-            -- ** Ordered list
-            , toAscList
-            , fromAscList
-            , fromDistinctAscList
-                        
-            -- * Debugging
-            , showTree
-            , showTreeWith
-            ) where
-
-
-import Prelude hiding (lookup,filter,foldr,foldl,null,map)
-import Data.Bits 
-
-import qualified Data.List as List
-import Data.Monoid (Monoid(..))
-import Data.Typeable
-
-{-
--- just for testing
-import QuickCheck 
-import List (nub,sort)
-import qualified List
--}
-
-#if __GLASGOW_HASKELL__
-import Text.Read
-import Data.Generics.Basics (Data(..), mkNorepType)
-import Data.Generics.Instances ()
-#endif
-
-#if __GLASGOW_HASKELL__ >= 503
-import GHC.Exts ( Word(..), Int(..), shiftRL# )
-#elif __GLASGOW_HASKELL__
-import Word
-import GlaExts ( Word(..), Int(..), shiftRL# )
-#else
-import Data.Word
-#endif
-
-infixl 9 \\{-This comment teaches CPP correct behaviour -}
-
--- A "Nat" is a natural machine word (an unsigned Int)
-type Nat = Word
-
-natFromInt :: Int -> Nat
-natFromInt i = fromIntegral i
-
-intFromNat :: Nat -> Int
-intFromNat w = fromIntegral w
-
-shiftRL :: Nat -> Int -> Nat
-#if __GLASGOW_HASKELL__
-{--------------------------------------------------------------------
-  GHC: use unboxing to get @shiftRL@ inlined.
---------------------------------------------------------------------}
-shiftRL (W# x) (I# i)
-  = W# (shiftRL# x i)
-#else
-shiftRL x i   = shiftR x i
-#endif
-
-{--------------------------------------------------------------------
-  Operators
---------------------------------------------------------------------}
--- | /O(n+m)/. See 'difference'.
-(\\) :: IntSet -> IntSet -> IntSet
-m1 \\ m2 = difference m1 m2
-
-{--------------------------------------------------------------------
-  Types  
---------------------------------------------------------------------}
--- | A set of integers.
-data IntSet = Nil
-            | Tip {-# UNPACK #-} !Int
-            | Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !IntSet !IntSet
--- Invariant: Nil is never found as a child of Bin.
-
-
-type Prefix = Int
-type Mask   = Int
-
-instance Monoid IntSet where
-    mempty  = empty
-    mappend = union
-    mconcat = unions
-
-#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 Data IntSet where
-  gfoldl f z is = z fromList `f` (toList is)
-  toConstr _    = error "toConstr"
-  gunfold _ _   = error "gunfold"
-  dataTypeOf _  = mkNorepType "Data.IntSet.IntSet"
-
-#endif
-
-{--------------------------------------------------------------------
-  Query
---------------------------------------------------------------------}
--- | /O(1)/. Is the set empty?
-null :: IntSet -> Bool
-null Nil   = True
-null other = False
-
--- | /O(n)/. Cardinality of the set.
-size :: IntSet -> Int
-size t
-  = case t of
-      Bin p m l r -> size l + size r
-      Tip y -> 1
-      Nil   -> 0
-
--- | /O(min(n,W))/. Is the value a member of the set?
-member :: Int -> IntSet -> Bool
-member x t
-  = case t of
-      Bin p m l r 
-        | nomatch x p m -> False
-        | zero x m      -> member x l
-        | otherwise     -> member x r
-      Tip y -> (x==y)
-      Nil   -> False
-    
--- | /O(min(n,W))/. Is the element not in the set?
-notMember :: Int -> IntSet -> Bool
-notMember k = not . member k
-
--- 'lookup' is used by 'intersection' for left-biasing
-lookup :: Int -> IntSet -> Maybe Int
-lookup k t
-  = let nk = natFromInt k  in seq nk (lookupN nk t)
-
-lookupN :: Nat -> IntSet -> Maybe Int
-lookupN k t
-  = case t of
-      Bin p m l r 
-        | zeroN k (natFromInt m) -> lookupN k l
-        | otherwise              -> lookupN k r
-      Tip kx 
-        | (k == natFromInt kx)  -> Just kx
-        | otherwise             -> Nothing
-      Nil -> Nothing
-
-{--------------------------------------------------------------------
-  Construction
---------------------------------------------------------------------}
--- | /O(1)/. The empty set.
-empty :: IntSet
-empty
-  = Nil
-
--- | /O(1)/. A set of one element.
-singleton :: Int -> IntSet
-singleton x
-  = Tip x
-
-{--------------------------------------------------------------------
-  Insert
---------------------------------------------------------------------}
--- | /O(min(n,W))/. Add a value to the set. When the value is already
--- an element of the set, it is replaced by the new one, ie. 'insert'
--- is left-biased.
-insert :: Int -> IntSet -> IntSet
-insert x t
-  = case t of
-      Bin p m l r 
-        | nomatch x p m -> join x (Tip x) p t
-        | zero x m      -> Bin p m (insert x l) r
-        | otherwise     -> Bin p m l (insert x r)
-      Tip y 
-        | x==y          -> Tip x
-        | otherwise     -> join x (Tip x) y t
-      Nil -> Tip x
-
--- right-biased insertion, used by 'union'
-insertR :: Int -> IntSet -> IntSet
-insertR x t
-  = case t of
-      Bin p m l r 
-        | nomatch x p m -> join x (Tip x) p t
-        | zero x m      -> Bin p m (insert x l) r
-        | otherwise     -> Bin p m l (insert x r)
-      Tip y 
-        | x==y          -> t
-        | otherwise     -> join x (Tip x) y t
-      Nil -> Tip x
-
--- | /O(min(n,W))/. Delete a value in the set. Returns the
--- original set when the value was not present.
-delete :: Int -> IntSet -> IntSet
-delete x t
-  = case t of
-      Bin p m l r 
-        | nomatch x p m -> t
-        | zero x m      -> bin p m (delete x l) r
-        | otherwise     -> bin p m l (delete x r)
-      Tip y 
-        | x==y          -> Nil
-        | otherwise     -> t
-      Nil -> Nil
-
-
-{--------------------------------------------------------------------
-  Union
---------------------------------------------------------------------}
--- | The union of a list of sets.
-unions :: [IntSet] -> IntSet
-unions xs
-  = foldlStrict union empty xs
-
-
--- | /O(n+m)/. The union of two sets. 
-union :: IntSet -> IntSet -> IntSet
-union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = union1
-  | shorter m2 m1  = union2
-  | p1 == p2       = Bin p1 m1 (union l1 l2) (union r1 r2)
-  | otherwise      = join p1 t1 p2 t2
-  where
-    union1  | nomatch p2 p1 m1  = join p1 t1 p2 t2
-            | zero p2 m1        = Bin p1 m1 (union l1 t2) r1
-            | otherwise         = Bin p1 m1 l1 (union r1 t2)
-
-    union2  | nomatch p1 p2 m2  = join p1 t1 p2 t2
-            | zero p1 m2        = Bin p2 m2 (union t1 l2) r2
-            | otherwise         = Bin p2 m2 l2 (union t1 r2)
-
-union (Tip x) t = insert x t
-union t (Tip x) = insertR x t  -- right bias
-union Nil t     = t
-union t Nil     = t
-
-
-{--------------------------------------------------------------------
-  Difference
---------------------------------------------------------------------}
--- | /O(n+m)/. Difference between two sets. 
-difference :: IntSet -> IntSet -> IntSet
-difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = difference1
-  | shorter m2 m1  = difference2
-  | p1 == p2       = bin p1 m1 (difference l1 l2) (difference r1 r2)
-  | otherwise      = t1
-  where
-    difference1 | nomatch p2 p1 m1  = t1
-                | zero p2 m1        = bin p1 m1 (difference l1 t2) r1
-                | otherwise         = bin p1 m1 l1 (difference r1 t2)
-
-    difference2 | nomatch p1 p2 m2  = t1
-                | zero p1 m2        = difference t1 l2
-                | otherwise         = difference t1 r2
-
-difference t1@(Tip x) t2 
-  | member x t2  = Nil
-  | otherwise    = t1
-
-difference Nil t     = Nil
-difference t (Tip x) = delete x t
-difference t Nil     = t
-
-
-
-{--------------------------------------------------------------------
-  Intersection
---------------------------------------------------------------------}
--- | /O(n+m)/. The intersection of two sets. 
-intersection :: IntSet -> IntSet -> IntSet
-intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = intersection1
-  | shorter m2 m1  = intersection2
-  | p1 == p2       = bin p1 m1 (intersection l1 l2) (intersection r1 r2)
-  | otherwise      = Nil
-  where
-    intersection1 | nomatch p2 p1 m1  = Nil
-                  | zero p2 m1        = intersection l1 t2
-                  | otherwise         = intersection r1 t2
-
-    intersection2 | nomatch p1 p2 m2  = Nil
-                  | zero p1 m2        = intersection t1 l2
-                  | otherwise         = intersection t1 r2
-
-intersection t1@(Tip x) t2 
-  | member x t2  = t1
-  | otherwise    = Nil
-intersection t (Tip x) 
-  = case lookup x t of
-      Just y  -> Tip y
-      Nothing -> Nil
-intersection Nil t = Nil
-intersection t Nil = Nil
-
-
-
-{--------------------------------------------------------------------
-  Subset
---------------------------------------------------------------------}
--- | /O(n+m)/. Is this a proper subset? (ie. a subset but not equal).
-isProperSubsetOf :: IntSet -> IntSet -> Bool
-isProperSubsetOf t1 t2
-  = case subsetCmp t1 t2 of 
-      LT -> True
-      ge -> False
-
-subsetCmp t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = GT
-  | shorter m2 m1  = subsetCmpLt
-  | p1 == p2       = subsetCmpEq
-  | otherwise      = GT  -- disjoint
-  where
-    subsetCmpLt | nomatch p1 p2 m2  = GT
-                | zero p1 m2        = subsetCmp t1 l2
-                | otherwise         = subsetCmp t1 r2
-    subsetCmpEq = case (subsetCmp l1 l2, subsetCmp r1 r2) of
-                    (GT,_ ) -> GT
-                    (_ ,GT) -> GT
-                    (EQ,EQ) -> EQ
-                    other   -> LT
-
-subsetCmp (Bin p m l r) t  = GT
-subsetCmp (Tip x) (Tip y)  
-  | x==y       = EQ
-  | otherwise  = GT  -- disjoint
-subsetCmp (Tip x) t        
-  | member x t = LT
-  | otherwise  = GT  -- disjoint
-subsetCmp Nil Nil = EQ
-subsetCmp Nil t   = LT
-
--- | /O(n+m)/. Is this a subset?
--- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.
-
-isSubsetOf :: IntSet -> IntSet -> Bool
-isSubsetOf t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
-  | shorter m1 m2  = False
-  | shorter m2 m1  = match p1 p2 m2 && (if zero p1 m2 then isSubsetOf t1 l2
-                                                      else isSubsetOf t1 r2)                     
-  | otherwise      = (p1==p2) && isSubsetOf l1 l2 && isSubsetOf r1 r2
-isSubsetOf (Bin p m l r) t  = False
-isSubsetOf (Tip x) t        = member x t
-isSubsetOf Nil t            = True
-
-
-{--------------------------------------------------------------------
-  Filter
---------------------------------------------------------------------}
--- | /O(n)/. Filter all elements that satisfy some predicate.
-filter :: (Int -> Bool) -> IntSet -> IntSet
-filter pred t
-  = case t of
-      Bin p m l r 
-        -> bin p m (filter pred l) (filter pred r)
-      Tip x 
-        | pred x    -> t
-        | otherwise -> Nil
-      Nil -> Nil
-
--- | /O(n)/. partition the set according to some predicate.
-partition :: (Int -> Bool) -> IntSet -> (IntSet,IntSet)
-partition pred t
-  = case t of
-      Bin p m l r 
-        -> let (l1,l2) = partition pred l
-               (r1,r2) = partition pred r
-           in (bin p m l1 r1, bin p m l2 r2)
-      Tip x 
-        | pred x    -> (t,Nil)
-        | otherwise -> (Nil,t)
-      Nil -> (Nil,Nil)
-
-
--- | /O(min(n,W))/. The expression (@'split' x set@) is a pair @(set1,set2)@
--- where all elements in @set1@ are lower than @x@ and all elements in
--- @set2@ larger than @x@.
---
--- > split 3 (fromList [1..5]) == (fromList [1,2], fromList [3,4])
-split :: Int -> IntSet -> (IntSet,IntSet)
-split x t
-  = case t of
-      Bin p m l r
-        | m < 0       -> if x >= 0 then let (lt,gt) = split' x l in (union r lt, gt)
-                                   else let (lt,gt) = split' x r in (lt, union gt l)
-                                   -- handle negative numbers.
-        | otherwise   -> split' x t
-      Tip y 
-        | x>y         -> (t,Nil)
-        | x<y         -> (Nil,t)
-        | otherwise   -> (Nil,Nil)
-      Nil             -> (Nil, Nil)
-
-split' :: Int -> IntSet -> (IntSet,IntSet)
-split' x t
-  = case t of
-      Bin p m l r
-        | match x p m -> if zero x m then let (lt,gt) = split' x l in (lt,union gt r)
-                                     else let (lt,gt) = split' x r in (union l lt,gt)
-        | otherwise   -> if x < p then (Nil, t)
-                                  else (t, Nil)
-      Tip y 
-        | x>y       -> (t,Nil)
-        | x<y       -> (Nil,t)
-        | otherwise -> (Nil,Nil)
-      Nil -> (Nil,Nil)
-
--- | /O(min(n,W))/. Performs a 'split' but also returns whether the pivot
--- element was found in the original set.
-splitMember :: Int -> IntSet -> (IntSet,Bool,IntSet)
-splitMember x t
-  = case t of
-      Bin p m l r
-        | m < 0       -> if x >= 0 then let (lt,found,gt) = splitMember' x l in (union r lt, found, gt)
-                                   else let (lt,found,gt) = splitMember' x r in (lt, found, union gt l)
-                                   -- handle negative numbers.
-        | otherwise   -> splitMember' x t
-      Tip y 
-        | x>y       -> (t,False,Nil)
-        | x<y       -> (Nil,False,t)
-        | otherwise -> (Nil,True,Nil)
-      Nil -> (Nil,False,Nil)
-
-splitMember' :: Int -> IntSet -> (IntSet,Bool,IntSet)
-splitMember' x t
-  = case t of
-      Bin p m l r
-         | match x p m ->  if zero x m then let (lt,found,gt) = splitMember x l in (lt,found,union gt r)
-                                       else let (lt,found,gt) = splitMember x r in (union l lt,found,gt)
-         | otherwise   -> if x < p then (Nil, False, t)
-                                   else (t, False, Nil)
-      Tip y 
-        | x>y       -> (t,False,Nil)
-        | x<y       -> (Nil,False,t)
-        | otherwise -> (Nil,True,Nil)
-      Nil -> (Nil,False,Nil)
-
-{----------------------------------------------------------------------
-  Min/Max
-----------------------------------------------------------------------}
-
--- | /O(min(n,W))/. Retrieves the maximal key of the set, and the set stripped from that element
--- @fail@s (in the monad) when passed an empty set.
-maxView :: (Monad m) => IntSet -> m (Int, IntSet)
-maxView t
-    = case t of
-        Bin p m l r | m < 0 -> let (result,t') = maxViewUnsigned l in return (result, bin p m t' r)
-        Bin p m l r         -> let (result,t') = maxViewUnsigned r in return (result, bin p m l t')            
-        Tip y -> return (y,Nil)
-        Nil -> fail "maxView: empty set has no maximal element"
-
-maxViewUnsigned :: IntSet -> (Int, IntSet)
-maxViewUnsigned t 
-    = case t of
-        Bin p m l r -> let (result,t') = maxViewUnsigned r in (result, bin p m l t')
-        Tip y -> (y, Nil)
-
--- | /O(min(n,W))/. Retrieves the minimal key of the set, and the set stripped from that element
--- @fail@s (in the monad) when passed an empty set.
-minView :: (Monad m) => IntSet -> m (Int, IntSet)
-minView t
-    = case t of
-        Bin p m l r | m < 0 -> let (result,t') = minViewUnsigned r in return (result, bin p m l t')            
-        Bin p m l r         -> let (result,t') = minViewUnsigned l in return (result, bin p m t' r)
-        Tip y -> return (y, Nil)
-        Nil -> fail "minView: empty set has no minimal element"
-
-minViewUnsigned :: IntSet -> (Int, IntSet)
-minViewUnsigned t 
-    = case t of
-        Bin p m l r -> let (result,t') = minViewUnsigned l in (result, bin p m t' r)
-        Tip y -> (y, Nil)
-
-
--- Duplicate the Identity monad here because base < mtl.
-newtype Identity a = Identity { runIdentity :: a }
-instance Monad Identity where
-       return a = Identity a
-       m >>= k  = k (runIdentity m)
-
-
--- | /O(min(n,W))/. Delete and find the minimal element.
--- 
--- > deleteFindMin set = (findMin set, deleteMin set)
-deleteFindMin :: IntSet -> (Int, IntSet)
-deleteFindMin = runIdentity . minView
-
--- | /O(min(n,W))/. Delete and find the maximal element.
--- 
--- > deleteFindMax set = (findMax set, deleteMax set)
-deleteFindMax :: IntSet -> (Int, IntSet)
-deleteFindMax = runIdentity . maxView
-
--- | /O(min(n,W))/. The minimal element of a set.
-findMin :: IntSet -> Int
-findMin = fst . runIdentity . minView
-
--- | /O(min(n,W))/. The maximal element of a set.
-findMax :: IntSet -> Int
-findMax = fst . runIdentity . maxView
-
--- | /O(min(n,W))/. Delete the minimal element.
-deleteMin :: IntSet -> IntSet
-deleteMin = snd . runIdentity . minView
-
--- | /O(min(n,W))/. Delete the maximal element.
-deleteMax :: IntSet -> IntSet
-deleteMax = snd . runIdentity . maxView
-
-
-
-{----------------------------------------------------------------------
-  Map
-----------------------------------------------------------------------}
-
--- | /O(n*min(n,W))/. 
--- @'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 :: (Int->Int) -> IntSet -> IntSet
-map f = fromList . List.map f . toList
-
-{--------------------------------------------------------------------
-  Fold
---------------------------------------------------------------------}
--- | /O(n)/. Fold over the elements of a set in an unspecified order.
---
--- > sum set   == fold (+) 0 set
--- > elems set == fold (:) [] set
-fold :: (Int -> b -> b) -> b -> IntSet -> b
-fold f z t
-  = case t of
-      Bin 0 m l r | m < 0 -> foldr f (foldr f z l) r  
-      -- put negative numbers before.
-      Bin p m l r -> foldr f z t
-      Tip x       -> f x z
-      Nil         -> z
-
-foldr :: (Int -> b -> b) -> b -> IntSet -> b
-foldr f z t
-  = case t of
-      Bin p m l r -> foldr f (foldr f z r) l
-      Tip x       -> f x z
-      Nil         -> z
-          
-{--------------------------------------------------------------------
-  List variations 
---------------------------------------------------------------------}
--- | /O(n)/. The elements of a set. (For sets, this is equivalent to toList)
-elems :: IntSet -> [Int]
-elems s
-  = toList s
-
-{--------------------------------------------------------------------
-  Lists 
---------------------------------------------------------------------}
--- | /O(n)/. Convert the set to a list of elements.
-toList :: IntSet -> [Int]
-toList t
-  = fold (:) [] t
-
--- | /O(n)/. Convert the set to an ascending list of elements.
-toAscList :: IntSet -> [Int]
-toAscList t = toList t
-
--- | /O(n*min(n,W))/. Create a set from a list of integers.
-fromList :: [Int] -> IntSet
-fromList xs
-  = foldlStrict ins empty xs
-  where
-    ins t x  = insert x t
-
--- | /O(n*min(n,W))/. Build a set from an ascending list of elements.
-fromAscList :: [Int] -> IntSet 
-fromAscList xs
-  = fromList xs
-
--- | /O(n*min(n,W))/. Build a set from an ascending list of distinct elements.
-fromDistinctAscList :: [Int] -> IntSet
-fromDistinctAscList xs
-  = fromList xs
-
-
-{--------------------------------------------------------------------
-  Eq 
---------------------------------------------------------------------}
-instance Eq IntSet where
-  t1 == t2  = equal t1 t2
-  t1 /= t2  = nequal t1 t2
-
-equal :: IntSet -> IntSet -> Bool
-equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
-  = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2) 
-equal (Tip x) (Tip y)
-  = (x==y)
-equal Nil Nil = True
-equal t1 t2   = False
-
-nequal :: IntSet -> IntSet -> Bool
-nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
-  = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2) 
-nequal (Tip x) (Tip y)
-  = (x/=y)
-nequal Nil Nil = False
-nequal t1 t2   = True
-
-{--------------------------------------------------------------------
-  Ord 
---------------------------------------------------------------------}
-
-instance Ord IntSet where
-    compare s1 s2 = compare (toAscList s1) (toAscList s2) 
-    -- tentative implementation. See if more efficient exists.
-
-{--------------------------------------------------------------------
-  Show
---------------------------------------------------------------------}
-instance Show IntSet where
-  showsPrec p xs = showParen (p > 10) $
-    showString "fromList " . shows (toList xs)
-
-showSet :: [Int] -> ShowS
-showSet []     
-  = showString "{}" 
-showSet (x:xs) 
-  = showChar '{' . shows x . showTail xs
-  where
-    showTail []     = showChar '}'
-    showTail (x:xs) = showChar ',' . shows x . showTail xs
-
-{--------------------------------------------------------------------
-  Read
---------------------------------------------------------------------}
-instance Read IntSet 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
---------------------------------------------------------------------}
-
-#include "Typeable.h"
-INSTANCE_TYPEABLE0(IntSet,intSetTc,"IntSet")
-
-{--------------------------------------------------------------------
-  Debugging
---------------------------------------------------------------------}
--- | /O(n)/. Show the tree that implements the set. The tree is shown
--- in a compressed, hanging format.
-showTree :: IntSet -> 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.
--}
-showTreeWith :: Bool -> Bool -> IntSet -> String
-showTreeWith hang wide t
-  | hang      = (showsTreeHang wide [] t) ""
-  | otherwise = (showsTree wide [] [] t) ""
-
-showsTree :: Bool -> [String] -> [String] -> IntSet -> ShowS
-showsTree wide lbars rbars t
-  = case t of
-      Bin p m l r
-          -> showsTree wide (withBar rbars) (withEmpty rbars) r .
-             showWide wide rbars .
-             showsBars lbars . showString (showBin p m) . showString "\n" .
-             showWide wide lbars .
-             showsTree wide (withEmpty lbars) (withBar lbars) l
-      Tip x
-          -> showsBars lbars . showString " " . shows x . showString "\n" 
-      Nil -> showsBars lbars . showString "|\n"
-
-showsTreeHang :: Bool -> [String] -> IntSet -> ShowS
-showsTreeHang wide bars t
-  = case t of
-      Bin p m l r
-          -> showsBars bars . showString (showBin p m) . showString "\n" . 
-             showWide wide bars .
-             showsTreeHang wide (withBar bars) l .
-             showWide wide bars .
-             showsTreeHang wide (withEmpty bars) r
-      Tip x
-          -> showsBars bars . showString " " . shows x . showString "\n" 
-      Nil -> showsBars bars . showString "|\n" 
-      
-showBin p m
-  = "*" -- ++ show (p,m)
-
-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           = "+--"
-withBar bars   = "|  ":bars
-withEmpty bars = "   ":bars
-
-
-{--------------------------------------------------------------------
-  Helpers
---------------------------------------------------------------------}
-{--------------------------------------------------------------------
-  Join
---------------------------------------------------------------------}
-join :: Prefix -> IntSet -> Prefix -> IntSet -> IntSet
-join p1 t1 p2 t2
-  | zero p1 m = Bin p m t1 t2
-  | otherwise = Bin p m t2 t1
-  where
-    m = branchMask p1 p2
-    p = mask p1 m
-
-{--------------------------------------------------------------------
-  @bin@ assures that we never have empty trees within a tree.
---------------------------------------------------------------------}
-bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet
-bin p m l Nil = l
-bin p m Nil r = r
-bin p m l r   = Bin p m l r
-
-  
-{--------------------------------------------------------------------
-  Endian independent bit twiddling
---------------------------------------------------------------------}
-zero :: Int -> Mask -> Bool
-zero i m
-  = (natFromInt i) .&. (natFromInt m) == 0
-
-nomatch,match :: Int -> Prefix -> Mask -> Bool
-nomatch i p m
-  = (mask i m) /= p
-
-match i p m
-  = (mask i m) == p
-
-mask :: Int -> Mask -> Prefix
-mask i m
-  = maskW (natFromInt i) (natFromInt m)
-
-zeroN :: Nat -> Nat -> Bool
-zeroN i m = (i .&. m) == 0
-
-{--------------------------------------------------------------------
-  Big endian operations  
---------------------------------------------------------------------}
-maskW :: Nat -> Nat -> Prefix
-maskW i m
-  = intFromNat (i .&. (complement (m-1) `xor` m))
-
-shorter :: Mask -> Mask -> Bool
-shorter m1 m2
-  = (natFromInt m1) > (natFromInt m2)
-
-branchMask :: Prefix -> Prefix -> Mask
-branchMask p1 p2
-  = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
-  
-{----------------------------------------------------------------------
-  Finding the highest bit (mask) in a word [x] can be done efficiently in
-  three ways:
-  * convert to a floating point value and the mantissa tells us the 
-    [log2(x)] that corresponds with the highest bit position. The mantissa 
-    is retrieved either via the standard C function [frexp] or by some bit 
-    twiddling on IEEE compatible numbers (float). Note that one needs to 
-    use at least [double] precision for an accurate mantissa of 32 bit 
-    numbers.
-  * use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
-  * use processor specific assembler instruction (asm).
-
-  The most portable way would be [bit], but is it efficient enough?
-  I have measured the cycle counts of the different methods on an AMD 
-  Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
-
-  highestBitMask: method  cycles
-                  --------------
-                   frexp   200
-                   float    33
-                   bit      11
-                   asm      12
-
-  highestBit:     method  cycles
-                  --------------
-                   frexp   195
-                   float    33
-                   bit      11
-                   asm      11
-
-  Wow, the bit twiddling is on today's RISC like machines even faster
-  than a single CISC instruction (BSR)!
-----------------------------------------------------------------------}
-
-{----------------------------------------------------------------------
-  [highestBitMask] returns a word where only the highest bit is set.
-  It is found by first setting all bits in lower positions than the 
-  highest bit and than taking an exclusive or with the original value.
-  Allthough the function may look expensive, GHC compiles this into
-  excellent C code that subsequently compiled into highly efficient
-  machine code. The algorithm is derived from Jorg Arndt's FXT library.
-----------------------------------------------------------------------}
-highestBitMask :: Nat -> Nat
-highestBitMask x
-  = case (x .|. shiftRL x 1) of 
-     x -> case (x .|. shiftRL x 2) of 
-      x -> case (x .|. shiftRL x 4) of 
-       x -> case (x .|. shiftRL x 8) of 
-        x -> case (x .|. shiftRL x 16) of 
-         x -> case (x .|. shiftRL x 32) of   -- for 64 bit platforms
-          x -> (x `xor` (shiftRL x 1))
-
-
-{--------------------------------------------------------------------
-  Utilities 
---------------------------------------------------------------------}
-foldlStrict f z xs
-  = case xs of
-      []     -> z
-      (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
-
-
-{-
-{--------------------------------------------------------------------
-  Testing
---------------------------------------------------------------------}
-testTree :: [Int] -> IntSet
-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 Arbitrary IntSet where
-  arbitrary = do{ xs <- arbitrary
-                ; return (fromList xs)
-                }
-
-
-{--------------------------------------------------------------------
-  Single, Insert, Delete
---------------------------------------------------------------------}
-prop_Single :: Int -> Bool
-prop_Single x
-  = (insert x empty == singleton x)
-
-prop_InsertDelete :: Int -> IntSet -> Property
-prop_InsertDelete k t
-  = not (member k t) ==> delete k (insert k t) == t
-
-
-{--------------------------------------------------------------------
-  Union
---------------------------------------------------------------------}
-prop_UnionInsert :: Int -> IntSet -> Bool
-prop_UnionInsert x t
-  = union t (singleton x) == insert x t
-
-prop_UnionAssoc :: IntSet -> IntSet -> IntSet -> Bool
-prop_UnionAssoc t1 t2 t3
-  = union t1 (union t2 t3) == union (union t1 t2) t3
-
-prop_UnionComm :: IntSet -> IntSet -> Bool
-prop_UnionComm t1 t2
-  = (union t1 t2 == union t2 t1)
-
-prop_Diff :: [Int] -> [Int] -> Bool
-prop_Diff xs ys
-  =  toAscList (difference (fromList xs) (fromList ys))
-    == List.sort ((List.\\) (nub xs)  (nub ys))
-
-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) == toAscList (fromList xs))
--}
diff --git a/libraries/base/Data/Map.hs b/libraries/base/Data/Map.hs
deleted file mode 100644 (file)
index b8fcf71..0000000
+++ /dev/null
@@ -1,1846 +0,0 @@
-{-# OPTIONS_GHC -fno-bang-patterns #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Map
--- Copyright   :  (c) Daan Leijen 2002
--- License     :  BSD-style
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- An efficient implementation of maps from keys to values (dictionaries).
---
--- Since many function names (but not the type name) clash with
--- "Prelude" names, this module is usually imported @qualified@, e.g.
---
--- >  import Data.Map (Map)
--- >  import qualified Data.Map as Map
---
--- The implementation of 'Map' 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'.
------------------------------------------------------------------------------
-
-module Data.Map  ( 
-            -- * Map type
-              Map          -- instance Eq,Show,Read
-
-            -- * Operators
-            , (!), (\\)
-
-
-            -- * Query
-            , null
-            , size
-            , member
-            , notMember
-            , lookup
-            , findWithDefault
-            
-            -- * Construction
-            , empty
-            , singleton
-
-            -- ** Insertion
-            , insert
-            , insertWith, insertWithKey, insertLookupWithKey
-            , insertWith', insertWithKey'
-            
-            -- ** Delete\/Update
-            , delete
-            , adjust
-            , adjustWithKey
-            , update
-            , updateWithKey
-            , updateLookupWithKey
-            , alter
-
-            -- * Combine
-
-            -- ** Union
-            , union         
-            , unionWith          
-            , unionWithKey
-            , unions
-           , unionsWith
-
-            -- ** Difference
-            , difference
-            , differenceWith
-            , differenceWithKey
-            
-            -- ** Intersection
-            , intersection           
-            , intersectionWith
-            , intersectionWithKey
-
-            -- * Traversal
-            -- ** Map
-            , map
-            , mapWithKey
-            , mapAccum
-            , mapAccumWithKey
-           , mapKeys
-           , mapKeysWith
-           , mapKeysMonotonic
-
-            -- ** Fold
-            , fold
-            , foldWithKey
-
-            -- * Conversion
-            , elems
-            , keys
-           , keysSet
-            , assocs
-            
-            -- ** Lists
-            , toList
-            , fromList
-            , fromListWith
-            , fromListWithKey
-
-            -- ** Ordered lists
-            , toAscList
-            , fromAscList
-            , fromAscListWith
-            , fromAscListWithKey
-            , fromDistinctAscList
-
-            -- * Filter 
-            , filter
-            , filterWithKey
-            , partition
-            , partitionWithKey
-
-            , mapMaybe
-            , mapMaybeWithKey
-            , mapEither
-            , mapEitherWithKey
-
-            , split         
-            , splitLookup   
-
-            -- * Submap
-            , isSubmapOf, isSubmapOfBy
-            , isProperSubmapOf, isProperSubmapOfBy
-
-            -- * Indexed 
-            , lookupIndex
-            , findIndex
-            , elemAt
-            , updateAt
-            , deleteAt
-
-            -- * Min\/Max
-            , findMin
-            , findMax
-            , deleteMin
-            , deleteMax
-            , deleteFindMin
-            , deleteFindMax
-            , updateMin
-            , updateMax
-            , updateMinWithKey
-            , updateMaxWithKey
-            , minView
-            , maxView
-            , minViewWithKey
-            , maxViewWithKey
-            
-            -- * Debugging
-            , showTree
-            , showTreeWith
-            , valid
-            ) where
-
-import Prelude hiding (lookup,map,filter,foldr,foldl,null)
-import qualified Data.Set as Set
-import qualified Data.List as List
-import Data.Monoid (Monoid(..))
-import Data.Typeable
-import Control.Applicative (Applicative(..), (<$>))
-import Data.Traversable (Traversable(traverse))
-import Data.Foldable (Foldable(foldMap))
-
-{-
--- for quick check
-import qualified Prelude
-import qualified List
-import Debug.QuickCheck       
-import List(nub,sort)    
--}
-
-#if __GLASGOW_HASKELL__
-import Text.Read
-import Data.Generics.Basics
-import Data.Generics.Instances
-#endif
-
-{--------------------------------------------------------------------
-  Operators
---------------------------------------------------------------------}
-infixl 9 !,\\ --
-
--- | /O(log n)/. Find the value at a key.
--- Calls 'error' when the element can not be found.
-(!) :: Ord k => Map k a -> k -> a
-m ! k    = find k m
-
--- | /O(n+m)/. See 'difference'.
-(\\) :: Ord k => Map k a -> Map k b -> Map k a
-m1 \\ m2 = difference m1 m2
-
-{--------------------------------------------------------------------
-  Size balanced trees.
---------------------------------------------------------------------}
--- | A Map from keys @k@ to values @a@. 
-data Map k a  = Tip 
-              | Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a) 
-
-type Size     = Int
-
-instance (Ord k) => Monoid (Map k v) where
-    mempty  = empty
-    mappend = union
-    mconcat = unions
-
-#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 (Data k, Data a, Ord k) => Data (Map k a) where
-  gfoldl f z map = z fromList `f` (toList map)
-  toConstr _     = error "toConstr"
-  gunfold _ _    = error "gunfold"
-  dataTypeOf _   = mkNorepType "Data.Map.Map"
-  dataCast2 f    = gcast2 f
-
-#endif
-
-{--------------------------------------------------------------------
-  Query
---------------------------------------------------------------------}
--- | /O(1)/. Is the map empty?
-null :: Map k a -> Bool
-null t
-  = case t of
-      Tip             -> True
-      Bin sz k x l r  -> False
-
--- | /O(1)/. The number of elements in the map.
-size :: Map k a -> Int
-size t
-  = case t of
-      Tip             -> 0
-      Bin sz k x l r  -> sz
-
-
--- | /O(log n)/. Lookup the value at a key in the map. 
---
--- The function will 
--- @return@ the result in the monad or @fail@ in it the key isn't in the 
--- map. Often, the monad to use is 'Maybe', so you get either 
--- @('Just' result)@ or @'Nothing'@.
-lookup :: (Monad m,Ord k) => k -> Map k a -> m a
-lookup k t = case lookup' k t of
-    Just x -> return x
-    Nothing -> fail "Data.Map.lookup: Key not found"
-lookup' :: Ord k => k -> Map k a -> Maybe a
-lookup' k t
-  = case t of
-      Tip -> Nothing
-      Bin sz kx x l r
-          -> case compare k kx of
-               LT -> lookup' k l
-               GT -> lookup' k r
-               EQ -> Just x       
-
-lookupAssoc :: Ord k => k -> Map k a -> Maybe (k,a)
-lookupAssoc  k t
-  = case t of
-      Tip -> Nothing
-      Bin sz kx x l r
-          -> case compare k kx of
-               LT -> lookupAssoc k l
-               GT -> lookupAssoc k r
-               EQ -> Just (kx,x)
-
--- | /O(log n)/. Is the key a member of the map?
-member :: Ord k => k -> Map k a -> Bool
-member k m
-  = case lookup k m of
-      Nothing -> False
-      Just x  -> True
-
--- | /O(log n)/. Is the key not a member of the map?
-notMember :: Ord k => k -> Map k a -> Bool
-notMember k m = not $ member k m
-
--- | /O(log n)/. Find the value at a key.
--- Calls 'error' when the element can not be found.
-find :: Ord k => k -> Map k a -> a
-find k m
-  = case lookup k m of
-      Nothing -> error "Map.find: element not in the map"
-      Just x  -> x
-
--- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns
--- the value at key @k@ or returns @def@ when the key is not in the map.
-findWithDefault :: Ord k => a -> k -> Map k a -> a
-findWithDefault def k m
-  = case lookup k m of
-      Nothing -> def
-      Just x  -> x
-
-
-
-{--------------------------------------------------------------------
-  Construction
---------------------------------------------------------------------}
--- | /O(1)/. The empty map.
-empty :: Map k a
-empty 
-  = Tip
-
--- | /O(1)/. A map with a single element.
-singleton :: k -> a -> Map k a
-singleton k x  
-  = Bin 1 k x Tip Tip
-
-{--------------------------------------------------------------------
-  Insertion
---------------------------------------------------------------------}
--- | /O(log n)/. Insert a new key and value in the map.
--- If the key is already present in the map, the associated value is
--- replaced with the supplied value, i.e. 'insert' is equivalent to
--- @'insertWith' 'const'@.
-insert :: Ord k => k -> a -> Map k a -> Map k a
-insert kx x t
-  = case t of
-      Tip -> singleton kx x
-      Bin sz ky y l r
-          -> case compare kx ky of
-               LT -> balance ky y (insert kx x l) r
-               GT -> balance ky y l (insert kx x r)
-               EQ -> Bin sz kx x l r
-
--- | /O(log n)/. Insert with a combining function.
--- @'insertWith' f key value mp@ 
--- will insert the pair (key, value) into @mp@ if key does
--- not exist in the map. If the key does exist, the function will
--- insert the pair @(key, f new_value old_value)@.
-insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
-insertWith f k x m          
-  = insertWithKey (\k x y -> f x y) k x m
-
--- | Same as 'insertWith', but the combining function is applied strictly.
-insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
-insertWith' f k x m          
-  = insertWithKey' (\k x y -> f x y) k x m
-
-
--- | /O(log n)/. Insert with a combining function.
--- @'insertWithKey' f key value mp@ 
--- will insert the pair (key, value) into @mp@ if key does
--- not exist in the map. If the key does exist, the function will
--- insert the pair @(key,f key new_value old_value)@.
--- Note that the key passed to f is the same key passed to 'insertWithKey'.
-insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
-insertWithKey f kx x t
-  = case t of
-      Tip -> singleton kx x
-      Bin sy ky y l r
-          -> case compare kx ky of
-               LT -> balance ky y (insertWithKey f kx x l) r
-               GT -> balance ky y l (insertWithKey f kx x r)
-               EQ -> Bin sy kx (f kx x y) l r
-
--- | Same as 'insertWithKey', but the combining function is applied strictly.
-insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
-insertWithKey' f kx x t
-  = case t of
-      Tip -> singleton kx x
-      Bin sy ky y l r
-          -> case compare kx ky of
-               LT -> balance ky y (insertWithKey' f kx x l) r
-               GT -> balance ky y l (insertWithKey' f kx x r)
-               EQ -> let x' = f kx x y in seq x' (Bin sy kx x' l r)
-
-
--- | /O(log n)/. The expression (@'insertLookupWithKey' f k x map@)
--- is a pair where the first element is equal to (@'lookup' k map@)
--- and the second element equal to (@'insertWithKey' f k x map@).
-insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a,Map k a)
-insertLookupWithKey f kx x t
-  = case t of
-      Tip -> (Nothing, singleton kx x)
-      Bin sy ky y l r
-          -> case compare kx ky of
-               LT -> let (found,l') = insertLookupWithKey f kx x l in (found,balance ky y l' r)
-               GT -> let (found,r') = insertLookupWithKey f kx x r in (found,balance ky y l r')
-               EQ -> (Just y, Bin sy kx (f kx x y) l r)
-
-{--------------------------------------------------------------------
-  Deletion
-  [delete] is the inlined version of [deleteWith (\k x -> Nothing)]
---------------------------------------------------------------------}
--- | /O(log n)/. Delete a key and its value from the map. When the key is not
--- a member of the map, the original map is returned.
-delete :: Ord k => k -> Map k a -> Map k a
-delete k t
-  = case t of
-      Tip -> Tip
-      Bin sx kx x l r 
-          -> case compare k kx of
-               LT -> balance kx x (delete k l) r
-               GT -> balance kx x l (delete k r)
-               EQ -> glue l r
-
--- | /O(log n)/. Adjust a value at a specific key. When the key is not
--- a member of the map, the original map is returned.
-adjust :: Ord k => (a -> a) -> k -> Map k a -> Map k a
-adjust f k m
-  = adjustWithKey (\k x -> f x) k m
-
--- | /O(log n)/. Adjust a value at a specific key. When the key is not
--- a member of the map, the original map is returned.
-adjustWithKey :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
-adjustWithKey f k m
-  = updateWithKey (\k x -> Just (f k x)) k m
-
--- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@
--- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
--- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
-update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
-update f k m
-  = updateWithKey (\k x -> f x) k m
-
--- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the
--- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing',
--- the element is deleted. If it is (@'Just' y@), the key @k@ is bound
--- to the new value @y@.
-updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
-updateWithKey f k t
-  = case t of
-      Tip -> Tip
-      Bin sx kx x l r 
-          -> case compare k kx of
-               LT -> balance kx x (updateWithKey f k l) r
-               GT -> balance kx x l (updateWithKey f k r)
-               EQ -> case f kx x of
-                       Just x' -> Bin sx kx x' l r
-                       Nothing -> glue l r
-
--- | /O(log n)/. Lookup and update.
-updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a,Map k a)
-updateLookupWithKey f k t
-  = case t of
-      Tip -> (Nothing,Tip)
-      Bin sx kx x l r 
-          -> case compare k kx of
-               LT -> let (found,l') = updateLookupWithKey f k l in (found,balance kx x l' r)
-               GT -> let (found,r') = updateLookupWithKey f k r in (found,balance kx x l r') 
-               EQ -> case f kx x of
-                       Just x' -> (Just x',Bin sx kx x' l r)
-                       Nothing -> (Just x,glue l r)
-
--- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
--- 'alter' can be used to insert, delete, or update a value in a 'Map'.
--- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@
-alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
-alter f k t
-  = case t of
-      Tip -> case f Nothing of
-               Nothing -> Tip
-               Just x -> singleton k x
-      Bin sx kx x l r 
-          -> case compare k kx of
-               LT -> balance kx x (alter f k l) r
-               GT -> balance kx x l (alter f k r)
-               EQ -> case f (Just x) of
-                       Just x' -> Bin sx kx x' l r
-                       Nothing -> glue l r
-
-{--------------------------------------------------------------------
-  Indexing
---------------------------------------------------------------------}
--- | /O(log n)/. Return the /index/ of a key. The index is a number from
--- /0/ up to, but not including, the 'size' of the map. Calls 'error' when
--- the key is not a 'member' of the map.
-findIndex :: Ord k => k -> Map k a -> Int
-findIndex k t
-  = case lookupIndex k t of
-      Nothing  -> error "Map.findIndex: element is not in the map"
-      Just idx -> idx
-
--- | /O(log n)/. Lookup the /index/ of a key. The index is a number from
--- /0/ up to, but not including, the 'size' of the map. 
-lookupIndex :: (Monad m,Ord k) => k -> Map k a -> m Int
-lookupIndex k t = case lookup 0 t of
-    Nothing -> fail "Data.Map.lookupIndex: Key not found."
-    Just x -> return x
-  where
-    lookup idx Tip  = Nothing
-    lookup idx (Bin _ kx x l r)
-      = case compare k kx of
-          LT -> lookup idx l
-          GT -> lookup (idx + size l + 1) r 
-          EQ -> Just (idx + size l)
-
--- | /O(log n)/. Retrieve an element by /index/. Calls 'error' when an
--- invalid index is used.
-elemAt :: Int -> Map k a -> (k,a)
-elemAt i Tip = error "Map.elemAt: index out of range"
-elemAt i (Bin _ kx x l r)
-  = case compare i sizeL of
-      LT -> elemAt i l
-      GT -> elemAt (i-sizeL-1) r
-      EQ -> (kx,x)
-  where
-    sizeL = size l
-
--- | /O(log n)/. Update the element at /index/. Calls 'error' when an
--- invalid index is used.
-updateAt :: (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
-updateAt f i Tip  = error "Map.updateAt: index out of range"
-updateAt f i (Bin sx kx x l r)
-  = case compare i sizeL of
-      LT -> balance kx x (updateAt f i l) r
-      GT -> balance kx x l (updateAt f (i-sizeL-1) r)
-      EQ -> case f kx x of
-              Just x' -> Bin sx kx x' l r
-              Nothing -> glue l r
-  where
-    sizeL = size l
-
--- | /O(log n)/. Delete the element at /index/.
--- Defined as (@'deleteAt' i map = 'updateAt' (\k x -> 'Nothing') i map@).
-deleteAt :: Int -> Map k a -> Map k a
-deleteAt i map
-  = updateAt (\k x -> Nothing) i map
-
-
-{--------------------------------------------------------------------
-  Minimal, Maximal
---------------------------------------------------------------------}
--- | /O(log n)/. The minimal key of the map.
-findMin :: Map k a -> (k,a)
-findMin (Bin _ kx x Tip r)  = (kx,x)
-findMin (Bin _ kx x l r)    = findMin l
-findMin Tip                 = error "Map.findMin: empty map has no minimal element"
-
--- | /O(log n)/. The maximal key of the map.
-findMax :: Map k a -> (k,a)
-findMax (Bin _ kx x l Tip)  = (kx,x)
-findMax (Bin _ kx x l r)    = findMax r
-findMax Tip                 = error "Map.findMax: empty map has no maximal element"
-
--- | /O(log n)/. Delete the minimal key.
-deleteMin :: Map k a -> Map k a
-deleteMin (Bin _ kx x Tip r)  = r
-deleteMin (Bin _ kx x l r)    = balance kx x (deleteMin l) r
-deleteMin Tip                 = Tip
-
--- | /O(log n)/. Delete the maximal key.
-deleteMax :: Map k a -> Map k a
-deleteMax (Bin _ kx x l Tip)  = l
-deleteMax (Bin _ kx x l r)    = balance kx x l (deleteMax r)
-deleteMax Tip                 = Tip
-
--- | /O(log n)/. Update the value at the minimal key.
-updateMin :: (a -> Maybe a) -> Map k a -> Map k a
-updateMin f m
-  = updateMinWithKey (\k x -> f x) m
-
--- | /O(log n)/. Update the value at the maximal key.
-updateMax :: (a -> Maybe a) -> Map k a -> Map k a
-updateMax f m
-  = updateMaxWithKey (\k x -> f x) m
-
-
--- | /O(log n)/. Update the value at the minimal key.
-updateMinWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
-updateMinWithKey f t
-  = case t of
-      Bin sx kx x Tip r  -> case f kx x of
-                              Nothing -> r
-                              Just x' -> Bin sx kx x' Tip r
-      Bin sx kx x l r    -> balance kx x (updateMinWithKey f l) r
-      Tip                -> Tip
-
--- | /O(log n)/. Update the value at the maximal key.
-updateMaxWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
-updateMaxWithKey f t
-  = case t of
-      Bin sx kx x l Tip  -> case f kx x of
-                              Nothing -> l
-                              Just x' -> Bin sx kx x' l Tip
-      Bin sx kx x l r    -> balance kx x l (updateMaxWithKey f r)
-      Tip                -> Tip
-
--- | /O(log n)/. Retrieves the minimal (key,value) pair of the map, and the map stripped from that element
--- @fail@s (in the monad) when passed an empty map.
-minViewWithKey :: Monad m => Map k a -> m ((k,a), Map k a)
-minViewWithKey Tip = fail "Map.minView: empty map"
-minViewWithKey x = return (deleteFindMin x)
-
--- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and the map stripped from that element
--- @fail@s (in the monad) when passed an empty map.
-maxViewWithKey :: Monad m => Map k a -> m ((k,a), Map k a)
-maxViewWithKey Tip = fail "Map.maxView: empty map"
-maxViewWithKey x = return (deleteFindMax x)
-
--- | /O(log n)/. Retrieves the minimal key\'s value of the map, and the map stripped from that element
--- @fail@s (in the monad) when passed an empty map.
-minView :: Monad m => Map k a -> m (a, Map k a)
-minView Tip = fail "Map.minView: empty map"
-minView x = return (first snd $ deleteFindMin x)
-
--- | /O(log n)/. Retrieves the maximal key\'s value of the map, and the map stripped from that element
--- @fail@s (in the monad) when passed an empty map.
-maxView :: Monad m => Map k a -> m (a, Map k a)
-maxView Tip = fail "Map.maxView: empty map"
-maxView x = return (first snd $ deleteFindMax x)
-
--- Update the 1st component of a tuple (special case of Control.Arrow.first)
-first :: (a -> b) -> (a,c) -> (b,c)
-first f (x,y) = (f x, y)
-
-{--------------------------------------------------------------------
-  Union. 
---------------------------------------------------------------------}
--- | The union of a list of maps:
---   (@'unions' == 'Prelude.foldl' 'union' 'empty'@).
-unions :: Ord k => [Map k a] -> Map k a
-unions ts
-  = foldlStrict union empty ts
-
--- | The union of a list of maps, with a combining operation:
---   (@'unionsWith' f == 'Prelude.foldl' ('unionWith' f) 'empty'@).
-unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a
-unionsWith f ts
-  = foldlStrict (unionWith f) empty ts
-
--- | /O(n+m)/.
--- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. 
--- It prefers @t1@ when duplicate keys are encountered,
--- i.e. (@'union' == 'unionWith' 'const'@).
--- The implementation uses the efficient /hedge-union/ algorithm.
--- Hedge-union is more efficient on (bigset `union` smallset)
-union :: Ord k => Map k a -> Map k a -> Map k a
-union Tip t2  = t2
-union t1 Tip  = t1
-union t1 t2 = hedgeUnionL (const LT) (const GT) t1 t2
-
--- left-biased hedge union
-hedgeUnionL cmplo cmphi t1 Tip 
-  = t1
-hedgeUnionL cmplo cmphi Tip (Bin _ kx x l r)
-  = join kx x (filterGt cmplo l) (filterLt cmphi r)
-hedgeUnionL cmplo cmphi (Bin _ kx x l r) t2
-  = join kx x (hedgeUnionL cmplo cmpkx l (trim cmplo cmpkx t2)) 
-              (hedgeUnionL cmpkx cmphi r (trim cmpkx cmphi t2))
-  where
-    cmpkx k  = compare kx k
-
--- right-biased hedge union
-hedgeUnionR cmplo cmphi t1 Tip 
-  = t1
-hedgeUnionR cmplo cmphi Tip (Bin _ kx x l r)
-  = join kx x (filterGt cmplo l) (filterLt cmphi r)
-hedgeUnionR cmplo cmphi (Bin _ kx x l r) t2
-  = join kx newx (hedgeUnionR cmplo cmpkx l lt) 
-                 (hedgeUnionR cmpkx cmphi r gt)
-  where
-    cmpkx k     = compare kx k
-    lt          = trim cmplo cmpkx t2
-    (found,gt)  = trimLookupLo kx cmphi t2
-    newx        = case found of
-                    Nothing -> x
-                    Just (_,y) -> y
-
-{--------------------------------------------------------------------
-  Union with a combining function
---------------------------------------------------------------------}
--- | /O(n+m)/. Union with a combining function. The implementation uses the efficient /hedge-union/ algorithm.
-unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
-unionWith f m1 m2
-  = unionWithKey (\k x y -> f x y) m1 m2
-
--- | /O(n+m)/.
--- Union with a combining function. The implementation uses the efficient /hedge-union/ algorithm.
--- Hedge-union is more efficient on (bigset `union` smallset).
-unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
-unionWithKey f Tip t2  = t2
-unionWithKey f t1 Tip  = t1
-unionWithKey f t1 t2 = hedgeUnionWithKey f (const LT) (const GT) t1 t2
-
-hedgeUnionWithKey f cmplo cmphi t1 Tip 
-  = t1
-hedgeUnionWithKey f cmplo cmphi Tip (Bin _ kx x l r)
-  = join kx x (filterGt cmplo l) (filterLt cmphi r)
-hedgeUnionWithKey f cmplo cmphi (Bin _ kx x l r) t2
-  = join kx newx (hedgeUnionWithKey f cmplo cmpkx l lt) 
-                 (hedgeUnionWithKey f cmpkx cmphi r gt)
-  where
-    cmpkx k     = compare kx k
-    lt          = trim cmplo cmpkx t2
-    (found,gt)  = trimLookupLo kx cmphi t2
-    newx        = case found of
-                    Nothing -> x
-                    Just (_,y) -> f kx x y
-
-{--------------------------------------------------------------------
-  Difference
---------------------------------------------------------------------}
--- | /O(n+m)/. Difference of two maps. 
--- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.
-difference :: Ord k => Map k a -> Map k b -> Map k a
-difference Tip t2  = Tip
-difference t1 Tip  = t1
-difference t1 t2   = hedgeDiff (const LT) (const GT) t1 t2
-
-hedgeDiff cmplo cmphi Tip t     
-  = Tip
-hedgeDiff cmplo cmphi (Bin _ kx x l r) Tip 
-  = join kx x (filterGt cmplo l) (filterLt cmphi r)
-hedgeDiff cmplo cmphi t (Bin _ kx x l r) 
-  = merge (hedgeDiff cmplo cmpkx (trim cmplo cmpkx t) l) 
-          (hedgeDiff cmpkx cmphi (trim cmpkx cmphi t) r)
-  where
-    cmpkx k = compare kx k   
-
--- | /O(n+m)/. Difference with a combining function. 
--- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.
-differenceWith :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
-differenceWith f m1 m2
-  = differenceWithKey (\k x y -> f x y) m1 m2
-
--- | /O(n+m)/. Difference with a combining function. When two equal keys are
--- encountered, the combining function is applied to the key and both values.
--- If it returns 'Nothing', the element is discarded (proper set difference). If
--- it returns (@'Just' y@), the element is updated with a new value @y@. 
--- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.
-differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
-differenceWithKey f Tip t2  = Tip
-differenceWithKey f t1 Tip  = t1
-differenceWithKey f t1 t2   = hedgeDiffWithKey f (const LT) (const GT) t1 t2
-
-hedgeDiffWithKey f cmplo cmphi Tip t     
-  = Tip
-hedgeDiffWithKey f cmplo cmphi (Bin _ kx x l r) Tip 
-  = join kx x (filterGt cmplo l) (filterLt cmphi r)
-hedgeDiffWithKey f cmplo cmphi t (Bin _ kx x l r) 
-  = case found of
-      Nothing -> merge tl tr
-      Just (ky,y) -> 
-          case f ky y x of
-            Nothing -> merge tl tr
-            Just z  -> join ky z tl tr
-  where
-    cmpkx k     = compare kx k   
-    lt          = trim cmplo cmpkx t
-    (found,gt)  = trimLookupLo kx cmphi t
-    tl          = hedgeDiffWithKey f cmplo cmpkx lt l
-    tr          = hedgeDiffWithKey f cmpkx cmphi gt r
-
-
-
-{--------------------------------------------------------------------
-  Intersection
---------------------------------------------------------------------}
--- | /O(n+m)/. Intersection of two maps. The values in the first
--- map are returned, i.e. (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@).
-intersection :: Ord k => Map k a -> Map k b -> Map k a
-intersection m1 m2
-  = intersectionWithKey (\k x y -> x) m1 m2
-
--- | /O(n+m)/. Intersection with a combining function.
-intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c
-intersectionWith f m1 m2
-  = intersectionWithKey (\k x y -> f x y) m1 m2
-
--- | /O(n+m)/. Intersection with a combining function.
--- Intersection is more efficient on (bigset `intersection` smallset)
---intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
---intersectionWithKey f Tip t = Tip
---intersectionWithKey f t Tip = Tip
---intersectionWithKey f t1 t2 = intersectWithKey f t1 t2
---
---intersectWithKey f Tip t = Tip
---intersectWithKey f t Tip = Tip
---intersectWithKey f t (Bin _ kx x l r)
---  = case found of
---      Nothing -> merge tl tr
---      Just y  -> join kx (f kx y x) tl tr
---  where
---    (lt,found,gt) = splitLookup kx t
---    tl            = intersectWithKey f lt l
---    tr            = intersectWithKey f gt r
-
-
-intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
-intersectionWithKey f Tip t = Tip
-intersectionWithKey f t Tip = Tip
-intersectionWithKey f t1@(Bin s1 k1 x1 l1 r1) t2@(Bin s2 k2 x2 l2 r2) =
-   if s1 >= s2 then
-      let (lt,found,gt) = splitLookupWithKey k2 t1
-          tl            = intersectionWithKey f lt l2
-          tr            = intersectionWithKey f gt r2
-      in case found of
-      Just (k,x) -> join k (f k x x2) tl tr
-      Nothing -> merge tl tr
-   else let (lt,found,gt) = splitLookup k1 t2
-            tl            = intersectionWithKey f l1 lt
-            tr            = intersectionWithKey f r1 gt
-      in case found of
-      Just x -> join k1 (f k1 x1 x) tl tr
-      Nothing -> merge tl tr
-
-
-
-{--------------------------------------------------------------------
-  Submap
---------------------------------------------------------------------}
--- | /O(n+m)/. 
--- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
-isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
-isSubmapOf m1 m2
-  = isSubmapOfBy (==) m1 m2
-
-{- | /O(n+m)/. 
- The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if
- all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when
- applied to their respective values. For example, the following 
- expressions are all 'True':
- > isSubmapOfBy (==) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
- > isSubmapOfBy (<=) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
- > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)])
-
- But the following are all 'False':
- > isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)])
- > isSubmapOfBy (<)  (fromList [('a',1)]) (fromList [('a',1),('b',2)])
- > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1)])
--}
-isSubmapOfBy :: Ord k => (a->b->Bool) -> Map k a -> Map k b -> Bool
-isSubmapOfBy f t1 t2
-  = (size t1 <= size t2) && (submap' f t1 t2)
-
-submap' f Tip t = True
-submap' f t Tip = False
-submap' f (Bin _ kx x l r) t
-  = case found of
-      Nothing -> False
-      Just y  -> f x y && submap' f l lt && submap' f r gt
-  where
-    (lt,found,gt) = splitLookup kx t
-
--- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal). 
--- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
-isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
-isProperSubmapOf m1 m2
-  = isProperSubmapOfBy (==) m1 m2
-
-{- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
- The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
- @m1@ and @m2@ are not equal,
- all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
- applied to their respective values. For example, the following 
- expressions are all 'True':
-  > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
-  > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
-
- But the following are all 'False':
-  > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
-  > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
-  > isProperSubmapOfBy (<)  (fromList [(1,1)])       (fromList [(1,1),(2,2)])
--}
-isProperSubmapOfBy :: Ord k => (a -> b -> Bool) -> Map k a -> Map k b -> Bool
-isProperSubmapOfBy f t1 t2
-  = (size t1 < size t2) && (submap' f t1 t2)
-
-{--------------------------------------------------------------------
-  Filter and partition
---------------------------------------------------------------------}
--- | /O(n)/. Filter all values that satisfy the predicate.
-filter :: Ord k => (a -> Bool) -> Map k a -> Map k a
-filter p m
-  = filterWithKey (\k x -> p x) m
-
--- | /O(n)/. Filter all keys\/values that satisfy the predicate.
-filterWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> Map k a
-filterWithKey p Tip = Tip
-filterWithKey p (Bin _ kx x l r)
-  | p kx x    = join kx x (filterWithKey p l) (filterWithKey p r)
-  | otherwise = merge (filterWithKey p l) (filterWithKey p r)
-
-
--- | /O(n)/. partition the map according to a predicate. The first
--- map contains all elements that satisfy the predicate, the second all
--- elements that fail the predicate. See also 'split'.
-partition :: Ord k => (a -> Bool) -> Map k a -> (Map k a,Map k a)
-partition p m
-  = partitionWithKey (\k x -> p x) m
-
--- | /O(n)/. partition the map according to a predicate. The first
--- map contains all elements that satisfy the predicate, the second all
--- elements that fail the predicate. See also 'split'.
-partitionWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> (Map k a,Map k a)
-partitionWithKey p Tip = (Tip,Tip)
-partitionWithKey p (Bin _ kx x l r)
-  | p kx x    = (join kx x l1 r1,merge l2 r2)
-  | otherwise = (merge l1 r1,join kx x l2 r2)
-  where
-    (l1,l2) = partitionWithKey p l
-    (r1,r2) = partitionWithKey p r
-
--- | /O(n)/. Map values and collect the 'Just' results.
-mapMaybe :: Ord k => (a -> Maybe b) -> Map k a -> Map k b
-mapMaybe f m
-  = mapMaybeWithKey (\k x -> f x) m
-
--- | /O(n)/. Map keys\/values and collect the 'Just' results.
-mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b
-mapMaybeWithKey f Tip = Tip
-mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of
-  Just y  -> join kx y (mapMaybeWithKey f l) (mapMaybeWithKey f r)
-  Nothing -> merge (mapMaybeWithKey f l) (mapMaybeWithKey f r)
-
--- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
-mapEither :: Ord k => (a -> Either b c) -> Map k a -> (Map k b, Map k c)
-mapEither f m
-  = mapEitherWithKey (\k x -> f x) m
-
--- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
-mapEitherWithKey :: Ord k =>
-  (k -> a -> Either b c) -> Map k a -> (Map k b, Map k c)
-mapEitherWithKey f Tip = (Tip, Tip)
-mapEitherWithKey f (Bin _ kx x l r) = case f kx x of
-  Left y  -> (join kx y l1 r1, merge l2 r2)
-  Right z -> (merge l1 r1, join kx z l2 r2)
-  where
-    (l1,l2) = mapEitherWithKey f l
-    (r1,r2) = mapEitherWithKey f r
-
-{--------------------------------------------------------------------
-  Mapping
---------------------------------------------------------------------}
--- | /O(n)/. Map a function over all values in the map.
-map :: (a -> b) -> Map k a -> Map k b
-map f m
-  = mapWithKey (\k x -> f x) m
-
--- | /O(n)/. Map a function over all values in the map.
-mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
-mapWithKey f Tip = Tip
-mapWithKey f (Bin sx kx x l r) 
-  = Bin sx kx (f kx x) (mapWithKey f l) (mapWithKey f r)
-
--- | /O(n)/. The function 'mapAccum' threads an accumulating
--- argument through the map in ascending order of keys.
-mapAccum :: (a -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
-mapAccum f a m
-  = mapAccumWithKey (\a k x -> f a x) a m
-
--- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating
--- argument through the map in ascending order of keys.
-mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
-mapAccumWithKey f a t
-  = mapAccumL f a t
-
--- | /O(n)/. The function 'mapAccumL' threads an accumulating
--- argument throught the map in ascending order of keys.
-mapAccumL :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
-mapAccumL f a t
-  = case t of
-      Tip -> (a,Tip)
-      Bin sx kx x l r
-          -> let (a1,l') = mapAccumL f a l
-                 (a2,x') = f a1 kx x
-                 (a3,r') = mapAccumL f a2 r
-             in (a3,Bin sx kx x' l' r')
-
--- | /O(n)/. The function 'mapAccumR' threads an accumulating
--- argument throught the map in descending order of keys.
-mapAccumR :: (a -> k -> b -> (a,c)) -> a -> Map k b -> (a,Map k c)
-mapAccumR f a t
-  = case t of
-      Tip -> (a,Tip)
-      Bin sx kx x l r 
-          -> let (a1,r') = mapAccumR f a r
-                 (a2,x') = f a1 kx x
-                 (a3,l') = mapAccumR f a2 l
-             in (a3,Bin sx kx x' l' r')
-
--- | /O(n*log n)/. 
--- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
--- 
--- The size of the result may be smaller if @f@ maps two or more distinct
--- keys to the same new key.  In this case the value at the smallest of
--- these keys is retained.
-
-mapKeys :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a
-mapKeys = mapKeysWith (\x y->x)
-
--- | /O(n*log n)/. 
--- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
--- 
--- The size of the result may be smaller if @f@ maps two or more distinct
--- keys to the same new key.  In this case the associated values will be
--- combined using @c@.
-
-mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a
-mapKeysWith c f = fromListWith c . List.map fFirst . toList
-    where fFirst (x,y) = (f x, y)
-
-
--- | /O(n)/.
--- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
--- is strictly monotonic.
--- /The precondition is not checked./
--- Semi-formally, we have:
--- 
--- > and [x < y ==> f x < f y | x <- ls, y <- ls] 
--- >                     ==> mapKeysMonotonic f s == mapKeys f s
--- >     where ls = keys s
-
-mapKeysMonotonic :: (k1->k2) -> Map k1 a -> Map k2 a
-mapKeysMonotonic f Tip = Tip
-mapKeysMonotonic f (Bin sz k x l r) =
-    Bin sz (f k) x (mapKeysMonotonic f l) (mapKeysMonotonic f r)
-
-{--------------------------------------------------------------------
-  Folds  
---------------------------------------------------------------------}
-
--- | /O(n)/. Fold the values in the map, such that
--- @'fold' f z == 'Prelude.foldr' f z . 'elems'@.
--- For example,
---
--- > elems map = fold (:) [] map
---
-fold :: (a -> b -> b) -> b -> Map k a -> b
-fold f z m
-  = foldWithKey (\k x z -> f x z) z m
-
--- | /O(n)/. Fold the keys and values in the map, such that
--- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
--- For example,
---
--- > keys map = foldWithKey (\k x ks -> k:ks) [] map
---
-foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
-foldWithKey f z t
-  = foldr f z t
-
--- | /O(n)/. In-order fold.
-foldi :: (k -> a -> b -> b -> b) -> b -> Map k a -> b 
-foldi f z Tip               = z
-foldi f z (Bin _ kx x l r)  = f kx x (foldi f z l) (foldi f z r)
-
--- | /O(n)/. Post-order fold.
-foldr :: (k -> a -> b -> b) -> b -> Map k a -> b
-foldr f z Tip              = z
-foldr f z (Bin _ kx x l r) = foldr f (f kx x (foldr f z r)) l
-
--- | /O(n)/. Pre-order fold.
-foldl :: (b -> k -> a -> b) -> b -> Map k a -> b
-foldl f z Tip              = z
-foldl f z (Bin _ kx x l r) = foldl f (f (foldl f z l) kx x) r
-
-{--------------------------------------------------------------------
-  List variations 
---------------------------------------------------------------------}
--- | /O(n)/.
--- Return all elements of the map in the ascending order of their keys.
-elems :: Map k a -> [a]
-elems m
-  = [x | (k,x) <- assocs m]
-
--- | /O(n)/. Return all keys of the map in ascending order.
-keys  :: Map k a -> [k]
-keys m
-  = [k | (k,x) <- assocs m]
-
--- | /O(n)/. The set of all keys of the map.
-keysSet :: Map k a -> Set.Set k
-keysSet m = Set.fromDistinctAscList (keys m)
-
--- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
-assocs :: Map k a -> [(k,a)]
-assocs m
-  = toList m
-
-{--------------------------------------------------------------------
-  Lists 
-  use [foldlStrict] to reduce demand on the control-stack
---------------------------------------------------------------------}
--- | /O(n*log n)/. Build a map from a list of key\/value pairs. See also 'fromAscList'.
-fromList :: Ord k => [(k,a)] -> Map k a 
-fromList xs       
-  = foldlStrict ins empty xs
-  where
-    ins t (k,x) = insert k x t
-
--- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
-fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a 
-fromListWith f xs
-  = fromListWithKey (\k x y -> f x y) xs
-
--- | /O(n*log n)/. Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'.
-fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a 
-fromListWithKey f xs 
-  = foldlStrict ins empty xs
-  where
-    ins t (k,x) = insertWithKey f k x t
-
--- | /O(n)/. Convert to a list of key\/value pairs.
-toList :: Map k a -> [(k,a)]
-toList t      = toAscList t
-
--- | /O(n)/. Convert to an ascending list.
-toAscList :: Map k a -> [(k,a)]
-toAscList t   = foldr (\k x xs -> (k,x):xs) [] t
-
--- | /O(n)/. 
-toDescList :: Map k a -> [(k,a)]
-toDescList t  = foldl (\xs k x -> (k,x):xs) [] t
-
-
-{--------------------------------------------------------------------
-  Building trees from ascending/descending lists can be done in linear time.
-  
-  Note that if [xs] is ascending that: 
-    fromAscList xs       == fromList xs
-    fromAscListWith f xs == fromListWith f xs
---------------------------------------------------------------------}
--- | /O(n)/. Build a map from an ascending list in linear time.
--- /The precondition (input list is ascending) is not checked./
-fromAscList :: Eq k => [(k,a)] -> Map k a 
-fromAscList xs
-  = fromAscListWithKey (\k x y -> x) xs
-
--- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.
--- /The precondition (input list is ascending) is not checked./
-fromAscListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a 
-fromAscListWith f xs
-  = fromAscListWithKey (\k x y -> f x y) xs
-
--- | /O(n)/. Build a map from an ascending list in linear time with a
--- combining function for equal keys.
--- /The precondition (input list is ascending) is not checked./
-fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a 
-fromAscListWithKey f xs
-  = fromDistinctAscList (combineEq f xs)
-  where
-  -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
-  combineEq f xs
-    = case xs of
-        []     -> []
-        [x]    -> [x]
-        (x:xx) -> combineEq' x xx
-
-  combineEq' z [] = [z]
-  combineEq' z@(kz,zz) (x@(kx,xx):xs)
-    | kx==kz    = let yy = f kx xx zz in combineEq' (kx,yy) xs
-    | otherwise = z:combineEq' x xs
-
-
--- | /O(n)/. Build a map from an ascending list of distinct elements in linear time.
--- /The precondition is not checked./
-fromDistinctAscList :: [(k,a)] -> Map k 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
-                       ((k1,x1):(k2,x2):(k3,x3):(k4,x4):(k5,x5):xx) 
-                            -> c (bin k4 x4 (bin k2 x2 (singleton k1 x1) (singleton k3 x3)) (singleton k5 x5)) xx
-    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 ((k,x):ys) = build (buildB l k x c) n ys
-    buildB l k x c r zs     = c (bin k x l r) zs
-                      
-
-
-{--------------------------------------------------------------------
-  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 k]
-  should be read as [compare lo k].
-
-  [trim cmplo cmphi t]  A tree that is either empty or where [cmplo k == LT]
-                        and [cmphi k == GT] for the key [k] of the root.
-  [filterGt cmp t]      A tree where for all keys [k]. [cmp k == LT]
-  [filterLt cmp t]      A tree where for all keys [k]. [cmp k == GT]
-
-  [split k t]           Returns two trees [l] and [r] where all keys
-                        in [l] are <[k] and all keys in [r] are >[k].
-  [splitLookup 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 :: (k -> Ordering) -> (k -> Ordering) -> Map k a -> Map k a
-trim cmplo cmphi Tip = Tip
-trim cmplo cmphi t@(Bin sx kx x l r)
-  = case cmplo kx of
-      LT -> case cmphi kx of
-              GT -> t
-              le -> trim cmplo cmphi l
-      ge -> trim cmplo cmphi r
-              
-trimLookupLo :: Ord k => k -> (k -> Ordering) -> Map k a -> (Maybe (k,a), Map k a)
-trimLookupLo lo cmphi Tip = (Nothing,Tip)
-trimLookupLo lo cmphi t@(Bin sx kx x l r)
-  = case compare lo kx of
-      LT -> case cmphi kx of
-              GT -> (lookupAssoc lo t, t)
-              le -> trimLookupLo lo cmphi l
-      GT -> trimLookupLo lo cmphi r
-      EQ -> (Just (kx,x),trim (compare lo) cmphi r)
-
-
-{--------------------------------------------------------------------
-  [filterGt k t] filter all keys >[k] from tree [t]
-  [filterLt k t] filter all keys <[k] from tree [t]
---------------------------------------------------------------------}
-filterGt :: Ord k => (k -> Ordering) -> Map k a -> Map k a
-filterGt cmp Tip = Tip
-filterGt cmp (Bin sx kx x l r)
-  = case cmp kx of
-      LT -> join kx x (filterGt cmp l) r
-      GT -> filterGt cmp r
-      EQ -> r
-      
-filterLt :: Ord k => (k -> Ordering) -> Map k a -> Map k a
-filterLt cmp Tip = Tip
-filterLt cmp (Bin sx kx x l r)
-  = case cmp kx of
-      LT -> filterLt cmp l
-      GT -> join kx x l (filterLt cmp r)
-      EQ -> l
-
-{--------------------------------------------------------------------
-  Split
---------------------------------------------------------------------}
--- | /O(log n)/. The expression (@'split' k map@) is a pair @(map1,map2)@ where
--- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@. Any key equal to @k@ is found in neither @map1@ nor @map2@.
-split :: Ord k => k -> Map k a -> (Map k a,Map k a)
-split k Tip = (Tip,Tip)
-split k (Bin sx kx x l r)
-  = case compare k kx of
-      LT -> let (lt,gt) = split k l in (lt,join kx x gt r)
-      GT -> let (lt,gt) = split k r in (join kx x l lt,gt)
-      EQ -> (l,r)
-
--- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just
--- like 'split' but also returns @'lookup' k map@.
-splitLookup :: Ord k => k -> Map k a -> (Map k a,Maybe a,Map k a)
-splitLookup k Tip = (Tip,Nothing,Tip)
-splitLookup k (Bin sx kx x l r)
-  = case compare k kx of
-      LT -> let (lt,z,gt) = splitLookup k l in (lt,z,join kx x gt r)
-      GT -> let (lt,z,gt) = splitLookup k r in (join kx x l lt,z,gt)
-      EQ -> (l,Just x,r)
-
--- | /O(log n)/.
-splitLookupWithKey :: Ord k => k -> Map k a -> (Map k a,Maybe (k,a),Map k a)
-splitLookupWithKey k Tip = (Tip,Nothing,Tip)
-splitLookupWithKey k (Bin sx kx x l r)
-  = case compare k kx of
-      LT -> let (lt,z,gt) = splitLookupWithKey k l in (lt,z,join kx x gt r)
-      GT -> let (lt,z,gt) = splitLookupWithKey k r in (join kx x l lt,z,gt)
-      EQ -> (l,Just (kx, x),r)
-
--- | /O(log n)/. Performs a 'split' but also returns whether the pivot
--- element was found in the original set.
-splitMember :: Ord k => k -> Map k a -> (Map k a,Bool,Map k a)
-splitMember x t = let (l,m,r) = splitLookup x t in
-     (l,maybe False (const True) m,r)
-
-
-{--------------------------------------------------------------------
-  Utility functions that maintain the balance properties of the tree.
-  All constructors assume that all values in [l] < [k] and all values
-  in [r] > [k], and that [l] and [r] are valid trees.
-  
-  In order of sophistication:
-    [Bin sz k x l r]  The type constructor.
-    [bin k x l r]     Maintains the correct size, assumes that both [l]
-                      and [r] are balanced with respect to each other.
-    [balance k 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 k 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 :: Ord k => k -> a -> Map k a -> Map k a -> Map k a
-join kx x Tip r  = insertMin kx x r
-join kx x l Tip  = insertMax kx x l
-join kx x l@(Bin sizeL ky y ly ry) r@(Bin sizeR kz z lz rz)
-  | delta*sizeL <= sizeR  = balance kz z (join kx x l lz) rz
-  | delta*sizeR <= sizeL  = balance ky y ly (join kx x ry r)
-  | otherwise             = bin kx x l r
-
-
--- insertMin and insertMax don't perform potentially expensive comparisons.
-insertMax,insertMin :: k -> a -> Map k a -> Map k a 
-insertMax kx x t
-  = case t of
-      Tip -> singleton kx x
-      Bin sz ky y l r
-          -> balance ky y l (insertMax kx x r)
-             
-insertMin kx x t
-  = case t of
-      Tip -> singleton kx x
-      Bin sz ky y l r
-          -> balance ky y (insertMin kx x l) r
-             
-{--------------------------------------------------------------------
-  [merge l r]: merges two trees.
---------------------------------------------------------------------}
-merge :: Map k a -> Map k a -> Map k a
-merge Tip r   = r
-merge l Tip   = l
-merge l@(Bin sizeL kx x lx rx) r@(Bin sizeR ky y ly ry)
-  | delta*sizeL <= sizeR = balance ky y (merge l ly) ry
-  | delta*sizeR <= sizeL = balance kx 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 :: Map k a -> Map k a -> Map k a
-glue Tip r = r
-glue l Tip = l
-glue l r   
-  | size l > size r = let ((km,m),l') = deleteFindMax l in balance km m l' r
-  | otherwise       = let ((km,m),r') = deleteFindMin r in balance km m l r'
-
-
--- | /O(log n)/. Delete and find the minimal element.
-deleteFindMin :: Map k a -> ((k,a),Map k a)
-deleteFindMin t 
-  = case t of
-      Bin _ k x Tip r -> ((k,x),r)
-      Bin _ k x l r   -> let (km,l') = deleteFindMin l in (km,balance k x l' r)
-      Tip             -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)
-
--- | /O(log n)/. Delete and find the maximal element.
-deleteFindMax :: Map k a -> ((k,a),Map k a)
-deleteFindMax t
-  = case t of
-      Bin _ k x l Tip -> ((k,x),l)
-      Bin _ k x l r   -> let (km,r') = deleteFindMax r in (km,balance k x l r')
-      Tip             -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip)
-
-
-{--------------------------------------------------------------------
-  [balance l x 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.
-  [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, and in practice, a rather large
-    [delta] may perform better than smaller one.
-
-  Note: in contrast to Adam's 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 an invalid ratio of [1].
---------------------------------------------------------------------}
-delta,ratio :: Int
-delta = 5
-ratio = 2
-
-balance :: k -> a -> Map k a -> Map k a -> Map k a
-balance k x l r
-  | sizeL + sizeR <= 1    = Bin sizeX k x l r
-  | sizeR >= delta*sizeL  = rotateL k x l r
-  | sizeL >= delta*sizeR  = rotateR k x l r
-  | otherwise             = Bin sizeX k x l r
-  where
-    sizeL = size l
-    sizeR = size r
-    sizeX = sizeL + sizeR + 1
-
--- rotate
-rotateL k x l r@(Bin _ _ _ ly ry)
-  | size ly < ratio*size ry = singleL k x l r
-  | otherwise               = doubleL k x l r
-
-rotateR k x l@(Bin _ _ _ ly ry) r
-  | size ry < ratio*size ly = singleR k x l r
-  | otherwise               = doubleR k x l r
-
--- basic rotations
-singleL k1 x1 t1 (Bin _ k2 x2 t2 t3)  = bin k2 x2 (bin k1 x1 t1 t2) t3
-singleR k1 x1 (Bin _ k2 x2 t1 t2) t3  = bin k2 x2 t1 (bin k1 x1 t2 t3)
-
-doubleL k1 x1 t1 (Bin _ k2 x2 (Bin _ k3 x3 t2 t3) t4) = bin k3 x3 (bin k1 x1 t1 t2) (bin k2 x2 t3 t4)
-doubleR k1 x1 (Bin _ k2 x2 t1 (Bin _ k3 x3 t2 t3)) t4 = bin k3 x3 (bin k2 x2 t1 t2) (bin k1 x1 t3 t4)
-
-
-{--------------------------------------------------------------------
-  The bin constructor maintains the size of the tree
---------------------------------------------------------------------}
-bin :: k -> a -> Map k a -> Map k a -> Map k a
-bin k x l r
-  = Bin (size l + size r + 1) k x l r
-
-
-{--------------------------------------------------------------------
-  Eq converts the tree 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 (Eq k,Eq a) => Eq (Map k a) where
-  t1 == t2  = (size t1 == size t2) && (toAscList t1 == toAscList t2)
-
-{--------------------------------------------------------------------
-  Ord 
---------------------------------------------------------------------}
-
-instance (Ord k, Ord v) => Ord (Map k v) where
-    compare m1 m2 = compare (toAscList m1) (toAscList m2)
-
-{--------------------------------------------------------------------
-  Functor
---------------------------------------------------------------------}
-instance Functor (Map k) where
-  fmap f m  = map f m
-
-instance Traversable (Map k) where
-  traverse f Tip = pure Tip
-  traverse f (Bin s k v l r)
-    = flip (Bin s k) <$> traverse f l <*> f v <*> traverse f r
-
-instance Foldable (Map k) where
-  foldMap _f Tip = mempty
-  foldMap f (Bin _s _k v l r)
-    = foldMap f l `mappend` f v `mappend` foldMap f r
-
-{--------------------------------------------------------------------
-  Read
---------------------------------------------------------------------}
-instance (Ord k, Read k, Read e) => Read (Map k e) 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
-
--- parses a pair of things with the syntax a:=b
-readPair :: (Read a, Read b) => ReadS (a,b)
-readPair s = do (a, ct1)    <- reads s
-                (":=", ct2) <- lex ct1
-                (b, ct3)    <- reads ct2
-                return ((a,b), ct3)
-
-{--------------------------------------------------------------------
-  Show
---------------------------------------------------------------------}
-instance (Show k, Show a) => Show (Map k a) where
-  showsPrec d m  = showParen (d > 10) $
-    showString "fromList " . shows (toList m)
-
-showMap :: (Show k,Show a) => [(k,a)] -> ShowS
-showMap []     
-  = showString "{}" 
-showMap (x:xs) 
-  = showChar '{' . showElem x . showTail xs
-  where
-    showTail []     = showChar '}'
-    showTail (x:xs) = showString ", " . showElem x . showTail xs
-    
-    showElem (k,x)  = shows k . showString " := " . shows x
-  
-
--- | /O(n)/. Show the tree that implements the map. The tree is shown
--- in a compressed, hanging format.
-showTree :: (Show k,Show a) => Map k a -> String
-showTree m
-  = showTreeWith showElem True False m
-  where
-    showElem k x  = show k ++ ":=" ++ show x
-
-
-{- | /O(n)/. The expression (@'showTreeWith' showelem hang wide map@) shows
- the tree that implements the map. Elements are shown using the @showElem@ function. 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.
-
->  Map> let t = fromDistinctAscList [(x,()) | x <- [1..5]]
->  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True False t
->  (4,())
->  +--(2,())
->  |  +--(1,())
->  |  +--(3,())
->  +--(5,())
->
->  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True True t
->  (4,())
->  |
->  +--(2,())
->  |  |
->  |  +--(1,())
->  |  |
->  |  +--(3,())
->  |
->  +--(5,())
->
->  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) False True t
->  +--(5,())
->  |
->  (4,())
->  |
->  |  +--(3,())
->  |  |
->  +--(2,())
->     |
->     +--(1,())
-
--}
-showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String
-showTreeWith showelem hang wide t
-  | hang      = (showsTreeHang showelem wide [] t) ""
-  | otherwise = (showsTree showelem wide [] [] t) ""
-
-showsTree :: (k -> a -> String) -> Bool -> [String] -> [String] -> Map k a -> ShowS
-showsTree showelem wide lbars rbars t
-  = case t of
-      Tip -> showsBars lbars . showString "|\n"
-      Bin sz kx x Tip Tip
-          -> showsBars lbars . showString (showelem kx x) . showString "\n" 
-      Bin sz kx x l r
-          -> showsTree showelem wide (withBar rbars) (withEmpty rbars) r .
-             showWide wide rbars .
-             showsBars lbars . showString (showelem kx x) . showString "\n" .
-             showWide wide lbars .
-             showsTree showelem wide (withEmpty lbars) (withBar lbars) l
-
-showsTreeHang :: (k -> a -> String) -> Bool -> [String] -> Map k a -> ShowS
-showsTreeHang showelem wide bars t
-  = case t of
-      Tip -> showsBars bars . showString "|\n" 
-      Bin sz kx x Tip Tip
-          -> showsBars bars . showString (showelem kx x) . showString "\n" 
-      Bin sz kx x l r
-          -> showsBars bars . showString (showelem kx x) . showString "\n" . 
-             showWide wide bars .
-             showsTreeHang showelem wide (withBar bars) l .
-             showWide wide bars .
-             showsTreeHang showelem wide (withEmpty bars) r
-
-
-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           = "+--"
-withBar bars   = "|  ":bars
-withEmpty bars = "   ":bars
-
-{--------------------------------------------------------------------
-  Typeable
---------------------------------------------------------------------}
-
-#include "Typeable.h"
-INSTANCE_TYPEABLE2(Map,mapTc,"Map")
-
-{--------------------------------------------------------------------
-  Assertions
---------------------------------------------------------------------}
--- | /O(n)/. Test if the internal map structure is valid.
-valid :: Ord k => Map k a -> Bool
-valid t
-  = balanced t && ordered t && validsize t
-
-ordered t
-  = bounded (const True) (const True) t
-  where
-    bounded lo hi t
-      = case t of
-          Tip              -> True
-          Bin sz kx x l r  -> (lo kx) && (hi kx) && bounded lo (<kx) l && bounded (>kx) hi r
-
--- | Exported only for "Debug.QuickCheck"
-balanced :: Map k a -> Bool
-balanced t
-  = case t of
-      Tip              -> True
-      Bin sz kx x l r  -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) &&
-                          balanced l && balanced r
-
-
-validsize t
-  = (realsize t == Just (size t))
-  where
-    realsize t
-      = case t of
-          Tip             -> Just 0
-          Bin sz kx x l r -> case (realsize l,realsize r) of
-                              (Just n,Just m)  | n+m+1 == sz  -> Just sz
-                              other            -> Nothing
-
-{--------------------------------------------------------------------
-  Utilities
---------------------------------------------------------------------}
-foldlStrict f z xs
-  = case xs of
-      []     -> z
-      (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
-
-
-{-
-{--------------------------------------------------------------------
-  Testing
---------------------------------------------------------------------}
-testTree xs   = fromList [(x,"*") | x <- 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 (Enum k,Arbitrary a) => Arbitrary (Map k a) where
-  arbitrary = sized (arbtree 0 maxkey)
-            where maxkey  = 10000
-
-arbtree :: (Enum k,Arbitrary a) => Int -> Int -> Int -> Gen (Map k a)
-arbtree lo hi n
-  | n <= 0        = return Tip
-  | lo >= hi      = return Tip
-  | otherwise     = do{ x  <- arbitrary 
-                      ; 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) x l r)
-                      }  
-
-
-{--------------------------------------------------------------------
-  Valid tree's
---------------------------------------------------------------------}
-forValid :: (Show k,Enum k,Show a,Arbitrary a,Testable b) => (Map k 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 => (Map Int Int -> a) -> Property
-forValidIntTree f
-  = forValid f
-
-forValidUnitTree :: Testable a => (Map Int () -> a) -> Property
-forValidUnitTree f
-  = forValid f
-
-
-prop_Valid 
-  = forValidUnitTree $ \t -> valid t
-
-{--------------------------------------------------------------------
-  Single, Insert, Delete
---------------------------------------------------------------------}
-prop_Single :: Int -> Int -> Bool
-prop_Single k x
-  = (insert k x empty == singleton k x)
-
-prop_InsertValid :: Int -> Property
-prop_InsertValid k
-  = forValidUnitTree $ \t -> valid (insert k () t)
-
-prop_InsertDelete :: Int -> Map Int () -> Property
-prop_InsertDelete k t
-  = (lookup k t == Nothing) ==> 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 k 
-  = forValidUnitTree $ \t ->
-    let (l,r) = split k t
-    in valid (join k () l r)
-
-prop_Merge :: Int -> Property 
-prop_Merge k
-  = forValidUnitTree $ \t ->
-    let (l,r) = split k t
-    in valid (merge l r)
-
-
-{--------------------------------------------------------------------
-  Union
---------------------------------------------------------------------}
-prop_UnionValid :: Property
-prop_UnionValid
-  = forValidUnitTree $ \t1 ->
-    forValidUnitTree $ \t2 ->
-    valid (union t1 t2)
-
-prop_UnionInsert :: Int -> Int -> Map Int Int -> Bool
-prop_UnionInsert k x t
-  = union (singleton k x) t == insert k x t
-
-prop_UnionAssoc :: Map Int Int -> Map Int Int -> Map Int Int -> Bool
-prop_UnionAssoc t1 t2 t3
-  = union t1 (union t2 t3) == union (union t1 t2) t3
-
-prop_UnionComm :: Map Int Int -> Map Int Int -> Bool
-prop_UnionComm t1 t2
-  = (union t1 t2 == unionWith (\x y -> y) t2 t1)
-
-prop_UnionWithValid 
-  = forValidIntTree $ \t1 ->
-    forValidIntTree $ \t2 ->
-    valid (unionWithKey (\k x y -> x+y) t1 t2)
-
-prop_UnionWith :: [(Int,Int)] -> [(Int,Int)] -> Bool
-prop_UnionWith xs ys
-  = sum (elems (unionWith (+) (fromListWith (+) xs) (fromListWith (+) ys))) 
-    == (sum (Prelude.map snd xs) + sum (Prelude.map snd ys))
-
-prop_DiffValid
-  = forValidUnitTree $ \t1 ->
-    forValidUnitTree $ \t2 ->
-    valid (difference t1 t2)
-
-prop_Diff :: [(Int,Int)] -> [(Int,Int)] -> Bool
-prop_Diff xs ys
-  =  List.sort (keys (difference (fromListWith (+) xs) (fromListWith (+) ys))) 
-    == List.sort ((List.\\) (nub (Prelude.map fst xs))  (nub (Prelude.map fst ys)))
-
-prop_IntValid
-  = forValidUnitTree $ \t1 ->
-    forValidUnitTree $ \t2 ->
-    valid (intersection t1 t2)
-
-prop_Int :: [(Int,Int)] -> [(Int,Int)] -> Bool
-prop_Int xs ys
-  =  List.sort (keys (intersection (fromListWith (+) xs) (fromListWith (+) ys))) 
-    == List.sort (nub ((List.intersect) (Prelude.map fst xs)  (Prelude.map fst ys)))
-
-{--------------------------------------------------------------------
-  Lists
---------------------------------------------------------------------}
-prop_Ordered
-  = forAll (choose (5,100)) $ \n ->
-    let xs = [(x,()) | x <- [0..n::Int]] 
-    in fromAscList xs == fromList xs
-
-prop_List :: [Int] -> Bool
-prop_List xs
-  = (sort (nub xs) == [x | (x,()) <- toList (fromList [(x,()) | x <- xs])])
--}
diff --git a/libraries/base/Data/Sequence.hs b/libraries/base/Data/Sequence.hs
deleted file mode 100644 (file)
index 318dc20..0000000
+++ /dev/null
@@ -1,1124 +0,0 @@
-{-# OPTIONS -cpp -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Sequence
--- Copyright   :  (c) Ross Paterson 2005
--- License     :  BSD-style
--- Maintainer  :  ross@soi.city.ac.uk
--- Stability   :  experimental
--- Portability :  portable
---
--- General purpose finite sequences.
--- Apart from being finite and having strict operations, sequences
--- also differ from lists in supporting a wider variety of operations
--- efficiently.
---
--- An amortized running time is given for each operation, with /n/ referring
--- to the length of the sequence and /i/ being the integral index used by
--- some operations.  These bounds hold even in a persistent (shared) setting.
---
--- The implementation uses 2-3 finger trees annotated with sizes,
--- as described in section 4.2 of
---
---    * Ralf Hinze and Ross Paterson,
---     \"Finger trees: a simple general-purpose data structure\",
---     /Journal of Functional Programming/ 16:2 (2006) pp 197-217.
---     <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
---
--- /Note/: Many of these operations have the same names as similar
--- operations on lists in the "Prelude".  The ambiguity may be resolved
--- using either qualification or the @hiding@ clause.
---
------------------------------------------------------------------------------
-
-module Data.Sequence (
-       Seq,
-       -- * Construction
-       empty,          -- :: Seq a
-       singleton,      -- :: a -> Seq a
-       (<|),           -- :: a -> Seq a -> Seq a
-       (|>),           -- :: Seq a -> a -> Seq a
-       (><),           -- :: Seq a -> Seq a -> Seq a
-       fromList,       -- :: [a] -> Seq a
-       -- * Deconstruction
-       -- | Additional functions for deconstructing sequences are available
-       -- via the 'Foldable' instance of 'Seq'.
-
-       -- ** Queries
-       null,           -- :: Seq a -> Bool
-       length,         -- :: Seq a -> Int
-       -- ** Views
-       ViewL(..),
-       viewl,          -- :: Seq a -> ViewL a
-       ViewR(..),
-       viewr,          -- :: Seq a -> ViewR a
-       -- ** Indexing
-       index,          -- :: Seq a -> Int -> a
-       adjust,         -- :: (a -> a) -> Int -> Seq a -> Seq a
-       update,         -- :: Int -> a -> Seq a -> Seq a
-       take,           -- :: Int -> Seq a -> Seq a
-       drop,           -- :: Int -> Seq a -> Seq a
-       splitAt,        -- :: Int -> Seq a -> (Seq a, Seq a)
-       -- * Transformations
-       reverse,        -- :: Seq a -> Seq a
-#if TESTING
-       valid,
-#endif
-       ) where
-
-import Prelude hiding (
-       null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
-       reverse)
-import qualified Data.List (foldl')
-import Control.Applicative (Applicative(..), (<$>))
-import Control.Monad (MonadPlus(..))
-import Data.Monoid (Monoid(..))
-import Data.Foldable
-import Data.Traversable
-import Data.Typeable
-
-#ifdef __GLASGOW_HASKELL__
-import Text.Read (Lexeme(Ident), lexP, parens, prec,
-       readPrec, readListPrec, readListPrecDefault)
-import Data.Generics.Basics (Data(..), Fixity(..),
-                       constrIndex, mkConstr, mkDataType)
-#endif
-
-#if TESTING
-import Control.Monad (liftM, liftM3, liftM4)
-import Test.QuickCheck
-#endif
-
-infixr 5 `consTree`
-infixl 5 `snocTree`
-
-infixr 5 ><
-infixr 5 <|, :<
-infixl 5 |>, :>
-
-class Sized a where
-       size :: a -> Int
-
--- | General-purpose finite sequences.
-newtype Seq a = Seq (FingerTree (Elem a))
-
-instance Functor Seq where
-       fmap f (Seq xs) = Seq (fmap (fmap f) xs)
-
-instance Foldable Seq where
-       foldr f z (Seq xs) = foldr (flip (foldr f)) z xs
-       foldl f z (Seq xs) = foldl (foldl f) z xs
-
-       foldr1 f (Seq xs) = getElem (foldr1 f' xs)
-         where f' (Elem x) (Elem y) = Elem (f x y)
-
-       foldl1 f (Seq xs) = getElem (foldl1 f' xs)
-         where f' (Elem x) (Elem y) = Elem (f x y)
-
-instance Traversable Seq where
-       traverse f (Seq xs) = Seq <$> traverse (traverse f) xs
-
-instance Monad Seq where
-       return = singleton
-       xs >>= f = foldl' add empty xs
-         where add ys x = ys >< f x
-
-instance MonadPlus Seq where
-       mzero = empty
-       mplus = (><)
-
-instance Eq a => Eq (Seq a) where
-       xs == ys = length xs == length ys && toList xs == toList ys
-
-instance Ord a => Ord (Seq a) where
-       compare xs ys = compare (toList xs) (toList ys)
-
-#if TESTING
-instance Show a => Show (Seq a) where
-       showsPrec p (Seq x) = showsPrec p x
-#else
-instance Show a => Show (Seq a) where
-       showsPrec p xs = showParen (p > 10) $
-               showString "fromList " . shows (toList xs)
-#endif
-
-instance Read a => Read (Seq 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
-
-instance Monoid (Seq a) where
-       mempty = empty
-       mappend = (><)
-
-#include "Typeable.h"
-INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
-
-#if __GLASGOW_HASKELL__
-instance Data a => Data (Seq a) where
-       gfoldl f z s    = case viewl s of
-               EmptyL  -> z empty
-               x :< xs -> z (<|) `f` x `f` xs
-
-       gunfold k z c   = case constrIndex c of
-               1 -> z empty
-               2 -> k (k (z (<|)))
-               _ -> error "gunfold"
-
-       toConstr xs
-         | null xs     = emptyConstr
-         | otherwise   = consConstr
-
-       dataTypeOf _    = seqDataType
-
-       dataCast1 f     = gcast1 f
-
-emptyConstr = mkConstr seqDataType "empty" [] Prefix
-consConstr  = mkConstr seqDataType "<|" [] Infix
-seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
-#endif
-
--- Finger trees
-
-data FingerTree a
-       = Empty
-       | Single a
-       | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
-#if TESTING
-       deriving Show
-#endif
-
-instance Sized a => Sized (FingerTree a) where
-       {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
-       {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
-       size Empty              = 0
-       size (Single x)         = size x
-       size (Deep v _ _ _)     = v
-
-instance Foldable FingerTree where
-       foldr _ z Empty = z
-       foldr f z (Single x) = x `f` z
-       foldr f z (Deep _ pr m sf) =
-               foldr f (foldr (flip (foldr f)) (foldr f z sf) m) pr
-
-       foldl _ z Empty = z
-       foldl f z (Single x) = z `f` x
-       foldl f z (Deep _ pr m sf) =
-               foldl f (foldl (foldl f) (foldl f z pr) m) sf
-
-       foldr1 _ Empty = error "foldr1: empty sequence"
-       foldr1 _ (Single x) = x
-       foldr1 f (Deep _ pr m sf) =
-               foldr f (foldr (flip (foldr f)) (foldr1 f sf) m) pr
-
-       foldl1 _ Empty = error "foldl1: empty sequence"
-       foldl1 _ (Single x) = x
-       foldl1 f (Deep _ pr m sf) =
-               foldl f (foldl (foldl f) (foldl1 f pr) m) sf
-
-instance Functor FingerTree where
-       fmap _ Empty = Empty
-       fmap f (Single x) = Single (f x)
-       fmap f (Deep v pr m sf) =
-               Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
-
-instance Traversable FingerTree where
-       traverse _ Empty = pure Empty
-       traverse f (Single x) = Single <$> f x
-       traverse f (Deep v pr m sf) =
-               Deep v <$> traverse f pr <*> traverse (traverse f) m <*>
-                       traverse f sf
-
-{-# INLINE deep #-}
-{-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
-deep           :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
-deep pr m sf   =  Deep (size pr + size m + size sf) pr m sf
-
--- Digits
-
-data Digit a
-       = One a
-       | Two a a
-       | Three a a a
-       | Four a a a a
-#if TESTING
-       deriving Show
-#endif
-
-instance Foldable Digit where
-       foldr f z (One a) = a `f` z
-       foldr f z (Two a b) = a `f` (b `f` z)
-       foldr f z (Three a b c) = a `f` (b `f` (c `f` z))
-       foldr f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))
-
-       foldl f z (One a) = z `f` a
-       foldl f z (Two a b) = (z `f` a) `f` b
-       foldl f z (Three a b c) = ((z `f` a) `f` b) `f` c
-       foldl f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d
-
-       foldr1 f (One a) = a
-       foldr1 f (Two a b) = a `f` b
-       foldr1 f (Three a b c) = a `f` (b `f` c)
-       foldr1 f (Four a b c d) = a `f` (b `f` (c `f` d))
-
-       foldl1 f (One a) = a
-       foldl1 f (Two a b) = a `f` b
-       foldl1 f (Three a b c) = (a `f` b) `f` c
-       foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d
-
-instance Functor Digit where
-       fmap = fmapDefault
-
-instance Traversable Digit where
-       traverse f (One a) = One <$> f a
-       traverse f (Two a b) = Two <$> f a <*> f b
-       traverse f (Three a b c) = Three <$> f a <*> f b <*> f c
-       traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d
-
-instance Sized a => Sized (Digit a) where
-       {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
-       {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
-       size xs = foldl (\ i x -> i + size x) 0 xs
-
-{-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
-digitToTree    :: Sized a => Digit a -> FingerTree a
-digitToTree (One a) = Single a
-digitToTree (Two a b) = deep (One a) Empty (One b)
-digitToTree (Three a b c) = deep (Two a b) Empty (One c)
-digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d)
-
--- Nodes
-
-data Node a
-       = Node2 {-# UNPACK #-} !Int a a
-       | Node3 {-# UNPACK #-} !Int a a a
-#if TESTING
-       deriving Show
-#endif
-
-instance Foldable Node where
-       foldr f z (Node2 _ a b) = a `f` (b `f` z)
-       foldr f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))
-
-       foldl f z (Node2 _ a b) = (z `f` a) `f` b
-       foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
-
-instance Functor Node where
-       fmap = fmapDefault
-
-instance Traversable Node where
-       traverse f (Node2 v a b) = Node2 v <$> f a <*> f b
-       traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
-
-instance Sized (Node a) where
-       size (Node2 v _ _)      = v
-       size (Node3 v _ _ _)    = v
-
-{-# INLINE node2 #-}
-{-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-}
-{-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-}
-node2          :: Sized a => a -> a -> Node a
-node2 a b      =  Node2 (size a + size b) a b
-
-{-# INLINE node3 #-}
-{-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-}
-{-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-}
-node3          :: Sized a => a -> a -> a -> Node a
-node3 a b c    =  Node3 (size a + size b + size c) a b c
-
-nodeToDigit :: Node a -> Digit a
-nodeToDigit (Node2 _ a b) = Two a b
-nodeToDigit (Node3 _ a b c) = Three a b c
-
--- Elements
-
-newtype Elem a  =  Elem { getElem :: a }
-
-instance Sized (Elem a) where
-       size _ = 1
-
-instance Functor Elem where
-       fmap f (Elem x) = Elem (f x)
-
-instance Foldable Elem where
-       foldr f z (Elem x) = f x z
-       foldl f z (Elem x) = f z x
-
-instance Traversable Elem where
-       traverse f (Elem x) = Elem <$> f x
-
-#ifdef TESTING
-instance (Show a) => Show (Elem a) where
-       showsPrec p (Elem x) = showsPrec p x
-#endif
-
-------------------------------------------------------------------------
--- Construction
-------------------------------------------------------------------------
-
--- | /O(1)/. The empty sequence.
-empty          :: Seq a
-empty          =  Seq Empty
-
--- | /O(1)/. A singleton sequence.
-singleton      :: a -> Seq a
-singleton x    =  Seq (Single (Elem x))
-
--- | /O(1)/. Add an element to the left end of a sequence.
--- Mnemonic: a triangle with the single element at the pointy end.
-(<|)           :: a -> Seq a -> Seq a
-x <| Seq xs    =  Seq (Elem x `consTree` xs)
-
-{-# SPECIALIZE consTree :: Elem a -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE consTree :: Node a -> FingerTree (Node a) -> FingerTree (Node a) #-}
-consTree       :: Sized a => a -> FingerTree a -> FingerTree a
-consTree a Empty       = Single a
-consTree a (Single b)  = deep (One a) Empty (One b)
-consTree a (Deep s (Four b c d e) m sf) = m `seq`
-       Deep (size a + s) (Two a b) (node3 c d e `consTree` m) sf
-consTree a (Deep s (Three b c d) m sf) =
-       Deep (size a + s) (Four a b c d) m sf
-consTree a (Deep s (Two b c) m sf) =
-       Deep (size a + s) (Three a b c) m sf
-consTree a (Deep s (One b) m sf) =
-       Deep (size a + s) (Two a b) m sf
-
--- | /O(1)/. Add an element to the right end of a sequence.
--- Mnemonic: a triangle with the single element at the pointy end.
-(|>)           :: Seq a -> a -> Seq a
-Seq xs |> x    =  Seq (xs `snocTree` Elem x)
-
-{-# SPECIALIZE snocTree :: FingerTree (Elem a) -> Elem a -> FingerTree (Elem a) #-}
-{-# SPECIALIZE snocTree :: FingerTree (Node a) -> Node a -> FingerTree (Node a) #-}
-snocTree       :: Sized a => FingerTree a -> a -> FingerTree a
-snocTree Empty a       =  Single a
-snocTree (Single a) b  =  deep (One a) Empty (One b)
-snocTree (Deep s pr m (Four a b c d)) e = m `seq`
-       Deep (s + size e) pr (m `snocTree` node3 a b c) (Two d e)
-snocTree (Deep s pr m (Three a b c)) d =
-       Deep (s + size d) pr m (Four a b c d)
-snocTree (Deep s pr m (Two a b)) c =
-       Deep (s + size c) pr m (Three a b c)
-snocTree (Deep s pr m (One a)) b =
-       Deep (s + size b) pr m (Two a b)
-
--- | /O(log(min(n1,n2)))/. Concatenate two sequences.
-(><)           :: Seq a -> Seq a -> Seq a
-Seq xs >< Seq ys = Seq (appendTree0 xs ys)
-
--- The appendTree/addDigits gunk below is machine generated
-
-appendTree0 :: FingerTree (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a)
-appendTree0 Empty xs =
-       xs
-appendTree0 xs Empty =
-       xs
-appendTree0 (Single x) xs =
-       x `consTree` xs
-appendTree0 xs (Single x) =
-       xs `snocTree` x
-appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
-       Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
-
-addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
-addDigits0 m1 (One a) (One b) m2 =
-       appendTree1 m1 (node2 a b) m2
-addDigits0 m1 (One a) (Two b c) m2 =
-       appendTree1 m1 (node3 a b c) m2
-addDigits0 m1 (One a) (Three b c d) m2 =
-       appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits0 m1 (One a) (Four b c d e) m2 =
-       appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits0 m1 (Two a b) (One c) m2 =
-       appendTree1 m1 (node3 a b c) m2
-addDigits0 m1 (Two a b) (Two c d) m2 =
-       appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits0 m1 (Two a b) (Three c d e) m2 =
-       appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits0 m1 (Two a b) (Four c d e f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits0 m1 (Three a b c) (One d) m2 =
-       appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits0 m1 (Three a b c) (Two d e) m2 =
-       appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits0 m1 (Three a b c) (Three d e f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits0 m1 (Three a b c) (Four d e f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits0 m1 (Four a b c d) (One e) m2 =
-       appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits0 m1 (Four a b c d) (Two e f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits0 m1 (Four a b c d) (Three e f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-
-appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
-appendTree1 Empty a xs =
-       a `consTree` xs
-appendTree1 xs a Empty =
-       xs `snocTree` a
-appendTree1 (Single x) a xs =
-       x `consTree` a `consTree` xs
-appendTree1 xs a (Single x) =
-       xs `snocTree` a `snocTree` x
-appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
-       Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
-
-addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
-addDigits1 m1 (One a) b (One c) m2 =
-       appendTree1 m1 (node3 a b c) m2
-addDigits1 m1 (One a) b (Two c d) m2 =
-       appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits1 m1 (One a) b (Three c d e) m2 =
-       appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits1 m1 (One a) b (Four c d e f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits1 m1 (Two a b) c (One d) m2 =
-       appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits1 m1 (Two a b) c (Two d e) m2 =
-       appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits1 m1 (Two a b) c (Three d e f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits1 m1 (Two a b) c (Four d e f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits1 m1 (Three a b c) d (One e) m2 =
-       appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits1 m1 (Three a b c) d (Two e f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits1 m1 (Three a b c) d (Three e f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits1 m1 (Three a b c) d (Four e f g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits1 m1 (Four a b c d) e (One f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits1 m1 (Four a b c d) e (Two f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits1 m1 (Four a b c d) e (Three f g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-
-appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
-appendTree2 Empty a b xs =
-       a `consTree` b `consTree` xs
-appendTree2 xs a b Empty =
-       xs `snocTree` a `snocTree` b
-appendTree2 (Single x) a b xs =
-       x `consTree` a `consTree` b `consTree` xs
-appendTree2 xs a b (Single x) =
-       xs `snocTree` a `snocTree` b `snocTree` x
-appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
-       Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
-
-addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
-addDigits2 m1 (One a) b c (One d) m2 =
-       appendTree2 m1 (node2 a b) (node2 c d) m2
-addDigits2 m1 (One a) b c (Two d e) m2 =
-       appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits2 m1 (One a) b c (Three d e f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits2 m1 (One a) b c (Four d e f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits2 m1 (Two a b) c d (One e) m2 =
-       appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits2 m1 (Two a b) c d (Two e f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits2 m1 (Two a b) c d (Three e f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits2 m1 (Two a b) c d (Four e f g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits2 m1 (Three a b c) d e (One f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits2 m1 (Three a b c) d e (Two f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits2 m1 (Three a b c) d e (Three f g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits2 m1 (Four a b c d) e f (One g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits2 m1 (Four a b c d) e f (Two g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
-       appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-
-appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
-appendTree3 Empty a b c xs =
-       a `consTree` b `consTree` c `consTree` xs
-appendTree3 xs a b c Empty =
-       xs `snocTree` a `snocTree` b `snocTree` c
-appendTree3 (Single x) a b c xs =
-       x `consTree` a `consTree` b `consTree` c `consTree` xs
-appendTree3 xs a b c (Single x) =
-       xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
-appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
-       Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
-
-addDigits3 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
-addDigits3 m1 (One a) b c d (One e) m2 =
-       appendTree2 m1 (node3 a b c) (node2 d e) m2
-addDigits3 m1 (One a) b c d (Two e f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits3 m1 (One a) b c d (Three e f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits3 m1 (One a) b c d (Four e f g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits3 m1 (Two a b) c d e (One f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits3 m1 (Two a b) c d e (Two f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits3 m1 (Three a b c) d e f (One g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
-       appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits3 m1 (Four a b c d) e f g (One h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =
-       appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
-       appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
-
-appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
-appendTree4 Empty a b c d xs =
-       a `consTree` b `consTree` c `consTree` d `consTree` xs
-appendTree4 xs a b c d Empty =
-       xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
-appendTree4 (Single x) a b c d xs =
-       x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
-appendTree4 xs a b c d (Single x) =
-       xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
-appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
-       Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
-
-addDigits4 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
-addDigits4 m1 (One a) b c d e (One f) m2 =
-       appendTree2 m1 (node3 a b c) (node3 d e f) m2
-addDigits4 m1 (One a) b c d e (Two f g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits4 m1 (One a) b c d e (Three f g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits4 m1 (Two a b) c d e f (One g) m2 =
-       appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
-addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
-       appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits4 m1 (Three a b c) d e f g (One h) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
-       appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
-       appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
-addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
-       appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
-       appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
-       appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
-addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
-       appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
-
-------------------------------------------------------------------------
--- Deconstruction
-------------------------------------------------------------------------
-
--- | /O(1)/. Is this the empty sequence?
-null           :: Seq a -> Bool
-null (Seq Empty) = True
-null _         =  False
-
--- | /O(1)/. The number of elements in the sequence.
-length         :: Seq a -> Int
-length (Seq xs) =  size xs
-
--- Views
-
-data Maybe2 a b = Nothing2 | Just2 a b
-
--- | View of the left end of a sequence.
-data ViewL a
-       = EmptyL        -- ^ empty sequence
-       | a :< Seq a    -- ^ leftmost element and the rest of the sequence
-#ifndef __HADDOCK__
-# if __GLASGOW_HASKELL__
-       deriving (Eq, Ord, Show, Read, Data)
-# else
-       deriving (Eq, Ord, Show, Read)
-# endif
-#else
-instance Eq a => Eq (ViewL a)
-instance Ord a => Ord (ViewL a)
-instance Show a => Show (ViewL a)
-instance Read a => Read (ViewL a)
-instance Data a => Data (ViewL a)
-#endif
-
-INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")
-
-instance Functor ViewL where
-       fmap = fmapDefault
-
-instance Foldable ViewL where
-       foldr f z EmptyL = z
-       foldr f z (x :< xs) = f x (foldr f z xs)
-
-       foldl f z EmptyL = z
-       foldl f z (x :< xs) = foldl f (f z x) xs
-
-       foldl1 f EmptyL = error "foldl1: empty view"
-       foldl1 f (x :< xs) = foldl f x xs
-
-instance Traversable ViewL where
-       traverse _ EmptyL       = pure EmptyL
-       traverse f (x :< xs)    = (:<) <$> f x <*> traverse f xs
-
--- | /O(1)/. Analyse the left end of a sequence.
-viewl          ::  Seq a -> ViewL a
-viewl (Seq xs) =  case viewLTree xs of
-       Nothing2 -> EmptyL
-       Just2 (Elem x) xs' -> x :< Seq xs'
-
-{-# SPECIALIZE viewLTree :: FingerTree (Elem a) -> Maybe2 (Elem a) (FingerTree (Elem a)) #-}
-{-# SPECIALIZE viewLTree :: FingerTree (Node a) -> Maybe2 (Node a) (FingerTree (Node a)) #-}
-viewLTree      :: Sized a => FingerTree a -> Maybe2 a (FingerTree a)
-viewLTree Empty                        = Nothing2
-viewLTree (Single a)           = Just2 a Empty
-viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of
-       Nothing2        -> digitToTree sf
-       Just2 b m'      -> Deep (s - size a) (nodeToDigit b) m' sf)
-viewLTree (Deep s (Two a b) m sf) =
-       Just2 a (Deep (s - size a) (One b) m sf)
-viewLTree (Deep s (Three a b c) m sf) =
-       Just2 a (Deep (s - size a) (Two b c) m sf)
-viewLTree (Deep s (Four a b c d) m sf) =
-       Just2 a (Deep (s - size a) (Three b c d) m sf)
-
--- | View of the right end of a sequence.
-data ViewR a
-       = EmptyR        -- ^ empty sequence
-       | Seq a :> a    -- ^ the sequence minus the rightmost element,
-                       -- and the rightmost element
-#ifndef __HADDOCK__
-# if __GLASGOW_HASKELL__
-       deriving (Eq, Ord, Show, Read, Data)
-# else
-       deriving (Eq, Ord, Show, Read)
-# endif
-#else
-instance Eq a => Eq (ViewR a)
-instance Ord a => Ord (ViewR a)
-instance Show a => Show (ViewR a)
-instance Read a => Read (ViewR a)
-instance Data a => Data (ViewR a)
-#endif
-
-INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")
-
-instance Functor ViewR where
-       fmap = fmapDefault
-
-instance Foldable ViewR where
-       foldr f z EmptyR = z
-       foldr f z (xs :> x) = foldr f (f x z) xs
-
-       foldl f z EmptyR = z
-       foldl f z (xs :> x) = f (foldl f z xs) x
-
-       foldr1 f EmptyR = error "foldr1: empty view"
-       foldr1 f (xs :> x) = foldr f x xs
-
-instance Traversable ViewR where
-       traverse _ EmptyR       = pure EmptyR
-       traverse f (xs :> x)    = (:>) <$> traverse f xs <*> f x
-
--- | /O(1)/. Analyse the right end of a sequence.
-viewr          ::  Seq a -> ViewR a
-viewr (Seq xs) =  case viewRTree xs of
-       Nothing2 -> EmptyR
-       Just2 xs' (Elem x) -> Seq xs' :> x
-
-{-# SPECIALIZE viewRTree :: FingerTree (Elem a) -> Maybe2 (FingerTree (Elem a)) (Elem a) #-}
-{-# SPECIALIZE viewRTree :: FingerTree (Node a) -> Maybe2 (FingerTree (Node a)) (Node a) #-}
-viewRTree      :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a
-viewRTree Empty                        = Nothing2
-viewRTree (Single z)           = Just2 Empty z
-viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of
-       Nothing2        ->  digitToTree pr
-       Just2 m' y      ->  Deep (s - size z) pr m' (nodeToDigit y)) z
-viewRTree (Deep s pr m (Two y z)) =
-       Just2 (Deep (s - size z) pr m (One y)) z
-viewRTree (Deep s pr m (Three x y z)) =
-       Just2 (Deep (s - size z) pr m (Two x y)) z
-viewRTree (Deep s pr m (Four w x y z)) =
-       Just2 (Deep (s - size z) pr m (Three w x y)) z
-
--- Indexing
-
--- | /O(log(min(i,n-i)))/. The element at the specified position
-index          :: Seq a -> Int -> a
-index (Seq xs) i
-  | 0 <= i && i < size xs = case lookupTree i xs of
-                               Place _ (Elem x) -> x
-  | otherwise  = error "index out of bounds"
-
-data Place a = Place {-# UNPACK #-} !Int a
-#if TESTING
-       deriving Show
-#endif
-
-{-# SPECIALIZE lookupTree :: Int -> FingerTree (Elem a) -> Place (Elem a) #-}
-{-# SPECIALIZE lookupTree :: Int -> FingerTree (Node a) -> Place (Node a) #-}
-lookupTree :: Sized a => Int -> FingerTree a -> Place a
-lookupTree _ Empty = error "lookupTree of empty tree"
-lookupTree i (Single x) = Place i x
-lookupTree i (Deep _ pr m sf)
-  | i < spr    =  lookupDigit i pr
-  | i < spm    =  case lookupTree (i - spr) m of
-                       Place i' xs -> lookupNode i' xs
-  | otherwise  =  lookupDigit (i - spm) sf
-  where        spr     = size pr
-       spm     = spr + size m
-
-{-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
-{-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
-lookupNode :: Sized a => Int -> Node a -> Place a
-lookupNode i (Node2 _ a b)
-  | i < sa     = Place i a
-  | otherwise  = Place (i - sa) b
-  where        sa      = size a
-lookupNode i (Node3 _ a b c)
-  | i < sa     = Place i a
-  | i < sab    = Place (i - sa) b
-  | otherwise  = Place (i - sab) c
-  where        sa      = size a
-       sab     = sa + size b
-
-{-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
-{-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
-lookupDigit :: Sized a => Int -> Digit a -> Place a
-lookupDigit i (One a) = Place i a
-lookupDigit i (Two a b)
-  | i < sa     = Place i a
-  | otherwise  = Place (i - sa) b
-  where        sa      = size a
-lookupDigit i (Three a b c)
-  | i < sa     = Place i a
-  | i < sab    = Place (i - sa) b
-  | otherwise  = Place (i - sab) c
-  where        sa      = size a
-       sab     = sa + size b
-lookupDigit i (Four a b c d)
-  | i < sa     = Place i a
-  | i < sab    = Place (i - sa) b
-  | i < sabc   = Place (i - sab) c
-  | otherwise  = Place (i - sabc) d
-  where        sa      = size a
-       sab     = sa + size b
-       sabc    = sab + size c
-
--- | /O(log(min(i,n-i)))/. Replace the element at the specified position
-update         :: Int -> a -> Seq a -> Seq a
-update i x     = adjust (const x) i
-
--- | /O(log(min(i,n-i)))/. Update the element at the specified position
-adjust         :: (a -> a) -> Int -> Seq a -> Seq a
-adjust f i (Seq xs)
-  | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) i xs)
-  | otherwise  = Seq xs
-
-{-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE adjustTree :: (Int -> Node a -> Node a) -> Int -> FingerTree (Node a) -> FingerTree (Node a) #-}
-adjustTree     :: Sized a => (Int -> a -> a) ->
-                       Int -> FingerTree a -> FingerTree a
-adjustTree _ _ Empty = error "adjustTree of empty tree"
-adjustTree f i (Single x) = Single (f i x)
-adjustTree f i (Deep s pr m sf)
-  | i < spr    = Deep s (adjustDigit f i pr) m sf
-  | i < spm    = Deep s pr (adjustTree (adjustNode f) (i - spr) m) sf
-  | otherwise  = Deep s pr m (adjustDigit f (i - spm) sf)
-  where        spr     = size pr
-       spm     = spr + size m
-
-{-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
-{-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
-adjustNode     :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
-adjustNode f i (Node2 s a b)
-  | i < sa     = Node2 s (f i a) b
-  | otherwise  = Node2 s a (f (i - sa) b)
-  where        sa      = size a
-adjustNode f i (Node3 s a b c)
-  | i < sa     = Node3 s (f i a) b c
-  | i < sab    = Node3 s a (f (i - sa) b) c
-  | otherwise  = Node3 s a b (f (i - sab) c)
-  where        sa      = size a
-       sab     = sa + size b
-
-{-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
-{-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
-adjustDigit    :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
-adjustDigit f i (One a) = One (f i a)
-adjustDigit f i (Two a b)
-  | i < sa     = Two (f i a) b
-  | otherwise  = Two a (f (i - sa) b)
-  where        sa      = size a
-adjustDigit f i (Three a b c)
-  | i < sa     = Three (f i a) b c
-  | i < sab    = Three a (f (i - sa) b) c
-  | otherwise  = Three a b (f (i - sab) c)
-  where        sa      = size a
-       sab     = sa + size b
-adjustDigit f i (Four a b c d)
-  | i < sa     = Four (f i a) b c d
-  | i < sab    = Four a (f (i - sa) b) c d
-  | i < sabc   = Four a b (f (i - sab) c) d
-  | otherwise  = Four a b c (f (i- sabc) d)
-  where        sa      = size a
-       sab     = sa + size b
-       sabc    = sab + size c
-
--- Splitting
-
--- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence.
-take           :: Int -> Seq a -> Seq a
-take i         =  fst . splitAt i
-
--- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@.
-drop           :: Int -> Seq a -> Seq a
-drop i         =  snd . splitAt i
-
--- | /O(log(min(i,n-i)))/. Split a sequence at a given position.
-splitAt                        :: Int -> Seq a -> (Seq a, Seq a)
-splitAt i (Seq xs)     =  (Seq l, Seq r)
-  where        (l, r)          =  split i xs
-
-split :: Int -> FingerTree (Elem a) ->
-       (FingerTree (Elem a), FingerTree (Elem a))
-split i Empty  = i `seq` (Empty, Empty)
-split i xs
-  | size xs > i        = (l, consTree x r)
-  | otherwise  = (xs, Empty)
-  where Split l x r = splitTree i xs
-
-data Split t a = Split t a t
-#if TESTING
-       deriving Show
-#endif
-
-{-# SPECIALIZE splitTree :: Int -> FingerTree (Elem a) -> Split (FingerTree (Elem a)) (Elem a) #-}
-{-# SPECIALIZE splitTree :: Int -> FingerTree (Node a) -> Split (FingerTree (Node a)) (Node a) #-}
-splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
-splitTree _ Empty = error "splitTree of empty tree"
-splitTree i (Single x) = i `seq` Split Empty x Empty
-splitTree i (Deep _ pr m sf)
-  | i < spr    = case splitDigit i pr of
-                       Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
-  | i < spm    = case splitTree im m of
-                       Split ml xs mr -> case splitNode (im - size ml) xs of
-                           Split l x r -> Split (deepR pr  ml l) x (deepL r mr sf)
-  | otherwise  = case splitDigit (i - spm) sf of
-                       Split l x r -> Split (deepR pr  m  l) x (maybe Empty digitToTree r)
-  where        spr     = size pr
-       spm     = spr + size m
-       im      = i - spr
-
-{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
-deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a
-deepL Nothing m sf     = case viewLTree m of
-       Nothing2        -> digitToTree sf
-       Just2 a m'      -> deep (nodeToDigit a) m' sf
-deepL (Just pr) m sf   = deep pr m sf
-
-{-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-}
-{-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-}
-deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a
-deepR pr m Nothing     = case viewRTree m of
-       Nothing2        -> digitToTree pr
-       Just2 m' a      -> deep pr m' (nodeToDigit a)
-deepR pr m (Just sf)   = deep pr m sf
-
-{-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
-{-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
-splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
-splitNode i (Node2 _ a b)
-  | i < sa     = Split Nothing a (Just (One b))
-  | otherwise  = Split (Just (One a)) b Nothing
-  where        sa      = size a
-splitNode i (Node3 _ a b c)
-  | i < sa     = Split Nothing a (Just (Two b c))
-  | i < sab    = Split (Just (One a)) b (Just (One c))
-  | otherwise  = Split (Just (Two a b)) c Nothing
-  where        sa      = size a
-       sab     = sa + size b
-
-{-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
-{-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
-splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
-splitDigit i (One a) = i `seq` Split Nothing a Nothing
-splitDigit i (Two a b)
-  | i < sa     = Split Nothing a (Just (One b))
-  | otherwise  = Split (Just (One a)) b Nothing
-  where        sa      = size a
-splitDigit i (Three a b c)
-  | i < sa     = Split Nothing a (Just (Two b c))
-  | i < sab    = Split (Just (One a)) b (Just (One c))
-  | otherwise  = Split (Just (Two a b)) c Nothing
-  where        sa      = size a
-       sab     = sa + size b
-splitDigit i (Four a b c d)
-  | i < sa     = Split Nothing a (Just (Three b c d))
-  | i < sab    = Split (Just (One a)) b (Just (Two c d))
-  | i < sabc   = Split (Just (Two a b)) c (Just (One d))
-  | otherwise  = Split (Just (Three a b c)) d Nothing
-  where        sa      = size a
-       sab     = sa + size b
-       sabc    = sab + size c
-
-------------------------------------------------------------------------
--- Lists
-------------------------------------------------------------------------
-
--- | /O(n)/. Create a sequence from a finite list of elements.
--- There is a function 'toList' in the opposite direction for all
--- instances of the 'Foldable' class, including 'Seq'.
-fromList       :: [a] -> Seq a
-fromList       =  Data.List.foldl' (|>) empty
-
-------------------------------------------------------------------------
--- Reverse
-------------------------------------------------------------------------
-
--- | /O(n)/. The reverse of a sequence.
-reverse :: Seq a -> Seq a
-reverse (Seq xs) = Seq (reverseTree id xs)
-
-reverseTree :: (a -> a) -> FingerTree a -> FingerTree a
-reverseTree _ Empty = Empty
-reverseTree f (Single x) = Single (f x)
-reverseTree f (Deep s pr m sf) =
-       Deep s (reverseDigit f sf)
-               (reverseTree (reverseNode f) m)
-               (reverseDigit f pr)
-
-reverseDigit :: (a -> a) -> Digit a -> Digit a
-reverseDigit f (One a) = One (f a)
-reverseDigit f (Two a b) = Two (f b) (f a)
-reverseDigit f (Three a b c) = Three (f c) (f b) (f a)
-reverseDigit f (Four a b c d) = Four (f d) (f c) (f b) (f a)
-
-reverseNode :: (a -> a) -> Node a -> Node a
-reverseNode f (Node2 s a b) = Node2 s (f b) (f a)
-reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a)
-
-#if TESTING
-
-------------------------------------------------------------------------
--- QuickCheck
-------------------------------------------------------------------------
-
-instance Arbitrary a => Arbitrary (Seq a) where
-       arbitrary = liftM Seq arbitrary
-       coarbitrary (Seq x) = coarbitrary x
-
-instance Arbitrary a => Arbitrary (Elem a) where
-       arbitrary = liftM Elem arbitrary
-       coarbitrary (Elem x) = coarbitrary x
-
-instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
-       arbitrary = sized arb
-         where arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
-               arb 0 = return Empty
-               arb 1 = liftM Single arbitrary
-               arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary
-
-       coarbitrary Empty = variant 0
-       coarbitrary (Single x) = variant 1 . coarbitrary x
-       coarbitrary (Deep _ pr m sf) =
-               variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf
-
-instance (Arbitrary a, Sized a) => Arbitrary (Node a) where
-       arbitrary = oneof [
-                       liftM2 node2 arbitrary arbitrary,
-                       liftM3 node3 arbitrary arbitrary arbitrary]
-
-       coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b
-       coarbitrary (Node3 _ a b c) =
-               variant 1 . coarbitrary a . coarbitrary b . coarbitrary c
-
-instance Arbitrary a => Arbitrary (Digit a) where
-       arbitrary = oneof [
-                       liftM One arbitrary,
-                       liftM2 Two arbitrary arbitrary,
-                       liftM3 Three arbitrary arbitrary arbitrary,
-                       liftM4 Four arbitrary arbitrary arbitrary arbitrary]
-
-       coarbitrary (One a) = variant 0 . coarbitrary a
-       coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b
-       coarbitrary (Three a b c) =
-               variant 2 . coarbitrary a . coarbitrary b . coarbitrary c
-       coarbitrary (Four a b c d) =
-               variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
-
-------------------------------------------------------------------------
--- Valid trees
-------------------------------------------------------------------------
-
-class Valid a where
-       valid :: a -> Bool
-
-instance Valid (Elem a) where
-       valid _ = True
-
-instance Valid (Seq a) where
-       valid (Seq xs) = valid xs
-
-instance (Sized a, Valid a) => Valid (FingerTree a) where
-       valid Empty = True
-       valid (Single x) = valid x
-       valid (Deep s pr m sf) =
-               s == size pr + size m + size sf && valid pr && valid m && valid sf
-
-instance (Sized a, Valid a) => Valid (Node a) where
-       valid (Node2 s a b) = s == size a + size b && valid a && valid b
-       valid (Node3 s a b c) =
-               s == size a + size b + size c && valid a && valid b && valid c
-
-instance Valid a => Valid (Digit a) where
-       valid (One a) = valid a
-       valid (Two a b) = valid a && valid b
-       valid (Three a b c) = valid a && valid b && valid c
-       valid (Four a b c d) = valid a && valid b && valid c && valid d
-
-#endif
diff --git a/libraries/base/Data/Set.hs b/libraries/base/Data/Set.hs
deleted file mode 100644 (file)
index 04d0100..0000000
+++ /dev/null
@@ -1,1149 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Set
--- Copyright   :  (c) Daan Leijen 2002
--- License     :  BSD-style
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- 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 (Set)
--- >  import qualified Data.Set as Set
---
--- The implementation of 'Set' 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.
------------------------------------------------------------------------------
-
-module Data.Set  ( 
-            -- * Set type
-              Set          -- instance Eq,Ord,Show,Read,Data,Typeable
-
-            -- * 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.Typeable
-import Data.Foldable (Foldable(foldMap))
-
-{-
--- just for testing
-import QuickCheck 
-import List (nub,sort)
-import qualified List
--}
-
-#if __GLASGOW_HASKELL__
-import Text.Read
-import Data.Generics.Basics
-import Data.Generics.Instances
-#endif
-
-{--------------------------------------------------------------------
-  Operators
---------------------------------------------------------------------}
-infixl 9 \\ --
-
--- | /O(n+m)/. See 'difference'.
-(\\) :: Ord a => Set a -> Set a -> Set a
-m1 \\ m2 = difference m1 m2
-
-{--------------------------------------------------------------------
-  Sets are size balanced trees
---------------------------------------------------------------------}
--- | A set of values @a@.
-data Set a    = Tip 
-              | Bin {-# UNPACK #-} !Size a !(Set a) !(Set a) 
-
-type Size     = Int
-
-instance Ord a => Monoid (Set a) where
-    mempty  = empty
-    mappend = union
-    mconcat = unions
-
-instance Foldable Set where
-    foldMap f Tip = mempty
-    foldMap f (Bin _s k l r) = foldMap f l `mappend` f k `mappend` foldMap 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 (Data a, Ord a) => Data (Set 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 :: Set a -> Bool
-null t
-  = case t of
-      Tip           -> True
-      Bin sz x l r  -> False
-
--- | /O(1)/. The number of elements in the set.
-size :: Set a -> Int
-size t
-  = case t of
-      Tip           -> 0
-      Bin sz x l r  -> sz
-
--- | /O(log n)/. Is the element in the set?
-member :: Ord a => a -> Set a -> Bool
-member x t
-  = case t of
-      Tip -> False
-      Bin sz 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 :: Ord a => a -> Set a -> Bool
-notMember x t = not $ member x t
-
-{--------------------------------------------------------------------
-  Construction
---------------------------------------------------------------------}
--- | /O(1)/. The empty set.
-empty  :: Set a
-empty
-  = Tip
-
--- | /O(1)/. Create a singleton set.
-singleton :: a -> Set 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 :: Ord a => a -> Set a -> Set a
-insert x t
-  = case t of
-      Tip -> singleton x
-      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 :: Ord a => a -> Set a -> Set a
-delete x t
-  = case t of
-      Tip -> Tip
-      Bin sz 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 :: Ord a => Set a -> Set 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 :: Ord a => Set a -> Set a -> Bool
-isSubsetOf t1 t2
-  = (size t1 <= size t2) && (isSubsetOfX t1 t2)
-
-isSubsetOfX Tip t = True
-isSubsetOfX t Tip = False
-isSubsetOfX (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 :: Set a -> a
-findMin (Bin _ x Tip r) = x
-findMin (Bin _ x l r)   = findMin l
-findMin Tip             = error "Set.findMin: empty set has no minimal element"
-
--- | /O(log n)/. The maximal element of a set.
-findMax :: Set a -> a
-findMax (Bin _ x l Tip)  = x
-findMax (Bin _ x l r)    = findMax r
-findMax Tip              = error "Set.findMax: empty set has no maximal element"
-
--- | /O(log n)/. Delete the minimal element.
-deleteMin :: Set a -> Set a
-deleteMin (Bin _ x Tip r) = r
-deleteMin (Bin _ x l r)   = balance x (deleteMin l) r
-deleteMin Tip             = Tip
-
--- | /O(log n)/. Delete the maximal element.
-deleteMax :: Set a -> Set a
-deleteMax (Bin _ x l Tip) = l
-deleteMax (Bin _ x l r)   = balance x l (deleteMax r)
-deleteMax Tip             = Tip
-
-
-{--------------------------------------------------------------------
-  Union. 
---------------------------------------------------------------------}
--- | The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@).
-unions :: Ord a => [Set a] -> Set 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 :: Ord a => Set a -> Set a -> Set a
-union Tip t2  = t2
-union t1 Tip  = t1
-union t1 t2 = hedgeUnion (const LT) (const GT) t1 t2
-
-hedgeUnion cmplo cmphi t1 Tip 
-  = t1
-hedgeUnion cmplo cmphi Tip (Bin _ x l r)
-  = join x (filterGt cmplo l) (filterLt cmphi r)
-hedgeUnion cmplo cmphi (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 y  = compare x y
-
-{--------------------------------------------------------------------
-  Difference
---------------------------------------------------------------------}
--- | /O(n+m)/. Difference of two sets. 
--- The implementation uses an efficient /hedge/ algorithm comparable with /hedge-union/.
-difference :: Ord a => Set a -> Set a -> Set a
-difference Tip t2  = Tip
-difference t1 Tip  = t1
-difference t1 t2   = hedgeDiff (const LT) (const GT) t1 t2
-
-hedgeDiff cmplo cmphi Tip t     
-  = Tip
-hedgeDiff cmplo cmphi (Bin _ x l r) Tip 
-  = join x (filterGt cmplo l) (filterLt cmphi r)
-hedgeDiff cmplo cmphi t (Bin _ x l r) 
-  = merge (hedgeDiff cmplo cmpx (trim cmplo cmpx t) l) 
-          (hedgeDiff cmpx cmphi (trim cmpx cmphi t) r)
-  where
-    cmpx y = compare x y
-
-{--------------------------------------------------------------------
-  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 :: Ord a => Set a -> Set a -> Set a
-intersection Tip t = Tip
-intersection t Tip = Tip
-intersection t1@(Bin s1 x1 l1 r1) t2@(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 :: Ord a => (a -> Bool) -> Set a -> Set a
-filter p Tip = Tip
-filter p (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 :: Ord a => (a -> Bool) -> Set a -> (Set a,Set a)
-partition p Tip = (Tip,Tip)
-partition p (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 :: (Ord a, Ord b) => (a->b) -> Set a -> Set 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 :: (a->b) -> Set a -> Set b
-mapMonotonic f Tip = Tip
-mapMonotonic f (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 :: (a -> b -> b) -> b -> Set a -> b
-fold f z s
-  = foldr f z s
-
--- | /O(n)/. Post-order fold.
-foldr :: (a -> b -> b) -> b -> Set a -> b
-foldr f z Tip           = z
-foldr f z (Bin _ x l r) = foldr f (f x (foldr f z r)) l
-
-{--------------------------------------------------------------------
-  List variations 
---------------------------------------------------------------------}
--- | /O(n)/. The elements of a set.
-elems :: Set a -> [a]
-elems s
-  = toList s
-
-{--------------------------------------------------------------------
-  Lists 
---------------------------------------------------------------------}
--- | /O(n)/. Convert the set to a list of elements.
-toList :: Set a -> [a]
-toList s
-  = toAscList s
-
--- | /O(n)/. Convert the set to an ascending list of elements.
-toAscList :: Set a -> [a]
-toAscList t   
-  = foldr (:) [] t
-
-
--- | /O(n*log n)/. Create a set from a list of elements.
-fromList :: Ord a => [a] -> Set a 
-fromList xs 
-  = foldlStrict ins empty xs
-  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 :: Eq a => [a] -> Set 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 :: [a] -> Set 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
-    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
-    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 Eq a => Eq (Set a) where
-  t1 == t2  = (size t1 == size t2) && (toAscList t1 == toAscList t2)
-
-{--------------------------------------------------------------------
-  Ord 
---------------------------------------------------------------------}
-
-instance Ord a => Ord (Set a) where
-    compare s1 s2 = compare (toAscList s1) (toAscList s2) 
-
-{--------------------------------------------------------------------
-  Show
---------------------------------------------------------------------}
-instance Show a => Show (Set a) where
-  showsPrec p xs = showParen (p > 10) $
-    showString "fromList " . shows (toList xs)
-
-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 (Read a, Ord a) => Read (Set 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 :: (a -> Ordering) -> (a -> Ordering) -> Set a -> Set a
-trim cmplo cmphi Tip = Tip
-trim cmplo cmphi t@(Bin sx x l r)
-  = case cmplo x of
-      LT -> case cmphi x of
-              GT -> t
-              le -> trim cmplo cmphi l
-      ge -> trim cmplo cmphi r
-              
-trimMemberLo :: Ord a => a -> (a -> Ordering) -> Set a -> (Bool, Set a)
-trimMemberLo lo cmphi Tip = (False,Tip)
-trimMemberLo lo cmphi t@(Bin sx x l r)
-  = case compare lo x of
-      LT -> case cmphi x of
-              GT -> (member lo t, t)
-              le -> trimMemberLo lo cmphi l
-      GT -> trimMemberLo lo cmphi r
-      EQ -> (True,trim (compare lo) cmphi r)
-
-
-{--------------------------------------------------------------------
-  [filterGt x t] filter all values >[x] from tree [t]
-  [filterLt x t] filter all values <[x] from tree [t]
---------------------------------------------------------------------}
-filterGt :: (a -> Ordering) -> Set a -> Set a
-filterGt cmp Tip = Tip
-filterGt cmp (Bin sx x l r)
-  = case cmp x of
-      LT -> join x (filterGt cmp l) r
-      GT -> filterGt cmp r
-      EQ -> r
-      
-filterLt :: (a -> Ordering) -> Set a -> Set a
-filterLt cmp Tip = Tip
-filterLt cmp (Bin sx 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 all elements in @set1@ are lower than @x@ and all elements in
--- @set2@ larger than @x@. @x@ is not found in neither @set1@ nor @set2@.
-split :: Ord a => a -> Set a -> (Set a,Set a)
-split x Tip = (Tip,Tip)
-split x (Bin sy 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 :: Ord a => a -> Set a -> (Set a,Bool,Set 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 :: Ord a => a -> Set a -> (Set a,Maybe a,Set a)
-splitLookup x Tip = (Tip,Nothing,Tip)
-splitLookup x (Bin sy 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 :: a -> Set a -> Set a -> Set a
-join x Tip r  = insertMin x r
-join x l Tip  = insertMax x l
-join x l@(Bin sizeL y ly ry) r@(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 :: a -> Set a -> Set a 
-insertMax x t
-  = case t of
-      Tip -> singleton x
-      Bin sz y l r
-          -> balance y l (insertMax x r)
-             
-insertMin x t
-  = case t of
-      Tip -> singleton x
-      Bin sz y l r
-          -> balance y (insertMin x l) r
-             
-{--------------------------------------------------------------------
-  [merge l r]: merges two trees.
---------------------------------------------------------------------}
-merge :: Set a -> Set a -> Set a
-merge Tip r   = r
-merge l Tip   = l
-merge l@(Bin sizeL x lx rx) r@(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 :: Set a -> Set a -> Set a
-glue Tip r = r
-glue l 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 :: Set a -> (a,Set a)
-deleteFindMin t 
-  = case t of
-      Bin _ x 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 :: Set a -> (a,Set a)
-deleteFindMax t
-  = case t of
-      Bin _ x l 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 from that element
--- @fail@s (in the monad) when passed an empty set.
-minView :: Monad m => Set a -> m (a, Set a)
-minView Tip = fail "Set.minView: empty set"
-minView x = return (deleteFindMin x)
-
--- | /O(log n)/. Retrieves the maximal key of the set, and the set stripped from that element
--- @fail@s (in the monad) when passed an empty set.
-maxView :: Monad m => Set a -> m (a, Set a)
-maxView Tip = fail "Set.maxView: empty set"
-maxView x = return (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 :: a -> Set a -> Set a -> Set 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 x l r@(Bin _ _ ly ry)
-  | size ly < ratio*size ry = singleL x l r
-  | otherwise               = doubleL x l r
-
-rotateR x l@(Bin _ _ ly ry) r
-  | size ry < ratio*size ly = singleR x l r
-  | otherwise               = doubleR x l r
-
--- basic rotations
-singleL x1 t1 (Bin _ x2 t2 t3)  = bin x2 (bin x1 t1 t2) t3
-singleR x1 (Bin _ x2 t1 t2) t3  = bin x2 t1 (bin x1 t2 t3)
-
-doubleL x1 t1 (Bin _ x2 (Bin _ x3 t2 t3) t4) = bin x3 (bin x1 t1 t2) (bin x2 t3 t4)
-doubleR x1 (Bin _ x2 t1 (Bin _ x3 t2 t3)) t4 = bin x3 (bin x2 t1 t2) (bin x1 t3 t4)
-
-
-{--------------------------------------------------------------------
-  The bin constructor maintains the size of the tree
---------------------------------------------------------------------}
-bin :: a -> Set a -> Set a -> Set a
-bin x l r
-  = Bin (size l + size r + 1) x l r
-
-
-{--------------------------------------------------------------------
-  Utilities
---------------------------------------------------------------------}
-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 :: Show a => Set 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 :: Show a => Bool -> Bool -> Set a -> String
-showTreeWith hang wide t
-  | hang      = (showsTreeHang wide [] t) ""
-  | otherwise = (showsTree wide [] [] t) ""
-
-showsTree :: Show a => Bool -> [String] -> [String] -> Set a -> ShowS
-showsTree wide lbars rbars t
-  = case t of
-      Tip -> showsBars lbars . showString "|\n"
-      Bin sz x Tip Tip
-          -> showsBars lbars . shows x . showString "\n" 
-      Bin sz 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 :: Show a => Bool -> [String] -> Set a -> ShowS
-showsTreeHang wide bars t
-  = case t of
-      Tip -> showsBars bars . showString "|\n" 
-      Bin sz x Tip Tip
-          -> showsBars bars . shows x . showString "\n" 
-      Bin sz 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 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           = "+--"
-withBar bars   = "|  ":bars
-withEmpty bars = "   ":bars
-
-{--------------------------------------------------------------------
-  Assertions
---------------------------------------------------------------------}
--- | /O(n)/. Test if the internal set structure is valid.
-valid :: Ord a => Set a -> Bool
-valid t
-  = balanced t && ordered t && validsize t
-
-ordered t
-  = bounded (const True) (const True) t
-  where
-    bounded lo hi t
-      = case t of
-          Tip           -> True
-          Bin sz x l r  -> (lo x) && (hi x) && bounded lo (<x) l && bounded (>x) hi r
-
-balanced :: Set a -> Bool
-balanced t
-  = case t of
-      Tip           -> True
-      Bin sz x l r  -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) &&
-                       balanced l && balanced r
-
-
-validsize t
-  = (realsize t == Just (size t))
-  where
-    realsize t
-      = case t of
-          Tip          -> Just 0
-          Bin sz x l r -> case (realsize l,realsize r) of
-                            (Just n,Just m)  | n+m+1 == sz  -> Just sz
-                            other            -> Nothing
-
-{-
-{--------------------------------------------------------------------
-  Testing
---------------------------------------------------------------------}
-testTree :: [Int] -> Set 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 (Enum a) => Arbitrary (Set a) where
-  arbitrary = sized (arbtree 0 maxkey)
-            where maxkey  = 10000
-
-arbtree :: (Enum a) => Int -> Int -> Int -> Gen (Set 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 :: (Enum a,Show a,Testable b) => (Set 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 => (Set Int -> a) -> Property
-forValidIntTree f
-  = forValid f
-
-forValidUnitTree :: Testable a => (Set 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 -> Set 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 -> Set Int -> Bool
-prop_UnionInsert x t
-  = union t (singleton x) == insert x t
-
-prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool
-prop_UnionAssoc t1 t2 t3
-  = union t1 (union t2 t3) == union (union t1 t2) t3
-
-prop_UnionComm :: Set Int -> Set 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))
--}
diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs
deleted file mode 100644 (file)
index 32347d7..0000000
+++ /dev/null
@@ -1,139 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Traversable
--- Copyright   :  Conor McBride and Ross Paterson 2005
--- License     :  BSD-style (see the LICENSE file in the distribution)
---
--- Maintainer  :  ross@soi.city.ac.uk
--- Stability   :  experimental
--- Portability :  portable
---
--- Class of data structures that can be traversed from left to right,
--- performing an action on each element.
---
--- See also
---
---  * /Applicative Programming with Effects/,
---    by Conor McBride and Ross Paterson, online at
---    <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.
---
---  * /The Essence of the Iterator Pattern/,
---    by Jeremy Gibbons and Bruno Oliveira,
---    in /Mathematically-Structured Functional Programming/, 2006, and online at
---    <http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/#iterator>.
---
--- Note that the functions 'mapM' and 'sequence' generalize "Prelude"
--- functions of the same names from lists to any 'Traversable' functor.
--- To avoid ambiguity, either import the "Prelude" hiding these names
--- or qualify uses of these function names with an alias for this module.
-
-module Data.Traversable (
-       Traversable(..),
-       for,
-       forM,
-       fmapDefault,
-       foldMapDefault,
-       ) where
-
-import Prelude hiding (mapM, sequence, foldr)
-import qualified Prelude (mapM, foldr)
-import Control.Applicative
-import Data.Foldable (Foldable())
-import Data.Monoid (Monoid)
-import Data.Array
-
--- | Functors representing data structures that can be traversed from
--- left to right.
---
--- Minimal complete definition: 'traverse' or 'sequenceA'.
---
--- Instances are similar to 'Functor', e.g. given a data type
---
--- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
---
--- a suitable instance would be
---
--- > instance Traversable Tree
--- >   traverse f Empty = pure Empty
--- >   traverse f (Leaf x) = Leaf <$> f x
--- >   traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r
---
--- This is suitable even for abstract types, as the laws for '<*>'
--- imply a form of associativity.
---
--- The superclass instances should satisfy the following:
---
---  * In the 'Functor' instance, 'fmap' should be equivalent to traversal
---    with the identity applicative functor ('fmapDefault').
---
---  * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be
---    equivalent to traversal with a constant applicative functor
---    ('foldMapDefault').
---
-class (Functor t, Foldable t) => Traversable t where
-       -- | Map each element of a structure to an action, evaluate
-       -- these actions from left to right, and collect the results.
-       traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
-       traverse f = sequenceA . fmap f
-
-       -- | Evaluate each action in the structure from left to right,
-       -- and collect the results.
-       sequenceA :: Applicative f => t (f a) -> f (t a)
-       sequenceA = traverse id
-
-       -- | Map each element of a structure to a monadic action, evaluate
-       -- these actions from left to right, and collect the results.
-       mapM :: Monad m => (a -> m b) -> t a -> m (t b)
-       mapM f = unwrapMonad . traverse (WrapMonad . f)
-
-       -- | Evaluate each monadic action in the structure from left to right,
-       -- and collect the results.
-       sequence :: Monad m => t (m a) -> m (t a)
-       sequence = mapM id
-
--- instances for Prelude types
-
-instance Traversable Maybe where
-       traverse f Nothing = pure Nothing
-       traverse f (Just x) = Just <$> f x
-
-instance Traversable [] where
-       traverse f = Prelude.foldr cons_f (pure [])
-         where cons_f x ys = (:) <$> f x <*> ys
-
-       mapM = Prelude.mapM
-
-instance Ix i => Traversable (Array i) where
-       traverse f arr = listArray (bounds arr) <$> traverse f (elems arr)
-
--- general functions
-
--- | 'for' is 'traverse' with its arguments flipped.
-for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)
-{-# INLINE for #-}
-for = flip traverse
-
--- | 'forM' is 'mapM' with its arguments flipped.
-forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
-{-# INLINE forM #-}
-forM = flip mapM
-
--- | This function may be used as a value for `fmap` in a `Functor` instance.
-fmapDefault :: Traversable t => (a -> b) -> t a -> t b
-fmapDefault f = getId . traverse (Id . f)
-
--- | This function may be used as a value for `Data.Foldable.foldMap`
--- in a `Foldable` instance.
-foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m
-foldMapDefault f = getConst . traverse (Const . f)
-
--- local instances
-
-newtype Id a = Id { getId :: a }
-
-instance Functor Id where
-       fmap f (Id x) = Id (f x)
-
-instance Applicative Id where
-       pure = Id
-       Id f <*> Id x = Id (f x)
diff --git a/libraries/base/Data/Tree.hs b/libraries/base/Data/Tree.hs
deleted file mode 100644 (file)
index c159a74..0000000
+++ /dev/null
@@ -1,166 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Tree
--- Copyright   :  (c) The University of Glasgow 2002
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  portable
---
--- Multi-way trees (/aka/ rose trees) and forests.
---
------------------------------------------------------------------------------
-
-module Data.Tree(
-       Tree(..), Forest,
-       -- * Two-dimensional drawing
-       drawTree, drawForest,
-       -- * Extraction
-       flatten, levels,
-       -- * Building trees
-       unfoldTree, unfoldForest,
-       unfoldTreeM, unfoldForestM,
-       unfoldTreeM_BF, unfoldForestM_BF,
-    ) where
-
-#ifdef __HADDOCK__
-import Prelude
-#endif
-
-import Control.Applicative (Applicative(..), (<$>))
-import Control.Monad
-import Data.Monoid (Monoid(..))
-import Data.Sequence (Seq, empty, singleton, (<|), (|>), fromList,
-                       ViewL(..), ViewR(..), viewl, viewr)
-import Data.Foldable (Foldable(foldMap), toList)
-import Data.Traversable (Traversable(traverse))
-import Data.Typeable
-
-#ifdef __GLASGOW_HASKELL__
-import Data.Generics.Basics (Data)
-#endif
-
--- | Multi-way trees, also known as /rose trees/.
-data Tree a   = Node {
-               rootLabel :: a,         -- ^ label value
-               subForest :: Forest a   -- ^ zero or more child trees
-       }
-#ifndef __HADDOCK__
-# ifdef __GLASGOW_HASKELL__
-  deriving (Eq, Read, Show, Data)
-# else
-  deriving (Eq, Read, Show)
-# endif
-#else /* __HADDOCK__ (which can't figure these out by itself) */
-instance Eq a => Eq (Tree a)
-instance Read a => Read (Tree a)
-instance Show a => Show (Tree a)
-instance Data a => Data (Tree a)
-#endif
-type Forest a = [Tree a]
-
-#include "Typeable.h"
-INSTANCE_TYPEABLE1(Tree,treeTc,"Tree")
-
-instance Functor Tree where
-  fmap f (Node x ts) = Node (f x) (map (fmap f) ts)
-
-instance Applicative Tree where
-  pure x = Node x []
-  Node f tfs <*> tx@(Node x txs) =
-    Node (f x) (map (f <$>) txs ++ map (<*> tx) tfs)
-
-instance Monad Tree where
-  return x = Node x []
-  Node x ts >>= f = Node x' (ts' ++ map (>>= f) ts)
-    where Node x' ts' = f x
-
-instance Traversable Tree where
-  traverse f (Node x ts) = Node <$> f x <*> traverse (traverse f) ts
-
-instance Foldable Tree where
-  foldMap f (Node x ts) = f x `mappend` foldMap (foldMap f) ts
-
--- | Neat 2-dimensional drawing of a tree.
-drawTree :: Tree String -> String
-drawTree  = unlines . draw
-
--- | Neat 2-dimensional drawing of a forest.
-drawForest :: Forest String -> String
-drawForest  = unlines . map drawTree
-
-draw :: Tree String -> [String]
-draw (Node x ts0) = x : drawSubTrees ts0
-  where drawSubTrees [] = []
-       drawSubTrees [t] =
-               "|" : shift "`- " "   " (draw t)
-       drawSubTrees (t:ts) =
-               "|" : shift "+- " "|  " (draw t) ++ drawSubTrees ts
-
-       shift first other = zipWith (++) (first : repeat other)
-
--- | The elements of a tree in pre-order.
-flatten :: Tree a -> [a]
-flatten t = squish t []
-  where squish (Node x ts) xs = x:Prelude.foldr squish xs ts
-
--- | Lists of nodes at each level of the tree.
-levels :: Tree a -> [[a]]
-levels t = map (map rootLabel) $
-               takeWhile (not . null) $
-               iterate (concatMap subForest) [t]
-
--- | Build a tree from a seed value
-unfoldTree :: (b -> (a, [b])) -> b -> Tree a
-unfoldTree f b = let (a, bs) = f b in Node a (unfoldForest f bs)
-
--- | Build a forest from a list of seed values
-unfoldForest :: (b -> (a, [b])) -> [b] -> Forest a
-unfoldForest f = map (unfoldTree f)
-
--- | Monadic tree builder, in depth-first order
-unfoldTreeM :: Monad m => (b -> m (a, [b])) -> b -> m (Tree a)
-unfoldTreeM f b = do
-       (a, bs) <- f b
-       ts <- unfoldForestM f bs
-       return (Node a ts)
-
--- | Monadic forest builder, in depth-first order
-#ifndef __NHC__
-unfoldForestM :: Monad m => (b -> m (a, [b])) -> [b] -> m (Forest a)
-#endif
-unfoldForestM f = Prelude.mapM (unfoldTreeM f)
-
--- | Monadic tree builder, in breadth-first order,
--- using an algorithm adapted from
--- /Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design/,
--- by Chris Okasaki, /ICFP'00/.
-unfoldTreeM_BF :: Monad m => (b -> m (a, [b])) -> b -> m (Tree a)
-unfoldTreeM_BF f b = liftM getElement $ unfoldForestQ f (singleton b)
-  where getElement xs = case viewl xs of
-               x :< _ -> x
-               EmptyL -> error "unfoldTreeM_BF"
-
--- | Monadic forest builder, in breadth-first order,
--- using an algorithm adapted from
--- /Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design/,
--- by Chris Okasaki, /ICFP'00/.
-unfoldForestM_BF :: Monad m => (b -> m (a, [b])) -> [b] -> m (Forest a)
-unfoldForestM_BF f = liftM toList . unfoldForestQ f . fromList
-
--- takes a sequence (queue) of seeds
--- produces a sequence (reversed queue) of trees of the same length
-unfoldForestQ :: Monad m => (b -> m (a, [b])) -> Seq b -> m (Seq (Tree a))
-unfoldForestQ f aQ = case viewl aQ of
-       EmptyL -> return empty
-       a :< aQ -> do
-               (b, as) <- f a
-               tQ <- unfoldForestQ f (Prelude.foldl (|>) aQ as)
-               let (tQ', ts) = splitOnto [] as tQ
-               return (Node b ts <| tQ')
-  where splitOnto :: [a'] -> [b'] -> Seq a' -> (Seq a', [a'])
-       splitOnto as [] q = (q, as)
-       splitOnto as (_:bs) q = case viewr q of
-               q' :> a -> splitOnto (a:as) bs q'
-               EmptyR -> error "unfoldForestQ"
index a9148dd..08dd8f9 100644 (file)
@@ -100,19 +100,14 @@ Library {
         Data.Dynamic,
         Data.Either,
         Data.Eq,
-        Data.Foldable,
         Data.Fixed,
         Data.Function,
-        Data.Graph,
         Data.HashTable,
         Data.IORef,
         Data.Int,
-        Data.IntMap,
-        Data.IntSet,
         Data.Ix,
         Data.List,
         Data.Maybe,
-        Data.Map,
         Data.Monoid,
         Data.Ord,
         Data.PackedString,
@@ -120,11 +115,7 @@ Library {
         Data.STRef,
         Data.STRef.Lazy,
         Data.STRef.Strict,
-        Data.Sequence,
-        Data.Set,
         Data.String,
-        Data.Tree,
-        Data.Traversable,
         Data.Tuple,
         Data.Typeable,
         Data.Unique,