{-# 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
--
-----------------------------------------------------------------------------

module Text.Read.Lex
  -- lexing types
  ( Lexeme(..), Number

  , numberToInteger, numberToFixed, numberToRational, numberToRangedRational

  -- lexer
  , lex, expect
  , hsLex
  , lexChar

  , readBinP
  , readIntP
  , readOctP
  , readDecP
  , readHexP

  , isSymbolChar
  )
 where

import Text.ParserCombinators.ReadP

import GHC.Base
import GHC.Char
import GHC.Num( Num(..), Integer )
import GHC.Show( Show(..) )
import GHC.Unicode
  ( GeneralCategory(..), generalCategory, isSpace, isAlpha, isAlphaNum )
import GHC.Real( Rational, (%), fromIntegral, Integral,
                 toInteger, (^), quot, even )
import GHC.List
import GHC.Enum( minBound, maxBound )
import Data.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      =  forall (m :: * -> *) a. Monad m => a -> m a
return ()
guard Bool
False     =  forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- -----------------------------------------------------------------------------
-- Lexing types

-- ^ Haskell lexemes.
data Lexeme
  = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lexeme -> Lexeme -> Bool
$c/= :: Lexeme -> Lexeme -> Bool
== :: Lexeme -> Lexeme -> Bool
$c== :: Lexeme -> Lexeme -> Bool
Eq   -- ^ @since 2.01
          , Int -> Lexeme -> ShowS
[Lexeme] -> ShowS
Lexeme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lexeme] -> ShowS
$cshowList :: [Lexeme] -> ShowS
show :: Lexeme -> String
$cshow :: Lexeme -> String
showsPrec :: Int -> Lexeme -> ShowS
$cshowsPrec :: Int -> Lexeme -> ShowS
Show -- ^ @since 2.01
          )

-- | @since 4.6.0.0
data Number = MkNumber Int              -- Base
                       Digits           -- Integral part
            | MkDecimal Digits          -- Integral part
                        (Maybe Digits)  -- Fractional part
                        (Maybe Integer) -- Exponent
 deriving ( Number -> Number -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Number -> Number -> Bool
$c/= :: Number -> Number -> Bool
== :: Number -> Number -> Bool
$c== :: Number -> Number -> Bool
Eq   -- ^ @since 4.6.0.0
          , Int -> Number -> ShowS
[Number] -> ShowS
Number -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Number] -> ShowS
$cshowList :: [Number] -> ShowS
show :: Number -> String
$cshow :: Number -> String
showsPrec :: Int -> Number -> ShowS
$cshowsPrec :: Int -> Number -> ShowS
Show -- ^ @since 4.6.0.0
          )

-- | @since 4.5.1.0
numberToInteger :: Number -> Maybe Integer
numberToInteger :: Number -> Maybe Integer
numberToInteger (MkNumber Int
base Digits
iPart) = forall a. a -> Maybe a
Just (forall a. Num a => a -> Digits -> a
val (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base) Digits
iPart)
numberToInteger (MkDecimal Digits
iPart Maybe Digits
Nothing Maybe Integer
Nothing) = forall a. a -> Maybe a
Just (forall a. Num a => a -> Digits -> a
val Integer
10 Digits
iPart)
numberToInteger Number
_ = forall a. Maybe a
Nothing

