[project @ 2005-07-21 10:59:27 by ross]

[ghc-base.git] / Data / Sequence.hs

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 6ffded0..381b25d 100644 (file)
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -120,7 +120,7 @@ instance Ord a => Ord (Seq a) where
        compare xs ys = compare (toList xs) (toList ys)
 
 #if TESTING
-instance (Show a) => Show (Seq a) where
+instance Show a => Show (Seq a) where
        showsPrec p (Seq x) = showsPrec p x
 #else
 instance Show a => Show (Seq a) where
@@ -143,10 +143,18 @@ INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
 
 #if __GLASGOW_HASKELL__
 instance Data a => Data (Seq a) where
-       gfoldl f z xs   = z fromList `f` toList xs
+       gfoldl f z      = gfoldSeq f z id
        toConstr _      = error "toConstr"
        gunfold _ _     = error "gunfold"
        dataTypeOf _    = mkNorepType "Data.Sequence.Seq"
+
+-- Treat the type as consisting of constructors of arity 0, 1, 2, ...
+gfoldSeq :: Data a => (forall a b. Data a => c (a -> b) -> a -> c b) ->
+       (forall g. g -> c g) -> (Seq a -> r) -> Seq a -> c r
+gfoldSeq f z k s = case viewr s of
+       EmptyR -> z (k empty)
+       xs :> x -> gfoldSeq f z (snoc k) xs `f` x
+  where        snoc k xs x = k (xs |> x)
 #endif
 
 -- Finger trees
@@ -171,6 +179,8 @@ instance Functor FingerTree where
                Deep v (fmap f pr) (fmap (fmap f) m) (fmap 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
 
@@ -220,10 +230,14 @@ instance Sized (Node a) where
        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