From: ross <unknown>
Date: Thu, 20 Oct 2005 15:08:35 +0000 (+0000)
Subject: [project @ 2005-10-20 15:08:35 by ross]
X-Git-Tag: cmm-merge2~9
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=8c8da35006467df7adaff2fd9e8dd3aef4fbe220;p=ghc-base.git

[project @ 2005-10-20 15:08:35 by ross]
Read instance
---

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 6f01e0d..69276ed 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -87,6 +87,7 @@ import Data.Typeable
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Exts (build)
+import Text.Read (readPrec, lexP, Lexeme(..), (<++), (+++), reset)
 import Data.Generics.Basics (Data(..), Fixity(..),
 			constrIndex, mkConstr, mkDataType)
 #endif
@@ -146,6 +147,49 @@ instance Show a => Show (Seq a) where
 		showChar '>'
 #endif
 
+instance Read a => Read (Seq a) where
+#ifdef __GLASGOW_HASKELL__
+	readPrec = parens $ (symbol "<>" >> return empty) <++ do
+		symbol "<"
+		readEnd empty <++ readRest empty
+	  where readEnd xs = do
+			symbol ">"
+			return xs
+		readRest xs = do
+			x <- reset readPrec
+			let xs' = xs |> x
+			readEnd xs' <++ do
+				symbol ","
+				readRest xs'
+		parens p = p +++ do
+			Punc "(" <- lexP
+			x        <- reset (parens p)
+			Punc ")" <- lexP
+			return x
+		symbol s = do
+			Symbol "<" <- lexP
+			return ()
+#else
+	readsPrec _ = readParen False $ \ r -> do
+		(tok,s) <- lex r
+		case tok of
+			"<>" -> return (empty,s)
+			"<"  -> do
+				(tok',t) <- lex s
+				case tok' of
+					">" -> return (empty,t)
+					_   -> readRest empty s
+			_    -> []
+	  where readRest xs s = do
+			(x,t) <- reads s
+			let xs' = xs |> x
+			(tok,u) <- lex t
+			case tok of
+				">" -> return (xs',u)
+				"," -> readRest xs' u
+				_   -> []
+#endif
+
 #include "Typeable.h"
 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")