-- | @since 4.7.0.0
numberToFixed :: Integer -> Number -> Maybe (Integer, Integer)
numberToFixed :: Integer -> Number -> Maybe (Integer, Integer)
numberToFixed Integer
_ (MkNumber Int
base Digits
iPart) = forall a. a -> Maybe a
Just (forall a. Num a => a -> Digits -> a
val (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) = forall a. a -> Maybe a
Just (forall a. Num a => a -> Digits -> a
val Integer
10 Digits
iPart, Integer
0)
numberToFixed Integer
p (MkDecimal Digits
iPart (Just Digits
fPart) Maybe Integer
Nothing)
    = let i :: Integer
i = forall a. Num a => a -> Digits -> a
val Integer
10 Digits
iPart
          f :: Integer
f = forall a. Num a => a -> Digits -> a
val Integer
10 (forall a. Integer -> [a] -> [a]
integerTake Integer
p (Digits
fPart forall a. [a] -> [a] -> [a]
++ 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 forall a. Ord a => a -> a -> Bool
<= Integer
0 = []
          integerTake Integer
_ []        =  []
          integerTake Integer
n (a
x:[a]
xs)    =  a
x forall a. a -> [a] -> [a]
: forall a. Integer -> [a] -> [a]
integerTake (Integer
nforall a. Num a => a -> a -> a
-Integer
1) [a]
xs
      in forall a. a -> Maybe a
Just (Integer
i, Integer
f)
numberToFixed Integer
_ Number
_ = 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 floateRange 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.0
numberToRangedRational :: (Int, Int) -> Number
                       -> Maybe Rational -- Nothing = Inf
numberToRangedRational :: (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 forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int) Bool -> Bool -> Bool
||
      Integer
exp forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int)
    = forall a. Maybe a
Nothing
    | Bool
otherwise
    = let mFirstDigit :: Maybe Int
mFirstDigit = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int
0 forall a. Eq a => a -> a -> Bool
==) Digits
iPart of
                        iPart' :: Digits
iPart'@(Int
_ : Digits
_) -> forall a. a -> Maybe a
Just (forall a. [a] -> Int
length Digits
iPart')
                        [] -> case Maybe Digits
mFPart of
                              Maybe Digits
Nothing -> forall a. Maybe a
Nothing
                              Just Digits
fPart ->
                                  case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Int
0 forall a. Eq a => a -> a -> Bool
==) Digits
fPart of
                                  (Digits
_, []) -> forall a. Maybe a
Nothing
                                  (Digits
zeroes, Digits
_) ->
                                      forall a. a -> Maybe a
Just (forall a. Num a => a -> a
negate (forall a. [a] -> Int
length Digits
zeroes))
      in case Maybe Int
mFirstDigit of
         Maybe Int
Nothing -> forall a. a -> Maybe a
Just Rational
0
         Just Int
firstDigit ->
             let firstDigit' :: Int
firstDigit' = Int
firstDigit forall a. Num a => a -> a -> a
+ forall a. Num a => Integer -> a
fromInteger Integer
exp
             in if Int
firstDigit' forall a. Ord a => a -> a -> Bool
> (Int
pos forall a. Num a => a -> a -> a
+ Int
3)
                then forall a. Maybe a
Nothing
                else if Int
firstDigit' forall a. Ord a => a -> a -> Bool
< (Int
neg forall a. Num a => a -> a -> a
- Int
3)
                then forall a. a -> Maybe a
Just Rational
0
                else forall a. a -> Maybe a
Just (Number -> Rational
numberToRational Number
n)
numberToRangedRational (Int, Int)
_ Number
n = forall a. a -> Maybe a
Just (Number -> Rational
numberToRational Number
n)

-- | @since 4.6.0.0
numberToRational :: Number -> Rational
numberToRational :: Number -> Rational
numberToRational (MkNumber Int
base Digits
iPart) = forall a. Num a => a -> Digits -> a
val (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base) Digits
iPart forall a. Integral a => a -> a -> Ratio a
% Integer
1
numberToRational (MkDecimal Digits
iPart Maybe Digits
mFPart Maybe Integer
mExp)
 = let i :: Integer
i = forall a. Num a => a -> Digits -> a
val Integer
10 Digits
iPart
   in case (Maybe Digits
mFPart, Maybe Integer
mExp) of
      (Maybe Digits
Nothing, Maybe Integer
Nothing)     -> Integer
i forall a. Integral a => a -> a -> Ratio a
% Integer
1
      (Maybe Digits
Nothing, Just Integer
exp)
       | Integer
exp forall a. Ord a => a -> a -> Bool
>= Integer
0            -> (Integer
i forall a. Num a => a -> a -> a
* (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
exp)) forall a. Integral a => a -> a -> Ratio a
% Integer
1
       | Bool
otherwise           -> Integer
i forall a. Integral a => a -> a -> Ratio a
% (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (- Integer
exp))
      (Just Digits
fPart, Maybe Integer
Nothing)  -> Integer -> Integer -> Digits -> Rational
fracExp Integer
0   Integer
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.

-- -----------------------------------------------------------------------------
-- Lexing

