shithub: MicroHs

Info  •  Files  •  Log  •  Branches

Get rid of old lex.

--- a/lib/Numeric/Read.hs

+++ b/lib/Numeric/Read.hs

@@ -1,6 +1,5 @@

 module Numeric.Read(

   readParen,

-  --

   readSigned,

   readInt,

   readBin,

@@ -24,7 +23,7 @@

 import Data.Num

 import Data.Ord

 import Data.String

-import Text.Read.OldLex(lex, dropSpace)

+import {-# SOURCE #-} Text.Read.Internal(lex)

 import Text.Show

 type ReadS a = String -> [(a, String)]

@@ -79,3 +78,6 @@

 readBoundedEnum :: forall a . (Enum a, Bounded a, Show a) => ReadS a

 readBoundedEnum = \ r -> [ (e, t) | (s, t) <- lex r, Just e <- [lookup s table] ]

   where table = [ (show e, e) | e <- [ minBound .. maxBound ] ]

+

+dropSpace :: String -> String

+dropSpace = dropWhile isSpace

--- /dev/null

+++ b/lib/Text/Read/Internal.hs-boot

@@ -1,0 +1,5 @@

+module Text.Read.Internal where

+import Prelude()

+import Data.Char_Type

+

+lex :: String -> [(String, String)]

--- a/lib/Text/Read/OldLex.hs

+++ /dev/null

@@ -1,71 +1,0 @@

-module Text.Read.OldLex(lex, dropSpace) where

-import Prelude()              -- do not import Prelude

-import Primitives

-import Data.Bool

-import Data.Char

-import Data.Eq

-import Data.List

-import Data.Ord

-

-type ReadS a = String -> [(a, String)]

-

-lex :: ReadS String

-lex []       = [([],[])]

-lex ('\'':s) = [('\'':ch++"'", t) | (ch,'\'':t) <- lexLitChar s,

-                                    ch /= "'" ]

-lex ('"':s)  = [('"':str, t) | (str,t) <- lexString s]

-  where

-    lexString ('"':s) = [("\""::String, s)]

-    lexString s = [(ch++str, u)

-                  | (ch,t)  <- lexStrItem s,

-                    (str,u) <- lexString t ]

-

-    lexStrItem ('\\':'&':s) =  [("\\&"::String,s)]

-    lexStrItem ('\\':c:s) | isSpace c = [("\\&"::String,t) |

-                                         '\\':t <- [dropSpace s]]

-    lexStrItem s = lexLitChar s

-

-lex (c:s) | isSpace c  = lex s

-          | isSingle c = [([c],s)]

-          | isSym c    = [(c:sym,t)    | (sym,t) <- [span isSym s]]

-          | isAlpha c  = [(c:nam,t)    | (nam,t) <- [span isIdChar s]]

-          | isDigit c  = [(c:ds++fe,t) | (ds,s)  <- [span isDigit s],

-                                         (fe,t)  <- lexFracExp s ]

-          | otherwise  = []    -- bad character  

-  where  

-    isSingle c = c `elem` (",;()[]{}_`"::String)

-    isSym c    = c `elem` ("!@#$%&?+./<=>?\\^|:-~"::String)

-    isIdChar c = isAlphaNum c || c == '_' || c == '\''

-

-    lexFracExp ('.':c:cs) | isDigit c

-      = [('.':ds++e,u) | (ds,t) <- lexDigits (c:cs),

-         (e,u) <- lexExp t]

-    lexFracExp s = lexExp s

- 

-    lexExp (e:s) | e == 'e' || e == 'E'

-      = [(e:c:ds,u) | (c:t)  <- [s], c == '-' || c == '+',

-          (ds,u) <- lexDigits t] ++

-        [(e:ds,t)   | (ds,t) <- lexDigits s]

-    lexExp s = [([],s)]

-

-lexDigits :: ReadS String

-lexDigits s = [(cs, t) | (cs@(_:_), t) <- [span isDigit s]]

-

-lexLitChar :: ReadS String

-lexLitChar ('\\':s) = [ prefix '\\' c | c <- lexEsc s ]

-  where

-    lexEsc (c:s)     | c `elem` ("abfnrtv\\\"'"::String) = [([c],s)]

-    lexEsc ('^':c:s) | c >= '@' && c <= '_'    = [(['^',c],s)]

-    lexEsc ('o':s)               = [prefix 'o' (span isOctDigit s)]

-    lexEsc ('x':s)               = [prefix 'x' (span isHexDigit s)]

-    lexEsc s@(d:_)   | isDigit d = [span isDigit s]

-    lexEsc _                     = []

-

-    prefix c (t,s) = (c:t, s)

-lexLitChar (c:cs) = [([c], cs)]

-lexLitChar [] = []

-

-dropSpace :: String -> String

-dropSpace [] = []

-dropSpace ccs@(c:cs) | isSpace c = dropSpace cs

-                     | True      = ccs

-- 

⑨