{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude #-}------------------------------------------------------------------------------- |-- Module : Text.Read.Lex-- Copyright : (c) The University of Glasgow 2002-- License : BSD-style (see the file libraries/base/LICENSE)---- Maintainer : libraries@haskell.org-- Stability : provisional-- Portability : non-portable (uses Text.ParserCombinators.ReadP)---- The cut-down Haskell lexer, used by Text.Read-------------------------------------------------------------------------------moduleText.Read.Lex-- lexing types(Lexeme (..),Number ,numberToInteger ,numberToFixed ,numberToRational ,numberToRangedRational -- lexer,lex ,expect ,hsLex ,lexChar ,readBinP ,readIntP ,readOctP ,readDecP ,readHexP ,isSymbolChar )whereimportText.ParserCombinators.ReadP importGHC.Base importGHC.Char importGHC.Num (Num (..),Integer )importGHC.Show (Show (..))importGHC.Unicode (GeneralCategory (..),generalCategory ,isSpace ,isAlpha ,isAlphaNum )importGHC.Real (Rational ,(%) ,fromIntegral ,Integral ,toInteger ,(^) ,quot ,even )importGHC.List importGHC.Enum (minBound ,maxBound )importData.Maybe -- local copy to break import-cycle-- | @'guard' b@ is @'return' ()@ if @b@ is 'True',-- and 'mzero' if @b@ is 'False'.guard ::(MonadPlus m )=>Bool ->m ()guard :: forall (m :: * -> *). MonadPlus m => Bool -> m ()
guard Bool
True =() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()guard Bool
False =m ()
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero -- ------------------------------------------------------------------------------- Lexing types-- ^ Haskell lexemes.dataLexeme =Char Char -- ^ Character literal|String String -- ^ String literal, with escapes interpreted|Punc String -- ^ Punctuation or reserved symbol, e.g. @(@, @::@|Ident String -- ^ Haskell identifier, e.g. @foo@, @Baz@|Symbol String -- ^ Haskell symbol, e.g. @>>@, @:%@|Number Number -- ^ @since 4.6.0.0|EOF deriving(Lexeme -> Lexeme -> Bool
(Lexeme -> Lexeme -> Bool)
-> (Lexeme -> Lexeme -> Bool) -> Eq Lexeme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lexeme -> Lexeme -> Bool
== :: Lexeme -> Lexeme -> Bool
$c/= :: Lexeme -> Lexeme -> Bool
/= :: Lexeme -> Lexeme -> Bool
Eq -- ^ @since 2.01,Int -> Lexeme -> ShowS
[Lexeme] -> ShowS
Lexeme -> String
(Int -> Lexeme -> ShowS)
-> (Lexeme -> String) -> ([Lexeme] -> ShowS) -> Show Lexeme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lexeme -> ShowS
showsPrec :: Int -> Lexeme -> ShowS
$cshow :: Lexeme -> String
show :: Lexeme -> String
$cshowList :: [Lexeme] -> ShowS
showList :: [Lexeme] -> ShowS
Show -- ^ @since 2.01)-- | @since 4.6.0.0dataNumber =MkNumber Int -- BaseDigits -- Integral part|MkDecimal Digits -- Integral part(Maybe Digits )-- Fractional part(Maybe Integer )-- Exponentderiving(Number -> Number -> Bool
(Number -> Number -> Bool)
-> (Number -> Number -> Bool) -> Eq Number
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Number -> Number -> Bool
== :: Number -> Number -> Bool
$c/= :: Number -> Number -> Bool
/= :: Number -> Number -> Bool
Eq -- ^ @since 4.6.0.0,Int -> Number -> ShowS
[Number] -> ShowS
Number -> String
(Int -> Number -> ShowS)
-> (Number -> String) -> ([Number] -> ShowS) -> Show Number
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Number -> ShowS
showsPrec :: Int -> Number -> ShowS
$cshow :: Number -> String
show :: Number -> String
$cshowList :: [Number] -> ShowS
showList :: [Number] -> ShowS
Show -- ^ @since 4.6.0.0)-- | @since 4.5.1.0numberToInteger ::Number ->Maybe Integer numberToInteger :: Number -> Maybe Integer
numberToInteger (MkNumber Int
base Digits
iPart )=Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base )Digits
iPart )numberToInteger (MkDecimal Digits
iPart Maybe Digits
Nothing Maybe Integer
Nothing )=Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val Integer
10Digits
iPart )numberToInteger Number
_=Maybe Integer
forall a. Maybe a
Nothing -- | @since 4.7.0.0numberToFixed ::Integer ->Number ->Maybe (Integer ,Integer )numberToFixed :: Integer -> Number -> Maybe (Integer, Integer)
numberToFixed Integer
_(MkNumber Int
base Digits
iPart )=(Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base )Digits
iPart ,Integer
0)numberToFixed Integer
_(MkDecimal Digits
iPart Maybe Digits
Nothing Maybe Integer
Nothing )=(Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val Integer
10Digits
iPart ,Integer
0)numberToFixed Integer
p (MkDecimal Digits
iPart (Just Digits
fPart )Maybe Integer
Nothing )=leti :: Integer
i =Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val Integer
10Digits
iPart f :: Integer
f =Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val Integer
10(Integer -> Digits -> Digits
forall a. Integer -> [a] -> [a]
integerTake Integer
p (Digits
fPart Digits -> Digits -> Digits
forall a. [a] -> [a] -> [a]
++ Int -> Digits
forall a. a -> [a]
repeat Int
0))-- Sigh, we really want genericTake, but that's above us in-- the hierarchy, so we define our own version here (actually-- specialised to Integer)integerTake ::Integer ->[a ]->[a ]integerTake :: forall a. Integer -> [a] -> [a]
integerTake Integer
n [a]
_|Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0=[]integerTake Integer
_[]=[]integerTake Integer
n (a
x : [a]
xs )=a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Integer -> [a] -> [a]
forall a. Integer -> [a] -> [a]
integerTake (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)[a]
xs in(Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
i ,Integer
f )numberToFixed Integer
_Number
_=Maybe (Integer, Integer)
forall a. Maybe a
Nothing -- This takes a floatRange, and if the Rational would be outside of-- the floatRange then it may return Nothing. Not that it will not-- /necessarily/ return Nothing, but it is good enough to fix the-- space problems in #5688-- Ways this is conservative:-- * the floatRange is in base 2, but we pretend it is in base 10-- * we pad the floatRange a bit, just in case it is very small-- and we would otherwise hit an edge case-- * We only worry about numbers that have an exponent. If they don't-- have an exponent then the Rational won't be much larger than the-- Number, so there is no problem-- | @since 4.5.1.0numberToRangedRational ::(Int ,Int )->Number ->Maybe Rational -- Nothing = InfnumberToRangedRational :: (Int, Int) -> Number -> Maybe Rational
numberToRangedRational (Int
neg ,Int
pos )n :: Number
n @(MkDecimal Digits
iPart Maybe Digits
mFPart (Just Integer
exp ))-- if exp is out of integer bounds,-- then the number is definitely out of range|Integer
exp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound ::Int )Bool -> Bool -> Bool
|| Integer
exp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
minBound ::Int )=Maybe Rational
forall a. Maybe a
Nothing |Bool
otherwise =letmFirstDigit :: Maybe Int
mFirstDigit =case(Int -> Bool) -> Digits -> Digits
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int
0Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== )Digits
iPart ofiPart' :: Digits
iPart' @(Int
_: Digits
_)->Int -> Maybe Int
forall a. a -> Maybe a
Just (Digits -> Int
forall a. [a] -> Int
length Digits
iPart' )[]->caseMaybe Digits
mFPart ofMaybe Digits
Nothing ->Maybe Int
forall a. Maybe a
Nothing Just Digits
fPart ->case(Int -> Bool) -> Digits -> (Digits, Digits)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int
0Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== )Digits
fPart of(Digits
_,[])->Maybe Int
forall a. Maybe a
Nothing (Digits
zeroes ,Digits
_)->Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Num a => a -> a
negate (Digits -> Int
forall a. [a] -> Int
length Digits
zeroes ))incaseMaybe Int
mFirstDigit ofMaybe Int
Nothing ->Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
0Just Int
firstDigit ->letfirstDigit' :: Int
firstDigit' =Int
firstDigit Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
exp inifInt
firstDigit' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)thenMaybe Rational
forall a. Maybe a
Nothing elseifInt
firstDigit' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
neg Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)thenRational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
0elseRational -> Maybe Rational
forall a. a -> Maybe a
Just (Number -> Rational
numberToRational Number
n )numberToRangedRational (Int, Int)
_Number
n =Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Number -> Rational
numberToRational Number
n )-- | @since 4.6.0.0numberToRational ::Number ->Rational numberToRational :: Number -> Rational
numberToRational (MkNumber Int
base Digits
iPart )=Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base )Digits
iPart Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1numberToRational (MkDecimal Digits
iPart Maybe Digits
mFPart Maybe Integer
mExp )=leti :: Integer
i =Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val Integer
10Digits
iPart incase(Maybe Digits
mFPart ,Maybe Integer
mExp )of(Maybe Digits
Nothing ,Maybe Integer
Nothing )->Integer
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1(Maybe Digits
Nothing ,Just Integer
exp )|Integer
exp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0->(Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
exp ))Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1|Bool
otherwise ->Integer
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (-Integer
exp ))(Just Digits
fPart ,Maybe Integer
Nothing )->Integer -> Integer -> Digits -> Rational
fracExp Integer
0Integer
i Digits
fPart (Just Digits
fPart ,Just Integer
exp )->Integer -> Integer -> Digits -> Rational
fracExp Integer
exp Integer
i Digits
fPart -- fracExp is a bit more efficient in calculating the Rational.-- Instead of calculating the fractional part alone, then-- adding the integral part and finally multiplying with-- 10 ^ exp if an exponent was given, do it all at once.-- ------------------------------------------------------------------------------- Lexinglex ::ReadP Lexeme lex :: ReadP Lexeme
lex =ReadP ()
skipSpaces ReadP () -> ReadP Lexeme -> ReadP Lexeme
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Lexeme
lexToken -- | @since 4.7.0.0expect ::Lexeme ->ReadP ()expect :: Lexeme -> ReadP ()
expect Lexeme
lexeme =do{ReadP ()
skipSpaces ;Lexeme
thing <-ReadP Lexeme
lexToken ;ifLexeme
thing Lexeme -> Lexeme -> Bool
forall a. Eq a => a -> a -> Bool
== Lexeme
lexeme then() -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()elseReadP ()
forall a. ReadP a
pfail }hsLex ::ReadP String -- ^ Haskell lexer: returns the lexed string, rather than the lexemehsLex :: ReadP String
hsLex =doReadP ()
skipSpaces (String
s ,Lexeme
_)<-ReadP Lexeme -> ReadP (String, Lexeme)
forall a. ReadP a -> ReadP (String, a)
gather ReadP Lexeme
lexToken String -> ReadP String
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return String
s lexToken ::ReadP Lexeme lexToken :: ReadP Lexeme
lexToken =ReadP Lexeme
lexEOF ReadP Lexeme -> ReadP Lexeme -> ReadP Lexeme
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Lexeme
lexLitChar ReadP Lexeme -> ReadP Lexeme -> ReadP Lexeme
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Lexeme
lexString ReadP Lexeme -> ReadP Lexeme -> ReadP Lexeme
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Lexeme
lexPunc ReadP Lexeme -> ReadP Lexeme -> ReadP Lexeme
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Lexeme
lexSymbol ReadP Lexeme -> ReadP Lexeme -> ReadP Lexeme
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Lexeme
lexId ReadP Lexeme -> ReadP Lexeme -> ReadP Lexeme
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Lexeme
lexNumber -- ------------------------------------------------------------------------ End of filelexEOF ::ReadP Lexeme lexEOF :: ReadP Lexeme
lexEOF =doString
s <-ReadP String
look Bool -> ReadP ()
forall (m :: * -> *). MonadPlus m => Bool -> m ()
guard (String -> Bool
forall a. [a] -> Bool
null String
s )Lexeme -> ReadP Lexeme
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Lexeme
EOF -- ----------------------------------------------------------------------------- Single character lexemeslexPunc ::ReadP Lexeme lexPunc :: ReadP Lexeme
lexPunc =doChar
c <-(Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isPuncChar Lexeme -> ReadP Lexeme
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Lexeme
Punc [Char
c ])-- | The @special@ character class as defined in the Haskell Report.isPuncChar ::Char ->Bool isPuncChar :: Char -> Bool
isPuncChar Char
c =Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` String
",;()[]{}`"-- ------------------------------------------------------------------------ SymbolslexSymbol ::ReadP Lexeme lexSymbol :: ReadP Lexeme
lexSymbol =doString
s <-(Char -> Bool) -> ReadP String
munch1 Char -> Bool
isSymbolChar ifString
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` [String]
reserved_ops thenLexeme -> ReadP Lexeme
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Lexeme
Punc String
s )-- Reserved-ops count as punctuationelseLexeme -> ReadP Lexeme
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Lexeme
Symbol String
s )wherereserved_ops :: [String]
reserved_ops =[String
"..",String
"::",String
"=",String
"\\",String
"|",String
"<-",String
"->",String
"@",String
"~",String
"=>"]isSymbolChar ::Char ->Bool isSymbolChar :: Char -> Bool
isSymbolChar Char
c =Bool -> Bool
not (Char -> Bool
isPuncChar Char
c )Bool -> Bool -> Bool
&& caseChar -> GeneralCategory
generalCategory Char
c ofGeneralCategory
MathSymbol ->Bool
True GeneralCategory
CurrencySymbol ->Bool
True GeneralCategory
ModifierSymbol ->Bool
True GeneralCategory
OtherSymbol ->Bool
True GeneralCategory
DashPunctuation ->Bool
True GeneralCategory
OtherPunctuation ->Bool -> Bool
not (Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` String
"'\"")GeneralCategory
ConnectorPunctuation ->Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_'GeneralCategory
_->Bool
False -- ------------------------------------------------------------------------ identifierslexId ::ReadP Lexeme lexId :: ReadP Lexeme
lexId =doChar
c <-(Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isIdsChar String
s <-(Char -> Bool) -> ReadP String
munch Char -> Bool
isIdfChar Lexeme -> ReadP Lexeme
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Lexeme
Ident (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
s ))where-- Identifiers can start with a '_'isIdsChar :: Char -> Bool
isIdsChar Char
c =Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'isIdfChar :: Char -> Bool
isIdfChar Char
c =Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` String
"_'"-- ----------------------------------------------------------------------------- Lexing character literalslexLitChar ::ReadP Lexeme lexLitChar :: ReadP Lexeme
lexLitChar =doChar
_<-Char -> ReadP Char
char Char
'\''(Char
c ,Bool
esc )<-ReadP (Char, Bool)
lexCharE Bool -> ReadP ()
forall (m :: * -> *). MonadPlus m => Bool -> m ()
guard (Bool
esc Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'')-- Eliminate '' possibilityChar
_<-Char -> ReadP Char
char Char
'\''Lexeme -> ReadP Lexeme
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Lexeme
Char Char
c )lexChar ::ReadP Char lexChar :: ReadP Char
lexChar =do{(Char
c ,Bool
_)<-ReadP (Char, Bool)
lexCharE ;ReadP ()
consumeEmpties ;Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c }where-- Consumes the string "\&" repeatedly and greedily (will only produce one match)consumeEmpties ::ReadP ()consumeEmpties :: ReadP ()
consumeEmpties =doString
rest <-ReadP String
look caseString
rest of(Char
'\\': Char
'&': String
_)->String -> ReadP String
string String
"\\&"ReadP String -> ReadP () -> ReadP ()
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP ()
consumeEmpties String
_->() -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()lexCharE ::ReadP (Char ,Bool )-- "escaped or not"?lexCharE :: ReadP (Char, Bool)
lexCharE =doChar
c1 <-ReadP Char
get ifChar
c1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'thendoChar
c2 <-ReadP Char
lexEsc ;(Char, Bool) -> ReadP (Char, Bool)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c2 ,Bool
True )else(Char, Bool) -> ReadP (Char, Bool)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c1 ,Bool
False )wherelexEsc :: ReadP Char
lexEsc =ReadP Char
lexEscChar ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Char
lexNumeric ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Char
lexCntrlChar ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Char
lexAscii lexEscChar :: ReadP Char
lexEscChar =doChar
c <-ReadP Char
get caseChar
c ofChar
'a'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\a'Char
'b'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'Char
'f'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'Char
'n'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'Char
'r'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'Char
't'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'Char
'v'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\v'Char
'\\'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\'Char
'\"'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\"'Char
'\''->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\''Char
_->ReadP Char
forall a. ReadP a
pfail lexNumeric :: ReadP Char
lexNumeric =doInt
base <-ReadP Int
lexBaseChar ReadP Int -> ReadP Int -> ReadP Int
forall a. ReadP a -> ReadP a -> ReadP a
<++ Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
10Integer
n <-Int -> ReadP Integer
lexInteger Int
base Bool -> ReadP ()
forall (m :: * -> *). MonadPlus m => Bool -> m ()
guard (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord Char
forall a. Bounded a => a
maxBound ))Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
chr (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n ))lexCntrlChar :: ReadP Char
lexCntrlChar =doChar
_<-Char -> ReadP Char
char Char
'^'Char
c <-ReadP Char
get caseChar
c ofChar
'@'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^@'Char
'A'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^A'Char
'B'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^B'Char
'C'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^C'Char
'D'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^D'Char
'E'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^E'Char
'F'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^F'Char
'G'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^G'Char
'H'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^H'Char
'I'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^I'Char
'J'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^J'Char
'K'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^K'Char
'L'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^L'Char
'M'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^M'Char
'N'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^N'Char
'O'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^O'Char
'P'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^P'Char
'Q'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^Q'Char
'R'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^R'Char
'S'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^S'Char
'T'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^T'Char
'U'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^U'Char
'V'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^V'Char
'W'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^W'Char
'X'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^X'Char
'Y'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^Y'Char
'Z'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^Z'Char
'['->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^['Char
'\\'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^\'Char
']'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^]'Char
'^'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^^'Char
'_'->Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^_'Char
_->ReadP Char
forall a. ReadP a
pfail lexAscii :: ReadP Char
lexAscii =[ReadP Char] -> ReadP Char
forall a. [ReadP a] -> ReadP a
choice [(String -> ReadP String
string String
"SOH"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SOH')ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
<++ (String -> ReadP String
string String
"SO"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SO')-- \SO and \SOH need maximal-munch treatment-- See the Haskell report Sect 2.6,String -> ReadP String
string String
"NUL"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\NUL',String -> ReadP String
string String
"STX"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\STX',String -> ReadP String
string String
"ETX"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ETX',String -> ReadP String
string String
"EOT"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\EOT',String -> ReadP String
string String
"ENQ"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ENQ',String -> ReadP String
string String
"ACK"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ACK',String -> ReadP String
string String
"BEL"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\BEL',String -> ReadP String
string String
"BS"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\BS',String -> ReadP String
string String
"HT"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\HT',String -> ReadP String
string String
"LF"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\LF',String -> ReadP String
string String
"VT"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\VT',String -> ReadP String
string String
"FF"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\FF',String -> ReadP String
string String
"CR"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\CR',String -> ReadP String
string String
"SI"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SI',String -> ReadP String
string String
"DLE"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DLE',String -> ReadP String
string String
"DC1"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC1',String -> ReadP String
string String
"DC2"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC2',String -> ReadP String
string String
"DC3"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC3',String -> ReadP String
string String
"DC4"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC4',String -> ReadP String
string String
"NAK"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\NAK',String -> ReadP String
string String
"SYN"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SYN',String -> ReadP String
string String
"ETB"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ETB',String -> ReadP String
string String
"CAN"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\CAN',String -> ReadP String
string String
"EM"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\EM',String -> ReadP String
string String
"SUB"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SUB',String -> ReadP String
string String
"ESC"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ESC',String -> ReadP String
string String
"FS"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\FS',String -> ReadP String
string String
"GS"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\GS',String -> ReadP String
string String
"RS"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\RS',String -> ReadP String
string String
"US"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\US',String -> ReadP String
string String
"SP"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SP',String -> ReadP String
string String
"DEL"ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DEL']-- ----------------------------------------------------------------------------- string literallexString ::ReadP Lexeme lexString :: ReadP Lexeme
lexString =doChar
_<-Char -> ReadP Char
char Char
'"'ShowS -> ReadP Lexeme
body ShowS
forall a. a -> a
id wherebody :: ShowS -> ReadP Lexeme
body ShowS
f =do(Char
c ,Bool
esc )<-ReadP (Char, Bool)
lexStrItem ifChar
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'Bool -> Bool -> Bool
|| Bool
esc thenShowS -> ReadP Lexeme
body (ShowS
f ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ))elselets :: String
s =ShowS
f String
""inLexeme -> ReadP Lexeme
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Lexeme
String String
s )lexStrItem :: ReadP (Char, Bool)
lexStrItem =(ReadP ()
lexEmpty ReadP () -> ReadP (Char, Bool) -> ReadP (Char, Bool)
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP (Char, Bool)
lexStrItem )ReadP (Char, Bool) -> ReadP (Char, Bool) -> ReadP (Char, Bool)
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP (Char, Bool)
lexCharE lexEmpty :: ReadP ()
lexEmpty =doChar
_<-Char -> ReadP Char
char Char
'\\'Char
c <-ReadP Char
get caseChar
c ofChar
'&'->() -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()Char
_|Char -> Bool
isSpace Char
c ->doReadP ()
skipSpaces ;Char
_<-Char -> ReadP Char
char Char
'\\';() -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()Char
_->ReadP ()
forall a. ReadP a
pfail -- ----------------------------------------------------------------------------- Lexing numberstypeBase =Int typeDigits =[Int ]lexNumber ::ReadP Lexeme lexNumber :: ReadP Lexeme
lexNumber =ReadP Lexeme
lexHexOct ReadP Lexeme -> ReadP Lexeme -> ReadP Lexeme
forall a. ReadP a -> ReadP a -> ReadP a
<++ -- First try for hex or octal 0x, 0o etc-- If that fails, try for a decimal numberReadP Lexeme
lexDecNumber -- Start with ordinary digitslexHexOct ::ReadP Lexeme lexHexOct :: ReadP Lexeme
lexHexOct =doChar
_<-Char -> ReadP Char
char Char
'0'Int
base <-ReadP Int
lexBaseChar Digits
digits <-Int -> ReadP Digits
lexDigits Int
base Lexeme -> ReadP Lexeme
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Number -> Lexeme
Number (Int -> Digits -> Number
MkNumber Int
base Digits
digits ))lexBaseChar ::ReadP Int -- Lex a single character indicating the base; fail if not therelexBaseChar :: ReadP Int
lexBaseChar =doChar
c <-ReadP Char
get caseChar
c ofChar
'o'->Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8Char
'O'->Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8Char
'x'->Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
16Char
'X'->Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
16Char
_->ReadP Int
forall a. ReadP a
pfail lexDecNumber ::ReadP Lexeme lexDecNumber :: ReadP Lexeme
lexDecNumber =doDigits
xs <-Int -> ReadP Digits
lexDigits Int
10Maybe Digits
mFrac <-ReadP (Maybe Digits)
lexFrac ReadP (Maybe Digits)
-> ReadP (Maybe Digits) -> ReadP (Maybe Digits)
forall a. ReadP a -> ReadP a -> ReadP a
<++ Maybe Digits -> ReadP (Maybe Digits)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Digits
forall a. Maybe a
Nothing Maybe Integer
mExp <-ReadP (Maybe Integer)
lexExp ReadP (Maybe Integer)
-> ReadP (Maybe Integer) -> ReadP (Maybe Integer)
forall a. ReadP a -> ReadP a -> ReadP a
<++ Maybe Integer -> ReadP (Maybe Integer)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing Lexeme -> ReadP Lexeme
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Number -> Lexeme
Number (Digits -> Maybe Digits -> Maybe Integer -> Number
MkDecimal Digits
xs Maybe Digits
mFrac Maybe Integer
mExp ))lexFrac ::ReadP (Maybe Digits )-- Read the fractional part; fail if it doesn't-- start ".d" where d is a digitlexFrac :: ReadP (Maybe Digits)
lexFrac =doChar
_<-Char -> ReadP Char
char Char
'.'Digits
fraction <-Int -> ReadP Digits
lexDigits Int
10Maybe Digits -> ReadP (Maybe Digits)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Digits -> Maybe Digits
forall a. a -> Maybe a
Just Digits
fraction )lexExp ::ReadP (Maybe Integer )lexExp :: ReadP (Maybe Integer)
lexExp =doChar
_<-Char -> ReadP Char
char Char
'e'ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
+++ Char -> ReadP Char
char Char
'E'Integer
exp <-ReadP Integer
signedExp ReadP Integer -> ReadP Integer -> ReadP Integer
forall a. ReadP a -> ReadP a -> ReadP a
+++ Int -> ReadP Integer
lexInteger Int
10Maybe Integer -> ReadP (Maybe Integer)
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
exp )wheresignedExp :: ReadP Integer
signedExp =doChar
c <-Char -> ReadP Char
char Char
'-'ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
+++ Char -> ReadP Char
char Char
'+'Integer
n <-Int -> ReadP Integer
lexInteger Int
10Integer -> ReadP Integer
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (ifChar
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'then-Integer
n elseInteger
n )lexDigits ::Int ->ReadP Digits -- Lex a non-empty sequence of digits in specified baselexDigits :: Int -> ReadP Digits
lexDigits Int
base =doString
s <-ReadP String
look Digits
xs <-String -> (Digits -> Digits) -> ReadP Digits
forall {b}. String -> (Digits -> b) -> ReadP b
scan String
s Digits -> Digits
forall a. a -> a
id Bool -> ReadP ()
forall (m :: * -> *). MonadPlus m => Bool -> m ()
guard (Bool -> Bool
not (Digits -> Bool
forall a. [a] -> Bool
null Digits
xs ))Digits -> ReadP Digits
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Digits
xs wherescan :: String -> (Digits -> b) -> ReadP b
scan (Char
c : String
cs )Digits -> b
f =caseInt -> Char -> Maybe Int
forall a. (Eq a, Num a) => a -> Char -> Maybe Int
valDig Int
base Char
c ofJust Int
n ->doChar
_<-ReadP Char
get ;String -> (Digits -> b) -> ReadP b
scan String
cs (Digits -> b
f (Digits -> b) -> (Digits -> Digits) -> Digits -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
n Int -> Digits -> Digits
forall a. a -> [a] -> [a]
: ))Maybe Int
Nothing ->b -> ReadP b
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Digits -> b
f [])scan []Digits -> b
f =b -> ReadP b
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Digits -> b
f [])lexInteger ::Base ->ReadP Integer lexInteger :: Int -> ReadP Integer
lexInteger Int
base =doDigits
xs <-Int -> ReadP Digits
lexDigits Int
base Integer -> ReadP Integer
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base )Digits
xs )val ::Num a =>a ->Digits ->a val :: forall a. Num a => a -> Digits -> a
val =a -> Digits -> a
forall a d. (Num a, Integral d) => a -> [d] -> a
valSimple {-# RULES"val/Integer"val =valInteger #-}{-# INLINE[1]val #-}-- The following algorithm is only linear for types whose Num operations-- are in constant time.valSimple ::(Num a ,Integral d )=>a ->[d ]->a valSimple :: forall a d. (Num a, Integral d) => a -> [d] -> a
valSimple a
base =a -> [d] -> a
forall {a}. Integral a => a -> [a] -> a
go a
0wherego :: a -> [a] -> a
go a
r []=a
r go a
r (a
d : [a]
ds )=a
r' a -> a -> a
forall a b. a -> b -> b
`seq` a -> [a] -> a
go a
r' [a]
ds wherer' :: a
r' =a
r a -> a -> a
forall a. Num a => a -> a -> a
* a
base a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d {-# INLINEvalSimple #-}-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b-- digits are combined into a single radix b^2 digit. This process is-- repeated until we are left with a single digit. This algorithm-- performs well only on large inputs, so we use the simple algorithm-- for smaller inputs.valInteger ::Integer ->Digits ->Integer valInteger :: Integer -> Digits -> Integer
valInteger Integer
b0 Digits
ds0 =Integer -> Int -> [Integer] -> Integer
forall {d} {t}. (Integral d, Integral t) => d -> t -> [d] -> d
go Integer
b0 (Digits -> Int
forall a. [a] -> Int
length Digits
ds0 )([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Int -> Integer) -> Digits -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Digits
ds0 wherego :: d -> t -> [d] -> d
go d
_t
_[]=d
0go d
_t
_[d
d ]=d
d go d
b t
l [d]
ds |t
l t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
40=d
b' d -> d -> d
forall a b. a -> b -> b
`seq` d -> t -> [d] -> d
go d
b' t
l' (d -> [d] -> [d]
forall {t}. Num t => t -> [t] -> [t]
combine d
b [d]
ds' )|Bool
otherwise =d -> [d] -> d
forall a d. (Num a, Integral d) => a -> [d] -> a
valSimple d
b [d]
ds where-- ensure that we have an even number of digits-- before we call combine:ds' :: [d]
ds' =ift -> Bool
forall a. Integral a => a -> Bool
even t
l then[d]
ds elsed
0d -> [d] -> [d]
forall a. a -> [a] -> [a]
: [d]
ds b' :: d
b' =d
b d -> d -> d
forall a. Num a => a -> a -> a
* d
b l' :: t
l' =(t
l t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)t -> t -> t
forall a. Integral a => a -> a -> a
`quot` t
2combine :: t -> [t] -> [t]
combine t
b (t
d1 : t
d2 : [t]
ds )=t
d t -> [t] -> [t]
forall a b. a -> b -> b
`seq` (t
d t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t] -> [t]
combine t
b [t]
ds )whered :: t
d =t
d1 t -> t -> t
forall a. Num a => a -> a -> a
* t
b t -> t -> t
forall a. Num a => a -> a -> a
+ t
d2 combine t
_[]=[]combine t
_[t
_]=String -> [t]
forall a. String -> a
errorWithoutStackTrace String
"this should not happen"-- Calculate a Rational from the exponent [of 10 to multiply with],-- the integral part of the mantissa and the digits of the fractional-- part. Leaving the calculation of the power of 10 until the end,-- when we know the effective exponent, saves multiplications.-- More importantly, this way we need at most one gcd instead of three.---- frac was never used with anything but Integer and base 10, so-- those are hardcoded now (trivial to change if necessary).fracExp ::Integer ->Integer ->Digits ->Rational fracExp :: Integer -> Integer -> Digits -> Rational
fracExp Integer
exp Integer
mant []|Integer
exp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0=Integer
mant Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (-Integer
exp ))|Bool
otherwise =Integer -> Rational
forall a. Num a => Integer -> a
fromInteger (Integer
mant Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
exp )fracExp Integer
exp Integer
mant (Int
d : Digits
ds )=Integer
exp' Integer -> Rational -> Rational
forall a b. a -> b -> b
`seq` Integer
mant' Integer -> Rational -> Rational
forall a b. a -> b -> b
`seq` Integer -> Integer -> Digits -> Rational
fracExp Integer
exp' Integer
mant' Digits
ds whereexp' :: Integer
exp' =Integer
exp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1mant' :: Integer
mant' =Integer
mant Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d valDig ::(Eq a ,Num a )=>a ->Char ->Maybe Int valDig :: forall a. (Eq a, Num a) => a -> Char -> Maybe Int
valDig a
2Char
c |Char
'0'Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'1'=Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')|Bool
otherwise =Maybe Int
forall a. Maybe a
Nothing valDig a
8Char
c |Char
'0'Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'7'=Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')|Bool
otherwise =Maybe Int
forall a. Maybe a
Nothing valDig a
10Char
c =Char -> Maybe Int
valDecDig Char
c valDig a
16Char
c |Char
'0'Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'=Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')|Char
'a'Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f'=Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a'Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)|Char
'A'Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F'=Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A'Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)|Bool
otherwise =Maybe Int
forall a. Maybe a
Nothing valDig a
_Char
_=String -> Maybe Int
forall a. String -> a
errorWithoutStackTrace String
"valDig: Bad base"valDecDig ::Char ->Maybe Int valDecDig :: Char -> Maybe Int
valDecDig Char
c |Char
'0'Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'=Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')|Bool
otherwise =Maybe Int
forall a. Maybe a
Nothing -- ------------------------------------------------------------------------ other numeric lexing functionsreadIntP ::Num a =>a ->(Char ->Bool )->(Char ->Int )->ReadP a readIntP :: forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
readIntP a
base Char -> Bool
isDigit Char -> Int
valDigit =doString
s <-(Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit a -> ReadP a
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Digits -> a
forall a. Num a => a -> Digits -> a
val a
base ((Char -> Int) -> String -> Digits
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
valDigit String
s )){-# SPECIALISEreadIntP ::Integer ->(Char ->Bool )->(Char ->Int )->ReadP Integer #-}readIntP' ::(Eq a ,Num a )=>a ->ReadP a readIntP' :: forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
base =a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
readIntP a
base Char -> Bool
isDigit Char -> Int
valDigit whereisDigit :: Char -> Bool
isDigit Char
c =Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True )(a -> Char -> Maybe Int
forall a. (Eq a, Num a) => a -> Char -> Maybe Int
valDig a
base Char
c )valDigit :: Char -> Int
valDigit Char
c =Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0Int -> Int
forall a. a -> a
id (a -> Char -> Maybe Int
forall a. (Eq a, Num a) => a -> Char -> Maybe Int
valDig a
base Char
c ){-# SPECIALISEreadIntP' ::Integer ->ReadP Integer #-}readBinP ,readOctP ,readDecP ,readHexP ::(Eq a ,Num a )=>ReadP a readBinP :: forall a. (Eq a, Num a) => ReadP a
readBinP =a -> ReadP a
forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
2readOctP :: forall a. (Eq a, Num a) => ReadP a
readOctP =a -> ReadP a
forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
8readDecP :: forall a. (Eq a, Num a) => ReadP a
readDecP =a -> ReadP a
forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
10readHexP :: forall a. (Eq a, Num a) => ReadP a
readHexP =a -> ReadP a
forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
16{-# SPECIALISEreadBinP ::ReadP Integer #-}{-# SPECIALISEreadOctP ::ReadP Integer #-}{-# SPECIALISEreadDecP ::ReadP Integer #-}{-# SPECIALISEreadHexP ::ReadP Integer #-}