lex :: ReadP Lexeme
lex :: ReadP Lexeme
lex = ReadP ()
skipSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Lexeme
lexToken

-- | @since 4.7.0.0
expect :: Lexeme -> ReadP ()
expect :: Lexeme -> ReadP ()
expect Lexeme
lexeme = do { ReadP ()
skipSpaces
                   ; Lexeme
thing <- ReadP Lexeme
lexToken
                   ; if Lexeme
thing forall a. Eq a => a -> a -> Bool
== Lexeme
lexeme then forall (m :: * -> *) a. Monad m => a -> m a
return () else forall a. ReadP a
pfail }

hsLex :: ReadP String
-- ^ Haskell lexer: returns the lexed string, rather than the lexeme
hsLex :: ReadP String
hsLex = do ReadP ()
skipSpaces
           (String
s,Lexeme
_) <- forall a. ReadP a -> ReadP (String, a)
gather ReadP Lexeme
lexToken
           forall (m :: * -> *) a. Monad m => a -> m a
return String
s

lexToken :: ReadP Lexeme
lexToken :: ReadP Lexeme
lexToken = ReadP Lexeme
lexEOF     forall a. ReadP a -> ReadP a -> ReadP a
+++
           ReadP Lexeme
lexLitChar forall a. ReadP a -> ReadP a -> ReadP a
+++
           ReadP Lexeme
lexString  forall a. ReadP a -> ReadP a -> ReadP a
+++
           ReadP Lexeme
lexPunc    forall a. ReadP a -> ReadP a -> ReadP a
+++
           ReadP Lexeme
lexSymbol  forall a. ReadP a -> ReadP a -> ReadP a
+++
           ReadP Lexeme
lexId      forall a. ReadP a -> ReadP a -> ReadP a
+++
           ReadP Lexeme
lexNumber


-- ----------------------------------------------------------------------
-- End of file
lexEOF :: ReadP Lexeme
lexEOF :: ReadP Lexeme
lexEOF = do String
s <- ReadP String
look
            forall (m :: * -> *). MonadPlus m => Bool -> m ()
guard (forall a. [a] -> Bool
null String
s)
            forall (m :: * -> *) a. Monad m => a -> m a
return Lexeme
EOF

-- ---------------------------------------------------------------------------
-- Single character lexemes

lexPunc :: ReadP Lexeme
lexPunc :: ReadP Lexeme
lexPunc =
  do Char
c <- (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isPuncChar
     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 forall a. Eq a => a -> [a] -> Bool
`elem` String
",;()[]{}`"

-- ----------------------------------------------------------------------
-- Symbols

lexSymbol :: ReadP Lexeme
lexSymbol :: ReadP Lexeme
lexSymbol =
  do String
s <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isSymbolChar
     if String
s forall a. Eq a => a -> [a] -> Bool
`elem` [String]
reserved_ops then
        forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Lexeme
Punc String
s)         -- Reserved-ops count as punctuation
      else
        forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Lexeme
Symbol String
s)
  where
    reserved_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
&& case Char -> GeneralCategory
generalCategory Char
c of
    GeneralCategory
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 forall a. Eq a => a -> [a] -> Bool
`elem` String
"'\"")
    GeneralCategory
ConnectorPunctuation    -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'_'
    GeneralCategory
_                       -> Bool
False
-- ----------------------------------------------------------------------
-- identifiers

lexId :: ReadP Lexeme
lexId :: ReadP Lexeme
lexId = do Char
c <- (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isIdsChar
           String
s <- (Char -> Bool) -> ReadP String
munch Char -> Bool
isIdfChar
           forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Lexeme
Ident (Char
cforall 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 forall a. Eq a => a -> a -> Bool
== Char
'_'
    isIdfChar :: Char -> Bool
isIdfChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> [a] -> Bool
`elem` String
"_'"

-- ---------------------------------------------------------------------------
-- Lexing character literals

lexLitChar :: ReadP Lexeme
lexLitChar :: ReadP Lexeme
lexLitChar =
  do Char
_ <- Char -> ReadP Char
char Char
'\''
     (Char
c,Bool
esc) <- ReadP (Char, Bool)
lexCharE
     forall (m :: * -> *). MonadPlus m => Bool -> m ()
guard (Bool
esc Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\'')   -- Eliminate '' possibility
     Char
_ <- Char -> ReadP Char
char Char
'\''
     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; 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 = do
        String
rest <- ReadP String
look
        case String
rest of
            (Char
'\\':Char
'&':String
_) -> String -> ReadP String
string String
"\\&" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP ()
consumeEmpties
            String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()


lexCharE :: ReadP (Char, Bool)  -- "escaped or not"?
lexCharE :: ReadP (Char, Bool)
lexCharE =
  do Char
c1 <- ReadP Char
get
     if Char
c1 forall a. Eq a => a -> a -> Bool
== Char
'\\'
       then do Char
c2 <- ReadP Char
lexEsc; forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c2, Bool
True)
       else forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c1, Bool
False)
 where
  lexEsc :: ReadP Char
