import Data.Int
import qualified Data.List as List
-import Data.Monoid
+import Data.Typeable
{-
-- just for testing
import qualified List
-}
+#if __GLASGOW_HASKELL__
+import Data.Generics.Basics
+import Data.Generics.Instances
+#endif
-#ifdef __GLASGOW_HASKELL__
-{--------------------------------------------------------------------
- GHC: use unboxing to get @shiftRL@ inlined.
---------------------------------------------------------------------}
#if __GLASGOW_HASKELL__ >= 503
import GHC.Word
import GHC.Exts ( Word(..), Int(..), shiftRL# )
-#else
+#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
intFromNat w = fromIntegral w
shiftRL :: Nat -> Int -> Nat
-shiftRL (W# x) (I# i)
- = W# (shiftRL# x i)
-
-#elif __HUGS__
+#if __GLASGOW_HASKELL__
{--------------------------------------------------------------------
- Hugs:
- * raises errors on boundary values when using 'fromIntegral'
- but not with the deprecated 'fromInt/toInt'.
- * Older Hugs doesn't define 'Word'.
- * Newer Hugs defines 'Word' in the Prelude but no operations.
+ GHC: use unboxing to get @shiftRL@ inlined.
--------------------------------------------------------------------}
-import Data.Word
-infixl 9 \\ -- comment to fool cpp
-
-type Nat = Word32 -- illegal on 64-bit platforms!
-
-natFromInt :: Int -> Nat
-natFromInt i = fromInt i
-
-intFromNat :: Nat -> Int
-intFromNat w = toInt w
-
-shiftRL :: Nat -> Int -> Nat
-shiftRL x i = shiftR x i
-
+shiftRL (W# x) (I# i)
+ = W# (shiftRL# x i)
#else
-{--------------------------------------------------------------------
- 'Standard' Haskell
- * A "Nat" is a natural machine word (an unsigned Int)
---------------------------------------------------------------------}
-import Data.Word
-infixl 9 \\ -- comment to fool cpp
-
-type Nat = Word
-
-natFromInt :: Int -> Nat
-natFromInt i = fromIntegral i
-
-intFromNat :: Nat -> Int
-intFromNat w = fromIntegral w
-
-shiftRL :: Nat -> Int -> Nat
-shiftRL w i = shiftR w i
-
+shiftRL x i = shiftR x i
#endif
{--------------------------------------------------------------------
type Prefix = Int
type Mask = 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 IntSet where
+ gfoldl f z is = z fromList `f` (toList is)
+ toConstr _ = error "toConstr"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNorepType "Data.IntSet.IntSet"
+
+#endif
+
{--------------------------------------------------------------------
Query
--------------------------------------------------------------------}
subsetCmp Nil t = LT
-- | /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 :: IntSet -> IntSet -> Bool
isSubsetOf t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
Nil -> (Nil,Nil)
--- | /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@.
--
-- | /O(log n)/. Performs a 'split' but also returns whether the pivot
-- element was found in the original set.
-splitMember :: Int -> IntSet -> (Bool,IntSet,IntSet)
+splitMember :: Int -> IntSet -> (IntSet,Bool,IntSet)
splitMember x t
= case t of
Bin p m l r
- | zero x m -> let (found,lt,gt) = splitMember x l in (found,lt,union gt r)
- | otherwise -> let (found,lt,gt) = splitMember x r in (found,union l lt,gt)
+ | zero x m -> let (lt,found,gt) = splitMember x l in (lt,found,union gt r)
+ | otherwise -> let (lt,found,gt) = splitMember x r in (union l lt,found,gt)
Tip y
- | x>y -> (False,t,Nil)
- | x<y -> (False,Nil,t)
- | otherwise -> (True,Nil,Nil)
- Nil -> (False,Nil,Nil)
+ | x>y -> (t,False,Nil)
+ | x<y -> (Nil,False,t)
+ | otherwise -> (Nil,True,Nil)
+ Nil -> (Nil,False,Nil)
{----------------------------------------------------------------------
Map
----------------------------------------------------------------------}
-- | /O(n*min(n,W))/.
--- @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@
-- tentative implementation. See if more efficient exists.
{--------------------------------------------------------------------
- Monoid
---------------------------------------------------------------------}
-
-instance Monoid IntSet where
- mempty = empty
- mappend = union
- mconcat = unions
-
-{--------------------------------------------------------------------
Show
--------------------------------------------------------------------}
instance Show IntSet where
showTail (x:xs) = showChar ',' . shows x . showTail xs
{--------------------------------------------------------------------
+ Typeable
+--------------------------------------------------------------------}
+
+#include "Typeable.h"
+INSTANCE_TYPEABLE0(IntSet,intSetTc,"IntSet")
+
+{--------------------------------------------------------------------
Debugging
--------------------------------------------------------------------}
-- | /O(n)/. Show the tree that implements the set. The tree is shown
= showTreeWith True False s
-{- | /O(n)/. The expression (@showTreeWith hang wide map@) shows
+{- | /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.
+ '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