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

  , 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 :: Bool -> m ()
guard Bool
True      =  () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
return ()
guard Bool
False     =  m ()
forall (m :: * -> *) a. MonadPlus m => m a
Evidence bound by a type signature of the constraint type MonadPlus m
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 ( Eq   -- ^ @since 2.01
          , 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 ( Eq   -- ^ @since 4.6.0.0
          , 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) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
External instance of the constraint type Num Integer
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
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
External instance of the constraint type Num Integer
val Integer
10 Digits
iPart)
numberToInteger Number
_ = Maybe Integer
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) = (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
External instance of the constraint type Num Integer
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
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
External instance of the constraint type Num Integer
val Integer
10 Digits
iPart, Integer
0)
numberToFixed Integer
p (MkDecimal Digits
iPart (Just Digits
fPart) Maybe Integer
Nothing)
    = let i :: Integer
i = Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
External instance of the constraint type Num Integer
val Integer
10 Digits
iPart
          f :: Integer
f = Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
External instance of the constraint type Num Integer
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 :: Integer -> [a] -> [a]
integerTake Integer
n [a]
_ | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
<= 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
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-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 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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
fromIntegral (Int
forall a. Bounded a => a
External instance of the constraint type Bounded Int
maxBound :: Int) Bool -> Bool -> Bool
||
      Integer
exp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
< Int -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
fromIntegral (Int
forall a. Bounded a => a
External instance of the constraint type Bounded Int
minBound :: Int)
    = Maybe Rational
forall a. Maybe a
Nothing
    | Bool
otherwise
    = let mFirstDigit :: Maybe Int
mFirstDigit = case (Int -> Bool) -> Digits -> Digits
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
==) Digits
iPart of
                        iPart' :: Digits
iPart'@(Int
_ : Digits
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Digits -> Int
forall a. [a] -> Int
length Digits
iPart')
                        [] -> case Maybe Digits
mFPart of
                              Maybe 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
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
==) 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
External instance of the constraint type Num Int
negate (Digits -> Int
forall a. [a] -> Int
length Digits
zeroes))
      in case Maybe Int
mFirstDigit of
         Maybe Int
Nothing -> Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
0
         Just Int
firstDigit ->
             let firstDigit' :: Int
firstDigit' = Int
firstDigit Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Integer -> Int
forall a. Num a => Integer -> a
External instance of the constraint type Num Int
fromInteger Integer
exp
             in if Int
firstDigit' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
3)
                then Maybe Rational
forall a. Maybe a
Nothing
                else if Int
firstDigit' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< (Int
neg Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
- Int
3)
                then Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
0
                else Rational -> 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.0
numberToRational :: Number -> Rational
numberToRational :: Number -> Rational
numberToRational (MkNumber Int
base Digits
iPart) = Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
External instance of the constraint type Num Integer
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
fromIntegral Int
base) Digits
iPart Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
External instance of the constraint type Integral Integer
% Integer
1
numberToRational (MkDecimal Digits
iPart Maybe Digits
mFPart Maybe Integer
mExp)
 = let i :: Integer
i = Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
External instance of the constraint type Num Integer
val Integer
10 Digits
iPart
   in case (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
External instance of the constraint type Integral Integer
% Integer
1
      (Maybe Digits
Nothing, Just Integer
exp)
       | Integer
exp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
>= Integer
0            -> (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
External instance of the constraint type Integral Integer
External instance of the constraint type Num Integer
^ Integer
exp)) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
External instance of the constraint type Integral Integer
% Integer
1
       | Bool
