Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude #-}------------------------------------------------------------------------------- |-- Module      :  Text.Read.Lex-- Copyright   :  (c) The University of Glasgow 2002-- License     :  BSD-style (see the file libraries/base/LICENSE)---- Maintainer  :  libraries@haskell.org-- Stability   :  provisional-- Portability :  non-portable (uses Text.ParserCombinators.ReadP)---- The cut-down Haskell lexer, used by Text.Read-------------------------------------------------------------------------------moduleText.Read.Lex-- lexing types(Lexeme(..),Number,numberToInteger,numberToFixed,numberToRational,numberToRangedRational-- lexer,lex,expect,hsLex,lexChar,readIntP,readOctP,readDecP,readHexP,isSymbolChar)whereimportText.ParserCombinators.ReadPimportGHC.BaseimportGHC.CharimportGHC.Num(Num(..),Integer)importGHC.Show(Show(..))importGHC.Unicode(GeneralCategory(..),generalCategory,isSpace,isAlpha,isAlphaNum)importGHC.Real(Rational,(%),fromIntegral,Integral,toInteger,(^),quot,even)importGHC.ListimportGHC.Enum(minBound,maxBound)importData.Maybe-- local copy to break import-cycle-- | @'guard' b@ is @'return' ()@ if @b@ is 'True',-- and 'mzero' if @b@ is 'False'.guard::(MonadPlusm)=>Bool->m()guardTrue=return()guardFalse=mzero-- ------------------------------------------------------------------------------- Lexing types-- ^ Haskell lexemes.dataLexeme=CharChar-- ^ Character literal|StringString-- ^ String literal, with escapes interpreted|PuncString-- ^ Punctuation or reserved symbol, e.g. @(@, @::@|IdentString-- ^ Haskell identifier, e.g. @foo@, @Baz@|SymbolString-- ^ Haskell symbol, e.g. @>>@, @:%@|NumberNumber-- ^ @since 4.6.0.0|EOFderiving(Eq-- ^ @since 2.01,Show-- ^ @since 2.01)-- | @since 4.6.0.0dataNumber=MkNumberInt-- BaseDigits-- Integral part|MkDecimalDigits-- Integral part(MaybeDigits)-- Fractional part(MaybeInteger)-- Exponentderiving(Eq-- ^ @since 4.6.0.0,Show-- ^ @since 4.6.0.0)-- | @since 4.5.1.0numberToInteger::Number->MaybeIntegernumberToInteger(MkNumberbaseiPart)=Just(val(fromIntegralbase)iPart)numberToInteger(MkDecimaliPartNothingNothing)=Just(val10iPart)numberToInteger_=Nothing-- | @since 4.7.0.0numberToFixed::Integer->Number->Maybe(Integer,Integer)numberToFixed_(MkNumberbaseiPart)=Just(val(fromIntegralbase)iPart,0)numberToFixed_(MkDecimaliPartNothingNothing)=Just(val10iPart,0)numberToFixedp(MkDecimaliPart(JustfPart)Nothing)=leti=val10iPartf=val10(integerTakep(fPart++repeat0))-- Sigh, we really want genericTake, but that's above us in-- the hierarchy, so we define our own version here (actually-- specialised to Integer)integerTake::Integer->[a]->[a]integerTaken_|n<=0=[]integerTake_[]=[]integerTaken(x:xs)=x:integerTake(n-1)xsinJust(i,f)numberToFixed__=Nothing-- This takes a floatRange, and if the Rational would be outside of-- the floatRange then it may return Nothing. Not that it will not-- /necessarily/ return Nothing, but it is good enough to fix the-- space problems in #5688-- Ways this is conservative:-- * the floatRange is in base 2, but we pretend it is in base 10-- * we pad the floateRange a bit, just in case it is very small--   and we would otherwise hit an edge case-- * We only worry about numbers that have an exponent. If they don't--   have an exponent then the Rational won't be much larger than the--   Number, so there is no problem-- | @since 4.5.1.0numberToRangedRational::(Int,Int)->Number->MaybeRational-- Nothing = InfnumberToRangedRational(neg,pos)n@(MkDecimaliPartmFPart(Justexp))-- if exp is out of integer bounds,-- then the number is definitely out of range|exp>fromIntegral(maxBound::Int)||exp<fromIntegral(minBound::Int)=Nothing|otherwise=letmFirstDigit=casedropWhile(0==)iPartofiPart'@(_:_)->Just(lengthiPart')[]->casemFPartofNothing->NothingJustfPart->casespan(0==)fPartof(_,[])->Nothing(zeroes,_)->Just(negate(lengthzeroes))incasemFirstDigitofNothing->Just0JustfirstDigit->letfirstDigit'=firstDigit+fromIntegerexpiniffirstDigit'>(pos+3)thenNothingelseiffirstDigit'<(neg-3)thenJust0elseJust(numberToRationaln)numberToRangedRational_n=Just(numberToRationaln)-- | @since 4.6.0.0numberToRational::Number->RationalnumberToRational(MkNumberbaseiPart)=val(fromIntegralbase)iPart%1numberToRational(MkDecimaliPartmFPartmExp)=leti=val10iPartincase(mFPart,mExp)of(Nothing,Nothing)->i%1(Nothing,Justexp)|exp>=0->(i*(10^exp))%1|otherwise->i%(10^(-exp))(JustfPart,Nothing)->fracExp0ifPart(JustfPart,Justexp)->fracExpexpifPart-- fracExp is a bit more efficient in calculating the Rational.-- Instead of calculating the fractional part alone, then-- adding the integral part and finally multiplying with-- 10 ^ exp if an exponent was given, do it all at once.-- ------------------------------------------------------------------------------- Lexinglex::ReadPLexemelex=skipSpaces>>lexToken-- | @since 4.7.0.0expect::Lexeme->ReadP()expectlexeme=do{skipSpaces;thing<-lexToken;ifthing==lexemethenreturn()elsepfail}hsLex::ReadPString-- ^ Haskell lexer: returns the lexed string, rather than the lexemehsLex=doskipSpaces(s,_)<-gatherlexTokenreturnslexToken::ReadPLexemelexToken=lexEOF+++lexLitChar+++lexString+++lexPunc+++lexSymbol+++lexId+++lexNumber-- ------------------------------------------------------------------------ End of filelexEOF::ReadPLexemelexEOF=dos<-lookguard(nulls)returnEOF-- ----------------------------------------------------------------------------- Single character lexemeslexPunc::ReadPLexemelexPunc=doc<-satisfyisPuncCharreturn(Punc[c])-- | The @special@ character class as defined in the Haskell Report.isPuncChar::Char->BoolisPuncCharc=c`elem`",;()[]{}`"-- ------------------------------------------------------------------------ SymbolslexSymbol::ReadPLexemelexSymbol=dos<-munch1isSymbolCharifs`elem`reserved_opsthenreturn(Puncs)-- Reserved-ops count as punctuationelsereturn(Symbols)wherereserved_ops=["..","::","=","\\","|","<-","->","@","~","=>"]isSymbolChar::Char->BoolisSymbolCharc=not(isPuncCharc)&&casegeneralCategorycofMathSymbol->TrueCurrencySymbol->TrueModifierSymbol->TrueOtherSymbol->TrueDashPunctuation->TrueOtherPunctuation->not(c`elem`"'\"")ConnectorPunctuation->c/='_'_->False-- ------------------------------------------------------------------------ identifierslexId::ReadPLexemelexId=doc<-satisfyisIdsChars<-munchisIdfCharreturn(Ident(c:s))where-- Identifiers can start with a '_'isIdsCharc=isAlphac||c=='_'isIdfCharc=isAlphaNumc||c`elem`"_'"-- ----------------------------------------------------------------------------- Lexing character literalslexLitChar::ReadPLexemelexLitChar=do_<-char'\''(c,esc)<-lexCharEguard(esc||c/='\'')-- Eliminate '' possibility_<-char'\''return(Charc)lexChar::ReadPCharlexChar=do{(c,_)<-lexCharE;consumeEmpties;returnc}where-- Consumes the string "\&" repeatedly and greedily (will only produce one match)consumeEmpties::ReadP()consumeEmpties=dorest<-lookcaserestof('\\':'&':_)->string"\\&">>consumeEmpties_->return()lexCharE::ReadP(Char,Bool)-- "escaped or not"?lexCharE=doc1<-getifc1=='\\'thendoc2<-lexEsc;return(c2,True)elsedoreturn(c1,False)wherelexEsc=lexEscChar+++lexNumeric+++lexCntrlChar+++lexAsciilexEscChar=doc<-getcasecof'a'->return'\a''b'->return'\b''f'->return'\f''n'->return'\n''r'->return'\r''t'->return'\t''v'->return'\v''\\'->return'\\''\"'->return'\"''\''->return'\''_->pfaillexNumeric=dobase<-lexBaseChar<++return10n<-lexIntegerbaseguard(n<=toInteger(ordmaxBound))return(chr(fromIntegern))lexCntrlChar=do_<-char'^'c<-getcasecof'@'->return'\^@''A'->return'\^A''B'->return'\^B''C'->return'\^C''D'->return'\^D''E'->return'\^E''F'->return'\^F''G'->return'\^G''H'->return'\^H''I'->return'\^I''J'->return'\^J''K'->return'\^K''L'->return'\^L''M'->return'\^M''N'->return'\^N''O'->return'\^O''P'->return'\^P''Q'->return'\^Q''R'->return'\^R''S'->return'\^S''T'->return'\^T''U'->return'\^U''V'->return'\^V''W'->return'\^W''X'->return'\^X''Y'->return'\^Y''Z'->return'\^Z''['->return'\^[''\\'->return'\^\'']'->return'\^]''^'->return'\^^''_'->return'\^_'_->pfaillexAscii=dochoice[(string"SOH">>return'\SOH')<++(string"SO">>return'\SO')-- \SO and \SOH need maximal-munch treatment-- See the Haskell report Sect 2.6,string"NUL">>return'\NUL',string"STX">>return'\STX',string"ETX">>return'\ETX',string"EOT">>return'\EOT',string"ENQ">>return'\ENQ',string"ACK">>return'\ACK',string"BEL">>return'\BEL',string"BS">>return'\BS',string"HT">>return'\HT',string"LF">>return'\LF',string"VT">>return'\VT',string"FF">>return'\FF',string"CR">>return'\CR',string"SI">>return'\SI',string"DLE">>return'\DLE',string"DC1">>return'\DC1',string"DC2">>return'\DC2',string"DC3">>return'\DC3',string"DC4">>return'\DC4',string"NAK">>return'\NAK',string"SYN">>return'\SYN',string"ETB">>return'\ETB',string"CAN">>return'\CAN',string"EM">>return'\EM',string"SUB">>return'\SUB',string"ESC">>return'\ESC',string"FS">>return'\FS',string"GS">>return'\GS',string"RS">>return'\RS',string"US">>return'\US',string"SP">>return'\SP',string"DEL">>return'\DEL']-- ----------------------------------------------------------------------------- string literallexString::ReadPLexemelexString=do_<-char'"'bodyidwherebodyf=do(c,esc)<-lexStrItemifc/='"'||escthenbody(f.(c:))elselets=f""inreturn(Strings)lexStrItem=(lexEmpty>>lexStrItem)+++lexCharElexEmpty=do_<-char'\\'c<-getcasecof'&'->doreturn()_|isSpacec->doskipSpaces;_<-char'\\';return()_->dopfail-- -----------------------------------------------------------------------------  Lexing numberstypeBase=InttypeDigits=[Int]lexNumber::ReadPLexemelexNumber=lexHexOct<++-- First try for hex or octal 0x, 0o etc-- If that fails, try for a decimal numberlexDecNumber-- Start with ordinary digitslexHexOct::ReadPLexemelexHexOct=do_<-char'0'base<-lexBaseChardigits<-lexDigitsbasereturn(Number(MkNumberbasedigits))lexBaseChar::ReadPInt-- Lex a single character indicating the base; fail if not therelexBaseChar=do{c<-get;casecof'o'->return8'O'->return8'x'->return16'X'->return16_->pfail}lexDecNumber::ReadPLexemelexDecNumber=doxs<-lexDigits10mFrac<-lexFrac<++returnNothingmExp<-lexExp<++returnNothingreturn(Number(MkDecimalxsmFracmExp))lexFrac::ReadP(MaybeDigits)-- Read the fractional part; fail if it doesn't-- start ".d" where d is a digitlexFrac=do_<-char'.'fraction<-lexDigits10return(Justfraction)lexExp::ReadP(MaybeInteger)lexExp=do_<-char'e'+++char'E'exp<-signedExp+++lexInteger10return(Justexp)wheresignedExp=doc<-char'-'+++char'+'n<-lexInteger10return(ifc=='-'then-nelsen)lexDigits::Int->ReadPDigits-- Lex a non-empty sequence of digits in specified baselexDigitsbase=dos<-lookxs<-scansidguard(not(nullxs))returnxswherescan(c:cs)f=casevalDigbasecofJustn->do_<-get;scancs(f.(n:))Nothing->doreturn(f[])scan[]f=doreturn(f[])lexInteger::Base->ReadPIntegerlexIntegerbase=doxs<-lexDigitsbasereturn(val(fromIntegralbase)xs)val::Numa=>a->Digits->aval=valSimple{-# RULES"val/Integer"val=valInteger#-}{-# INLINE[1]val#-}-- The following algorithm is only linear for types whose Num operations-- are in constant time.valSimple::(Numa,Integrald)=>a->[d]->avalSimplebase=go0wheregor[]=rgor(d:ds)=r'`seq`gor'dswherer'=r*base+fromIntegrald{-# INLINEvalSimple#-}-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b-- digits are combined into a single radix b^2 digit. This process is-- repeated until we are left with a single digit. This algorithm-- performs well only on large inputs, so we use the simple algorithm-- for smaller inputs.valInteger::Integer->Digits->IntegervalIntegerb0ds0=gob0(lengthds0)$mapfromIntegralds0wherego__[]=0go__[d]=dgoblds|l>40=b'`seq`gob'l'(combinebds')|otherwise=valSimplebdswhere-- ensure that we have an even number of digits-- before we call combine:ds'=ifevenlthendselse0:dsb'=b*bl'=(l+1)`quot`2combineb(d1:d2:ds)=d`seq`(d:combinebds)whered=d1*b+d2combine_[]=[]combine_[_]=errorWithoutStackTrace"this should not happen"-- Calculate a Rational from the exponent [of 10 to multiply with],-- the integral part of the mantissa and the digits of the fractional-- part. Leaving the calculation of the power of 10 until the end,-- when we know the effective exponent, saves multiplications.-- More importantly, this way we need at most one gcd instead of three.---- frac was never used with anything but Integer and base 10, so-- those are hardcoded now (trivial to change if necessary).fracExp::Integer->Integer->Digits->RationalfracExpexpmant[]|exp<0=mant%(10^(-exp))|otherwise=fromInteger(mant*10^exp)fracExpexpmant(d:ds)=exp'`seq`mant'`seq`fracExpexp'mant'dswhereexp'=exp-1mant'=mant*10+fromIntegraldvalDig::(Eqa,Numa)=>a->Char->MaybeIntvalDig8c|'0'<=c&&c<='7'=Just(ordc-ord'0')|otherwise=NothingvalDig10c=valDecDigcvalDig16c|'0'<=c&&c<='9'=Just(ordc-ord'0')|'a'<=c&&c<='f'=Just(ordc-ord'a'+10)|'A'<=c&&c<='F'=Just(ordc-ord'A'+10)|otherwise=NothingvalDig__=errorWithoutStackTrace"valDig: Bad base"valDecDig::Char->MaybeIntvalDecDigc|'0'<=c&&c<='9'=Just(ordc-ord'0')|otherwise=Nothing-- ------------------------------------------------------------------------ other numeric lexing functionsreadIntP::Numa=>a->(Char->Bool)->(Char->Int)->ReadPareadIntPbaseisDigitvalDigit=dos<-munch1isDigitreturn(valbase(mapvalDigits)){-# SPECIALISEreadIntP::Integer->(Char->Bool)->(Char->Int)->ReadPInteger#-}readIntP'::(Eqa,Numa)=>a->ReadPareadIntP'base=readIntPbaseisDigitvalDigitwhereisDigitc=maybeFalse(constTrue)(valDigbasec)valDigitc=maybe0id(valDigbasec){-# SPECIALISEreadIntP'::Integer->ReadPInteger#-}readOctP,readDecP,readHexP::(Eqa,Numa)=>ReadPareadOctP=readIntP'8readDecP=readIntP'10readHexP=readIntP'16{-# SPECIALISEreadOctP::ReadPInteger#-}{-# SPECIALISEreadDecP::ReadPInteger#-}{-# SPECIALISEreadHexP::ReadPInteger#-}