lexEsc =
    ReadP Char
lexEscChar
      forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Char
lexNumeric
        forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Char
lexCntrlChar
          forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP Char
lexAscii

  lexEscChar :: ReadP Char
lexEscChar =
    do Char
c <- ReadP Char
get
       case Char
c of
         Char
'a'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\a'
         Char
'b'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'
         Char
'f'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'
         Char
'n'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
         Char
'r'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
         Char
't'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'
         Char
'v'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\v'
         Char
'\\' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\'
         Char
'\"' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\"'
         Char
'\'' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\''
         Char
_    -> forall a. ReadP a
pfail

  lexNumeric :: ReadP Char
lexNumeric =
    do Int
base <- ReadP Int
lexBaseChar forall a. ReadP a -> ReadP a -> ReadP a
<++ forall (m :: * -> *) a. Monad m => a -> m a
return Int
10
       Integer
n    <- Int -> ReadP Integer
lexInteger Int
base
       forall (m :: * -> *). MonadPlus m => Bool -> m ()
guard (Integer
n forall a. Ord a => a -> a -> Bool
<= forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord forall a. Bounded a => a
maxBound))
       forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
chr (forall a. Num a => Integer -> a
fromInteger Integer
n))

  lexCntrlChar :: ReadP Char
lexCntrlChar =
    do Char
_ <- Char -> ReadP Char
char Char
'^'
       Char
c <- ReadP Char
get
       case Char
c of
         Char
'@'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^@'
         Char
'A'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^A'
         Char
'B'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^B'
         Char
'C'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^C'
         Char
'D'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^D'
         Char
'E'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^E'
         Char
'F'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^F'
         Char
'G'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^G'
         Char
'H'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^H'
         Char
'I'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^I'
         Char
'J'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^J'
         Char
'K'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^K'
         Char
'L'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^L'
         Char
'M'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^M'
         Char
'N'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^N'
         Char
'O'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^O'
         Char
'P'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^P'
         Char
'Q'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^Q'
         Char
'R'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^R'
         Char
'S'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^S'
         Char
'T'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^T'
         Char
'U'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^U'
         Char
'V'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^V'
         Char
'W'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^W'
         Char
'X'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^X'
         Char
'Y'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^Y'
         Char
'Z'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^Z'
         Char
'['  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^['
         Char
'\\' -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^\'
         Char
']'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^]'
         Char
'^'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^^'
         Char
'_'  -> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^_'
         Char
_    -> forall a. ReadP a
pfail

  lexAscii :: ReadP Char
lexAscii =
     forall a. [ReadP a] -> ReadP a
