From: ross <unknown>
Date: Tue, 19 Jul 2005 17:33:23 +0000 (+0000)
Subject: [project @ 2005-07-19 17:33:23 by ross]
X-Git-Tag: cmm-merge2~54
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0a3dc34b2cd99d74151ff08cedb68560ec59cc36;p=ghc-base.git

[project @ 2005-07-19 17:33:23 by ross]
improved definition of gfold for Seq a
---

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 6ffded0..7ff4403 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -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