-- Copyright (c) 2006-2011-- The President and Fellows of Harvard College.---- Redistribution and use in source and binary forms, with or without-- modification, are permitted provided that the following conditions-- are met:-- 1. Redistributions of source code must retain the above copyright-- notice, this list of conditions and the following disclaimer.-- 2. Redistributions in binary form must reproduce the above copyright-- notice, this list of conditions and the following disclaimer in the-- documentation and/or other materials provided with the distribution.-- 3. Neither the name of the University nor the names of its contributors-- may be used to endorse or promote products derived from this software-- without specific prior written permission.---- THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-- ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-- OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF-- SUCH DAMAGE.---------------------------------------------------------------------------------- |-- Module : Language.C.Parser.Monad-- Copyright : (c) Harvard University 2006-2011-- License : BSD-style-- Maintainer : mainland@eecs.harvard.edu----------------------------------------------------------------------------------{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE MultiParamTypeClasses #-}moduleLanguage.C.Parser.Monad(P,runP,evalP,PState,emptyPState,getInput,setInput,pushLexState,popLexState,getLexState,getCurToken,setCurToken,addTypedef,addVariable,isTypedef,pushScope,popScope,gccExts,cudaExts,openCLExts,useExts,antiquotationExts,useGccExts,useCUDAExts,useOpenCLExts,LexerException(..),ParserException(..),failAt,lexerError,unexpectedEOF,emptyCharacterLiteral,illegalCharacterLiteral,illegalNumericalLiteral,parserError,unclosed,expected,AlexInput(..),alexGetChar,alexGetByte,alexInputPrevChar,nextChar,peekChar,maybePeekChar,skipChar,AlexPredicate,allowAnti,ifExtension)whereimportControl.Applicative(Applicative(..))importControl.Monad.ExceptionimportControl.Monad.IdentityimportControl.Monad.StateimportData.BitsimportqualifiedData.ByteString.Char8asBimportData.ByteString.Internal(c2w)importData.List(foldl')importData.LocimportqualifiedData.SetasSetimportData.Typeable(Typeable)importData.WordimportText.PrettyPrint.MainlandimportLanguage.C.Parser.TokensimportLanguage.C.SyntaxdataPState=PState{inp::!AlexInput,curToken::LToken,lexState::![Int],extensions::!ExtensionsInt,typedefs::!(Set.SetString),scopes::[Set.SetString]}emptyPState::[Extensions]->[String]->B.ByteString->Pos->PStateemptyPStateextstypnamesbufpos=PState{inp=inp,curToken=error"no token",lexState=[0],extensions=foldl'setBit0(mapfromEnumexts),typedefs=Set.fromListtypnames,scopes=[]}whereinp::AlexInputinp=AlexInput{alexPos=pos,alexPrevChar='\n',alexInp=buf,alexOff=0}newtypePa=P{runP::PState->EitherSomeException(a,PState)}instanceFunctorPwherefmapfx=x>>=return.finstanceApplicativePwherepure=return(<*>)=apinstanceMonadPwherem>>=k=P$\s->caserunPmsofLefte->LefteRight(a,s')->runP(ka)s'm1>>m2=P$\s->caserunPm1sofLefte->LefteRight(_,s')->runPm2s'returna=P$\s->Right(a,s)failmsg=doinp<-getInputthrow(ParserException(Loc(alexPosinp)(alexPosinp))(ppr(alexPosinp)))instanceMonadStatePStatePwhereget=P$\s->Right(s,s)puts=P$\_->Right((),s)instanceMonadExceptionPwherethrowe=P$\_->Left(toExceptione)m`catch`h=P$\s->caserunPmsofLefte->casefromExceptioneofJuste'->runP(he')sNothing->LefteRight(a,s')->Right(a,s')evalP::Pa->PState->EitherSomeExceptionaevalPcompst=caserunPcompstofLefte->LefteRight(a,_)->RightagetInput::PAlexInputgetInput=getsinpsetInput::AlexInput->P()setInputinp=modify$\s->s{inp=inp}pushLexState::Int->P()pushLexStatels=modify$\s->s{lexState=ls:lexStates}popLexState::PIntpopLexState=dols<-getLexStatemodify$\s->s{lexState=tail(lexStates)}returnlsgetLexState::PIntgetLexState=gets(head.lexState)getCurToken::P(LToken)getCurToken=getscurTokensetCurToken::LToken->P()setCurTokentok=modify$\s->s{curToken=tok}addTypedef::String->P()addTypedefid=modify$\s->s{typedefs=Set.insertid(typedefss)}addVariable::String->P()addVariableid=modify$\s->s{typedefs=Set.deleteid(typedefss)}isTypedef::String->PBoolisTypedefid=gets$\s->Set.memberid(typedefss)pushScope::P()pushScope=modify$\s->s{scopes=typedefss:scopess}popScope::P()popScope=modify$\s->s{scopes=(tail.scopes)s,typedefs=(head.scopes)s}antiquotationExts::ExtensionsIntantiquotationExts=(bit.fromEnum)AntiquotationgccExts::ExtensionsIntgccExts=(bit.fromEnum)GcccudaExts::ExtensionsIntcudaExts=(bit.fromEnum)CUDAopenCLExts::ExtensionsIntopenCLExts=(bit.fromEnum)OpenCLuseExts::ExtensionsInt->PBooluseExtsext=gets$\s->extensionss.&.ext/=0useGccExts::PBooluseGccExts=useExtsgccExtsuseCUDAExts::PBooluseCUDAExts=useExtscudaExtsuseOpenCLExts::PBooluseOpenCLExts=useExtsopenCLExtsdataLexerException=LexerExceptionPosDocderiving(Typeable)instanceExceptionLexerExceptionwhereinstanceShowLexerExceptionwhereshow(LexerExceptionposmsg)=show$nest4$pprpos<>text":"</>msgdataParserException=ParserExceptionLocDocderiving(Typeable)instanceExceptionParserExceptionwhereinstanceShowParserExceptionwhereshow(ParserExceptionlocmsg)=show$nest4$pprloc<>text":"</>msgfailAt::Loc->String->PafailAtlocmsg=throw$ParserExceptionloc(textmsg)lexerError::AlexInput->Doc->PalexerErrorinps=throw$LexerException(alexPosinp)(text"lexer error on"<+>squotess)unexpectedEOF::AlexInput->PaunexpectedEOFinp=lexerErrorinp(text"unexpected end of file")emptyCharacterLiteral::AlexInput->PaemptyCharacterLiteralinp=lexerErrorinp(text"empty character literal")illegalCharacterLiteral::AlexInput->PaillegalCharacterLiteralinp=lexerErrorinp(text"illegal character literal")illegalNumericalLiteral::AlexInput->PaillegalNumericalLiteralinp=lexerErrorinp(text"illegal numerical literal")parserError::Loc->Doc->PaparserErrorlocmsg=throw$ParserExceptionlocmsgunclosed::Loc->String->Paunclosedlocx=parserError(locEndloc)(text"unclosed"<+>squotes(textx))expected::[String]->Pbexpectedalts=dotok@(Lloc_)<-getCurTokenparserError(locStartloc)(text"expected"<+>pprAltsalts<+>pprGottok)wherepprAlts::[String]->DocpprAlts[]=emptypprAlts[s]=textspprAlts[s1,s2]=texts1<+>text"or"<+>texts2pprAlts(s:ss)=texts<>comma<+>pprAltssspprGot::LToken->DocpprGot(L_Teof)=text"but reached end of file"pprGot(L_t)=text"but got"<+>text(showt)dataAlexInput=AlexInput{alexPos::{-#UNPACK#-}!Pos,alexPrevChar::{-#UNPACK#-}!Char,alexInp::{-#UNPACK#-}!B.ByteString,alexOff::{-#UNPACK#-}!Int}alexGetChar::AlexInput->Maybe(Char,AlexInput)alexGetCharinp=caseB.uncons(alexInpinp)ofNothing->NothingJust(c,bs)->Just(c,inp{alexPos=advancePos(alexPosinp)c,alexPrevChar=c,alexInp=bs,alexOff=alexOffinp+1})alexGetByte::AlexInput->Maybe(Word8,AlexInput)alexGetByteinp=casealexGetCharinpofNothing->NothingJust(c,inp')->Just(c2wc,inp')alexInputPrevChar::AlexInput->CharalexInputPrevChar=alexPrevCharnextChar::PCharnextChar=doinp<-getInputcasealexGetCharinpofNothing->unexpectedEOFinpJust(c,inp')->setInputinp'>>returncpeekChar::PCharpeekChar=doinp<-getInputcaseB.uncons(alexInpinp)ofNothing->unexpectedEOFinpJust(c,_)->returncmaybePeekChar::P(MaybeChar)maybePeekChar=doinp<-getInputcasealexGetCharinpofNothing->returnNothingJust(c,_)->return(Justc)skipChar::P()skipChar=doinp<-getInputcasealexGetCharinpofNothing->unexpectedEOFinpJust(_,inp')->setInputinp'-- | The components of an 'AlexPredicate' are the predicate state, input stream-- before the token, length of the token, input stream after the token.typeAlexPredicate=PState->AlexInput->Int->AlexInput->BoolallowAnti::AlexPredicateallowAnti=ifExtensionantiquotationExtsifExtension::ExtensionsInt->AlexPredicateifExtensionis___=extensionss.&.i/=0