otherwise           -> Integer
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
External instance of the constraint type Integral Integer
% (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
External instance of the constraint type Integral Integer
External instance of the constraint type Num Integer
^ (- 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 ReadP () -> ReadP Lexeme -> ReadP Lexeme
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad ReadP
>> 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 Lexeme -> Lexeme -> Bool
forall a. Eq a => a -> a -> Bool
Instance of class: Eq of the constraint type Eq Lexeme
== Lexeme
lexeme then () -> ReadP ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return () else ReadP ()
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
_) <- ReadP Lexeme -> ReadP (String, Lexeme)
forall a. ReadP a -> ReadP (String, a)
gather ReadP Lexeme
lexToken
           String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
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 file
lexEOF :: ReadP Lexeme
lexEOF :: ReadP Lexeme
lexEOF = do String
s <- ReadP String
look
            Bool -> ReadP ()
forall (m :: * -> *). MonadPlus m => Bool -> m ()
External instance of the constraint type MonadPlus ReadP
guard (String -> Bool
forall a. [a] -> Bool
null String
s)
            Lexeme -> ReadP Lexeme
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Lexeme
EOF

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

lexPunc :: ReadP Lexeme
lexPunc :: ReadP Lexeme
lexPunc =
  do Char
c <- (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isPuncChar
     Lexeme -> ReadP Lexeme
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
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
External instance of the constraint type Eq Char
`elem` String
",;()[]{}`"

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

lexSymbol :: ReadP Lexeme
lexSymbol :: ReadP Lexeme
lexSymbol =
  do String
s <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isSymbolChar
     if String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
`elem` [String]
reserved_ops then
        Lexeme -> ReadP Lexeme
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (String -> Lexeme
Punc String
s)         -- Reserved-ops count as punctuation
      else
        Lexeme -> ReadP Lexeme
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
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 Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
External instance of the constraint type Eq Char
`elem` String
"'\"")
    GeneralCategory
ConnectorPunctuation    -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
/= 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
           Lexeme -> ReadP Lexeme
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (String -> Lexeme
Ident (Char
cChar -> 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
External instance of the constraint type Eq Char
== 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
External instance of the constraint type Eq Char
`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
     Bool -> ReadP ()
forall (m :: * -> *). MonadPlus m => Bool -> m ()
External instance of the constraint type MonadPlus ReadP
guard (Bool
esc Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
/= Char
'\'')   -- Eliminate '' possibility
     Char
_ <- Char -> ReadP Char
char Char
'\''
     Lexeme -> ReadP Lexeme
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
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 (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
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
"\\&" ReadP String -> ReadP () -> ReadP ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad ReadP
>> ReadP ()
consumeEmpties
            String
_ -> () -> ReadP ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return ()


lexCharE :: ReadP (Char, Bool)  -- "escaped or not"?
lexCharE :: ReadP (Char, Bool)
lexCharE =
  do Char
c1 <- ReadP Char
get
     if Char
c1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'\\'
       then do Char
c2 <- ReadP Char
lexEsc; (Char, Bool) -> ReadP (Char, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (Char
c2, Bool
True)
       else do (Char, Bool) -> ReadP (Char, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (Char
c1, Bool
False)
 where
  lexEsc :: 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 =
    do Char
c <- ReadP Char
get
       case Char
c of
         Char
'a'  -> Char -> ReadP Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Char
'\a'
         Char
'b'  -> Char -> ReadP Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Char
'\b'
         Char
'f'  -> Char -> ReadP Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Char
'\f'
         Char
'n'  -> Char -> ReadP Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Char
'\n'
         Char
'r'  -> Char -> ReadP Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Char
'\r'
         Char
't'  -> Char -> ReadP Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Char
'\t'
         Char
'v'  -> Char -> ReadP Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Char
'\v'
         Char
'\\' -> Char -> ReadP Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Char
'\\'
         Char
'\"' -> Char -> ReadP Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Char
'\"'
         Char
'\'' -> Char -> ReadP Char
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Char
'\''
         Char
_    -> ReadP Char
forall a. ReadP a
pfail

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

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

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


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

lexString :: ReadP Lexeme
lexString :: ReadP Lexeme
lexString =
  do Char
_ <- Char -> ReadP Char
char Char
'"'
     ShowS -> ReadP Lexeme
body ShowS
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
/= Char
'"' Bool -> Bool -> Bool
|| Bool
esc
         then ShowS -> ReadP Lexeme
body (ShowS
fShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:))
         else let s :: String
s = ShowS
f String
"" in
              Lexeme -> ReadP Lexeme
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (String -> Lexeme
String String
s)

  lexStrItem :: ReadP (Char, Bool)
lexStrItem = (ReadP ()
lexEmpty ReadP () -> ReadP (Char, Bool) -> ReadP (Char, Bool)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad ReadP
>> 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 =
    do Char
_ <- Char -> ReadP Char
char Char
'\\'
       Char
c <- ReadP Char
get
       case Char
c of
         Char
'&'           -> do () -> ReadP ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return ()
         Char
_ | Char -> Bool
isSpace Char
c -> do ReadP ()
skipSpaces; Char
_ <- Char -> ReadP Char
char Char
'\\'; () -> ReadP ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return ()
         Char
_             -> do ReadP ()
forall a. ReadP a
pfail

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

type Base   = Int
type Digits = [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 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
        Lexeme -> ReadP Lexeme
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
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' -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Int
8
                        Char
'O' -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Int
8
                        Char
'x' -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Int
16
                        Char
'X' -> Int -> ReadP Int
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Int
16
                        Char
_   -> ReadP Int
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 ReadP (Maybe Digits)
-> ReadP (Maybe Digits) -> ReadP (Maybe Digits)
forall a. ReadP a -> ReadP a -> ReadP a
<++ Maybe Digits -> ReadP (Maybe Digits)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
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 (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Maybe Integer
forall a. Maybe a
Nothing
     Lexeme -> ReadP Lexeme
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
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
             Maybe Digits -> ReadP (Maybe Digits)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (Digits -> Maybe Digits
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' 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
10
            Maybe Integer -> ReadP (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
exp)
 where
   signedExp :: ReadP Integer
signedExp
     = do Char
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
10
          Integer -> ReadP Integer
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== 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 <- String -> (Digits -> Digits) -> ReadP Digits
forall {a}. String -> (Digits -> a) -> ReadP a
scan String
s Digits -> Digits
forall a. a -> a
id
     Bool -> ReadP ()
forall (m :: * -> *). MonadPlus m => Bool -> m ()
External instance of the constraint type MonadPlus ReadP
guard (Bool -> Bool
not (Digits -> Bool
forall a. [a] -> Bool
null Digits
xs))
     Digits -> ReadP Digits
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return Digits
xs
 where
  scan :: String -> (Digits -> a) -> ReadP a
scan (Char
c:String
cs) Digits -> a
f = case Int -> Char -> Maybe Int
forall a. (Eq a, Num a) => a -> Char -> Maybe Int
External instance of the constraint type Num Int
External instance of the constraint type Eq Int
valDig Int
base Char
c of
                    Just Int
n  -> do Char
_ <- ReadP Char
get; String -> (Digits -> a) -> ReadP a
scan String
cs (Digits -> a
f(Digits -> a) -> (Digits -> Digits) -> Digits -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int
nInt -> Digits -> Digits
forall a. a -> [a] -> [a]
:))
                    Maybe Int
Nothing -> do a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (Digits -> a
f [])
  scan []     Digits -> a
f = do a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (Digits -> a
f [])

lexInteger :: Base -> ReadP Integer
lexInteger :: Int -> ReadP Integer
lexInteger Int
base =
  do Digits
xs <- Int -> ReadP Digits
lexDigits Int
base
     Integer -> ReadP Integer
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
External instance of the constraint type Num Integer
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
fromIntegral Int
base) Digits
xs)

val :: Num a => a -> Digits -> a
val :: a -> Digits -> a
val = a -> Digits -> a
forall a d. (Num a, Integral d) => a -> [d] -> a
External instance of the constraint type Integral Int
Evidence bound by a type signature of the constraint type Num 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 :: a -> [d] -> a
valSimple a
base = a -> [d] -> a
forall {a}. Integral a => a -> [a] -> a
Evidence bound by a type signature of the constraint type Integral d
go a
0
  where
    go :: a -> [a] -> a
go a
r [] = a
r
    go a
r (a
d : [a]
ds) = a
r' a -> a -> a
`seq` a -> [a] -> a
go a
r' [a]
ds
      where
        r' :: a
r' = a
r a -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
* a
base a -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
Evidence bound by a type signature of the constraint type Num a
Evidence bound by a type signature of the constraint type Integral a
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 = Integer -> Int -> [Integer] -> Integer
forall {t} {t}. (Integral t, Integral t) => t -> t -> [t] -> t
External instance of the constraint type Integral Int
External instance of the constraint type Integral Integer
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
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
fromIntegral Digits
ds0
  where
    go :: t -> t -> [t] -> t
go t
_ t
_ []  = t
0
    go t
_ t
_ [t
d] = t
d
    go t
b t
l [t]
ds
        | t
l t -> t -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type forall a. Real a => Ord a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
> t
40 = t
b' t -> t -> t
`seq` t -> t -> [t] -> t
go t
b' t
l' (t -> [t] -> [t]
forall {a}. Num a => a -> [a] -> [a]
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
combine t
b [t]
ds')
        | Bool
otherwise = t -> [t] -> t
forall a d. (Num a, Integral d) => a -> [d] -> a
Evidence bound by a type signature of the constraint type Integral t
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
valSimple t
b [t]
ds
      where
        -- ensure that we have an even number of digits
        -- before we call combine:
        ds' :: [t]
ds' = if t -> Bool
forall a. Integral a => a -> Bool
Evidence bound by a type signature of the constraint type Integral t
even t
l then [t]
ds else t
0 t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
ds
        b' :: t
b' = t
b t -> t -> t
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
* t
b
        l' :: t
l' = (t
l t -> t -> t
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral t
+ t
1) t -> t -> t
forall a. Integral a => a -> a -> a
Evidence bound by a type signature of the constraint type Integral t
`quot` t
2
    combine :: a -> [a] -> [a]
combine a
b (a
d1 : a
d2 : [a]
ds) = a
d a -> [a] -> [a]
`seq` (a
d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
combine a
b [a]
ds)
      where
        d :: a
d = a
d1 a -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
Evidence bound by a type signature of the constraint type Num a
+ a
d2
    combine a
_ []  = []
    combine a
_ [a
_] = String -> [a]
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
External instance of the constraint type Ord Integer
< Integer
0     = Integer
mant Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
External instance of the constraint type Integral Integer
% (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
External instance of the constraint type Integral Integer
External instance of the constraint type Num Integer
^ (-Integer
exp))
  | Bool
otherwise   = Integer -> Rational
forall a. Num a => Integer -> a
External instance of the constraint type forall a. Integral a => Num (Ratio a)
External instance of the constraint type Integral Integer
fromInteger (Integer
mant Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
External instance of the constraint type Integral Integer
External instance of the constraint type Num Integer
^ Integer
exp)
fracExp Integer
exp Integer
mant (Int
d:Digits
ds) = Integer
exp' Integer -> Rational -> Rational
`seq` Integer
mant' Integer -> Rational -> Rational
`seq` Integer -> Integer -> Digits -> Rational
fracExp Integer
exp' Integer
mant' Digits
ds
  where
    exp' :: Integer
exp'  = Integer
exp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
- Integer
1
    mant' :: Integer
mant' = Integer
mant Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
fromIntegral Int
d

valDig :: (Eq a, Num a) => a -> Char -> Maybe Int
valDig :: a -> Char -> Maybe Int
valDig a
8 Char
c
  | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
<= 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
External instance of the constraint type Num Int
- Char -> Int
ord Char
'0')
  | Bool
otherwise            = Maybe Int
forall a. Maybe a
Nothing

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

valDig a
16 Char
c
  | Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
<= 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
External instance of the constraint type Num Int
- Char -> Int
ord Char
'0')
  | Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
<= 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
External instance of the constraint type Num Int
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
10)
  | Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
<= 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
External instance of the constraint type Num Int
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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
External instance of the constraint type Ord Char
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
<= 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
External instance of the constraint type Num Int
- Char -> Int
ord Char
'0')
  | Bool
otherwise            = Maybe Int
forall a. Maybe a
Nothing

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

readIntP :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
readIntP :: 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
     a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadP
return (a -> Digits -> a
forall a. Num a => a -> Digits -> a
Evidence bound by a type signature of the constraint type Num a
val a
base ((Char -> Int) -> String -> Digits
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' :: a -> ReadP a
readIntP' a
base = a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
Evidence bound by a type signature of the constraint type Num a
readIntP a
base Char -> Bool
isDigit Char -> Int
valDigit
 where
  isDigit :: 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
Evidence bound by a type signature of the constraint type Num a
Evidence bound by a type signature of the constraint type Eq a
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
0     Int -> Int
forall a. a -> a
id           (a -> Char -> Maybe Int
forall a. (Eq a, Num a) => a -> Char -> Maybe Int
Evidence bound by a type signature of the constraint type Num a
Evidence bound by a type signature of the constraint type Eq a
valDig a
base Char
c)
{-# SPECIALISE readIntP' :: Integer -> ReadP Integer #-}

readOctP, readDecP, readHexP :: (Eq a, Num a) => ReadP a
readOctP :: ReadP a
readOctP = a -> ReadP a
forall a. (Eq a, Num a) => a -> ReadP a
Evidence bound by a type signature of the constraint type Num a
Evidence bound by a type signature of the constraint type Eq a
readIntP' a
8
readDecP :: ReadP a
readDecP = a -> ReadP a
forall a. (Eq a, Num a) => a -> ReadP a
Evidence bound by a type signature of the constraint type Num a
Evidence bound by a type signature of the constraint type Eq a
readIntP' a
10
readHexP :: ReadP a
readHexP = a -> ReadP a
forall a. (Eq a, Num a) => a -> ReadP a
Evidence bound by a type signature of the constraint type Num a
Evidence bound by a type signature of the constraint type Eq a
readIntP' a
16
{-# SPECIALISE readOctP :: ReadP Integer #-}
{-# SPECIALISE readDecP :: ReadP Integer #-}
{-# SPECIALISE readHexP :: ReadP Integer #-}