(original) (raw)

{-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving, ScopedTypeVariables #-} {-# OPTIONS_HADDOCK hide #-}

module GHC.Read ( Read(..)

, ReadS

, lex , lexLitChar , readLitChar , lexDigits

, lexP, expectP , paren , parens , list , choose , readListDefault, readListPrecDefault , readNumber , readField , readFieldHash , readSymField

, readParen ) where

#include "MachDeps.h"

import qualified Text.ParserCombinators.ReadP as P

import Text.ParserCombinators.ReadP ( ReadS , readP_to_S )

import qualified Text.Read.Lex as L

import Text.ParserCombinators.ReadPrec

import Data.Maybe

import GHC.Unicode import GHC.Num import GHC.Real import GHC.Float import GHC.Show import GHC.Base import GHC.Arr import GHC.Word import GHC.List (filter)

readParen :: Bool -> ReadS a -> ReadS a

readParen b g = if b then mandatory else optional where optional r = g r ++ mandatory r mandatory r = do ("(",s) <- lex r (x,t) <- optional s (")",u) <- lex t return (x,u)

class Read a where {-# MINIMAL readsPrec | readPrec #-}

readsPrec :: Int

            -> [ReadS](Text.ParserCombinators.ReadP.html#ReadS) [a](#local-6989586621679082380)

readList :: ReadS [a]

readPrec :: ReadPrec a

readListPrec :: ReadPrec [a]

readsPrec = readPrec_to_S readPrec readList = readPrec_to_S (list readPrec) 0 readPrec = readS_to_Prec readsPrec readListPrec = readS_to_Prec (_ -> readList)

readListDefault :: Read a => ReadS [a]

readListDefault = readPrec_to_S readListPrec 0

readListPrecDefault :: Read a => ReadPrec [a]

readListPrecDefault = list readPrec

lex :: ReadS String
lex s = readP_to_S L.hsLex s

lexLitChar :: ReadS String
lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ; let s' = removeNulls s in return s' }) where

[removeNulls](#local-6989586621679082685) [] = []
removeNulls ('\\':'&':[xs](#local-6989586621679082686)) = [removeNulls](#local-6989586621679082685) [xs](#local-6989586621679082686)
removeNulls ([first](#local-6989586621679082687):[rest](#local-6989586621679082688)) = [first](#local-6989586621679082687) : [removeNulls](#local-6989586621679082685) [rest](#local-6989586621679082688)

readLitChar :: ReadS Char
readLitChar = readP_to_S L.lexChar

lexDigits :: ReadS String lexDigits = readP_to_S (P.munch1 isDigit)

lexP :: ReadPrec L.Lexeme

lexP = lift L.lex

expectP :: L.Lexeme -> ReadPrec () expectP lexeme = lift (L.expect lexeme)

expectCharP :: Char -> ReadPrec a -> ReadPrec a expectCharP c a = do q <- get if q == c then a else pfail {-# INLINE expectCharP #-}

skipSpacesThenP :: ReadPrec a -> ReadPrec a skipSpacesThenP m = do s <- look skip s where skip (c:s) | isSpace c = get *> skip s skip _ = m

paren :: ReadPrec a -> ReadPrec a

paren p = skipSpacesThenP (paren' p)

paren' :: ReadPrec a -> ReadPrec a paren' p = expectCharP '(' $ reset p >>= [x](#local-6989586621679082702) -> skipSpacesThenP (expectCharP ')' (pure x))

parens :: ReadPrec a -> ReadPrec a

parens p = optional where optional = skipSpacesThenP (p +++ mandatory) mandatory = paren' optional

list :: ReadPrec a -> ReadPrec [a]

list readx = parens ( do expectP (L.Punc "[") (listRest False +++ listNext) ) where listRest started = do L.Punc c <- lexP case c of "]" -> return [] "," | started -> listNext _ -> pfail

listNext = do x <- reset readx xs <- listRest True return (x:xs)

choose :: [(String, ReadPrec a)] -> ReadPrec a

choose sps = foldr ((+++) . try_one) pfail sps where try_one (s,p) = do { token <- lexP ; case token of L.Ident s' | s==s' -> p L.Symbol s' | s==s' -> p _other -> pfail }

readField :: String -> ReadPrec a -> ReadPrec a readField fieldName readVal = do expectP (L.Ident fieldName) expectP (L.Punc "=") readVal {-# NOINLINE readField #-}

readFieldHash :: String -> ReadPrec a -> ReadPrec a readFieldHash fieldName readVal = do expectP (L.Ident fieldName) expectP (L.Symbol "#") expectP (L.Punc "=") readVal {-# NOINLINE readFieldHash #-}

readSymField :: String -> ReadPrec a -> ReadPrec a readSymField fieldName readVal = do expectP (L.Punc "(") expectP (L.Symbol fieldName) expectP (L.Punc ")") expectP (L.Punc "=") readVal {-# NOINLINE readSymField #-}

deriving instance Read GeneralCategory

instance Read Char where readPrec = parens ( do L.Char c <- lexP return c )

readListPrec = parens ( do L.String s <- lexP
return s +++ readListPrecDefault
)

readList = readListDefault

instance Read Bool where readPrec = parens ( do L.Ident s <- lexP case s of "True" -> return True "False" -> return False _ -> pfail )

readListPrec = readListPrecDefault readList = readListDefault

instance Read Ordering where readPrec = parens ( do L.Ident s <- lexP case s of "LT" -> return LT "EQ" -> return EQ "GT" -> return GT _ -> pfail )

readListPrec = readListPrecDefault readList = readListDefault

deriving instance Read a => Read (NonEmpty a)

instance Read a => Read (Maybe a) where readPrec = parens (do expectP (L.Ident "Nothing") return Nothing +++ prec appPrec ( do expectP (L.Ident "Just") x <- step readPrec return (Just x)) )

readListPrec = readListPrecDefault readList = readListDefault

instance Read a => Read [a] where {-# SPECIALISE instance Read [String] #-} {-# SPECIALISE instance Read [Char] #-} {-# SPECIALISE instance Read [Int] #-} readPrec = readListPrec readListPrec = readListPrecDefault readList = readListDefault

instance (Ix a, Read a, Read b) => Read (Array a b) where readPrec = parens $ prec appPrec $ do expectP (L.Ident "array") theBounds <- step readPrec vals <- step readPrec return (array theBounds vals)

[readListPrec](GHC.Read.html#readListPrec) = [readListPrecDefault](GHC.Read.html#readListPrecDefault)
[readList](GHC.Read.html#readList)     = [readListDefault](GHC.Read.html#readListDefault)

instance Read L.Lexeme where readPrec = lexP readListPrec = readListPrecDefault readList = readListDefault

readNumber :: Num a => (L.Lexeme -> ReadPrec a) -> ReadPrec a

readNumber convert = parens ( do x <- lexP case x of L.Symbol "-" -> do y <- lexP n <- convert y return (negate n)

     _   -> [convert](#local-6989586621679082727) [x](#local-6989586621679082728)

)

convertInt :: Num a => L.Lexeme -> ReadPrec a convertInt (L.Number n) | Just i <- L.numberToInteger n = return (fromInteger i) convertInt _ = pfail

convertFrac :: forall a . RealFloat a => L.Lexeme -> ReadPrec a convertFrac (L.Ident "NaN") = return (0 / 0) convertFrac (L.Ident "Infinity") = return (1 / 0) convertFrac (L.Number n) = let resRange = floatRange (undefined :: a) in case L.numberToRangedRational resRange n of Nothing -> return (1 / 0) Just rat -> return $ fromRational rat convertFrac _ = pfail

instance Read Int where readPrec = readNumber convertInt readListPrec = readListPrecDefault readList = readListDefault

instance Read Word where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]

instance Read Word8 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]

instance Read Word16 where readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]

instance Read Word32 where #if WORD_SIZE_IN_BITS < 33 readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s] #else readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s] #endif

instance Read Word64 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]

instance Read Integer where readPrec = readNumber convertInt readListPrec = readListPrecDefault readList = readListDefault

#if defined(MIN_VERSION_integer_gmp)

instance Read Natural where readsPrec d = map ((n, s) -> (fromInteger n, s)) . filter ((>= 0) . ((x,_)->x)) . readsPrec d #else

instance Read Natural where readsPrec d = map ((n, s) -> (Natural n, s)) . filter ((>= 0) . ((x,_)->x)) . readsPrec d #endif

instance Read Float where readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault

instance Read Double where readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault

instance (Integral a, Read a) => Read (Ratio a) where readPrec = parens ( prec ratioPrec ( do x <- step readPrec expectP (L.Symbol "%") y <- step readPrec return (x % y) ) )

readListPrec = readListPrecDefault readList = readListDefault

instance Read () where readPrec = parens ( paren ( return () ) )

readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b) => Read (a,b) where readPrec = wrap_tup read_tup2 readListPrec = readListPrecDefault readList = readListDefault

wrap_tup :: ReadPrec a -> ReadPrec a wrap_tup p = parens (paren p)

read_comma :: ReadPrec () read_comma = expectP (L.Punc ",")

read_tup2 :: (Read a, Read b) => ReadPrec (a,b)

read_tup2 = do x <- readPrec read_comma y <- readPrec return (x,y)

read_tup4 :: (Read a, Read b, Read c, Read d) => ReadPrec (a,b,c,d) read_tup4 = do (a,b) <- read_tup2 read_comma (c,d) <- read_tup2 return (a,b,c,d)

read_tup8 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) => ReadPrec (a,b,c,d,e,f,g,h) read_tup8 = do (a,b,c,d) <- read_tup4 read_comma (e,f,g,h) <- read_tup4 return (a,b,c,d,e,f,g,h)

instance (Read a, Read b, Read c) => Read (a, b, c) where readPrec = wrap_tup (do { (a,b) <- read_tup2; read_comma ; c <- readPrec ; return (a,b,c) }) readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where readPrec = wrap_tup read_tup4 readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma ; e <- readPrec ; return (a,b,c,d,e) }) readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e, Read f) => Read (a, b, c, d, e, f) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma ; (e,f) <- read_tup2 ; return (a,b,c,d,e,f) }) readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g) => Read (a, b, c, d, e, f, g) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma ; (e,f) <- read_tup2; read_comma ; g <- readPrec ; return (a,b,c,d,e,f,g) }) readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) => Read (a, b, c, d, e, f, g, h) where readPrec = wrap_tup read_tup8 readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i) => Read (a, b, c, d, e, f, g, h, i) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; i <- readPrec ; return (a,b,c,d,e,f,g,h,i) }) readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j) => Read (a, b, c, d, e, f, g, h, i, j) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j) <- read_tup2 ; return (a,b,c,d,e,f,g,h,i,j) }) readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k) => Read (a, b, c, d, e, f, g, h, i, j, k) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j) <- read_tup2; read_comma ; k <- readPrec ; return (a,b,c,d,e,f,g,h,i,j,k) }) readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l) => Read (a, b, c, d, e, f, g, h, i, j, k, l) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j,k,l) <- read_tup4 ; return (a,b,c,d,e,f,g,h,i,j,k,l) }) readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j,k,l) <- read_tup4; read_comma ; m <- readPrec ; return (a,b,c,d,e,f,g,h,i,j,k,l,m) }) readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m, Read n) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j,k,l) <- read_tup4; read_comma ; (m,n) <- read_tup2 ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n) }) readListPrec = readListPrecDefault readList = readListDefault

instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Read k, Read l, Read m, Read n, Read o) => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma ; (i,j,k,l) <- read_tup4; read_comma ; (m,n) <- read_tup2; read_comma ; o <- readPrec ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) }) readListPrec = readListPrecDefault readList = readListDefault