X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FSet.hs;h=fd09eb0ca24f2f1fd092c54e825b9716ac1355a6;hb=a5d8b45865712ab237eee066f37c667f3574f7ac;hp=e515667c82285ab7465e5df1c3b5bec107f5bae6;hpb=bbbba97cbcf12039810533e3a2daf2eefdefe7f0;p=haskell-directory.git

diff --git a/Data/Set.hs b/Data/Set.hs
index e515667..fd09eb0 100644
--- a/Data/Set.hs
+++ b/Data/Set.hs
@@ -1,36 +1,40 @@
-{-| Module      :  Data.Set
-    Copyright   :  (c) Daan Leijen 2002
-    License     :  BSD-style
-    Maintainer  :  libraries@haskell.org
-    Stability   :  provisional
-    Portability :  portable
-
-  An efficient implementation of sets. 
-
-  This module is intended to be imported @qualified@, to avoid name
-  clashes with Prelude functions.  eg.
-
-  >  import 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.
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Set
+-- Copyright   :  (c) Daan Leijen 2002
+-- License     :  BSD-style
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- An efficient implementation of sets.
+--
+-- This module is intended to be imported @qualified@, to avoid name
+-- clashes with "Prelude" functions.  eg.
+--
+-- >  import 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 perferred 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.
+-----------------------------------------------------------------------------
 
-  Note that the implementation is /left-biased/ -- the elements of a
-  first argument are always perferred to the second, for example in
-  'union' or 'insert'.  Of course, left-biasing can only be observed
-  when equality an equivalence relation instead of structural
-  equality.
--}
----------------------------------------------------------------------------------
 module Data.Set  ( 
             -- * Set type
-              Set          -- instance Eq,Show
+              Set          -- instance Eq,Ord,Show,Read,Data,Typeable
 
             -- * Operators
             , (\\)
@@ -107,9 +111,9 @@ module Data.Set  (
 	delFromSet,    	-- :: Ord a => Set a -> a -> Set a
             ) where
 
-import Prelude hiding (filter,foldr,foldl,null,map)
-import Data.Monoid
+import Prelude hiding (filter,foldr,null,map)
 import qualified Data.List as List
+import Data.Typeable
 
 {-
 -- just for testing
@@ -118,6 +122,12 @@ import List (nub,sort)
 import qualified List
 -}
 
+#if __GLASGOW_HASKELL__
+import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec)
+import Data.Generics.Basics
+import Data.Generics.Instances
+#endif
+
 {--------------------------------------------------------------------
   Operators
 --------------------------------------------------------------------}
@@ -136,6 +146,23 @@ data Set a    = Tip
 
 type Size     = Int
 
+#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"
+
+#endif
+
 {--------------------------------------------------------------------
   Query
 --------------------------------------------------------------------}
@@ -181,6 +208,8 @@ singleton x
   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
@@ -213,7 +242,7 @@ isProperSubsetOf s1 s2
 
 
 -- | /O(n+m)/. Is this a subset?
--- @(s1 `isSubsetOf` s2)@ tells whether s1 is a subset of s2.
+-- @(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)
@@ -223,7 +252,7 @@ isSubsetOfX t Tip = False
 isSubsetOfX (Bin _ x l r) t
   = found && isSubsetOfX l lt && isSubsetOfX r gt
   where
-    (found,lt,gt) = splitMember x t
+    (lt,found,gt) = splitMember x t
 
 
 {--------------------------------------------------------------------
@@ -257,13 +286,15 @@ deleteMax Tip             = Tip
 {--------------------------------------------------------------------
   Union. 
 --------------------------------------------------------------------}
--- | The union of a list of sets: (@unions == foldl union empty@).
+-- | 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. Uses the efficient /hedge-union/ algorithm.
+-- | /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
@@ -320,7 +351,7 @@ intersect' t (Bin _ x l r)
   | found     = join x tl tr
   | otherwise = merge tl tr
   where
-    (found,lt,gt) = splitMember x t
+    (lt,found,gt) = splitMember x t
     tl            = intersect' lt l
     tr            = intersect' gt r
 
@@ -352,7 +383,7 @@ partition p (Bin _ x l r)
 ----------------------------------------------------------------------}
 
 -- | /O(n*log n)/. 
--- @map f s@ is the set obtained by applying @f@ to each element of @s@.
+-- @'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@
@@ -362,7 +393,7 @@ map f = fromList . List.map f . toList
 
 -- | /O(n)/. The 
 --
--- @mapMonotonic f s == 'map' f s@, but works only when @f@ is monotonic.
+-- @'mapMonotonic' f s == 'map' f s@, but works only when @f@ is monotonic.
 -- /The precondition is not checked./
 -- Semi-formally, we have:
 -- 
@@ -400,7 +431,7 @@ elems s
 {--------------------------------------------------------------------
   Lists 
 --------------------------------------------------------------------}
--- | /O(n)/. Convert the set to an ascending list of elements.
+-- | /O(n)/. Convert the set to a list of elements.
 toList :: Set a -> [a]
 toList s
   = toAscList s
@@ -479,19 +510,11 @@ instance Ord a => Ord (Set a) where
     compare s1 s2 = compare (toAscList s1) (toAscList s2) 
 
 {--------------------------------------------------------------------
-  Monoid 
---------------------------------------------------------------------}
-
-instance Ord a => Monoid (Set a) where
-    mempty = empty
-    mappend = union
-    mconcat = unions
-
-{--------------------------------------------------------------------
   Show
 --------------------------------------------------------------------}
 instance Show a => Show (Set a) where
