(original) (raw)

{-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}

module Text.Read.Lex

( Lexeme(..), Number

, numberToInteger, numberToFixed, numberToRational, numberToRangedRational

, lex, expect , hsLex , lexChar

, readBinP , readIntP , readOctP , readDecP , readHexP

, isSymbolChar ) where

import Text.ParserCombinators.ReadP

import GHC.Base import GHC.Char import GHC.Num( Num(..), Integer ) import GHC.Show( Show(..) ) import GHC.Unicode ( GeneralCategory(..), generalCategory, isSpace, isAlpha, isAlphaNum ) import GHC.Real( Rational, (%), fromIntegral, Integral, toInteger, (^), quot, even ) import GHC.List import GHC.Enum( minBound, maxBound ) import Data.Maybe

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](#local-6989586621679591081)             :: [Integer](../https://hackage.haskell.org/package/ghc-bignum-1.3/docs/src/GHC.Num.Integer.html#Integer/GHC.Num.Integer.html#Integer) -> [[a](#local-6989586621679590723)] -> [[a](#local-6989586621679590723)]
      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))

| Integer

exp Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool > Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral (Int forall a. Bounded a => a maxBound :: Int) Bool -> Bool -> Bool || Integer exp Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral (Int forall a. Bounded a => a minBound :: Int) = Maybe Rational forall a. Maybe a Nothing | Bool otherwise = 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' :: Int firstDigit' = Int firstDigit Int -> Int -> Int forall a. Num a => a -> a -> a + Integer -> Int forall a. Num a => Integer -> a fromInteger Integer exp in if Int firstDigit' Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > (Int pos Int -> Int -> Int forall a. Num a => a -> a -> a + Int 3) then Maybe Rational forall a. Maybe a Nothing else if Int firstDigit' Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < (Int neg Int -> Int -> Int forall a. Num a => a -> a -> a - Int 3) 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 ; Lexeme thing <- ReadP Lexeme lexToken ; if Lexeme thing Lexeme -> Lexeme -> Bool forall a. Eq a => a -> a -> Bool == Lexeme lexeme then () -> ReadP () forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return () else ReadP () forall a. ReadP a pfail }

hsLex :: ReadP String

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 a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return String s

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

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

