X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FSequence.hs;h=611a0cb4d6deb983d4d7f7e3840dd6432fb92a5e;hb=4ad6d47a2fa74203a689115479d5d7ee5548ba31;hp=381b25d323850e02a51704a1a80a11441128fe59;hpb=382b9acb3a481a4d0980724a1a503bbbf5d8560a;p=haskell-directory.git

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 381b25d..611a0cb 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -90,7 +90,8 @@ import Test.QuickCheck
 #endif
 
 #if __GLASGOW_HASKELL__
-import Data.Generics.Basics (Data(..), mkNorepType)
+import Data.Generics.Basics (Data(..), Fixity(..),
+			constrIndex, mkConstr, mkDataType)
 #endif
 
 infixr 5 `consTree`
@@ -143,18 +144,26 @@ INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
 
 #if __GLASGOW_HASKELL__
 instance Data a => Data (Seq a) where
-	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)
+	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	= gcast1
+
+emptyConstr = mkConstr seqDataType "empty" [] Prefix
+consConstr  = mkConstr seqDataType "<|" [] Infix
+seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
 #endif
 
 -- Finger trees