{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-}moduleAgda.Syntax.Parser.Monad(-- * The parser monadParser,ParseResult(..),ParseState(..),ParseError(..),LexState,LayoutContext(..),ParseFlags(..)-- * Running the parser,initState,defaultParseFlags,parse,parsePosString,parseFile-- * Manipulating the state,setParsePos,setLastPos,getParseInterval,setPrevToken,getParseFlags,getLexState,pushLexState,popLexState-- ** Layout,topContext,popContext,pushContext,pushCurrentContext-- ** Errors,parseError,parseErrorAt,lexError)whereimportControl.ExceptionimportData.CharimportData.IntimportData.TypeableimportControl.Monad.StateimportControl.Monad.ErrorimportControl.ApplicativeimportAgda.Syntax.PositionimportAgda.Utils.FileNameimportqualifiedAgda.Utils.IO.UTF8asUTF8importAgda.Utils.Monad{--------------------------------------------------------------------------
The parse monad
--------------------------------------------------------------------------}-- | The parse monad. Equivalent to @StateT 'ParseState' (Either 'ParseError')@-- except for the definition of @fail@, which builds a suitable 'ParseError'-- object.newtypeParsera=P{unP::ParseState->ParseResulta}-- | The parser state. Contains everything the parser and the lexer could ever-- need.dataParseState=PState{parsePos::!Position-- ^ position at current input location,parseLastPos::!Position-- ^ position of last token,parseInp::String-- ^ the current input,parsePrevChar::!Char-- ^ the character before the input,parsePrevToken::String-- ^ the previous token,parseLayout::[LayoutContext]-- ^ the stack of layout contexts,parseLexState::[LexState]-- ^ the state of the lexer-- (states can be nested so we need a stack),parseFlags::ParseFlags-- ^ currently there are no flags}derivingShow{-| To do context sensitive lexing alex provides what is called /start codes/
in the Alex documentation. It is really an integer representing the state
of the lexer, so we call it @LexState@ instead.
-}typeLexState=Int-- | We need to keep track of the context to do layout. The context-- specifies the indentation (if any) of a layout block. See-- "Agda.Syntax.Parser.Layout" for more informaton.dataLayoutContext=NoLayout-- ^ no layout|LayoutInt32-- ^ layout at specified columnderivingShow-- | There aren't any parser flags at the moment.dataParseFlags=ParseFlags{parseKeepComments::Bool-- ^ Should comment tokens be returned by the lexer?}derivingShow-- | What you get if parsing fails.dataParseError=ParseError{errPos::Position-- ^ where the error occured,errInput::String-- ^ the remaining input,errPrevToken::String-- ^ the previous token,errMsg::String-- ^ hopefully an explanation-- of what happened}deriving(Typeable)instanceExceptionParseError-- | The result of parsing something.dataParseResulta=ParseOkParseStatea|ParseFailedParseError{--------------------------------------------------------------------------
Instances
--------------------------------------------------------------------------}instanceMonadParserwherereturnx=P$\s->ParseOksxPm>>=f=P$\s->casemsofParseFailede->ParseFailedeParseOks'x->unP(fx)s'failmsg=P$\s->ParseFailed$ParseError{errPos=parseLastPoss,errInput=parseInps,errPrevToken=parsePrevTokens,errMsg=msg}instanceFunctorParserwherefmap=liftMinstanceApplicativeParserwherepure=return(<*>)=apinstanceMonadErrorParseErrorParserwherethrowErrore=P$\_->ParseFailedePm`catchError`h=P$\s->casemsofParseFailederr->unP(herr)sm'->m'instanceMonadStateParseStateParserwhereget=P$\s->ParseOkssputs=P$\_->ParseOks()instanceShowParseErrorwhereshowerr=unlines[pos++": "++errMsgerr--, replicate (length pos + 2) ' ' ++ "on '" ++ errPrevToken err ++ "'",errPrevTokenerr++"<ERROR>\n"++take30(errInputerr)++"..."]wherepos=show(errPoserr)-- showInp "" = "at end of file"-- showInp t = "on input " ++ elide 5 t---- elide 3 s-- | length (take 4 s) < 4 = s-- | otherwise = "..."-- elide n (c:s) = c : elide (n - 1) s-- elide _ "" = ""instanceHasRangeParseErrorwheregetRangeerr=posToRange(errPoserr)(errPoserr){--------------------------------------------------------------------------
Running the parser
--------------------------------------------------------------------------}initStatePos::Position->ParseFlags->String->[LexState]->ParseStateinitStatePosposflagsinpst=PState{parsePos=pos,parseLastPos=pos,parseInp=inp,parsePrevChar='\n',parsePrevToken="",parseLexState=st,parseLayout=[NoLayout],parseFlags=flags}-- | Constructs the initial state of the parser. The string argument-- is the input string, the file path is only there because it's part-- of a position.initState::MaybeAbsolutePath->ParseFlags->String->[LexState]->ParseStateinitStatefile=initStatePos(startPosfile)-- | The default flags.defaultParseFlags::ParseFlagsdefaultParseFlags=ParseFlags{parseKeepComments=False}-- | The most general way of parsing a string. The "Agda.Syntax.Parser" will define-- more specialised functions that supply the 'ParseFlags' and the-- 'LexState'.parse::ParseFlags->[LexState]->Parsera->String->ParseResultaparseflagsstpinput=unPp(initStateNothingflagsinputst)-- | The even more general way of parsing a string.parsePosString::Position->ParseFlags->[LexState]->Parsera->String->ParseResultaparsePosStringposflagsstpinput=unPp(initStatePosposflagsinputst)-- | The most general way of parsing a file. The "Agda.Syntax.Parser" will define-- more specialised functions that supply the 'ParseFlags' and the-- 'LexState'.---- Note that Agda source files always use the UTF-8 character-- encoding.parseFile::ParseFlags->[LexState]->Parsera->AbsolutePath->IO(ParseResulta)parseFileflagsstpfile=doinput<-liftIO$UTF8.readTextFile$filePathfilereturn$unPp(initState(Justfile)flagsinputst){--------------------------------------------------------------------------
Manipulating the state
--------------------------------------------------------------------------}setParsePos::Position->Parser()setParsePosp=modify$\s->s{parsePos=p}setLastPos::Position->Parser()setLastPosp=modify$\s->s{parseLastPos=p}setPrevToken::String->Parser()setPrevTokent=modify$\s->s{parsePrevToken=t}getLastPos::ParserPositiongetLastPos=get>>=return.parseLastPos-- | The parse interval is between the last position and the current position.getParseInterval::ParserIntervalgetParseInterval=dos<-getreturn$Interval(parseLastPoss)(parsePoss)getLexState::Parser[LexState]getLexState=parseLexState<$>getsetLexState::[LexState]->Parser()setLexStatels=dos<-getput$s{parseLexState=ls}pushLexState::LexState->Parser()pushLexStatel=dos<-getLexStatesetLexState(l:s)popLexState::Parser()popLexState=do_:ls<-getLexStatesetLexStatelsgetParseFlags::ParserParseFlagsgetParseFlags=parseFlags<$>get-- | @parseError = fail@parseError::String->ParseraparseError=fail-- | Fake a parse error at the specified position. Used, for instance, when-- lexing nested comments, which when failing will always fail at the end-- of the file. A more informative position is the beginning of the failing-- comment.parseErrorAt::Position->String->ParseraparseErrorAtpmsg=dosetLastPospparseErrormsg-- | For lexical errors we want to report the current position as the site of-- the error, whereas for parse errors the previous position is the one-- we're interested in (since this will be the position of the token we just-- lexed). This function does 'parseErrorAt' the current position.lexError::String->ParseralexErrormsg=dop<-parsePos<$>getparseErrorAtpmsg{--------------------------------------------------------------------------
Layout
--------------------------------------------------------------------------}getContext::Parser[LayoutContext]getContext=parseLayout<$>getsetContext::[LayoutContext]->Parser()setContextctx=dos<-getput$s{parseLayout=ctx}-- | Return the current layout context.topContext::ParserLayoutContexttopContext=doctx<-getContextcasectxof[]->parseError"No layout context in scope"l:_->returnlpopContext::Parser()popContext=doctx<-getContextcasectxof[]->parseError"There is no layout block to close at this point."_:ctx->setContextctxpushContext::LayoutContext->Parser()pushContextl=doctx<-getContextsetContext(l:ctx)-- | Should only be used at the beginning of a file. When we start parsing-- we should be in layout mode. Instead of forcing zero indentation we use-- the indentation of the first token.pushCurrentContext::Parser()pushCurrentContext=dop<-getLastPospushContext(Layout(posColp))