lexPunc :: ReadP Lexeme lexPunc :: ReadP Lexeme lexPunc = do Char c <- (Char -> Bool) -> ReadP Char satisfy Char -> Bool isPuncChar Lexeme -> ReadP Lexeme forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (String -> Lexeme Punc [Char c])

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 String s <- (Char -> Bool) -> ReadP String munch1 Char -> Bool isSymbolChar if String s String -> [String] -> Bool forall a. Eq a => a -> [a] -> Bool elem [String] reserved_ops then Lexeme -> ReadP Lexeme forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (String -> Lexeme Punc String s)
else Lexeme -> ReadP Lexeme forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (String -> Lexeme Symbol String s) where reserved_ops :: [String] reserved_ops = [String "..", String "::", String "=", String "\", String "|", String "<-", String "->", String "@", String "~", String "=>"]

isSymbolChar :: Char -> Bool isSymbolChar :: Char -> Bool isSymbolChar Char c = Bool -> Bool not (Char -> Bool isPuncChar Char c) Bool -> Bool -> Bool && case Char -> GeneralCategory generalCategory Char c of GeneralCategory MathSymbol -> Bool True GeneralCategory CurrencySymbol -> Bool True GeneralCategory ModifierSymbol -> Bool True GeneralCategory OtherSymbol -> Bool True GeneralCategory DashPunctuation -> Bool True GeneralCategory OtherPunctuation -> Bool -> Bool not (Char c 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 Char c <- (Char -> Bool) -> ReadP Char satisfy Char -> Bool isIdsChar String s <- (Char -> Bool) -> ReadP String munch Char -> Bool isIdfChar Lexeme -> ReadP Lexeme forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (String -> Lexeme Ident (Char cChar -> ShowS forall a. a -> [a] -> [a] :String 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 _ <- Char -> ReadP Char char Char ''' (Char c,Bool esc) <- ReadP (Char, Bool) lexCharE Bool -> ReadP () forall (m :: * -> *). MonadPlus m => Bool -> m () guard (Bool esc Bool -> Bool -> Bool || Char c Char -> Char -> Bool forall a. Eq a => a -> a -> Bool /= Char ''')
Char _ <- Char -> ReadP Char char Char ''' Lexeme -> ReadP Lexeme forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (Char -> Lexeme Char Char c)

lexChar :: ReadP Char lexChar :: ReadP Char lexChar = do { (Char c,Bool _) <- ReadP (Char, Bool) lexCharE; ReadP () consumeEmpties; Char -> ReadP Char forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return Char c } where

[consumeEmpties](#local-6989586621679591184) :: [ReadP](Text.ParserCombinators.ReadP.html#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 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 Char c1 <- ReadP Char get if Char c1 Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '\' then do Char c2 <- ReadP Char lexEsc; (Char, Bool) -> ReadP (Char, Bool) forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (Char c2, Bool True) else (Char, Bool) -> ReadP (Char, Bool) forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (Char c1, Bool False) 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 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 Int 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 Integer n <- Int -> ReadP Integer lexInteger Int base Bool -> ReadP () forall (m :: * -> *). MonadPlus m => Bool -> m () guard (Integer n Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool <= Int -> Integer forall a. Integral a => a -> Integer toInteger (Char -> Int ord Char forall a. Bounded a => a maxBound)) Char -> ReadP Char forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (Int -> Char chr (Integer -> Int forall a. Num a => Integer -> a fromInteger Integer n))

lexCntrlChar :: ReadP Char lexCntrlChar = do Char _ <- Char -> ReadP Char char Char '^' Char c <- ReadP Char get case Char 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 _ <- 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 /= 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 a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (String -> Lexeme String String s)

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

lexEmpty :: ReadP () lexEmpty = do Char _ <- Char -> ReadP Char char Char '\' Char c <- ReadP Char get case Char 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 _ <- Char -> ReadP Char char Char '\'; () -> ReadP () forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return () Char _ -> ReadP () forall a. ReadP a pfail

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 <++

ReadP Lexeme

lexDecNumber

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 a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (Number -> Lexeme Number (Int -> Digits -> Number MkNumber Int base Digits digits))

lexBaseChar :: ReadP Int

lexBaseChar :: ReadP Int lexBaseChar = do Char c <- ReadP Char get case Char 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

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 a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return Maybe Digits forall a. Maybe a Nothing Maybe Integer mExp <- ReadP (Maybe Integer) lexExp ReadP (Maybe Integer) -> ReadP (Maybe Integer) -> ReadP (Maybe Integer) forall a. ReadP a -> ReadP a -> ReadP a <++ Maybe Integer -> ReadP (Maybe Integer) forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return Maybe Integer forall a. Maybe a Nothing Lexeme -> ReadP Lexeme forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (Number -> Lexeme Number (Digits -> Maybe Digits -> Maybe Integer -> Number MkDecimal Digits xs Maybe Digits mFrac Maybe Integer mExp))

lexFrac :: ReadP (Maybe Digits)

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 a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (Digits -> Maybe Digits forall a. a -> Maybe a Just Digits fraction)

lexExp :: ReadP (Maybe Integer) lexExp :: ReadP (Maybe Integer) lexExp = 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 a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a 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 a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (if Char c Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '-' then -Integer n else Integer n)

lexDigits :: Int -> ReadP Digits

lexDigits :: Int -> ReadP Digits lexDigits Int base = do String s <- ReadP String look Digits xs <- String -> (Digits -> Digits) -> ReadP Digits forall {b}. String -> (Digits -> b) -> ReadP b scan String s Digits -> Digits forall a. a -> a id Bool -> ReadP () forall (m :: * -> *). MonadPlus m => Bool -> m () guard (Bool -> Bool not (Digits -> Bool forall a. [a] -> Bool null Digits xs)) Digits -> ReadP Digits forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return Digits xs 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 Char _ <- ReadP Char get; String -> (Digits -> b) -> ReadP b scan String cs (Digits -> b f(Digits -> b) -> (Digits -> Digits) -> Digits -> b forall b c a. (b -> c) -> (a -> b) -> a -> c .(Int nInt -> Digits -> Digits forall a. a -> [a] -> [a] :)) Maybe Int Nothing -> b -> ReadP b forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (Digits -> b f []) scan [] Digits -> b f = b -> ReadP b forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (Digits -> b f [])

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

val :: Num a => a -> Digits -> a val :: forall a. Num a => a -> Digits -> a val = a -> Digits -> a forall a d. (Num a, Integral d) => a -> [d] -> a valSimple {-# RULES "val/Integer" val = valInteger #-} {-# INLINE [1] val #-}

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 String s <- (Char -> Bool) -> ReadP String munch1 Char -> Bool isDigit a -> ReadP a forall a. a -> ReadP a forall (m :: * -> *) a. Monad m => a -> m a return (a -> Digits -> a forall a. Num a => a -> Digits -> a val a base ((Char -> Int) -> String -> Digits forall a b. (a -> b) -> [a] -> [b] map Char -> Int valDigit String s)) {-# 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 #-}