From: Ian Lynagh Date: Wed, 6 Aug 2008 12:05:04 +0000 (+0000) Subject: Move some bits around to stop Data.Either being in the base import knot X-Git-Tag: 6_10_branch_has_been_forked~74 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=bb916d929d2ebd226eb9a1d0fdb30f73314ef3ec;p=ghc-base.git Move some bits around to stop Data.Either being in the base import knot --- diff --git a/Data/Either.hs b/Data/Either.hs index cb71eaa..956e6da 100644 --- a/Data/Either.hs +++ b/Data/Either.hs @@ -21,9 +21,13 @@ module Data.Either ( partitionEithers, -- :: [Either a b] -> ([a],[b]) ) where +#include "Typeable.h" + #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Show +import GHC.Read +import Data.Typeable {- -- just for testing @@ -40,7 +44,7 @@ either correct or an error; by convention, the 'Left' constructor is used to hold an error value and the 'Right' constructor is used to hold a correct value (mnemonic: \"right\" also means \"correct\"). -} -data Either a b = Left a | Right b deriving (Eq, Ord, Show) +data Either a b = Left a | Right b deriving (Eq, Ord, Read, Show) -- | Case analysis for the 'Either' type. -- If the value is @'Left' a@, apply the first function to @a@; @@ -50,6 +54,8 @@ either f _ (Left x) = f x either _ g (Right y) = g y #endif /* __GLASGOW_HASKELL__ */ +INSTANCE_TYPEABLE2(Either,eitherTc,"Either") + -- | Extracts from a list of 'Either' all the 'Left' elements -- All the 'Left' elements are extracted in order. diff --git a/Data/Typeable.hs b/Data/Typeable.hs index aae61fe..cad0b78 100644 --- a/Data/Typeable.hs +++ b/Data/Typeable.hs @@ -83,7 +83,6 @@ module Data.Typeable import qualified Data.HashTable as HT import Data.Maybe -import Data.Either import Data.Int import Data.Word import Data.List( foldl, intersperse ) @@ -487,7 +486,6 @@ INSTANCE_TYPEABLE0((),unitTc,"()") INSTANCE_TYPEABLE1([],listTc,"[]") INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe") INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio") -INSTANCE_TYPEABLE2(Either,eitherTc,"Either") INSTANCE_TYPEABLE2((->),funTc,"->") INSTANCE_TYPEABLE1(IO,ioTc,"IO") diff --git a/GHC/Read.lhs b/GHC/Read.lhs index 769e055..b890b46 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -22,12 +22,6 @@ module GHC.Read -- ReadS type , ReadS -- :: *; = String -> [(a,String)] - -- utility functions - , reads -- :: Read a => ReadS a - , readp -- :: Read a => ReadP a - , readEither -- :: Read a => String -> Either String a - , read -- :: Read a => String -> a - -- H98 compatibility , lex -- :: ReadS String , lexLitChar -- :: ReadS String @@ -44,6 +38,9 @@ module GHC.Read -- Temporary , readParen + + -- XXX Can this be removed? + , readp ) where @@ -64,7 +61,6 @@ import qualified Text.Read.Lex as L import Text.ParserCombinators.ReadPrec import Data.Maybe -import Data.Either #ifndef __HADDOCK__ import {-# SOURCE #-} GHC.Unicode ( isDigit ) @@ -225,33 +221,6 @@ readListPrecDefault :: Read a => ReadPrec [a] readListPrecDefault = list readPrec ------------------------------------------------------------------------ --- utility functions - --- | equivalent to 'readsPrec' with a precedence of 0. -reads :: Read a => ReadS a -reads = readsPrec minPrec - -readp :: Read a => ReadP a -readp = readPrec_to_P readPrec minPrec - -readEither :: Read a => String -> Either String a -readEither s = - case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of - [x] -> Right x - [] -> Left "Prelude.read: no parse" - _ -> Left "Prelude.read: ambiguous parse" - where - read' = - do x <- readPrec - lift P.skipSpaces - return x - --- | The 'read' function reads input from a string, which must be --- completely consumed by the input process. -read :: Read a => String -> a -read s = either error id (readEither s) - ------------------------------------------------------------------------- -- H98 compatibility -- | The 'lex' function reads a single lexeme from the input, discarding @@ -448,23 +417,6 @@ instance Read a => Read (Maybe a) where readListPrec = readListPrecDefault readList = readListDefault -instance (Read a, Read b) => Read (Either a b) where - readPrec = - parens - ( prec appPrec - ( do L.Ident "Left" <- lexP - x <- step readPrec - return (Left x) - +++ - do L.Ident "Right" <- lexP - y <- step readPrec - return (Right y) - ) - ) - - readListPrec = readListPrecDefault - readList = readListDefault - instance Read a => Read [a] where readPrec = readListPrec readListPrec = readListPrecDefault @@ -714,3 +666,11 @@ instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, readListPrec = readListPrecDefault readList = readListDefault \end{code} + +\begin{code} +-- XXX Can this be removed? + +readp :: Read a => ReadP a +readp = readPrec_to_P readPrec minPrec +\end{code} + diff --git a/Text/Read.hs b/Text/Read.hs index 172a4c2..5ab8877 100644 --- a/Text/Read.hs +++ b/Text/Read.hs @@ -45,7 +45,10 @@ module Text.Read ( ) where #ifdef __GLASGOW_HASKELL__ +import GHC.Base import GHC.Read +import Data.Either +import Text.ParserCombinators.ReadP as P #endif #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) import Text.ParserCombinators.ReadPrec @@ -68,3 +71,30 @@ parens p = optional L.Punc ")" <- lexP return x #endif + +#ifdef __GLASGOW_HASKELL__ +------------------------------------------------------------------------ +-- utility functions + +-- | equivalent to 'readsPrec' with a precedence of 0. +reads :: Read a => ReadS a +reads = readsPrec minPrec + +readEither :: Read a => String -> Either String a +readEither s = + case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of + [x] -> Right x + [] -> Left "Prelude.read: no parse" + _ -> Left "Prelude.read: ambiguous parse" + where + read' = + do x <- readPrec + lift P.skipSpaces + return x + +-- | The 'read' function reads input from a string, which must be +-- completely consumed by the input process. +read :: Read a => String -> a +read s = either error id (readEither s) +#endif +