choice
         [ (String -> ReadP String
string String
"SOH" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SOH') forall a. ReadP a -> ReadP a -> ReadP a
<++
           (String -> ReadP String
string String
"SO"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\NUL'
         , String -> ReadP String
string String
"STX" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\STX'
         , String -> ReadP String
string String
"ETX" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ETX'
         , String -> ReadP String
string String
"EOT" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\EOT'
         , String -> ReadP String
string String
"ENQ" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ENQ'
         , String -> ReadP String
string String
"ACK" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ACK'
         , String -> ReadP String
string String
"BEL" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\BEL'
         , String -> ReadP String
string String
"BS"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\BS'
         , String -> ReadP String
string String
"HT"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\HT'
         , String -> ReadP String
string String
"LF"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\LF'
         , String -> ReadP String
string String
"VT"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\VT'
         , String -> ReadP String
string String
"FF"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\FF'
         , String -> ReadP String
string String
"CR"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\CR'
         , String -> ReadP String
string String
"SI"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SI'
         , String -> ReadP String
string String
"DLE" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DLE'
         , String -> ReadP String
string String
"DC1" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC1'
         , String -> ReadP String
string String
"DC2" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC2'
         , String -> ReadP String
string String
"DC3" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC3'
         , String -> ReadP String
string String
"DC4" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC4'
         , String -> ReadP String
string String
"NAK" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\NAK'
         , String -> ReadP String
string String
"SYN" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SYN'
         , String -> ReadP String
string String
"ETB" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ETB'
         , String -> ReadP String
string String
"CAN" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\CAN'
         , String -> ReadP String
string String
"EM"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\EM'
         , String -> ReadP String
string String
"SUB" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SUB'
         , String -> ReadP String
string String
"ESC" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ESC'
         , String -> ReadP String
string String
"FS"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\FS'
         , String -> ReadP String
string String
"GS"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\GS'
         , String -> ReadP String
string String
"RS"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\RS'
         , String -> ReadP String
string String
"US"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\US'
         , String -> ReadP String
string String
"SP"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SP'
         , String -> ReadP String
string String
"DEL" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DEL'
         ]


-- ---------------------------------------------------------------------------
-- string literal

lexString :: ReadP Lexeme
lexString :: ReadP Lexeme
lexString =
  do Char
_ <- Char -> ReadP Char
char Char
'"'
     ShowS -> ReadP Lexeme
body forall a. a -> a
id
 where
  body :: ShowS -> ReadP Lexeme
body ShowS
f =
    do (Char
c,Bool
esc) <- ReadP (Char, Bool)
lexStrItem
       if Char
c forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
|| Bool
esc
         then ShowS -> ReadP Lexeme
body (ShowS
fforall b c a. (b -> c) -> (a -> b) -> a -> c
.(Char
cforall a. a -> [a] -> [a]
:))
         else let s :: String
s = ShowS
f String
"" in
              forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Lexeme
String String
s)

  lexStrItem :: ReadP (Char, Bool)
lexStrItem = (ReadP ()
lexEmpty forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP (Char, Bool)
lexStrItem)
               forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP (Char, Bool)
lexCharE

  lexEmpty :: ReadP ()
lexEmpty =
    do Char
_ <- Char -> ReadP Char
char Char
'\\'
       Char
c <- ReadP Char
get
       case Char
c of
         Char
'&'           -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Char
_ | Char -> Bool
isSpace Char
c -> do ReadP ()
skipSpaces; Char
_ <- Char -> ReadP Char
char Char
'\\'; forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Char
_             -> forall a. ReadP a
pfail

-- ---------------------------------------------------------------------------
--  Lexing numbers

type Base   = Int
type Digits = [Int]

lexNumber :: ReadP Lexeme
lexNumber :: ReadP Lexeme
lexNumber
  = ReadP Lexeme
lexHexOct  forall a. ReadP a -> ReadP a -> ReadP a
<++      -- First try for hex or octal 0x, 0o etc
                        -- If that fails, try for a decimal number
    ReadP Lexeme
lexDecNumber        -- Start with ordinary digits

lexHexOct :: ReadP Lexeme
lexHexOct :: ReadP Lexeme
lexHexOct
  = do  Char
_ <- Char -> ReadP Char
char Char
'0'
        Int
base <- ReadP Int
lexBaseChar
        Digits
digits <- Int -> ReadP Digits
lexDigits Int
base
        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 there
lexBaseChar :: ReadP Int
lexBaseChar = do
  Char
c <- ReadP Char
get
  case Char
c of
    Char
'o' -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
8
    Char
'O' -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
8
    Char
'x' -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
16
    Char
'X' -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
16
    Char
_   -> forall a. ReadP a
pfail

lexDecNumber :: ReadP Lexeme
lexDecNumber :: ReadP Lexeme
lexDecNumber =
  do Digits
xs    <- Int -> ReadP Digits
lexDigits Int
10
     Maybe Digits
mFrac <- ReadP (Maybe Digits)
lexFrac forall a. ReadP a -> ReadP a -> ReadP a
<++ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
     Maybe Integer
mExp  <- ReadP (Maybe Integer)
lexExp  forall a. ReadP a -> ReadP a -> ReadP a
<++ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
     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 digit
lexFrac :: ReadP (Maybe Digits)
lexFrac = do Char
_ <- Char -> ReadP Char
char Char
'.'
             Digits
fraction <- Int -> ReadP Digits
lexDigits Int
10
             forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Digits
fraction)