-  showsPrec d s  = showSet (toAscList s)
+  showsPrec p xs = showParen (p > 10) $
+    showString "fromList " . shows (toList xs)
 
 showSet :: (Show a) => [a] -> ShowS
 showSet []     
@@ -501,7 +524,29 @@ showSet (x: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)
+#else
+  readsPrec p = readParen (p > 10) $ \ r -> do
+    ("fromList",s) <- lex
+    (xs,t) <- reads
+    return (fromList xs,t)
+#endif
+
+{--------------------------------------------------------------------
+  Typeable/Data
+--------------------------------------------------------------------}
+
+#include "Typeable.h"
+INSTANCE_TYPEABLE1(Set,setTc,"Set")
 
 {--------------------------------------------------------------------
   Utility functions that return sub-ranges of the original
@@ -569,7 +614,7 @@ filterLt cmp (Bin sx x l r)
 {--------------------------------------------------------------------
   Split
 --------------------------------------------------------------------}
--- | /O(log n)/. The expression (@split x set@) is a pair @(set1,set2)@
+-- | /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)
@@ -582,13 +627,13 @@ split x (Bin sy y 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 -> (Bool,Set a,Set a)
-splitMember x Tip = (False,Tip,Tip)
+splitMember :: Ord a => a -> Set a -> (Set a,Bool,Set a)
+splitMember x Tip = (Tip,False,Tip)
 splitMember x (Bin sy y l r)
   = case compare x y of
-      LT -> let (found,lt,gt) = splitMember x l in (found,lt,join y gt r)
-      GT -> let (found,lt,gt) = splitMember x r in (found,join y l lt,gt)
-      EQ -> (True,l,r)
+      LT -> let (lt,found,gt) = splitMember x l in (lt,found,join y gt r)
+      GT -> let (lt,found,gt) = splitMember x r in (join y l lt,found,gt)
+      EQ -> (l,True,r)
 
 {--------------------------------------------------------------------
   Utility functions that maintain the balance properties of the tree.
@@ -797,7 +842,7 @@ showTree 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.
+ @wide@ is 'True', an extra wide version is shown.
 
 > Set> putStrLn $ showTreeWith True False $ fromDistinctAscList [1..5]
 > 4
@@ -1077,53 +1122,66 @@ prop_List xs
 --------------------------------------------------------------------}
 
 {-# DEPRECATED emptySet "Use empty instead" #-}
+-- | Obsolete equivalent of 'empty'.
 emptySet :: Set a
 emptySet = empty
 
-{-# DEPRECATED mkSet "Equivalent to 'foldl insert empty'." #-}
+{-# DEPRECATED mkSet "Use fromList instead" #-}
+-- | Obsolete equivalent of 'fromList'.
 mkSet :: Ord a => [a]  -> Set a
-mkSet = List.foldl' (flip insert) empty
+mkSet = fromList
 
-{-# DEPRECATED setToList "Use instead." #-}
+{-# DEPRECATED setToList "Use elems instead." #-}
+-- | Obsolete equivalent of 'elems'.
 setToList :: Set a -> [a] 
 setToList = elems
 
 {-# DEPRECATED unitSet "Use singleton instead." #-}
+-- | Obsolete equivalent of 'singleton'.
 unitSet :: a -> Set a
 unitSet = singleton
 
 {-# DEPRECATED elementOf "Use member instead." #-}
+-- | Obsolete equivalent of 'member'.
 elementOf :: Ord a => a -> Set a -> Bool
 elementOf = member
 
 {-# DEPRECATED isEmptySet "Use null instead." #-}
+-- | Obsolete equivalent of 'null'.
 isEmptySet :: Set a -> Bool
 isEmptySet = null
 
 {-# DEPRECATED cardinality "Use size instead." #-}
+-- | Obsolete equivalent of 'size'.
 cardinality :: Set a -> Int
 cardinality = size
 
 {-# DEPRECATED unionManySets "Use unions instead." #-}
+-- | Obsolete equivalent of 'unions'.
 unionManySets :: Ord a => [Set a] -> Set a
 unionManySets = unions
 
 {-# DEPRECATED minusSet "Use difference instead." #-}
+-- | Obsolete equivalent of 'difference'.
 minusSet :: Ord a => Set a -> Set a -> Set a
 minusSet = difference
 
 {-# DEPRECATED mapSet "Use map instead." #-}
+-- | Obsolete equivalent of 'map'.
 mapSet :: (Ord a, Ord b) => (b -> a) -> Set b -> Set a
 mapSet = map
 
 {-# DEPRECATED intersect "Use intersection instead." #-}
+-- | Obsolete equivalent of 'intersection'.
 intersect :: Ord a => Set a -> Set a -> Set a
 intersect = intersection
 
-{-# DEPRECATED addToSet "Use insert instead." #-}
+{-# DEPRECATED addToSet "Use 'flip insert' instead." #-}
+-- | Obsolete equivalent of @'flip' 'insert'@.
 addToSet :: Ord a => Set a -> a -> Set a
 addToSet = flip insert
 
-{-# DEPRECATED delFromSet "Use delete instead." #-}
+{-# DEPRECATED delFromSet "Use `flip delete' instead." #-}
+-- | Obsolete equivalent of @'flip' 'delete'@.
 delFromSet :: Ord a => Set a -> a -> Set a
 delFromSet = flip delete