{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
module GHC.Internal.Text.Read.Lex
( Lexeme(..), Number
, numberToInteger, numberToFixed, numberToRational, numberToRangedRational
, lex, expect
, hsLex
, lexChar
, readBinP
, readIntP
, readOctP
, readDecP
, readHexP
, isSymbolChar
)
where
import GHC.Internal.Text.ParserCombinators.ReadP
import GHC.Internal.Base
import GHC.Internal.Char
import GHC.Internal.Num( Num(..), Integer )
import GHC.Internal.Show( Show(..) )
import GHC.Internal.Unicode
( GeneralCategory(..), generalCategory, isSpace, isAlpha, isAlphaNum )
import GHC.Internal.Real( Rational, (%), fromIntegral, Integral,
toInteger, (^), quot, even )
import GHC.Internal.List
import GHC.Internal.Enum( maxBound )
import GHC.Internal.Data.Maybe
guard :: (MonadPlus m) => Bool -> m ()
guard :: forall (m :: * -> *). MonadPlus m => Bool -> m ()
guard Bool
True = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
guard Bool
False = m ()
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
data Lexeme
= Char Char
| String String
| Punc String
| Ident String
| Symbol String
| Number Number
| EOF
deriving ( Lexeme -> Lexeme -> Bool
(Lexeme -> Lexeme -> Bool)
-> (Lexeme -> Lexeme -> Bool) -> Eq Lexeme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lexeme -> Lexeme -> Bool
== :: Lexeme -> Lexeme -> Bool
$c/= :: Lexeme -> Lexeme -> Bool
/= :: Lexeme -> Lexeme -> Bool
Eq
, Int -> Lexeme -> ShowS
[Lexeme] -> ShowS
Lexeme -> String
(Int -> Lexeme -> ShowS)
-> (Lexeme -> String) -> ([Lexeme] -> ShowS) -> Show Lexeme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lexeme -> ShowS
showsPrec :: Int -> Lexeme -> ShowS
$cshow :: Lexeme -> String
show :: Lexeme -> String
$cshowList :: [Lexeme] -> ShowS
showList :: [Lexeme] -> ShowS
Show
)
data Number = MkNumber Int
Digits
| MkDecimal Digits
(Maybe Digits)
(Maybe Integer)
deriving ( Number -> Number -> Bool
(Number -> Number -> Bool)
-> (Number -> Number -> Bool) -> Eq Number
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Number -> Number -> Bool
== :: Number -> Number -> Bool
$c/= :: Number -> Number -> Bool
/= :: Number -> Number -> Bool
Eq
, Int -> Number -> ShowS
[Number] -> ShowS
Number -> String
(Int -> Number -> ShowS)
-> (Number -> String) -> ([Number] -> ShowS) -> Show Number
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Number -> ShowS
showsPrec :: Int -> Number -> ShowS
$cshow :: Number -> String
show :: Number -> String
$cshowList :: [Number] -> ShowS
showList :: [Number] -> ShowS
Show
)
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
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base) Digits
iPart)
numberToInteger (MkDecimal Digits
iPart Maybe Digits
Nothing Maybe Integer
Nothing) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val Integer
10 Digits
iPart)
numberToInteger Number
_ = Maybe Integer
forall a. Maybe a
Nothing
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
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base) Digits
iPart, Integer
0)
numberToFixed Integer
_ (MkDecimal Digits
iPart Maybe Digits
Nothing Maybe Integer
Nothing) = (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val Integer
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
val Integer
10 Digits
iPart
f :: Integer
f = Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val Integer
10 (Integer -> Digits -> Digits
forall a. Integer -> [a] -> [a]
integerTake Integer
p (Digits
fPart Digits -> Digits -> Digits
forall a. [a] -> [a] -> [a]
++ Int -> Digits
forall a. a -> [a]
repeat Int
0))
integerTake :: Integer -> [a] -> [a]
integerTake :: forall a. Integer -> [a] -> [a]
integerTake Integer
n [a]
_ | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = []
integerTake Integer
_ [] = []
integerTake Integer
n (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Integer -> [a] -> [a]
forall a. Integer -> [a] -> [a]
integerTake (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) [a]
xs
in (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
i, Integer
f)
numberToFixed Integer
_ Number
_ = Maybe (Integer, Integer)
forall a. Maybe a
Nothing
numberToRangedRational :: (Int, Int) -> Number
-> Maybe Rational
numberToRangedRational :: (Int, Int) -> Number -> Maybe Rational
numberToRangedRational (Int
neg, Int
pos) n :: Number
n@(MkDecimal Digits
iPart Maybe Digits
mFPart (Just Integer
exp))
= 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
==) 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
==) Digits
fPart of
(Digits
_, []) -> Maybe Int
forall a. Maybe a
Nothing
(Digits
zeroes, Digits
_) ->
Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int
forall a. Num a => a -> a
negate (Digits -> Int
forall a. [a] -> Int
length Digits
zeroes))
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' :: Integer
firstDigit' = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
firstDigit Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
exp
in if Integer
firstDigit' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
then Maybe Rational
forall a. Maybe a
Nothing
else if Integer
firstDigit' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
neg Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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)
numberToRational :: Number -> Rational
numberToRational :: Number -> Rational
numberToRational (MkNumber Int
base Digits
iPart) = Integer -> Digits -> Integer
forall a. Num a => a -> Digits -> a
val (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base) Digits
iPart Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
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
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
% Integer
1
(Maybe Digits
Nothing, Just Integer
exp)
| Integer
exp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 -> (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
exp)) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1
| Bool
otherwise -> Integer
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (- Integer
exp))
(Just Digits
fPart, Maybe Integer
Nothing) -> Integer -> Integer -> Digits -> Rational
fracExp Integer
0 Integer
i Digits
fPart
(Just Digits
fPart, Just Integer
exp) -> Integer -> Integer -> Digits -> Rational
fracExp Integer
exp Integer
i Digits
fPart
lex :: ReadP Lexeme
lex :: ReadP Lexeme
lex = ReadP ()
skipSpaces ReadP () -> ReadP Lexeme -> ReadP Lexeme
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Lexeme
lexToken
expect :: Lexeme -> ReadP ()
expect :: Lexeme -> ReadP ()
expect Lexeme
lexeme = do { ReadP ()
skipSpaces
; thing <- ReadP Lexeme
lexToken
; if thing == lexeme then return () else pfail }
hsLex :: ReadP String
hsLex :: ReadP String
hsLex = do ReadP ()
skipSpaces
(s,_) <- ReadP Lexeme -> ReadP (String, Lexeme)
forall a. ReadP a -> ReadP (String, a)
gather ReadP Lexeme
lexToken
return 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
lexEOF :: ReadP Lexeme
lexEOF :: ReadP Lexeme
lexEOF = do s <- ReadP String
look
guard (null s)
return EOF
lexPunc :: ReadP Lexeme
lexPunc :: ReadP Lexeme
lexPunc =
do c <- (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isPuncChar
return (Punc [c])
isPuncChar :: Char -> Bool
isPuncChar :: Char -> Bool
isPuncChar Char
c = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` String
",;()[]{}`"
lexSymbol :: ReadP Lexeme
lexSymbol :: ReadP Lexeme
lexSymbol =
do s <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isSymbolChar
if s `elem` reserved_ops then
return (Punc s)
else
return (Symbol 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
`elem` String
"'\"")
GeneralCategory
ConnectorPunctuation -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_'
GeneralCategory
_ -> Bool
False
lexId :: ReadP Lexeme
lexId :: ReadP Lexeme
lexId = do c <- (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isIdsChar
s <- munch isIdfChar
return (Ident (c:s))
where
isIdsChar :: Char -> Bool
isIdsChar Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
isIdfChar :: Char -> Bool
isIdfChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` String
"_'"
lexLitChar :: ReadP Lexeme
lexLitChar :: ReadP Lexeme
lexLitChar =
do _ <- Char -> ReadP Char
char Char
'\''
(c,esc) <- lexCharE
guard (esc || c /= '\'')
_ <- char '\''
return (Char c)
lexChar :: ReadP Char
lexChar :: ReadP Char
lexChar = do { (c,_) <- ReadP (Char, Bool)
lexCharE; consumeEmpties; return c }
where
consumeEmpties :: ReadP ()
consumeEmpties :: ReadP ()
consumeEmpties = do
rest <- ReadP String
look
case rest of
(Char
'\\':Char
'&':String
_) -> String -> ReadP String
string String
"\\&" ReadP String -> ReadP () -> ReadP ()
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP ()
consumeEmpties
String
_ -> () -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lexCharE :: ReadP (Char, Bool)
lexCharE :: ReadP (Char, Bool)
lexCharE =
do c1 <- ReadP Char
get
if c1 == '\\'
then do c2 <- lexEsc; return (c2, True)
else return (c1, 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 c <- ReadP Char
get
case c of
Char
'a' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\a'
Char
'b' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'
Char
'f' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'
Char
'n' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
Char
'r' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
Char
't' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'
Char
'v' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\v'
Char
'\\' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\'
Char
'\"' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\"'
Char
'\'' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\''
Char
_ -> ReadP Char
forall a. ReadP a
pfail
lexNumeric :: ReadP Char
lexNumeric =
do base <- ReadP Int
lexBaseChar ReadP Int -> ReadP Int -> ReadP Int
forall a. ReadP a -> ReadP a -> ReadP a
<++ Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
10
n <- lexInteger base
guard (n <= toInteger (ord maxBound))
return (chr (fromInteger n))
where
lexBaseChar :: ReadP Int
lexBaseChar = do
c <- ReadP Char
get
case c of
Char
'o' -> Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8
Char
'O' -> Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8
Char
'x' -> Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
16
Char
'X' -> Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
16
Char
_ -> ReadP Int
forall a. ReadP a
pfail
lexCntrlChar :: ReadP Char
lexCntrlChar =
do _ <- Char -> ReadP Char
char Char
'^'
c <- get
case c of
Char
'@' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^@'
Char
'A' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^A'
Char
'B' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^B'
Char
'C' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^C'
Char
'D' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^D'
Char
'E' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^E'
Char
'F' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^F'
Char
'G' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^G'
Char
'H' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^H'
Char
'I' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^I'
Char
'J' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^J'
Char
'K' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^K'
Char
'L' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^L'
Char
'M' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^M'
Char
'N' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^N'
Char
'O' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^O'
Char
'P' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^P'
Char
'Q' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^Q'
Char
'R' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^R'
Char
'S' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^S'
Char
'T' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^T'
Char
'U' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^U'
Char
'V' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^V'
Char
'W' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^W'
Char
'X' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^X'
Char
'Y' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^Y'
Char
'Z' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^Z'
Char
'[' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^['
Char
'\\' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^\'
Char
']' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^]'
Char
'^' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^^'
Char
'_' -> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\^_'
Char
_ -> ReadP Char
forall a. ReadP a
pfail
lexAscii :: ReadP Char
lexAscii =
[ReadP Char] -> ReadP Char
forall a. [ReadP a] -> ReadP a
choice
[ (String -> ReadP String
string String
"SOH" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SOH') ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
<++
(String -> ReadP String
string String
"SO" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SO')
, String -> ReadP String
string String
"NUL" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\NUL'
, String -> ReadP String
string String
"STX" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\STX'
, String -> ReadP String
string String
"ETX" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ETX'
, String -> ReadP String
string String
"EOT" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\EOT'
, String -> ReadP String
string String
"ENQ" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ENQ'
, String -> ReadP String
string String
"ACK" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ACK'
, String -> ReadP String
string String
"BEL" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\BEL'
, String -> ReadP String
string String
"BS" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\BS'
, String -> ReadP String
string String
"HT" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\HT'
, String -> ReadP String
string String
"LF" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\LF'
, String -> ReadP String
string String
"VT" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\VT'
, String -> ReadP String
string String
"FF" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\FF'
, String -> ReadP String
string String
"CR" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\CR'
, String -> ReadP String
string String
"SI" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SI'
, String -> ReadP String
string String
"DLE" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DLE'
, String -> ReadP String
string String
"DC1" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC1'
, String -> ReadP String
string String
"DC2" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC2'
, String -> ReadP String
string String
"DC3" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC3'
, String -> ReadP String
string String
"DC4" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DC4'
, String -> ReadP String
string String
"NAK" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\NAK'
, String -> ReadP String
string String
"SYN" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SYN'
, String -> ReadP String
string String
"ETB" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ETB'
, String -> ReadP String
string String
"CAN" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\CAN'
, String -> ReadP String
string String
"EM" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\EM'
, String -> ReadP String
string String
"SUB" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SUB'
, String -> ReadP String
string String
"ESC" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\ESC'
, String -> ReadP String
string String
"FS" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\FS'
, String -> ReadP String
string String
"GS" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\GS'
, String -> ReadP String
string String
"RS" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\RS'
, String -> ReadP String
string String
"US" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\US'
, String -> ReadP String
string String
"SP" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\SP'
, String -> ReadP String
string String
"DEL" ReadP String -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\DEL'
]
lexString :: ReadP Lexeme
lexString :: ReadP Lexeme
lexString =
do _ <- Char -> ReadP Char
char Char
'"'
body id
where
body :: ShowS -> ReadP Lexeme
body ShowS
f =
do (c,esc) <- ReadP (Char, Bool)
lexStrItem
if c /= '"' || esc
then body (f.(c:))
else let s = ShowS
f String
"" in
return (String s)
lexStrItem :: ReadP (Char, Bool)
lexStrItem = (ReadP ()
lexEmpty ReadP () -> ReadP (Char, Bool) -> ReadP (Char, Bool)
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP (Char, Bool)
lexStrItem)
ReadP (Char, Bool) -> ReadP (Char, Bool) -> ReadP (Char, Bool)
forall a. ReadP a -> ReadP a -> ReadP a
+++ ReadP (Char, Bool)
lexCharE
lexEmpty :: ReadP ()
lexEmpty =
do _ <- Char -> ReadP Char
char Char
'\\'
c <- get
case c of
Char
'&' -> () -> ReadP ()
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Char
_ | Char -> Bool
isSpace Char
c -> do ReadP ()
skipSpaces; _ <- Char -> ReadP Char
char Char
'\\'; return ()
Char
_ -> ReadP ()
forall a. ReadP a
pfail
type Base = Int
type Digits = [Int]
lexNumber :: ReadP Lexeme
lexNumber :: ReadP Lexeme
lexNumber
= ReadP Lexeme
lexHexOctBin ReadP Lexeme -> ReadP Lexeme -> ReadP Lexeme
forall a. ReadP a -> ReadP a -> ReadP a
<++
ReadP Lexeme
lexDecNumber
lexHexOctBin :: ReadP Lexeme
lexHexOctBin :: ReadP Lexeme
lexHexOctBin
= do _ <- Char -> ReadP Char
char Char
'0'
base <- lexBaseChar
digits <- lexDigits base
return (Number (MkNumber base digits))
where
lexBaseChar :: ReadP Int
lexBaseChar = do
c <- ReadP Char
get
case c of
Char
'b' -> Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
Char
'B' -> Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
Char
'o' -> Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8
Char
'O' -> Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8
Char
'x' -> Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
16
Char
'X' -> Int -> ReadP Int
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
16
Char
_ -> ReadP Int
forall a. ReadP a
pfail
lexDecNumber :: ReadP Lexeme
lexDecNumber :: ReadP Lexeme
lexDecNumber =
do xs <- Int -> ReadP Digits
lexDigits Int
10
mFrac <- lexFrac <++ return Nothing
mExp <- lexExp <++ return Nothing
return (Number (MkDecimal xs mFrac mExp))
lexFrac :: ReadP (Maybe Digits)
lexFrac :: ReadP (Maybe Digits)
lexFrac = do _ <- Char -> ReadP Char
char Char
'.'
fraction <- lexDigits 10
return (Just fraction)
lexExp :: ReadP (Maybe Integer)
lexExp :: ReadP (Maybe Integer)
lexExp = do _ <- 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'
exp <- signedExp +++ lexInteger 10
return (Just exp)
where
signedExp :: ReadP Integer
signedExp
= do 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
'+'
n <- lexInteger 10
return (if c == '-' then -n else n)
lexDigits :: Int -> ReadP Digits
lexDigits :: Int -> ReadP Digits
lexDigits Int
base =
do s <- ReadP String
look
xs <- scan s id
guard (not (null xs))
return xs
where
scan :: String -> (Digits -> b) -> ReadP b
scan (Char
c:String
cs) Digits -> b
f = case Int -> Char -> Maybe Int
forall a. (Eq a, Num a) => a -> Char -> Maybe Int
valDig Int
base Char
c of
Just Int
n -> do _ <- ReadP Char
get; scan cs (f.(n:))
Maybe Int
Nothing -> b -> ReadP b
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Digits -> b
f [])
scan [] Digits -> b
f = b -> ReadP b
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Digits -> b
f [])
lexInteger :: Base -> ReadP Integer
lexInteger :: Int -> ReadP Integer
lexInteger Int
base =
do xs <- Int -> ReadP Digits
lexDigits Int
base
return (val (fromIntegral base) xs)
val :: Num a => a -> Digits -> a
val :: forall a. Num a => a -> Digits -> a
val = a -> Digits -> a
forall a d. (Num a, Integral d) => a -> [d] -> a
valSimple
{-# RULES
"val/Integer" val = valInteger
#-}
{-# INLINE [1] val #-}
valSimple :: (Num a, Integral d) => a -> [d] -> a
valSimple :: forall a d. (Num a, Integral d) => a -> [d] -> a
valSimple a
base = a -> [d] -> a
forall {a}. Integral a => a -> [a] -> a
go a
0
where
go :: a -> [a] -> a
go a
r [] = a
r
go a
r (a
d : [a]
ds) = a
r' a -> a -> a
forall a b. a -> b -> b
`seq` a -> [a] -> a
go a
r' [a]
ds
where
r' :: a
r' = a
r a -> a -> a
forall a. Num a => a -> a -> a
* a
base a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d
{-# INLINE valSimple #-}
valInteger :: Integer -> Digits -> Integer
valInteger :: Integer -> Digits -> Integer
valInteger Integer
b0 Digits
ds0 = Integer -> Int -> [Integer] -> Integer
forall {d} {t}. (Integral d, Integral t) => d -> t -> [d] -> d
go Integer
b0 (Digits -> Int
forall a. [a] -> Int
length Digits
ds0) ([Integer] -> Integer) -> [Integer] -> Integer
forall a b. (a -> b) -> a -> b
$ (Int -> Integer) -> Digits -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Digits
ds0
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 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
40 = d
b' d -> d -> d
forall a b. a -> b -> b
`seq` d -> t -> [d] -> d
go d
b' t
l' (d -> [d] -> [d]
forall {t}. Num t => t -> [t] -> [t]
combine d
b [d]
ds')
| Bool
otherwise = d -> [d] -> d
forall a d. (Num a, Integral d) => a -> [d] -> a
valSimple d
b [d]
ds
where
ds' :: [d]
ds' = if t -> Bool
forall a. Integral a => a -> Bool
even t
l then [d]
ds else d
0 d -> [d] -> [d]
forall a. a -> [a] -> [a]
: [d]
ds
b' :: d
b' = d
b d -> d -> d
forall a. Num a => a -> a -> a
* d
b
l' :: t
l' = (t
l t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) t -> t -> t
forall a. Integral a => a -> a -> a
`quot` t
2
combine :: t -> [t] -> [t]
combine t
b (t
d1 : t
d2 : [t]
ds) = t
d t -> [t] -> [t]
forall a b. a -> b -> b
`seq` (t
d t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t] -> [t]
combine t
b [t]
ds)
where
d :: t
d = t
d1 t -> t -> t
forall a. Num a => a -> a -> a
* t
b t -> t -> t
forall a. Num a => a -> a -> a
+ t
d2
combine t
_ [] = []
combine t
_ [t
_] = String -> [t]
forall a. String -> a
errorWithoutStackTrace String
"this should not happen"
fracExp :: Integer -> Integer -> Digits -> Rational
fracExp :: Integer -> Integer -> Digits -> Rational
fracExp Integer
exp Integer
mant []
| Integer
exp Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Integer
mant Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (-Integer
exp))
| Bool
otherwise = Integer -> Rational
forall a. Num a => Integer -> a
fromInteger (Integer
mant Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
exp)
fracExp Integer
exp Integer
mant (Int
d:Digits
ds) = Integer
exp' Integer -> Rational -> Rational
forall a b. a -> b -> b
`seq` Integer
mant' Integer -> Rational -> Rational
forall a b. a -> b -> b
`seq` Integer -> Integer -> Digits -> Rational
fracExp Integer
exp' Integer
mant' Digits
ds
where
exp' :: Integer
exp' = Integer
exp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
mant' :: Integer
mant' = Integer
mant Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d
valDig :: (Eq a, Num a) => a -> Char -> Maybe Int
valDig :: forall a. (Eq a, Num a) => a -> Char -> Maybe Int
valDig a
2 Char
c
| Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'1' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
| Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
valDig a
8 Char
c
| Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'7' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
| Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
valDig a
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
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
| Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
| Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
| Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
valDig a
_ Char
_ = String -> Maybe Int
forall a. String -> a
errorWithoutStackTrace String
"valDig: Bad base"
valDecDig :: Char -> Maybe Int
valDecDig :: Char -> Maybe Int
valDecDig Char
c
| Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Int -> Maybe Int
forall a. a -> Maybe a
Just (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
| Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
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 s <- (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
return (val base (map valDigit 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 = a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
readIntP a
base Char -> Bool
isDigit Char -> Int
valDigit
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
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
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 = a -> ReadP a
forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
2
readOctP :: forall a. (Eq a, Num a) => ReadP a
readOctP = a -> ReadP a
forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
8
readDecP :: forall a. (Eq a, Num a) => ReadP a
readDecP = a -> ReadP a
forall a. (Eq a, Num a) => a -> ReadP a
readIntP' a
10
readHexP :: forall a. (Eq a, Num a) => ReadP a
readHexP = a -> ReadP a
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 #-}
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4