lexExp :: ReadP (Maybe Integer)
lexExp :: ReadP (Maybe Integer)
lexExp = do Char
_ <- Char -> ReadP Char
char Char
'e' forall a. ReadP a -> ReadP a -> ReadP a
+++ Char -> ReadP Char
char Char
'E'
            Integer
exp <- ReadP Integer
signedExp forall a. ReadP a -> ReadP a -> ReadP a
+++ Int -> ReadP Integer
lexInteger Int
10
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Integer
exp)
 where
   signedExp :: ReadP Integer
signedExp
     = do Char
c <- Char -> ReadP Char
char Char
'-' forall a. ReadP a -> ReadP a -> ReadP a
+++ Char -> ReadP Char
char Char
'+'
          Integer
n <- Int -> ReadP Integer
lexInteger Int
10
          forall (m :: * -> *) a. Monad m => a -> m a
return (if Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' then -Integer
n else Integer
n)

lexDigits :: Int -> ReadP Digits
-- Lex a non-empty sequence of digits in specified base
lexDigits :: Int -> ReadP Digits
lexDigits Int
base =
  do String
s  <- ReadP String
look
     Digits
xs <- forall {b}. String -> (Digits -> b) -> ReadP b
scan String
s forall a. a -> a
id
     forall (m :: * -> *). MonadPlus m => Bool -> m ()
guard (Bool -> Bool
not (forall a. [a] -> Bool
null Digits
xs))
     forall (m :: * -> *) a. Monad m => a -> m a
return Digits
xs
 where
  scan :: String -> (Digits -> b) -> ReadP b
scan (Char
c:String
cs) Digits -> b
f = case forall a. (Eq a, Num a) => a -> Char -> Maybe Int
valDig Int
base Char
c of
                    Just Int
n  -> do Char
_ <- ReadP Char
get; String -> (Digits -> b) -> ReadP b
scan String
cs (Digits -> b
fforall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int
nforall a. a -> [a] -> [a]
:))
                    Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (Digits -> b
f [])
  scan []     Digits -> b
f = forall (m :: * -> *) a. Monad m => a -> m a
return (Digits -> b
f [])

lexInteger :: Base -> ReadP Integer
lexInteger :: Int -> ReadP Integer
lexInteger Int
base =
  do Digits
xs <- Int -> ReadP Digits
lexDigits Int
base
     forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => a -> Digits -> a
