0#_      !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ portable provisionalderek.a.elkins@gmail.com Safe-Infered The abstract data type  SourcePos! represents source positions. It E contains the name of the source (i.e. file name), a line number and  a column number.  SourcePos is an instance of the ,  and   class.  Create a new  with the given source name,  line number and column number.  Create a new  with the given source name, = and line number and column number set to 1, the upper left. 9Extracts the name of the source from a source position. 2Extracts the line number from a source position. 4Extracts the column number from a source position. 2Increments the line number of a source position. 4Increments the column number of a source position. Set the name of the source. +Set the line number of a source position. -Set the column number of a source position. The expression updatePosString pos s updates the source position  pos by calling  on every character in s, ie.  foldl updatePosChar pos string. BUpdate a source position given a character. If the character is a  newline ('\n') or carriage return ('\r') the line number is . incremented by 1. If the character is a tab ('t' ) the column ' number is incremented to the nearest 8'th column, ie.  column + 8 -  ((column-1) `mod` 8)$. In all other cases, the column is  incremented by 1.     portable provisionalderek.a.elkins@gmail.com Safe-InferedThe abstract data type  ParseError represents parse errors. It  provides the source position () of the error  and a list of error messages (). A  ParseError ! can be returned by the function .  ParseError is an  instance of the  class. CThis abstract data type represents parse error messages. There are  four kinds of messages:  $ data Message = SysUnExpect String ! | UnExpect String  | Expect String  | Message String DThe fine distinction between different kinds of parse errors allows C the system to generate quite good error messages for the user. It < also allows error messages that are formatted in different H languages. Each kind of message is generated by different combinators:  A + message is automatically generated by the  ! combinator. The argument is the  unexpected input.  A  message is generated by the  . combinator. The argument describes the  unexpected item.  A  message is generated by the  = combinator. The argument describes the expected item.  A  message is generated by the  A combinator. The argument is some general parser message. 2Extract the message string from an error message 2Extracts the source position from the parse error 9Extracts the list of error messages from the parse error     portable provisionalderek.a.elkins@gmail.com Safe-Infered!" !"!" !"portable provisionalderek.a.elkins@gmail.com Safe-Infered  portable provisionalderek.a.elkins@gmail.com Safe-Infered#An instance of Stream has stream type s, underlying monad m and token type t determined by the stream Some rough guidelines for a "correct" instance of Stream:  unfoldM uncons gives the [t] corresponding to the stream  A Stream- instance is responsible for maintaining the "position within the stream" in the stream state sH. This is trivial unless you are using the monad in a non-trivial way. 1*ParserT monad transformer and Parser type ParsecT s u m a is a parser with stream type s, user state type u,  underlying monad m and return type a'. Parsec is strict in the user state. 6 If this is undesirable, simply used a data type like data Box a = Box a and  the state type Box YourStateType to add a level of indirection. 4 The parser unexpected msg' always fails with an unexpected error  message msg without consuming any input.  The parsers , (>) and  unexpected are the three parsers 2 used to generate error messages. Of these, only (>) is commonly $ used. For an example of the use of  unexpected, see the definition  of . 5LLow-level unpacking of the ParsecT type. To run your parser, please look to > runPT, runP, runParserT, runParser and other such functions. 6:Low-level creation of the ParsecT type. You really shouldn't have to do this. < parserZero+ always fails without consuming any input.  parserZero is defined  equal to the  member of the  class and to the  member  of the  class. > The parser p  ? msg behaves as parser p, but whenever the  parser p fails without consuming any input, it replaces expect . error messages with the expect error message msg. EThis is normally used at the end of a set alternatives where we want A to return an error message in terms of a higher level construct D rather than returning all possible characters. For example, if the  expr parser from the C example would fail, the error  message is: '...: expecting expression'. Without the (<?>) ' combinator, the message would be like '...: expecting "let" or  letter', which is less friendly. ?.This combinator implements choice. The parser p <|> q first  applies p. If it succeeds, the value of p is returned. If p  fails without consuming any input , parser q is tried. This $ combinator is defined equal to the  member of the   class and the ( ) member of . The parser is called  predictive since q is only tried when  parser p didn'1t consume any input (i.e.. the look ahead is 1). > This non-backtracking behaviour allows for both an efficient E implementation of the parser combinators and the generation of good  error messages. C The parser try p behaves like parser p, except that it  pretends that it hasn'+t consumed any input when an error occurs. AThis combinator is used whenever arbitrary look ahead is needed.  Since it pretends that it hasn't consumed any input when p fails,  the (?;) combinator will try its second alternative even when the , first parser failed while consuming input. The try3 combinator can for example be used to distinguish E identifiers and reserved words. Both reserved words and identifiers B are a sequence of letters. Whenever we expect a certain reserved @ word where we can also expect an identifier we have to use the try  combinator. Suppose we write:  8 expr = letExpr <|> identifier <?> "expression"  ( letExpr = do{ string "let"; ... }  identifier = many1 letter If the user writes "lexical", the parser fails with:  unexpected  'x' , expecting 't' in "let". Indeed, since the (? ) combinator 8 only tries alternatives when the first alternative hasn' t consumed  input, the  identifier+ parser is never tried (because the prefix  "le" of the string "let"" parser is already consumed). The / right behaviour can be obtained by adding the try combinator: 8 expr = letExpr <|> identifier <?> "expression"  . letExpr = do{ try (string "let"); ... }  identifier = many1 letter D lookAhead p parses p without consuming any input. If p( fails and consumes some input, so does  lookAhead. Combine with C  if this is undesirable. E The parser  token showTok posFromTok testTok accepts a token t  with result x when the function  testTok t returns  x. The  source position of the t should be returned by  posFromTok t and  the token can be shown using  showTok t. )This combinator is expressed in terms of F. ? It is used to accept user defined token streams. For example, B suppose that we have a stream of basic tokens tupled with source G positions. We can than define a parser that accepts single tokens as:  mytoken x ' = token showTok posFromTok testTok  where # showTok (pos,t) = show t  posFromTok (pos,t) = pos ? testTok (pos,t) = if x == t then Just t else Nothing F The parser !tokenPrim showTok nextPos testTok accepts a token t  with result x when the function  testTok t returns  x. The  token can be shown using  showTok t. The position of the next  token should be returned when nextPos is called with the current  source position pos, the current token t and the rest of the  tokens toks, nextPos pos t toks. @This is the most primitive combinator for accepting tokens. For  example, the ! parser could be implemented as:  char c * = tokenPrim showChar nextPos testChar  where * showChar x = "'" ++ x ++ "'" = testChar x = if x == c then Just x else Nothing . nextPos pos x xs = updatePosChar pos x Hmany p applies the parser p zero or more times. Returns a # list of the returned values of p. ! identifier = do{ c <- letter 7 ; cs <- many (alphaNum <|> char '_') " ; return (c:cs)  } I skipMany p applies the parser p zero or more times, skipping  its result.  spaces = skipMany space M&The most general way to run a parser. runParserT p state filePath  input runs parser p on the input list of tokens input,  obtained from source filePath with the initial user state st.  The filePath5 is only used in error messages and may be the empty 7 string. Returns a computation in the underlying monad m that return either a  () or a  value of type a (). N>The most general way to run a parser over the Identity monad. runParser p state filePath  input runs parser p on the input list of tokens input,  obtained from source filePath with the initial user state st.  The filePath5 is only used in error messages and may be the empty  string. Returns either a  () or a  value of type a ().  parseFromFile p fname " = do{ input <- readFile fname . ; return (runParser p () fname input)  } Oparse p filePath input runs a parser p over Identity without user  state. The filePath/ is only used in error messages and may be the  empty string. Returns either a  ()  or a value of type a (). 3 main = case (parse numbers "" "11, 2, 43") of $ Left err -> print err ) Right xs -> print (sum xs)   numbers = commaSep integer PThe expression parseTest p input applies a parser p against  input input3 and prints the result to stdout. Used for testing  parsers. Q.Returns the current source position. See also . RReturns the current input SsetPosition pos% sets the current source position to pos. TsetInput input continues parsing with input. The R and  setInput0 functions can for example be used to deal with #include  files. U#Returns the full parser state as a % record. VsetParserState st set the full parser state to st. WupdateParserState f applies function f to the parser state. X!Returns the current user state. Y putState st set the user state to st. Z updateState f applies function f to the user state. Suppose F that we want to count identifiers in a source, we could use the user  state as:  expr = do{ x <- identifier  ; updateState (+1)  ; return (Id x)  } [3An alias for putState for backwards compatibility. \6An alias for modifyState for backwards compatibility. G#$%&'()*+,-./0123456789:;<=>?@ABCDE Token pretty-printing function. "Computes the position of a token. *Matching function for the token to parse. F Token pretty-printing function. $Next position calculating function. *Matching function for the token to parse. GHIJKLMNOPQRSTUVWXYZ[\:#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\:2341560-/.*,+%&'()789:;<=>?@AD#$BCEFGHIJKLMNOPQRSTUVWXYZ[\>#$%&'()*,+-/.0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\portable provisionalderek.a.elkins@gmail.com Safe-Infered]oneOf cs6 succeeds if the current character is in the supplied  list of characters cs). Returns the parsed character. See also  l.  vowel = oneOf "aeiou" ^As the dual of ],  noneOf cs succeeds if the current  character not$ in the supplied list of characters cs. Returns the  parsed character.  consonant = noneOf "aeiou" _Skips zero* or more white space characters. See also I. `>Parses a white space character (any character which satisfies )  Returns the parsed character. aParses a newline character ('\n'!). Returns a newline character. bParses a tab character ('\t'). Returns a tab character. c1Parses an upper case letter (a character between 'A' and 'Z').  Returns the parsed character. d3Parses a lower case character (a character between 'a' and 'z').  Returns the parsed character. e.Parses a letter or digit (a character between '0' and '9').  Returns the parsed character. fEParses a letter (an upper case or lower case character). Returns the  parsed character. g/Parses a digit. Returns the parsed character. h8Parses a hexadecimal digit (a digit or a letter between 'a' and  'f' or 'A' and 'F'"). Returns the parsed character. i+Parses an octal digit (a character between '0' and '7' ). Returns  the parsed character. jchar c parses a single character c. Returns the parsed  character (i.e. c).  semiColon = char ';' kGThis parser succeeds for any character. Returns the parsed character. l The parser  satisfy f* succeeds for any character for which the  supplied function f returns  . Returns the character that is  actually parsed. mstring s* parses a sequence of characters given by s . Returns  the parsed string (i.e. s).  divOrMod = string "div"  <|> string "mod" ]^_`abcdefghijklm]^_`abcdefghijklm]^_`abcdefghijklm]^_`abcdefghijklmportable provisionalderek.a.elkins@gmail.com Safe-Inferedn choice ps( tries to apply the parsers in the list ps in order, A until one of them succeeds. Returns the value of the succeeding  parser. o option x p tries to apply parser p. If p fails without ' consuming input, it returns the value x, otherwise the value  returned by p. ' priority = option 0 (do{ d <- digit 3 ; return (digitToInt d)  }) p optionMaybe p tries to apply parser p. If p fails without  consuming input, it return , otherwise it returns   the value returned by p. q optional p tries to apply parser p. It will parse p or nothing.  It only fails if p5 fails after consuming input. It discards the result  of p. rbetween open close p parses open, followed by p and close.  Returns the value returned by p. . braces = between (symbol "{") (symbol "}") s skipMany1 p applies the parser p one or more times, skipping  its result. tmany1 p applies the parser p one or more times. Returns a  list of the returned values of p.  word = many1 letter u sepBy p sep parses zero or more occurrences of p , separated  by sep'. Returns a list of values returned by p. ' commaSep p = p `sepBy` (symbol ",") v sepBy1 p sep parses one or more occurrences of p , separated  by sep'. Returns a list of values returned by p. wsepEndBy1 p sep parses one or more occurrences of p, # separated and optionally ended by sep. Returns a list of values  returned by p. xsepEndBy p sep parses zero or more occurrences of p, # separated and optionally ended by sep, ie. haskell style 2 statements. Returns a list of values returned by p. 8 haskellStatements = haskellStatement `sepEndBy` semi y endBy1 p sep parses one or more occurrences of p , seperated  and ended by sep'. Returns a list of values returned by p. z endBy p sep parses zero or more occurrences of p , seperated  and ended by sep'. Returns a list of values returned by p. * cStatements = cStatement `endBy` semi { count n p parses n occurrences of p. If n is smaller or % equal to zero, the parser equals to return []. Returns a list of  n values returned by p. | chainr p op x parser zero or more occurrences of p,  separated by op Returns a value obtained by a right associative * application of all functions returned by op to the values returned  by p!. If there are no occurrences of p , the value x is  returned. } chainl p op x parser zero or more occurrences of p,  separated by op . Returns a value obtained by a left associative * application of all functions returned by op to the values returned  by p#. If there are zero occurrences of p , the value x is  returned. ~chainl1 p op x parser one or more occurrences of p,  separated by op Returns a value obtained by a left associative * application of all functions returned by op to the values returned  by p:. . This parser can for example be used to eliminate left : recursion which typically occurs in expression grammars. # expr = term `chainl1` addop # term = factor `chainl1` mulop $ factor = parens expr <|> integer  - mulop = do{ symbol "*"; return (*) } - <|> do{ symbol "/"; return (div) }  + addop = do{ symbol "+"; return (+) } + <|> do{ symbol "-"; return (-) } chainr1 p op x parser one or more occurrences of |p|,  separated by op Returns a value obtained by a right associative * application of all functions returned by op to the values returned  by p.  The parser anyToken. accepts any kind of token. It is for example  used to implement . Returns the accepted token. AThis parser only succeeds at the end of the input. This is not a * primitive parser but it is defined using . 3 eof = notFollowedBy anyToken <?> "end of input" notFollowedBy p only succeeds when parser p fails. This parser F does not consume any input. This parser can be used to implement the  ' longest match'3 rule. For example, when recognizing keywords (for  example let7), we want to make sure that a keyword is not followed ? by a legal identifier character, in which case the keyword is % actually an identifier (for example lets). We can program this  behaviour as follows: & keywordLet = try (do{ string "let" 0 ; notFollowedBy alphaNum  }) manyTill p end applies parser p zero or more times until  parser end2 succeeds. Returns the list of values returned by p. + This parser can be used to scan comments:  & simpleComment = do{ string "<!--" > ; manyTill anyChar (try (string "-->"))  } Note the overlapping parsers anyChar and string "-->", and  therefore the use of the C combinator. nopqrstuvwxyz{|}~Dnopqrstuvwxyz{|}~n{ropqstuvzyxw}~|Dnopqrstuvwxyz{|}~portable provisionalderek.a.elkins@gmail.com Safe-InferedDnopqrstuvwxyz{|}~n{ropqstuvzyxw}~|Dportable provisionalderek.a.elkins@gmail.com Safe-InferedparseFromFile p filePath runs a string parser p on the  input read from filePath using . Returns either a   () or a value of type a (). = main = do{ result <- parseFromFile numbers "digits.txt"  ; case result of ) Left err -> print err . Right xs -> print (sum xs)  } portable provisionalderek.a.elkins@gmail.com Safe-Infered]^_`abcdefghijklm_`abcdefghijmk]^l portable provisionalderek.a.elkins@gmail.com Safe-InferedparseFromFile p filePath! runs a strict bytestring parser p on the  input read from filePath using  !. Returns either a   () or a value of type a (). = main = do{ result <- parseFromFile numbers "digits.txt"  ; case result of ) Left err -> print err . Right xs -> print (sum xs)  }  portable provisionalderek.a.elkins@gmail.com Safe-InferedparseFromFile p filePath runs a lazy bytestring parser p on the  input read from filePath using "!. Returns either a   () or a value of type a (). = main = do{ result <- parseFromFile numbers "digits.txt"  ; case result of ) Left err -> print err . Right xs -> print (sum xs)  }  portable provisionalaslatter@gmail.com Safe-Infered portable provisionalaslatter@gmail.com Safe-Infered Inon-portable (uses local universal quantification: PolymorphicComponents) provisionalderek.a.elkins@gmail.com Safe-Infered+?The type of the record that holds lexical parsers that work on  s streams with state u over a monad m. EThis lexeme parser parses a legal identifier. Returns the identifier @ string. This parser will fail on identifiers that are reserved C words. Legal identifier (start) characters and reserved words are  defined in the  that is passed to  . An  identifier is treated as  a single token using C. The lexeme parser  reserved name parses symbol  name, but it also checks that the name is not a prefix of a  valid identifier. A reserved# word is treated as a single token  using C. DThis lexeme parser parses a legal operator. Returns the name of the D operator. This parser will fail on any operators that are reserved E operators. Legal operator (start) characters and reserved operators  are defined in the  that is passed to  . An operator is treated as a  single token using C. The lexeme parser reservedOp name parses symbol  name, but it also checks that the name is not a prefix of a  valid operator. A  reservedOp$ is treated as a single token using  C. BThis lexeme parser parses a single literal character. Returns the C literal character value. This parsers deals correctly with escape E sequences. The literal character is parsed according to the grammar E rules defined in the Haskell report (which matches most programming  languages quite closely). @This lexeme parser parses a literal string. Returns the literal F string value. This parsers deals correctly with escape sequences and C gaps. The literal string is parsed according to the grammar rules ? defined in the Haskell report (which matches most programming  languages quite closely). =This lexeme parser parses a natural number (a positive whole = number). Returns the value of the number. The number can be  specified in ,  or  0. The number is parsed according to the grammar  rules in the Haskell report. CThis lexeme parser parses an integer (a whole number). This parser  is like % except that it can be prefixed with  sign (i.e. '-' or '+'(). Returns the value of the number. The  number can be specified in ,   or !. The number is parsed according . to the grammar rules in the Haskell report. DThis lexeme parser parses a floating point value. Returns the value D of the number. The number is parsed according to the grammar rules ! defined in the Haskell report. !This lexeme parser parses either  or a . : Returns the value of the number. This parsers deals with F any overlap in the grammar rules for naturals and floats. The number J is parsed according to the grammar rules defined in the Haskell report. BParses a positive whole number in the decimal system. Returns the  value of the number. EParses a positive whole number in the hexadecimal system. The number  should be prefixed with "0x" or "0X". Returns the value of the  number. ?Parses a positive whole number in the octal system. The number  should be prefixed with "0o" or "0O". Returns the value of the  number. Lexeme parser symbol s parses m s and skips  trailing white space. lexeme p first applies parser p and than the   parser, returning the value of p. Every lexical ! token (lexeme) is defined using lexeme, this way every parse 9 starts at a point without white space. Parsers that use lexeme are  called lexeme parsers in this document. The only point where the  parser should be D called explicitly is the start of the main parser in order to skip  any leading white space. ! mainParser = do{ whiteSpace 1 ; ds <- many (lexeme digit)  ; eof ' ; return (sum ds)  } 0Parses any white space. White space consists of zero or more  occurrences of a `#, a line comment or a block (multi ? line) comment. Block comments may be nested. How comments are % started and ended is defined in the   that is passed to . Lexeme parser parens p parses p enclosed in parenthesis,  returning the value of p. Lexeme parser braces p parses p enclosed in braces ('{' and  '}'), returning the value of p. Lexeme parser angles p parses p enclosed in angle brackets ('<'  and '>'), returning the value of p. Lexeme parser  brackets p parses p enclosed in brackets ('['  and ']'), returning the value of p. DEPRECATED: Use . *Lexeme parser |semi| parses the character ';' and skips any * trailing white space. Returns the string ";". Lexeme parser comma parses the character ',' and skips any * trailing white space. Returns the string ",". Lexeme parser colon parses the character ':' and skips any * trailing white space. Returns the string ":". Lexeme parser dot parses the character '.' and skips any * trailing white space. Returns the string ".". Lexeme parser  semiSep p parses zero or more occurrences of p  separated by '. Returns a list of values returned by  p. Lexeme parser  semiSep1 p parses one or more occurrences of p  separated by '. Returns a list of values returned by p. Lexeme parser  commaSep p parses zero or more occurrences of  p separated by $. Returns a list of values returned  by p. Lexeme parser  commaSep1 p parses one or more occurrences of  p separated by $. Returns a list of values returned  by p. The GenLanguageDef4 type is a record that contains all parameterizable  features of the #$ module. The module #% $ contains some default definitions. DDescribes the start of a block comment. Use the empty string if the  language doesn'&t support block comments. For example "/*". BDescribes the end of a block comment. Use the empty string if the  language doesn'&t support block comments. For example "*/". CDescribes the start of a line comment. Use the empty string if the  language doesn'%t support line comments. For example "//". Set to 2 if the language supports nested block comments. CThis parser should accept any start characters of identifiers. For  example letter <|> char "_". DThis parser should accept any legal tail characters of identifiers.  For example  alphaNum <|> char "_". AThis parser should accept any start characters of operators. For  example oneOf ":!#$%&*+./<=>?@\\^|-~" BThis parser should accept any legal tail characters of operators. C Note that this parser should even be defined if the language doesn't 2 support user-defined operators, or otherwise the   parser won't work correctly. #The list of reserved identifiers. !The list of reserved operators. Set to % if the language is case sensitive. The expression makeTokenParser language creates a  / record that contains lexical parsers that are & defined using the definitions in the language record. =The use of this function is quite stylized - one imports the E appropiate language definition and selects the lexical parsers that  are needed from the resulting .  module Main where   import Text.Parsec * import qualified Text.Parsec.Token as P + import Text.Parsec.Language (haskellDef)   -- The parser  ...   expr = parens expr  <|> identifier  <|> ...    -- The lexer 1 lexer = P.makeTokenParser haskellDef   parens = P.parens lexer  braces = P.braces lexer # identifier = P.identifier lexer ! reserved = P.reserved lexer  ... /// &portable provisionalderek.a.elkins@gmail.com Safe-Infered// non-portable provisionalderek.a.elkins@gmail.com Safe-InferedAn OperatorTable s u m a is a list of Operator s u m a * lists. The list is ordered in descending E precedence. All operators in one list have the same precedence (but & may have a different associativity). ?This data type specifies operators that work on values of type a. B An operator is either binary infix or unary prefix or postfix. A 7 binary operator has also an associated associativity. EThis data type specifies the associativity of operators: left, right  or none.  buildExpressionParser table term! builds an expression parser for  terms term with operators from table, taking the associativity  and precedence specified in table" into account. Prefix and postfix < operators of the same precedence can only occur once (i.e. --2 is  not allowed if -1 is prefix negate). Prefix and postfix operators 7 of the same precedence associate to the left (i.e. if ++ is  postfix increment, than -2++ equals -1, not -3). The buildExpressionParser" takes care of all the complexity B involved in building expression parser. Here is an example of an D expression parser that handles prefix signs, postfix increment and  basic arithmetic. - expr = buildExpressionParser table term  <?> "expression"   term = parens expr  <|> natural " <?> "simple expression"  2 table = [ [prefix "-" negate, prefix "+" id ] " , [postfix "++" (+1)] F , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ] F , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft ]  ]  K binary name fun assoc = Infix (do{ reservedOp name; return fun }) assoc F prefix name fun = Prefix (do{ reservedOp name; return fun }) G postfix name fun = Postfix (do{ reservedOp name; return fun }) portable provisionalderek.a.elkins@gmail.com Safe-Infered!%&'()4>?@ABEFGHIOPQRSTUVX[\!>?OPEBFG@A4HIX[\QSRT%&'()UV'portable provisionalderek.a.elkins@gmail.com Safe-InferedX %&'()4>?@ABDEFGHIOPQRSTUVX[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ portable provisionalderek.a.elkins@gmail.com Safe-Infered #portable provisionalderek.a.elkins@gmail.com Safe-Inferedo #$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ 9non-portable (uses non-portable module Text.Parsec.Token) provisionalderek.a.elkins@gmail.com Safe-InferedCThis is a minimal token definition for Haskell style languages. It ; defines the style of comments, valid identifiers and case B sensitivity. It does not define any reserved words or operators. @This is a minimal token definition for Java style languages. It ; defines the style of comments, valid identifiers and case B sensitivity. It does not define any reserved words or operators. "A lexer for the haskell language. 2The language definition for the Haskell language. #A lexer for the mondrian language. 3The language definition for the language Mondrian.  (portable provisionalderek.a.elkins@gmail.com Safe-Infered>non-portable (uses existentially quantified data constructors) provisionalderek.a.elkins@gmail.com Safe-Infered The type StreamPermParser s st a$ denotes a permutation parser that,  when converted by the  function, parses  s streams with user state st and returns a value of  type a on success. ENormally, a permutation parser is first build with special operators  like (,) and than transformed into a normal parser  using . @Provided for backwards compatibility. The tok type is ignored. The expression perm <||> p adds parser p to the permutation  parser perm . The parser p( is not allowed to accept empty input -  use the optional combinator () instead. Returns a & new permutation parser that includes p. The expression f <$$> p$ creates a fresh permutation parser  consisting of parser p*. The the final result of the permutation  parser is the function f applied to the return value of p. The  parser p9 is not allowed to accept empty input - use the optional  combinator ( ) instead. If the function f2 takes more than one parameter, the type variable  bA is instantiated to a functional type which combines nicely with  the adds parser p to the () combinator. This C results in stylized code where a permutation parser starts with a  combining function f' followed by the parsers. The function f F gets its parameters in the order in which the parsers are specified, ' but actual input can be in any order. The expression perm < ||> (x,p) adds parser p to the  permutation parser perm . The parser p is optional - if it can # not be applied, the default value x will be used instead. Returns < a new permutation parser that includes the optional parser p. The expression f < $?> (x,p)$ creates a fresh permutation parser  consisting of parser p*. The the final result of the permutation  parser is the function f applied to the return value of p. The  parser p; is optional - if it can not be applied, the default value  x will be used instead.  The parser  permute perm* parses a permutation of parser described  by perm:. For example, suppose we want to parse a permutation of:  an optional string of a's, the character b and an optional c.  This can be described by: 4 test = permute (tuple <$?> ("",many1 (char 'a')) ( <||> char 'b' . <|?> ('_',char 'c'))  where ! tuple a b c = (a,b,c) )portable provisionalderek.a.elkins@gmail.com Safe-Infered*+,-./0123456789:;;<=>?@ABCDEFGHIJKLMNNOPQRSTUVUWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~               rg     !     parsec-3.1.3Text.Parsec.PosText.Parsec.Error#Text.ParserCombinators.Parsec.ErrorText.Parsec.PrimText.Parsec.CharText.Parsec.CombinatorText.Parsec.String"Text.ParserCombinators.Parsec.CharText.Parsec.ByteStringText.Parsec.ByteString.LazyText.Parsec.TextText.Parsec.Text.LazyText.Parsec.TokenText.Parsec.Expr"Text.ParserCombinators.Parsec.Prim"Text.ParserCombinators.Parsec.ExprText.Parsec.LanguageText.Parsec.Permparsesatisfy unexpected!Text.ParserCombinators.Parsec.Pos notFollowedByControl.Applicativeempty Applicative<|> Alternativechar(Text.ParserCombinators.Parsec.CombinatorByteString.Char8readFileByteString.Lazy.Char8 Text.ParsecTokenLanguage#Text.ParserCombinators.Parsec.TokenText.ParserCombinators.Parsec&Text.ParserCombinators.Parsec.Language"Text.ParserCombinators.Parsec.Perm SourcePosColumnLine SourceNamenewPos initialPos sourceName sourceLine sourceColumn incSourceLineincSourceColumn setSourceName setSourceLinesetSourceColumnupdatePosString updatePosChar ParseErrorMessageExpectUnExpect SysUnExpect messageStringerrorPos errorMessageserrorIsUnknownnewErrorUnknownnewErrorMessageaddErrorMessage setErrorPossetErrorMessage mergeErrorshowErrorMessagesmessageCompare messageEqStreamunconsState stateInputstatePos stateUserReplyErrorOkConsumedEmptyParsecParsecT unknownErrorsysUnExpectError runParsecTmkPT parsecMap parserReturn parserBindmergeErrorReply parserFail parserZero parserPluslabellabelstokenstry lookAheadtoken tokenPrim tokenPrimExmanyskipMany manyAccumrunPTrunP runParserT runParser parseTest getPositiongetInput setPositionsetInputgetParserStatesetParserStateupdateParserStategetStateputState modifyStatesetState updateStateoneOfnoneOfspacesspacenewlinetabupperloweralphaNumletterdigithexDigitoctDigitanyCharstringchoiceoption optionMaybeoptionalbetween skipMany1many1sepBysepBy1 sepEndBy1sepEndByendBy1endBycountchainrchainlchainl1chainr1anyTokeneofmanyTill GenParserParser parseFromFile CharParserGenTokenParser TokenParser identifierreservedoperator reservedOp charLiteral stringLiteralnaturalintegerfloatnaturalOrFloatdecimal hexadecimaloctalsymbollexeme whiteSpaceparensbracesanglesbracketssquaressemicommacolondotsemiSepsemiSep1commaSep commaSep1GenLanguageDef LanguageDef commentStart commentEnd commentLinenestedComments identStart identLetteropStartopLetter reservedNamesreservedOpNames caseSensitivemakeTokenParser OperatorTableOperatorPostfixPrefixInfixAssoc AssocRight AssocLeft AssocNonebuildExpressionParserpzero haskellStyle javaStyleemptyDefhaskell haskellDefmondrian mondrianDefStreamPermParser PermParser<||><$$><|?><$?>permutebaseGHC.ShowShowghc-prim GHC.ClassesEqOrd$fShowSourcePosGHC.Basefail$fShowParseError $fOrdMessage $fEqMessage $fEnumMessage Control.Monadmzero MonadPlusmplus Data.MaybeJust Data.EitherLeftRight$fMonadTransParsecT$fMonadPlusParsecT$fMonadErroreParsecT$fMonadContParsecT$fMonadStatesParsecT$fMonadReaderrParsecT$fMonadIOParsecT$fMonadParsecT$fAlternativeParsecT$fApplicativeParsecT$fFunctorParsecT$fFunctorReply$fFunctorConsumed GHC.UnicodeisSpace GHC.TypesTrueNothing System.IO$fStream[]mtok$fStreamByteStringmChar$fStreamTextmChar