-lex ('\'':s) = [('\'':ch++"'", t) | (ch,'\'':t) <- lexLitChar s,
- ch /= "'" ]
-lex ('"':s) = [('"':str, t) | (str,t) <- lexString s]
- where
- lexString ('"':s) = [("\"",s)]
- lexString s = [(ch++str, u)
- | (ch,t) <- lexStrItem s,
- (str,u) <- lexString t ]
-
- lexStrItem ('\\':'&':s) = [("\\&",s)]
- lexStrItem ('\\':c:s) | isSpace c
- = [("\\&",t) | '\\':t <- [dropWhile isSpace s]]
- lexStrItem s = lexLitChar s
-
-lex (c: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
+lex ('\'':s) = do
+ (ch, '\'':t) <- lexLitChar s
+ guard (ch /= "'")
+ return ('\'':ch++"'", t)
+lex ('"':s) = do
+ (str,t) <- lexString s
+ return ('"':str, t)
+
+ where
+ lexString ('"':s) = return ("\"",s)
+ lexString s = do
+ (ch,t) <- lexStrItem s
+ (str,u) <- lexString t
+ return (ch++str, u)
+
+
+ lexStrItem ('\\':'&':s) = return ("\\&",s)
+ lexStrItem ('\\':c:s) | isSpace c = do
+ ('\\':t) <- return (dropWhile isSpace s)
+ return ("\\&",t)
+ lexStrItem s = lexLitChar s
+
+lex (c:s) | isSingle c = return ([c],s)
+ | isSym c = do
+ (sym,t) <- return (span isSym s)
+ return (c:sym,t)
+ | isAlpha c = do
+ (nam,t) <- return (span isIdChar s)
+ return (c:nam, t)
+ | isDigit c = do
+ (ds,s) <- return (span isDigit s)
+ (fe,t) <- lexFracExp s
+ return (c:ds++fe,t)
+ | otherwise = zero -- bad character