val (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 = 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 = forall {a}. Integral a => a -> [a] -> a
go a
0
  where
    go :: a -> [a] -> a
go a
r [] = a
r
    go a
r (a
d : [a]
ds) = a
r' seq :: forall a b. a -> b -> b
`seq` a -> [a] -> a
go a
r' [a]
ds
      where
        r' :: a
r' = a
r forall a. Num a => a -> a -> a
* a
base forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d
{-# INLINE valSimple #-}

-- 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 = forall {d} {t}. (Integral d, Integral t) => d -> t -> [d] -> d
go Integer
b0 (forall a. [a] -> Int
length Digits
ds0) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral Digits
ds0
  where
    go :: d -> t -> [d] -> d
go d
_ t
_ []  = d
0
    go d
_ t
_ [d
d] = d
d
    go d
b t
l [d]
ds
        | t
l forall a. Ord a => a -> a -> Bool
> t
40 = d
b' seq :: forall a b. a -> b -> b
`seq` d -> t -> [d] -> d
go d
b' t
l' (forall {t}. Num t => t -> [t] -> [t]
combine d
b [d]
ds')
        | Bool
otherwise = 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' = if forall a. Integral a => a -> Bool
even t
l then [d]
ds else d
0 forall a. a -> [a] -> [a]
: [d]
ds
        b' :: d
b' = d
b forall a. Num a => a -> a -> a
* d
b
        l' :: t
l' = (t
l forall a. Num a => a -> a -> a
+ t
1) forall a. Integral a => a -> a -> a
`quot` t
2
    combine :: t -> [t] -> [t]
combine t
b (t
d1 : t
d2 : [t]
ds) = t
d seq :: forall a b. a -> b -> b
`seq` (t
d forall a. a -> [a] -> [a]
: t -> [t] -> [t]
combine t
b [t]
ds)
      where
        d :: t
d = t
d1 forall a. Num a => a -> a -> a
* t
b forall a. Num a => a -> a -> a
+ t
d2
    combine t
_ []  = []
    combine t
_ [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 forall a. Ord a => a -> a -> Bool
< Integer
0     = Integer
mant forall a. Integral a => a -> a -> Ratio a
% (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (-Integer
exp))
  | Bool
otherwise   = forall a. Num a => Integer -> a
fromInteger (Integer
mant forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
exp)
fracExp Integer
exp Integer
mant (Int
d:Digits
ds) = Integer
exp' seq :: forall a b. a -> b -> b
`seq` Integer
mant' seq :: forall a b. a -> b -> b
`seq` Integer -> Integer -> Digits -> Rational
fracExp Integer
exp' Integer
mant' Digits
ds
  where
    exp' :: Integer
exp'  = Integer
exp forall a. Num a => a -> a -> a
- Integer
1
    mant' :: Integer
mant' = Integer
mant forall a. Num a => a -> a -> a
* Integer
10 forall a. Num a => a -> a -> a
+ 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
2 Char
c
  | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'1' = forall a. a -> Maybe a
Just (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
  | Bool
otherwise            = forall a. Maybe a
Nothing

valDig a
8 Char
c
  | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'7' = forall a. a -> Maybe a
Just (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
  | Bool
otherwise            = forall a. Maybe a
Nothing

valDig a
10 Char
c = Char -> Maybe Int
valDecDig Char
c

valDig a
16 Char
c
  | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' = forall a. a -> Maybe a
Just (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
  | Char
'a' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'f' = forall a. a -> Maybe a
Just (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ Int
10)
  | Char
'A' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'F' = forall a. a -> Maybe a
Just (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' forall a. Num a => a -> a -> a
+ Int
10)
  | Bool
otherwise            = forall a. Maybe a
Nothing

valDig a
_ Char
_ = forall a. String -> a
errorWithoutStackTrace String
"valDig: Bad base"

valDecDig :: Char -> Maybe Int
valDecDig :: Char -> Maybe Int
valDecDig Char
c
  | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' = forall a. a -> Maybe a
Just (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
  | Bool
otherwise            = forall a. Maybe a
Nothing

-- ----------------------------------------------------------------------
-- other numeric lexing functions

readIntP :: 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 =
  do String
s <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
     forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => a -> Digits -> a
val a
base (forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
valDigit String
s))
{-# SPECIALISE readIntP
        :: 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 = forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
readIntP a
base Char -> Bool
isDigit Char -> Int
valDigit
 where
  isDigit :: Char -> Bool
isDigit  Char
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a b. a -> b -> a
const Bool
True) (forall a. (Eq a, Num a) => a -> Char -> Maybe Int
valDig a
base Char
c)
  valDigit :: Char -> Int
valDigit Char
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0     forall a. a -> a
id           (forall a. (Eq a, Num a) => a -> Char -> Maybe Int
valDig a
base Char
c)
{-# SPECIALISE readIntP' :: Integer -> ReadP Integer #-}

readBinP, readOctP, readDecP, readHexP :: (Eq a, Num a) => ReadP a
readBinP :: forall a. (Eq a, Num a) => ReadP a
readBinP = forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
2
readOctP :: forall a. (Eq a, Num a) => ReadP a
readOctP = forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
8
readDecP :: forall a. (Eq a, Num a) => ReadP a
readDecP = forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
10
readHexP :: forall a. (Eq a, Num a) => ReadP a
readHexP = forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
16
{-# SPECIALISE readBinP :: ReadP Integer #-}
{-# SPECIALISE readOctP :: ReadP Integer #-}
{-# SPECIALISE readDecP :: ReadP Integer #-}
{-# SPECIALISE readHexP :: ReadP Integer #-}