X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelRead.lhs;h=2b060fc206b053d63cddeaabab423c1e8f26fe89;hb=239e9471e104fd88ec93bf42623c3a68a496657a;hp=c096e80becac0a3f944c030ad7f36670350e4641;hpb=8b90646791f16015f067e4654a069f64d8aeacb4;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelRead.lhs b/ghc/lib/std/PrelRead.lhs index c096e80..2b060fc 100644 --- a/ghc/lib/std/PrelRead.lhs +++ b/ghc/lib/std/PrelRead.lhs @@ -1,5 +1,7 @@ +% ------------------------------------------------------------------------------ +% $Id: PrelRead.lhs,v 1.22 2001/11/23 16:20:08 simonpj Exp $ % -% (c) The AQUA Project, Glasgow University, 1994-1998 +% (c) The University of Glasgow, 1994-2000 % \section[PrelRead]{Module @PrelRead@} @@ -11,21 +13,15 @@ Instances of the Read class. module PrelRead where -import PrelErr ( error ) -import PrelEnum ( Enum(..) ) +import {-# SOURCE #-} PrelErr ( error ) +import PrelEnum ( Enum(..), maxBound ) import PrelNum import PrelReal import PrelFloat import PrelList -import PrelTup import PrelMaybe import PrelShow -- isAlpha etc import PrelBase -import Monad - --- needed for readIO and instance Read Buffermode -import PrelIOBase ( IO, userError, BufferMode(..) ) -import PrelException ( ioError ) \end{code} %********************************************************* @@ -59,6 +55,22 @@ class Read a where readList = readList__ reads \end{code} +In this module we treat [(a,String)] as a monad in MonadPlus +But MonadPlus isn't defined yet, so we simply give local +declarations for mzero and guard suitable for this particular +type. It would also be reasonably to move MonadPlus to PrelBase +along with Monad and Functor, but that seems overkill for one +example + +\begin{code} +mzero :: [a] +mzero = [] + +guard :: Bool -> [()] +guard True = [()] +guard False = [] +\end{code} + %********************************************************* %* * \subsection{Utility functions} @@ -85,19 +97,6 @@ read s = (x,str1) <- reads str ("","") <- lex str1 return x - - -- raises an exception instead of an error -readIO :: Read a => String -> IO a -readIO s = case (do { (x,t) <- reads s ; ("","") <- lex t ; return x }) of -#ifndef NEW_READS_REP - [x] -> return x - [] -> ioError (userError "Prelude.readIO: no parse") - _ -> ioError (userError "Prelude.readIO: ambiguous parse") -#else - Just x -> return x - Nothing -> ioError (userError "Prelude.readIO: no parse") -#endif - \end{code} \begin{code} @@ -256,7 +255,7 @@ lexLitChar ('\\':s) = do fromAsciiLab (x:y:ls) | isUpper y && [x,y] `elem` asciiEscTab = return ([x,y], ls) fromAsciiLab _ = mzero - + asciiEscTab = "DEL" : asciiTab {- @@ -268,8 +267,7 @@ lexLitChar ('\\':s) = do -} checkSize base f str = do (num, res) <- f str - -- Note: this is assumes that a Char is 8 bits long. - if (toAnInt base num) > 255 then + if toAnInteger base num > toInteger (ord maxBound) then mzero else case base of @@ -277,7 +275,7 @@ lexLitChar ('\\':s) = do 16 -> return ('x':num, res) _ -> return (num, res) - toAnInt base xs = foldl (\ acc n -> acc*base + n) 0 (map digitToInt xs) + toAnInteger base = foldl (\ acc n -> acc*base + toInteger (digitToInt n)) 0 lexLitChar (c:s) = return ([c],s) @@ -373,7 +371,7 @@ instance (Integral a, Read a) => Read (Ratio a) where (x,s) <- reads r ("%",t) <- lex s (y,u) <- reads t - return (x%y,u)) + return (x % y,u)) instance (Read a) => Read [a] where readsPrec _ = readList @@ -505,26 +503,27 @@ include lexing common prefixes such as '0x' or '0o' etc. ReadS Int, ReadS Integer #-} readDec :: (Integral a) => ReadS a -readDec = readInt 10 isDigit (\d -> ord d - ord_0) +readDec = readInt 10 isDigit (\d -> ord d - ord '0') {-# SPECIALISE readOct :: ReadS Int, ReadS Integer #-} readOct :: (Integral a) => ReadS a -readOct = readInt 8 isOctDigit (\d -> ord d - ord_0) +readOct = readInt 8 isOctDigit (\d -> ord d - ord '0') {-# SPECIALISE readHex :: ReadS Int, ReadS Integer #-} readHex :: (Integral a) => ReadS a readHex = readInt 16 isHexDigit hex - where hex d = ord d - (if isDigit d then ord_0 + where hex d = ord d - (if isDigit d then ord '0' else ord (if isUpper d then 'A' else 'a') - 10) readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a readInt radix isDig digToInt s = do (ds,r) <- nonnull isDig s - return (foldl1 (\n d -> n * radix + d) (map (fromInt . digToInt) ds), r) + return (foldl1 (\n d -> n * radix + d) + (map (fromInteger . toInteger . digToInt) ds), r) {-# SPECIALISE readSigned :: ReadS Int -> ReadS Int, @@ -553,23 +552,22 @@ point type to obtain the same results. ReadS Double, ReadS Float #-} readFloat :: (RealFloat a) => ReadS a -readFloat r = do - (x,t) <- readRational r - return (fromRational x,t) - -readRational :: ReadS Rational -- NB: doesn't handle leading "-" - -readRational r = - (do - (n,d,s) <- readFix r - (k,t) <- readExp s - return ((n%1)*10^^(k-d), t )) ++ +readFloat r = + (do + (x,t) <- readRational r + return (fromRational x,t) ) ++ (do ("NaN",t) <- lex r return (0/0,t) ) ++ (do ("Infinity",t) <- lex r return (1/0,t) ) + +readRational :: ReadS Rational -- NB: doesn't handle leading "-" +readRational r = do + (n,d,s) <- readFix r + (k,t) <- readExp s + return ((n%1)*10^^(k-d), t) where readFix r = do (ds,s) <- lexDecDigits r @@ -607,26 +605,3 @@ readRational__ top_s #endif \end{code} - -%********************************************************* -%* * -\subsection{Reading BufferMode} -%* * -%********************************************************* - -This instance decl is here rather than somewhere more appropriate in -order that we can avoid both orphan-instance modules and recursive -dependencies. - -\begin{code} -instance Read BufferMode where - readsPrec _ = - readParen False - (\r -> let lr = lex r - in - [(NoBuffering, rest) | ("NoBuffering", rest) <- lr] ++ - [(LineBuffering,rest) | ("LineBuffering",rest) <- lr] ++ - [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr, - (mb, rest2) <- reads rest1]) - -\end{code}