parsec2 (empty) → 1.0.0
raw patch · 14 files changed
+2591/−0 lines, 14 filesdep +basesetup-changed
Dependencies added: base
Files
- CHANGELOG +9/−0
- LICENSE +21/−0
- Setup.hs +6/−0
- Text/ParserCombinators/Parsec.hs +54/−0
- Text/ParserCombinators/Parsec/Char.hs +139/−0
- Text/ParserCombinators/Parsec/Combinator.hs +267/−0
- Text/ParserCombinators/Parsec/Error.hs +192/−0
- Text/ParserCombinators/Parsec/Expr.hs +163/−0
- Text/ParserCombinators/Parsec/Language.hs +138/−0
- Text/ParserCombinators/Parsec/Perm.hs +167/−0
- Text/ParserCombinators/Parsec/Pos.hs +114/−0
- Text/ParserCombinators/Parsec/Prim.hs +597/−0
- Text/ParserCombinators/Parsec/Token.hs +675/−0
- parsec2.cabal +49/−0
+ CHANGELOG view
@@ -0,0 +1,9 @@+parsec2-1.0.0 (Changes from parsec-2.1.0.1)++Sat Jul 24 12:17:43 CDT 2010 Antoine Latter <aslatter@gmail.com>+ * add dcoumentation done for parsec-3++Wed Jun 9 22:23:52 CDT 2010 Antoine Latter <aslatter@gmail.com>+ * in Parsec.Token, sort names after accounting for case sensitivity, not before+ from: Greg Fitzgerald+
+ LICENSE view
@@ -0,0 +1,21 @@+Copyright 1999-2000, Daan Leijen. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.+* 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.++This software is provided by the copyright holders "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 copyright holders 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.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ Text/ParserCombinators/Parsec.hs view
@@ -0,0 +1,54 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : Antoine Latter <aslatter@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- Parsec, the Fast Monadic Parser combinator library, see+-- <http://www.cs.uu.nl/people/daan/parsec.html>.+--+-- Inspired by:+--+-- * Graham Hutton and Erik Meijer:+-- Monadic Parser Combinators.+-- Technical report NOTTCS-TR-96-4. +-- Department of Computer Science, University of Nottingham, 1996. +-- <http://www.cs.nott.ac.uk/~gmh/monparsing.ps>+--+-- * Andrew Partridge, David Wright: +-- Predictive parser combinators need four values to report errors.+-- Journal of Functional Programming 6(2): 355-364, 1996+--+-- This helper module exports elements from the basic libraries.+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec+ ( -- complete modules+ module Text.ParserCombinators.Parsec.Prim+ , module Text.ParserCombinators.Parsec.Combinator+ , module Text.ParserCombinators.Parsec.Char+ + -- module Text.ParserCombinators.Parsec.Error+ , ParseError + , errorPos + + -- module Text.ParserCombinators.Parsec.Pos+ , SourcePos+ , SourceName, Line, Column + , sourceName, sourceLine, sourceColumn + , incSourceLine, incSourceColumn+ , setSourceLine, setSourceColumn, setSourceName++ ) where++import Text.ParserCombinators.Parsec.Pos -- textual positions+import Text.ParserCombinators.Parsec.Error -- parse errors+import Text.ParserCombinators.Parsec.Prim -- primitive combinators+import Text.ParserCombinators.Parsec.Combinator -- derived combinators+import Text.ParserCombinators.Parsec.Char -- character parsers+
+ Text/ParserCombinators/Parsec/Char.hs view
@@ -0,0 +1,139 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Char+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : Antoine Latter <aslatter@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- Commonly used character parsers.+-- +-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Char+ ( CharParser+ , spaces, space+ , newline, tab+ , upper, lower, alphaNum, letter+ , digit, hexDigit, octDigit+ , char, string+ , anyChar, oneOf, noneOf+ , satisfy+ ) where++import Prelude+import Data.Char+import Text.ParserCombinators.Parsec.Pos( updatePosChar, updatePosString )+import Text.ParserCombinators.Parsec.Prim++-----------------------------------------------------------+-- Type of character parsers+-----------------------------------------------------------+type CharParser st a = GenParser Char st a++-----------------------------------------------------------+-- Character parsers+-----------------------------------------------------------++-- | @oneOf cs@ succeeds if the current character is in the supplied+-- list of characters @cs@. Returns the parsed character. See also+-- 'satisfy'.+--+-- > vowel = oneOf "aeiou"+oneOf :: [Char] -> CharParser st Char+oneOf cs = satisfy (\c -> elem c cs)++-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current+-- character /not/ in the supplied list of characters @cs@. Returns the+-- parsed character.+--+-- > consonant = noneOf "aeiou"+noneOf :: [Char] -> CharParser st Char+noneOf cs = satisfy (\c -> not (elem c cs))++-- | Skips /zero/ or more white space characters. See also 'skipMany'.+spaces :: CharParser st ()+spaces = skipMany space <?> "white space" ++-- | Parses a white space character (any character which satisfies 'isSpace')+-- Returns the parsed character.+space :: CharParser st Char+space = satisfy (isSpace) <?> "space"++-- | Parses a newline character (\'\\n\'). Returns a newline character.+newline :: CharParser st Char+newline = char '\n' <?> "new-line"++-- | Parses a tab character (\'\\t\'). Returns a tab character.+tab :: CharParser st Char+tab = char '\t' <?> "tab"++-- | Parses an upper case letter (a character between \'A\' and \'Z\').+-- Returns the parsed character.+upper :: CharParser st Char+upper = satisfy (isUpper) <?> "uppercase letter"++-- | Parses a lower case character (a character between \'a\' and \'z\').+-- Returns the parsed character.+lower :: CharParser st Char+lower = satisfy (isLower) <?> "lowercase letter"++-- | Parses a letter or digit (a character between \'0\' and \'9\').+-- Returns the parsed character.+alphaNum :: CharParser st Char+alphaNum = satisfy (isAlphaNum) <?> "letter or digit"++-- | Parses a letter (an upper case or lower case character). Returns the+-- parsed character.+letter :: CharParser st Char+letter = satisfy (isAlpha) <?> "letter"++-- | Parses a digit. Returns the parsed character.+digit :: CharParser st Char+digit = satisfy (isDigit) <?> "digit"++-- | Parses a hexadecimal digit (a digit or a letter between \'a\' and+-- \'f\' or \'A\' and \'F\'). Returns the parsed character.+hexDigit :: CharParser st Char+hexDigit = satisfy (isHexDigit) <?> "hexadecimal digit"++-- | Parses an octal digit (a character between \'0\' and \'7\'). Returns+-- the parsed character.+octDigit :: CharParser st Char+octDigit = satisfy (isOctDigit) <?> "octal digit"++-- | @char c@ parses a single character @c@. Returns the parsed+-- character (i.e. @c@).+--+-- > semiColon = char ';'+char :: Char -> CharParser st Char+char c = satisfy (==c) <?> show [c]++-- | This parser succeeds for any character. Returns the parsed character.+anyChar :: CharParser st Char+anyChar = satisfy (const True)++-----------------------------------------------------------+-- Primitive character parsers+-----------------------------------------------------------++-- | The parser @satisfy f@ succeeds for any character for which the+-- supplied function @f@ returns 'True'. Returns the character that is+-- actually parsed.+--+-- > digit = satisfy isDigit+-- > oneOf cs = satisfy (\c -> c `elem` cs)+satisfy :: (Char -> Bool) -> CharParser st Char+satisfy f = tokenPrim (\c -> show [c]) + (\pos c cs -> updatePosChar pos c) + (\c -> if f c then Just c else Nothing)++-- | @string s@ parses a sequence of characters given by @s@. Returns+-- the parsed string (i.e. @s@).+--+-- > divOrMod = string "div"+-- > <|> string "mod"+string :: String -> CharParser st String+string s = tokens show updatePosString s
+ Text/ParserCombinators/Parsec/Combinator.hs view
@@ -0,0 +1,267 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Combinator+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : Antoine Latter <aslatter@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- Commonly used generic combinators+-- +-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Combinator+ ( choice+ , count+ , between+ , option, optionMaybe, optional+ , skipMany1+ , many1+ , sepBy, sepBy1+ , endBy, endBy1+ , sepEndBy, sepEndBy1+ , chainl, chainl1+ , chainr, chainr1+ , eof, notFollowedBy+ + -- tricky combinators+ , manyTill, lookAhead, anyToken+ ) where++import Control.Monad+import Text.ParserCombinators.Parsec.Prim+++-- | @choice ps@ tries to apply the parsers in the list @ps@ in order,+-- until one of them succeeds. Returns the value of the succeeding+-- parser.+choice :: [GenParser tok st a] -> GenParser tok st a+choice ps = foldr (<|>) mzero ps++-- | @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+-- > ; return (digitToInt d)+-- > })+option :: a -> GenParser tok st a -> GenParser tok st a+option x p = p <|> return x++-- | @optionMaybe p@ tries to apply parser @p@. If @p@ fails without+-- consuming input, it return 'Nothing', otherwise it returns+-- 'Just' the value returned by @p@.+optionMaybe :: GenParser tok st a -> GenParser tok st (Maybe a)+optionMaybe p = option Nothing (liftM Just p)++-- | @optional p@ tries to apply parser @p@. It will parse @p@ or nothing.+-- It only fails if @p@ fails after consuming input. It discards the result+-- of @p@.+optional :: GenParser tok st a -> GenParser tok st ()+optional p = do{ p; return ()} <|> return ()++-- | @between open close p@ parses @open@, followed by @p@ and @close@.+-- Returns the value returned by @p@.+--+-- > braces = between (symbol "{") (symbol "}")+between :: GenParser tok st open -> GenParser tok st close + -> GenParser tok st a -> GenParser tok st a+between open close p+ = do{ open; x <- p; close; return x }+ + +-- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping+-- its result.+skipMany1 :: GenParser tok st a -> GenParser tok st ()+skipMany1 p = do{ p; skipMany p }+{-+skipMany p = scan+ where+ scan = do{ p; scan } <|> return ()+-}++-- | @many1 p@ applies the parser @p@ /one/ or more times. Returns a+-- list of the returned values of @p@.+--+-- > word = many1 letter+many1 :: GenParser tok st a -> GenParser tok st [a]+many1 p = do{ x <- p; xs <- many p; return (x:xs) }+{-+many p = scan id+ where+ scan f = do{ x <- p+ ; scan (\tail -> f (x:tail))+ }+ <|> return (f [])+-}++-- | @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 ",")+sepBy :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]+sepBy p sep = sepBy1 p sep <|> return []++-- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated+-- by @sep@. Returns a list of values returned by @p@.+sepBy1 :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]+sepBy1 p sep = do{ x <- p+ ; xs <- many (sep >> p)+ ; return (x:xs)+ }++-- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@,+-- separated and optionally ended by @sep@. Returns a list of values+-- returned by @p@.+sepEndBy1 :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]+sepEndBy1 p sep = do{ x <- p+ ; do{ sep+ ; xs <- sepEndBy p sep+ ; return (x:xs)+ }+ <|> return [x]+ }+ +-- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@,+-- separated and optionally ended by @sep@, ie. haskell style+-- statements. Returns a list of values returned by @p@.+--+-- > haskellStatements = haskellStatement `sepEndBy` semi+sepEndBy :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]+sepEndBy p sep = sepEndBy1 p sep <|> return []+++-- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, seperated+-- and ended by @sep@. Returns a list of values returned by @p@.+endBy1 :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]+endBy1 p sep = many1 (do{ x <- p; sep; return x })++-- | @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+endBy :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]+endBy p sep = many (do{ x <- p; sep; return x })++-- | @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@.+count :: Int -> GenParser tok st a -> GenParser tok st [a]+count n p | n <= 0 = return []+ | otherwise = sequence (replicate n 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.+chainr :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> a -> GenParser tok st a+chainr p op x = chainr1 p op <|> return x++-- | @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.+chainl :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> a -> GenParser tok st a+chainl p op x = chainl1 p op <|> return x++-- | @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 (-) }+chainl1 :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> GenParser tok st a+chainl1 p op = do{ x <- p; rest x }+ where+ rest x = do{ f <- op+ ; y <- p+ ; rest (f x y)+ }+ <|> return x+ +-- | @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@.+chainr1 :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> GenParser tok st a+chainr1 p op = scan+ where+ scan = do{ x <- p; rest x }+ + rest x = do{ f <- op+ ; y <- scan+ ; return (f x y)+ }+ <|> return x++-----------------------------------------------------------+-- Tricky combinators+-----------------------------------------------------------++-- | The parser @anyToken@ accepts any kind of token. It is for example+-- used to implement 'eof'. Returns the accepted token.+anyToken :: Show tok => GenParser tok st tok+anyToken = tokenPrim show (\pos tok toks -> pos) Just++-- | This parser only succeeds at the end of the input. This is not a+-- primitive parser but it is defined using 'notFollowedBy'.+--+-- > eof = notFollowedBy anyToken <?> "end of input"+eof :: Show tok => GenParser tok st ()+eof = notFollowedBy anyToken <?> "end of input" ++-- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser+-- does not consume any input. This parser can be used to implement the+-- \'longest match\' rule. For example, when recognizing keywords (for+-- example @let@), 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"+-- > ; notFollowedBy alphaNum+-- > })+notFollowedBy :: Show tok => GenParser tok st tok -> GenParser tok st () +notFollowedBy p = try (do{ c <- p; unexpected (show [c]) }+ <|> return ()+ )++-- | @manyTill p end@ applies parser @p@ /zero/ or more times until+-- parser @end@ 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 'try' combinator.+manyTill :: GenParser tok st a -> GenParser tok st end -> GenParser tok st [a]+manyTill p end = scan+ where+ scan = do{ end; return [] }+ <|>+ do{ x <- p; xs <- scan; return (x:xs) }+++-- | @lookAhead p@ parses @p@ without consuming any input.+lookAhead :: GenParser tok st a -> GenParser tok st a+lookAhead p = do{ state <- getParserState+ ; x <- p+ ; setParserState state+ ; return x+ }
+ Text/ParserCombinators/Parsec/Error.hs view
@@ -0,0 +1,192 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Error+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : Antoine Latter <aslatter@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- Parse errors+-- +-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Error+ ( Message(SysUnExpect,UnExpect,Expect,Message)+ , messageString, messageCompare, messageEq+ + , ParseError, errorPos, errorMessages, errorIsUnknown+ , showErrorMessages+ + , newErrorMessage, newErrorUnknown+ , addErrorMessage, setErrorPos, setErrorMessage+ , mergeError+ )+ where+++import Prelude+import Data.List (nub,sortBy)+import Text.ParserCombinators.Parsec.Pos + +-- | This abstract data type represents parse error messages. There are+-- four kinds of messages:+--+-- > data Message = SysUnExpect String+-- > | UnExpect String+-- > | Expect String+-- > | Message String+-- +-- The fine distinction between different kinds of parse errors allows+-- the system to generate quite good error messages for the user. It+-- also allows error messages that are formatted in different+-- languages. Each kind of message is generated by different combinators:+--+-- * A 'SysUnExpect' message is automatically generated by the+-- 'Text.Parsec.Combinator.satisfy' combinator. The argument is the+-- unexpected input.+--+-- * A 'UnExpect' message is generated by the 'Text.Parsec.Prim.unexpected'+-- combinator. The argument describes the+-- unexpected item.+--+-- * A 'Expect' message is generated by the 'Text.Parsec.Prim.<?>'+-- combinator. The argument describes the expected item.+--+-- * A 'Message' message is generated by the 'fail'+-- combinator. The argument is some general parser message.+data Message = SysUnExpect !String --library generated unexpect + | UnExpect !String --unexpected something + | Expect !String --expecting something+ | Message !String --raw message+ +messageToEnum msg+ = case msg of SysUnExpect _ -> 0+ UnExpect _ -> 1+ Expect _ -> 2+ Message _ -> 3 + +messageCompare :: Message -> Message -> Ordering+messageCompare msg1 msg2+ = compare (messageToEnum msg1) (messageToEnum msg2)+ +-- | Extract the message string from an error message+messageString :: Message -> String+messageString msg+ = case msg of SysUnExpect s -> s+ UnExpect s -> s+ Expect s -> s+ Message s -> s ++messageEq :: Message -> Message -> Bool+messageEq msg1 msg2+ = (messageCompare msg1 msg2 == EQ)+ + +-- | The abstract data type @ParseError@ represents parse errors. It+-- provides the source position ('SourcePos') of the error+-- and a list of error messages ('Message'). A @ParseError@+-- can be returned by the function 'Text.Parsec.Prim.parse'. @ParseError@ is an+-- instance of the 'Show' class.+data ParseError = ParseError !SourcePos [Message]++-- | Extracts the source position from the parse error+errorPos :: ParseError -> SourcePos+errorPos (ParseError pos msgs)+ = pos+ +-- | Extracts the list of error messages from the parse error+errorMessages :: ParseError -> [Message]+errorMessages (ParseError pos msgs)+ = sortBy messageCompare msgs + +errorIsUnknown :: ParseError -> Bool+errorIsUnknown (ParseError pos msgs)+ = null msgs+ + +-----------------------------------------------------------+-- Create parse errors+----------------------------------------------------------- +newErrorUnknown :: SourcePos -> ParseError+newErrorUnknown pos+ = ParseError pos []+ +newErrorMessage :: Message -> SourcePos -> ParseError+newErrorMessage msg pos + = ParseError pos [msg]++addErrorMessage :: Message -> ParseError -> ParseError+addErrorMessage msg (ParseError pos msgs)+ = ParseError pos (msg:msgs)+ +setErrorPos :: SourcePos -> ParseError -> ParseError+setErrorPos pos (ParseError _ msgs)+ = ParseError pos msgs+ +setErrorMessage :: Message -> ParseError -> ParseError+setErrorMessage msg (ParseError pos msgs)+ = ParseError pos (msg:filter (not . messageEq msg) msgs)+ + +mergeError :: ParseError -> ParseError -> ParseError+mergeError (ParseError pos msgs1) (ParseError _ msgs2)+ = ParseError pos (msgs1 ++ msgs2)+ +++-----------------------------------------------------------+-- Show Parse Errors+----------------------------------------------------------- +instance Show ParseError where+ show err+ = show (errorPos err) ++ ":" ++ + showErrorMessages "or" "unknown parse error" + "expecting" "unexpected" "end of input"+ (errorMessages err)+++-- | Language independent show function+showErrorMessages ::+ String -> String -> String -> String -> String -> [Message] -> String+showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs+ | null msgs = msgUnknown+ | otherwise = concat $ map ("\n"++) $ clean $+ [showSysUnExpect,showUnExpect,showExpect,showMessages]+ where+ (sysUnExpect,msgs1) = span (messageEq (SysUnExpect "")) msgs+ (unExpect,msgs2) = span (messageEq (UnExpect "")) msgs1+ (expect,messages) = span (messageEq (Expect "")) msgs2+ + showExpect = showMany msgExpecting expect+ showUnExpect = showMany msgUnExpected unExpect+ showSysUnExpect | not (null unExpect) ||+ null sysUnExpect = ""+ | null firstMsg = msgUnExpected ++ " " ++ msgEndOfInput+ | otherwise = msgUnExpected ++ " " ++ firstMsg+ where+ firstMsg = messageString (head sysUnExpect)+ + showMessages = showMany "" messages++ + --helpers + showMany pre msgs = case (clean (map messageString msgs)) of+ [] -> ""+ ms | null pre -> commasOr ms+ | otherwise -> pre ++ " " ++ commasOr ms+ + commasOr [] = "" + commasOr [m] = m + commasOr ms = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms+ + commaSep = seperate ", " . clean+ semiSep = seperate "; " . clean + + seperate sep [] = ""+ seperate sep [m] = m+ seperate sep (m:ms) = m ++ sep ++ seperate sep ms + + clean = nub . filter (not.null) +
+ Text/ParserCombinators/Parsec/Expr.hs view
@@ -0,0 +1,163 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Expr+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : Antoine Latter <aslatter@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- A helper module to parse \"expressions\".+-- Builds a parser given a table of operators and associativities.+-- +-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Expr+ ( Assoc(..), Operator(..), OperatorTable+ , buildExpressionParser+ ) where++import Text.ParserCombinators.Parsec.Prim+import Text.ParserCombinators.Parsec.Combinator+++-----------------------------------------------------------+-- Assoc and OperatorTable+-----------------------------------------------------------++-- | This data type specifies the associativity of operators: left, right+-- or none.+data Assoc = AssocNone + | AssocLeft+ | AssocRight+ +-- | This data type specifies operators that work on values of type @a@.+-- An operator is either binary infix or unary prefix or postfix. A+-- binary operator has also an associated associativity.+data Operator t st a = Infix (GenParser t st (a -> a -> a)) Assoc+ | Prefix (GenParser t st (a -> a))+ | Postfix (GenParser t st (a -> a))++-- | An @OperatorTable s u m a@ is a list of @Operator s u m a@+-- lists. The list is ordered in descending+-- precedence. All operators in one list have the same precedence (but+-- may have a different associativity).+type OperatorTable t st a = [[Operator t st a]]++++-----------------------------------------------------------+-- Convert an OperatorTable and basic term parser into+-- a full fledged expression parser+-----------------------------------------------------------++-- | @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 @-@ is prefix negate). Prefix and postfix operators+-- 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+-- involved in building expression parser. Here is an example of an+-- expression parser that handles prefix signs, postfix increment and+-- basic arithmetic.+--+-- > expr = buildExpressionParser table term+-- > <?> "expression"+-- >+-- > term = parens expr+-- > <|> natural+-- > <?> "simple expression"+-- >+-- > table = [ [prefix "-" negate, prefix "+" id ]+-- > , [postfix "++" (+1)]+-- > , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ]+-- > , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft ]+-- > ]+-- >+-- > binary name fun assoc = Infix (do{ reservedOp name; return fun }) assoc+-- > prefix name fun = Prefix (do{ reservedOp name; return fun })+-- > postfix name fun = Postfix (do{ reservedOp name; return fun })+buildExpressionParser :: OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a+buildExpressionParser operators simpleExpr+ = foldl (makeParser) simpleExpr operators+ where+ makeParser term ops+ = let (rassoc,lassoc,nassoc+ ,prefix,postfix) = foldr splitOp ([],[],[],[],[]) ops+ + rassocOp = choice rassoc+ lassocOp = choice lassoc+ nassocOp = choice nassoc+ prefixOp = choice prefix <?> ""+ postfixOp = choice postfix <?> ""+ + ambigious assoc op= try $+ do{ op; fail ("ambiguous use of a " ++ assoc + ++ " associative operator")+ }+ + ambigiousRight = ambigious "right" rassocOp+ ambigiousLeft = ambigious "left" lassocOp+ ambigiousNon = ambigious "non" nassocOp + + termP = do{ pre <- prefixP+ ; x <- term + ; post <- postfixP+ ; return (post (pre x))+ }+ + postfixP = postfixOp <|> return id+ + prefixP = prefixOp <|> return id+ + rassocP x = do{ f <- rassocOp+ ; y <- do{ z <- termP; rassocP1 z }+ ; return (f x y)+ }+ <|> ambigiousLeft+ <|> ambigiousNon+ -- <|> return x+ + rassocP1 x = rassocP x <|> return x + + lassocP x = do{ f <- lassocOp+ ; y <- termP+ ; lassocP1 (f x y)+ }+ <|> ambigiousRight+ <|> ambigiousNon+ -- <|> return x+ + lassocP1 x = lassocP x <|> return x + + nassocP x = do{ f <- nassocOp+ ; y <- termP+ ; ambigiousRight+ <|> ambigiousLeft+ <|> ambigiousNon+ <|> return (f x y)+ } + -- <|> return x + + in do{ x <- termP+ ; rassocP x <|> lassocP x <|> nassocP x <|> return x+ <?> "operator"+ }+ ++ splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix)+ = case assoc of+ AssocNone -> (rassoc,lassoc,op:nassoc,prefix,postfix)+ AssocLeft -> (rassoc,op:lassoc,nassoc,prefix,postfix)+ AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix)+ + splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix)+ = (rassoc,lassoc,nassoc,op:prefix,postfix)+ + splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix)+ = (rassoc,lassoc,nassoc,prefix,op:postfix)+
+ Text/ParserCombinators/Parsec/Language.hs view
@@ -0,0 +1,138 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Language+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : Antoine Latter <aslatter@gmail.com>+-- Stability : provisional+-- Portability : non-portable (uses non-portable module Text.ParserCombinators.Parsec.Token)+--+-- A helper module that defines some language definitions that can be used+-- to instantiate a token parser (see "Text.ParserCombinators.Parsec.Token").+-- +-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Language+ ( haskellDef, haskell+ , mondrianDef, mondrian+ + , emptyDef+ , haskellStyle+ , javaStyle + , LanguageDef (..) + ) where+import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Token ++ +-----------------------------------------------------------+-- Styles: haskellStyle, javaStyle+----------------------------------------------------------- ++-- | This is a minimal token definition for Haskell style languages. It+-- defines the style of comments, valid identifiers and case+-- sensitivity. It does not define any reserved words or operators.+haskellStyle :: LanguageDef st+haskellStyle= emptyDef + { commentStart = "{-"+ , commentEnd = "-}"+ , commentLine = "--"+ , nestedComments = True+ , identStart = letter+ , identLetter = alphaNum <|> oneOf "_'"+ , opStart = opLetter haskellStyle+ , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~" + , reservedOpNames= []+ , reservedNames = []+ , caseSensitive = True + } + +-- | This is a minimal token definition for Java style languages. It+-- defines the style of comments, valid identifiers and case+-- sensitivity. It does not define any reserved words or operators.+javaStyle :: LanguageDef st+javaStyle = emptyDef+ { commentStart = "/*"+ , commentEnd = "*/"+ , commentLine = "//"+ , nestedComments = True+ , identStart = letter+ , identLetter = alphaNum <|> oneOf "_'" + , reservedNames = []+ , reservedOpNames= [] + , caseSensitive = False + }++-----------------------------------------------------------+-- minimal language definition+----------------------------------------------------------- +emptyDef :: LanguageDef st+emptyDef = LanguageDef + { commentStart = ""+ , commentEnd = ""+ , commentLine = ""+ , nestedComments = True+ , identStart = letter <|> char '_'+ , identLetter = alphaNum <|> oneOf "_'"+ , opStart = opLetter emptyDef+ , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"+ , reservedOpNames= []+ , reservedNames = []+ , caseSensitive = True+ }+ +++-----------------------------------------------------------+-- Haskell+----------------------------------------------------------- ++-- | A lexer for the haskell language.+haskell :: TokenParser st+haskell = makeTokenParser haskellDef++-- | The language definition for the Haskell language.+haskellDef :: LanguageDef st+haskellDef = haskell98Def+ { identLetter = identLetter haskell98Def <|> char '#'+ , reservedNames = reservedNames haskell98Def ++ + ["foreign","import","export","primitive"+ ,"_ccall_","_casm_"+ ,"forall"+ ]+ }+ +-- | The language definition for the language Haskell98.+haskell98Def :: LanguageDef st+haskell98Def = haskellStyle+ { reservedOpNames= ["::","..","=","\\","|","<-","->","@","~","=>"]+ , reservedNames = ["let","in","case","of","if","then","else",+ "data","type",+ "class","default","deriving","do","import",+ "infix","infixl","infixr","instance","module",+ "newtype","where",+ "primitive"+ -- "as","qualified","hiding"+ ]+ } + + +-----------------------------------------------------------+-- Mondrian+----------------------------------------------------------- ++-- | A lexer for the mondrian language.+mondrian :: TokenParser st+mondrian = makeTokenParser mondrianDef++-- | The language definition for the language Mondrian.+mondrianDef :: LanguageDef st+mondrianDef = javaStyle+ { reservedNames = [ "case", "class", "default", "extends"+ , "import", "in", "let", "new", "of", "package"+ ] + , caseSensitive = True + }++
+ Text/ParserCombinators/Parsec/Perm.hs view
@@ -0,0 +1,167 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Perm+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : Antoine Latter <aslatter@gmail.com>+-- Stability : provisional+-- Portability : non-portable (uses existentially quantified data constructors)+--+-- This module implements permutation parsers. The algorithm used+-- is fairly complex since we push the type system to its limits :-)+-- The algorithm is described in:+--+-- /Parsing Permutation Phrases,/+-- by Arthur Baars, Andres Loh and Doaitse Swierstra.+-- Published as a functional pearl at the Haskell Workshop 2001.+-- +-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Perm+ ( PermParser -- abstract++ , permute+ , (<||>), (<$$>)+ , (<|?>), (<$?>)+ ) where++import Text.ParserCombinators.Parsec++{---------------------------------------------------------------++---------------------------------------------------------------}+infixl 1 <||>, <|?>+infixl 2 <$$>, <$?>+++{---------------------------------------------------------------+ test -- parse a permutation of + * an optional string of 'a's+ * a required 'b'+ * an optional 'c'+---------------------------------------------------------------}+test input+ = parse (do{ x <- ptest; eof; return x }) "" input++ptest :: Parser (String,Char,Char)+ptest + = permute $+ (,,) <$?> ("",many1 (char 'a'))+ <||> char 'b' + <|?> ('_',char 'c')+++{---------------------------------------------------------------+ Building a permutation parser+---------------------------------------------------------------}++-- | 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@.+(<||>) :: PermParser tok st (a -> b) -> GenParser tok st a -> PermParser tok st b+(<||>) perm p = add perm 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 @p@ is not allowed to accept empty input - use the optional+-- combinator ('<$?>') instead.+--+-- If the function @f@ takes more than one parameter, the type variable+-- @b@ is instantiated to a functional type which combines nicely with+-- the adds parser @p@ to the ('<||>') combinator. This+-- results in stylized code where a permutation parser starts with a+-- combining function @f@ followed by the parsers. The function @f@+-- gets its parameters in the order in which the parsers are specified,+-- but actual input can be in any order.+(<$$>) :: (a -> b) -> GenParser tok st a -> PermParser tok st b+(<$$>) f p = newperm f <||> p++-- | 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@.+(<|?>) :: PermParser tok st (a -> b) -> (a, GenParser tok st a) -> PermParser tok st b+(<|?>) perm (x,p) = addopt perm x 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.+(<$?>) :: (a -> b) -> (a, GenParser tok st a) -> PermParser tok st b+(<$?>) f (x,p) = newperm f <|?> (x,p)++++{---------------------------------------------------------------+ The permutation tree+---------------------------------------------------------------}++-- | The type @PermParser tok st a@ denotes a permutation parser that,+-- when converted by the 'permute' function, parses+-- @tok@ tokens with user state @st@ and returns a value of+-- type @a@ on success.+--+-- Normally, a permutation parser is first build with special operators+-- like ('<||>') and than transformed into a normal parser+-- using 'permute'.+data PermParser tok st a = Perm (Maybe a) [Branch tok st a]+data Branch tok st a = forall b. Branch (PermParser tok st (b -> a)) (GenParser tok st b)+++-- | 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:+--+-- > test = permute (tuple <$?> ("",many1 (char 'a'))+-- > <||> char 'b'+-- > <|?> ('_',char 'c'))+-- > where+-- > tuple a b c = (a,b,c)+permute :: PermParser tok st a -> GenParser tok st a+permute (Perm def xs)+ = choice (map branch xs ++ empty)+ where+ empty+ = case def of+ Nothing -> []+ Just x -> [return x]++ branch (Branch perm p)+ = do{ x <- p+ ; f <- permute perm+ ; return (f x)+ }++-- build permutation trees+newperm :: (a -> b) -> PermParser tok st (a -> b)+newperm f+ = Perm (Just f) []++add :: PermParser tok st (a -> b) -> GenParser tok st a -> PermParser tok st b+add perm@(Perm mf fs) p+ = Perm Nothing (first:map insert fs)+ where+ first = Branch perm p+ insert (Branch perm' p')+ = Branch (add (mapPerms flip perm') p) p'++addopt :: PermParser tok st (a -> b) -> a -> GenParser tok st a -> PermParser tok st b+addopt perm@(Perm mf fs) x p+ = Perm (fmap ($ x) mf) (first:map insert fs)+ where+ first = Branch perm p+ insert (Branch perm' p')+ = Branch (addopt (mapPerms flip perm') x p) p'+++mapPerms :: (a -> b) -> PermParser tok st a -> PermParser tok st b+mapPerms f (Perm x xs)+ = Perm (fmap f x) (map (mapBranch f) xs)+ where+ mapBranch f (Branch perm p)+ = Branch (mapPerms (f.) perm) p
+ Text/ParserCombinators/Parsec/Pos.hs view
@@ -0,0 +1,114 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Pos+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : Antoine Latter <aslatter@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- Textual source positions.+-- +-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Pos+ ( SourceName, Line, Column + , SourcePos+ , sourceLine, sourceColumn, sourceName+ , incSourceLine, incSourceColumn+ , setSourceLine, setSourceColumn, setSourceName+ , newPos, initialPos+ , updatePosChar, updatePosString+ ) where++-----------------------------------------------------------+-- Source Positions, a file name, a line and a column.+-- upper left is (1,1)+----------------------------------------------------------- +type SourceName = String+type Line = Int+type Column = Int++-- | The abstract data type @SourcePos@ represents source positions. It+-- contains the name of the source (i.e. file name), a line number and+-- a column number. @SourcePos@ is an instance of the 'Show', 'Eq' and+-- 'Ord' class.+data SourcePos = SourcePos SourceName !Line !Column+ deriving (Eq,Ord)+ +-- | Create a new 'SourcePos' with the given source name,+-- line number and column number.+newPos :: SourceName -> Line -> Column -> SourcePos+newPos sourceName line column+ = SourcePos sourceName line column++-- | Create a new 'SourcePos' with the given source name,+-- and line number and column number set to 1, the upper left.+initialPos :: SourceName -> SourcePos+initialPos sourceName+ = newPos sourceName 1 1++-- | Extracts the name of the source from a source position.+sourceName :: SourcePos -> SourceName+sourceName (SourcePos name line column) = name ++-- | Extracts the line number from a source position.+sourceLine :: SourcePos -> Line+sourceLine (SourcePos name line column) = line++-- | Extracts the column number from a source position.+sourceColumn :: SourcePos -> Column+sourceColumn (SourcePos name line column) = column++-- | Increments the line number of a source position.+incSourceLine :: SourcePos -> Line -> SourcePos+incSourceLine (SourcePos name line column) n = SourcePos name (line+n) column++-- | Increments the column number of a source position.+incSourceColumn :: SourcePos -> Column -> SourcePos+incSourceColumn (SourcePos name line column) n = SourcePos name line (column+n)++-- | Set the name of the source.+setSourceName :: SourcePos -> SourceName -> SourcePos+setSourceName (SourcePos name line column) n = SourcePos n line column++-- | Set the line number of a source position.+setSourceLine :: SourcePos -> Line -> SourcePos+setSourceLine (SourcePos name line column) n = SourcePos name n column++-- | Set the column number of a source position.+setSourceColumn :: SourcePos -> Column -> SourcePos+setSourceColumn (SourcePos name line column) n = SourcePos name line n++-- | The expression @updatePosString pos s@ updates the source position+-- @pos@ by calling 'updatePosChar' on every character in @s@, ie.+-- @foldl updatePosChar pos string@.+updatePosString :: SourcePos -> String -> SourcePos+updatePosString pos string+ = forcePos (foldl updatePosChar pos string)++updatePosChar :: SourcePos -> Char -> SourcePos+updatePosChar pos@(SourcePos name line column) c + = forcePos $+ case c of+ '\n' -> SourcePos name (line+1) 1+ '\t' -> SourcePos name line (column + 8 - ((column-1) `mod` 8))+ _ -> SourcePos name line (column + 1)+ ++forcePos :: SourcePos -> SourcePos +forcePos pos@(SourcePos name line column)+ = seq line (seq column (pos))++-----------------------------------------------------------+-- Show positions +----------------------------------------------------------- +instance Show SourcePos where+ show (SourcePos name line column)+ | null name = showLineColumn+ | otherwise = "\"" ++ name ++ "\" " ++ showLineColumn+ where+ showLineColumn = "(line " ++ show line +++ ", column " ++ show column +++ ")"
+ Text/ParserCombinators/Parsec/Prim.hs view
@@ -0,0 +1,597 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Prim+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : Antoine Latter <aslatter@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- The primitive parser combinators.+-- +-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Prim+ ( -- operators: label a parser, alternative+ (<?>), (<|>)++ -- basic types+ , Parser, GenParser+ , runParser, parse, parseFromFile, parseTest+ + -- primitive parsers:+ -- instance Functor Parser : fmap+ -- instance Monad Parser : return, >>=, fail+ -- instance MonadPlus Parser : mzero (pzero), mplus (<|>)+ , token, tokens, tokenPrim, tokenPrimEx+ , try, label, labels, unexpected, pzero++ -- primitive because of space behaviour+ , many, skipMany+ + -- user state manipulation+ , getState, setState, updateState++ -- state manipulation+ , getPosition, setPosition+ , getInput, setInput + , State(..), getParserState, setParserState + ) where++import Prelude+import Text.ParserCombinators.Parsec.Pos+import Text.ParserCombinators.Parsec.Error+import Control.Monad++{-# INLINE parsecMap #-}+{-# INLINE parsecReturn #-}+{-# INLINE parsecBind #-}+{-# INLINE parsecZero #-}+{-# INLINE parsecPlus #-}+{-# INLINE token #-}+{-# INLINE tokenPrim #-}++-----------------------------------------------------------+-- Operators:+-- <?> gives a name to a parser (which is used in error messages)+-- <|> is the choice operator+-----------------------------------------------------------+infix 0 <?>+infixr 1 <|>++-- | 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@.+--+-- This is normally used at the end of a set alternatives where we want+-- to return an error message in terms of a higher level construct+-- rather than returning all possible characters. For example, if the+-- @expr@ parser from the 'try' 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.+(<?>) :: GenParser tok st a -> String -> GenParser tok st a+p <?> msg = label p msg++-- | 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 'mplus' member of the 'MonadPlus'+-- class and the ('Control.Applicative.<|>') member of 'Control.Applicative.Alternative'.+--+-- The parser is called /predictive/ since @q@ is only tried when+-- parser @p@ didn't consume any input (i.e.. the look ahead is 1).+-- This non-backtracking behaviour allows for both an efficient+-- implementation of the parser combinators and the generation of good+-- error messages.+(<|>) :: GenParser tok st a -> GenParser tok st a -> GenParser tok st a+p1 <|> p2 = mplus p1 p2+++-----------------------------------------------------------+-- User state combinators+-----------------------------------------------------------++-- | Returns the current user state.+getState :: GenParser tok st st+getState = do{ state <- getParserState+ ; return (stateUser state)+ }++-- | @setState st@ set the user state to @st@.+setState :: st -> GenParser tok st ()+setState st = do{ updateParserState (\(State input pos _) -> State input pos st)+ ; return ()+ }++-- | @updateState f@ applies function @f@ to the user state. Suppose+-- 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)+-- > }+updateState :: (st -> st) -> GenParser tok st ()+updateState f = do{ updateParserState (\(State input pos user) -> State input pos (f user))+ ; return ()+ }+++-----------------------------------------------------------+-- Parser state combinators+-----------------------------------------------------------++-- | Returns the current source position. See also 'SourcePos'.+getPosition :: GenParser tok st SourcePos+getPosition = do{ state <- getParserState; return (statePos state) }++-- | Returns the current input+getInput :: GenParser tok st [tok]+getInput = do{ state <- getParserState; return (stateInput state) }+++-- | @setPosition pos@ sets the current source position to @pos@.+setPosition :: SourcePos -> GenParser tok st ()+setPosition pos = do{ updateParserState (\(State input _ user) -> State input pos user)+ ; return ()+ }+ +-- | @setInput input@ continues parsing with @input@.+setInput :: [tok] -> GenParser tok st ()+setInput input = do{ updateParserState (\(State _ pos user) -> State input pos user)+ ; return ()+ }++-- | Returns the full parser state as a 'State' record.+getParserState :: GenParser tok st (State tok st)+getParserState = updateParserState id ++-- | @setParserState st@ set the full parser state to @st@.+setParserState :: State tok st -> GenParser tok st (State tok st)+setParserState st = updateParserState (const st)+++++-----------------------------------------------------------+-- Parser definition.+-- GenParser tok st a:+-- General parser for tokens of type "tok", +-- a user state "st" and a result type "a"+-----------------------------------------------------------+type Parser a = GenParser Char () a++newtype GenParser tok st a = Parser (State tok st -> Consumed (Reply tok st a))+runP (Parser p) = p++data Consumed a = Consumed a --input is consumed+ | Empty !a --no input is consumed+ +data Reply tok st a = Ok !a !(State tok st) ParseError --parsing succeeded with "a"+ | Error ParseError --parsing failed++data State tok st = State { stateInput :: [tok]+ , statePos :: !SourcePos+ , stateUser :: !st+ }+++-----------------------------------------------------------+-- run a parser+-----------------------------------------------------------+parseFromFile :: Parser a -> SourceName -> IO (Either ParseError a)+parseFromFile p fname+ = do{ input <- readFile fname+ ; return (parse p fname input)+ }++-- | The expression @parseTest p input@ applies a parser @p@ against+-- input @input@ and prints the result to stdout. Used for testing+-- parsers.+parseTest :: Show a => GenParser tok () a -> [tok] -> IO ()+parseTest p input+ = case (runParser p () "" input) of+ Left err -> do{ putStr "parse error at "+ ; print err+ }+ Right x -> print x++-- | @parse p filePath input@ runs a parser @p@ without user+-- state. The @filePath@ is only used in error messages and may be the+-- empty string. Returns either a 'ParseError' ('Left')+-- or a value of type @a@ ('Right').+--+-- > main = case (parse numbers "" "11, 2, 43") of+-- > Left err -> print err+-- > Right xs -> print (sum xs)+-- >+-- > numbers = commaSep integer+parse :: GenParser tok () a -> SourceName -> [tok] -> Either ParseError a+parse p name input+ = runParser p () name input++-- | The most general way to run a parser. @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 @filePath@ is only used in error messages and may be the empty+-- string. Returns either a 'ParseError' ('Left') or a+-- value of type @a@ ('Right').+--+-- > parseFromFile p fname+-- > = do{ input <- readFile fname+-- > ; return (runParser p () fname input)+-- > }+runParser :: GenParser tok st a -> st -> SourceName -> [tok] -> Either ParseError a+runParser p st name input+ = case parserReply (runP p (State input (initialPos name) st)) of+ Ok x _ _ -> Right x+ Error err -> Left err++parserReply result + = case result of+ Consumed reply -> reply+ Empty reply -> reply+++-----------------------------------------------------------+-- Functor: fmap+-----------------------------------------------------------+instance Functor (GenParser tok st) where+ fmap f p = parsecMap f p++parsecMap :: (a -> b) -> GenParser tok st a -> GenParser tok st b+parsecMap f (Parser p)+ = Parser (\state -> + case (p state) of+ Consumed reply -> Consumed (mapReply reply)+ Empty reply -> Empty (mapReply reply)+ )+ where+ mapReply reply+ = case reply of+ Ok x state err -> let fx = f x + in seq fx (Ok fx state err)+ Error err -> Error err+ ++-----------------------------------------------------------+-- Monad: return, sequence (>>=) and fail+----------------------------------------------------------- +instance Monad (GenParser tok st) where+ return x = parsecReturn x + p >>= f = parsecBind p f+ fail msg = parsecFail msg++parsecReturn :: a -> GenParser tok st a+parsecReturn x+ = Parser (\state -> Empty (Ok x state (unknownError state))) ++parsecBind :: GenParser tok st a -> (a -> GenParser tok st b) -> GenParser tok st b+parsecBind (Parser p) f+ = Parser (\state ->+ case (p state) of + Consumed reply1 + -> Consumed $+ case (reply1) of+ Ok x state1 err1 -> case runP (f x) state1 of+ Empty reply2 -> mergeErrorReply err1 reply2+ Consumed reply2 -> reply2+ Error err1 -> Error err1++ Empty reply1 + -> case (reply1) of+ Ok x state1 err1 -> case runP (f x) state1 of+ Empty reply2 -> Empty (mergeErrorReply err1 reply2)+ other -> other + Error err1 -> Empty (Error err1)+ ) ++mergeErrorReply err1 reply+ = case reply of+ Ok x state err2 -> Ok x state (mergeError err1 err2)+ Error err2 -> Error (mergeError err1 err2)+++parsecFail :: String -> GenParser tok st a+parsecFail msg+ = Parser (\state -> + Empty (Error (newErrorMessage (Message msg) (statePos state))))+++-----------------------------------------------------------+-- MonadPlus: alternative (mplus) and mzero+-----------------------------------------------------------+instance MonadPlus (GenParser tok st) where+ mzero = parsecZero+ mplus p1 p2 = parsecPlus p1 p2+ ++pzero :: GenParser tok st a+pzero = parsecZero++-- | @parsecZero@ always fails without consuming any input. @parsecZero@ is defined+-- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member+-- of the 'Control.Applicative.Applicative' class.+parsecZero :: GenParser tok st a+parsecZero+ = Parser (\state -> Empty (Error (unknownError state)))++parsecPlus :: GenParser tok st a -> GenParser tok st a -> GenParser tok st a+parsecPlus (Parser p1) (Parser p2)+ = Parser (\state ->+ case (p1 state) of + Empty (Error err) -> case (p2 state) of+ Empty reply -> Empty (mergeErrorReply err reply)+ consumed -> consumed+ other -> other+ )+++{- +-- variant that favors a consumed reply over an empty one, even it is not the first alternative.+ empty@(Empty reply) -> case reply of+ Error err ->+ case (p2 state) of+ Empty reply -> Empty (mergeErrorReply err reply)+ consumed -> consumed+ ok ->+ case (p2 state) of+ Empty reply -> empty+ consumed -> consumed+ consumed -> consumed+-}+++-- | The parser @try p@ behaves like parser @p@, except that it+-- pretends that it hasn't consumed any input when an error occurs.+--+-- This 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 @try@ combinator can for example be used to distinguish+-- identifiers and reserved words. Both reserved words and identifiers+-- 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:+--+-- > 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+-- 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:+--+-- > expr = letExpr <|> identifier <?> "expression"+-- >+-- > letExpr = do{ try (string "let"); ... }+-- > identifier = many1 letter+try :: GenParser tok st a -> GenParser tok st a+try (Parser p)+ = Parser (\state@(State input pos user) -> + case (p state) of+ Consumed (Error err) -> Empty (Error (setErrorPos pos err))+ Consumed ok -> Consumed ok -- was: Empty ok+ empty -> empty+ )++-- | The parser @token showTok posFromTok testTok@ accepts a token @t@+-- with result @x@ when the function @testTok t@ returns @'Just' 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 'tokenPrim'.+-- It is used to accept user defined token streams. For example,+-- suppose that we have a stream of basic tokens tupled with source+-- 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+token :: (tok -> String) -> (tok -> SourcePos) -> (tok -> Maybe a) -> GenParser tok st a +token show tokpos test+ = tokenPrim show nextpos test+ where+ nextpos _ _ (tok:toks) = tokpos tok+ nextpos _ tok [] = tokpos tok++-- | The parser @token showTok nextPos testTok@ accepts a token @t@+-- with result @x@ when the function @testTok t@ returns @'Just' 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 'Text.Parsec.Char.char' 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+tokenPrim :: (tok -> String) -> (SourcePos -> tok -> [tok] -> SourcePos) -> (tok -> Maybe a) -> GenParser tok st a+tokenPrim show nextpos test+ = tokenPrimEx show nextpos Nothing test++-- | The most primitive token recogniser. The expression @tokenPrimEx show nextpos mbnextstate test@,+-- recognises tokens when @test@ returns @Just x@ (and returns the value @x@). Tokens are shown in+-- error messages using @show@. The position is calculated using @nextpos@, and finally, @mbnextstate@,+-- can hold a function that updates the user state on every token recognised (nice to count tokens :-).+-- The function is packed into a 'Maybe' type for performance reasons.+tokenPrimEx :: (tok -> String) -> + (SourcePos -> tok -> [tok] -> SourcePos) -> + Maybe (SourcePos -> tok -> [tok] -> st -> st) ->+ (tok -> Maybe a) -> + GenParser tok st a+tokenPrimEx show nextpos mbNextState test+ = case mbNextState of+ Nothing + -> Parser (\state@(State input pos user) -> + case input of+ (c:cs) -> case test c of+ Just x -> let newpos = nextpos pos c cs+ newstate = State cs newpos user+ in seq newpos $ seq newstate $ + Consumed (Ok x newstate (newErrorUnknown newpos))+ Nothing -> Empty (sysUnExpectError (show c) pos)+ [] -> Empty (sysUnExpectError "" pos)+ )+ Just nextState+ -> Parser (\state@(State input pos user) -> + case input of+ (c:cs) -> case test c of+ Just x -> let newpos = nextpos pos c cs+ newuser = nextState pos c cs user+ newstate = State cs newpos newuser+ in seq newpos $ seq newstate $ + Consumed (Ok x newstate (newErrorUnknown newpos))+ Nothing -> Empty (sysUnExpectError (show c) pos)+ [] -> Empty (sysUnExpectError "" pos)+ )+++label :: GenParser tok st a -> String -> GenParser tok st a +label p msg+ = labels p [msg]++labels :: GenParser tok st a -> [String] -> GenParser tok st a+labels (Parser p) msgs+ = Parser (\state -> + case (p state) of+ Empty reply -> Empty $ + case (reply) of+ Error err -> Error (setExpectErrors err msgs)+ Ok x state1 err | errorIsUnknown err -> reply+ | otherwise -> Ok x state1 (setExpectErrors err msgs)+ other -> other+ )+++-- | @updateParserState f@ applies function @f@ to the parser state.+updateParserState :: (State tok st -> State tok st) -> GenParser tok st (State tok st)+updateParserState f + = Parser (\state -> let newstate = f state+ in Empty (Ok state newstate (unknownError newstate)))+ +-- | The parser @unexpected msg@ always fails with an unexpected error+-- message @msg@ without consuming any input.+--+-- The parsers 'fail', ('<?>') and @unexpected@ are the three parsers+-- used to generate error messages. Of these, only ('<?>') is commonly+-- used. For an example of the use of @unexpected@, see the definition+-- of 'Text.Parsec.Combinator.notFollowedBy'.+unexpected :: String -> GenParser tok st a+unexpected msg+ = Parser (\state -> Empty (Error (newErrorMessage (UnExpect msg) (statePos state))))+ ++setExpectErrors err [] = setErrorMessage (Expect "") err+setExpectErrors err [msg] = setErrorMessage (Expect msg) err+setExpectErrors err (msg:msgs) = foldr (\msg err -> addErrorMessage (Expect msg) err) + (setErrorMessage (Expect msg) err) msgs++sysUnExpectError msg pos = Error (newErrorMessage (SysUnExpect msg) pos)+unknownError state = newErrorUnknown (statePos state)++-----------------------------------------------------------+-- Parsers unfolded for space:+-- if many and skipMany are not defined as primitives,+-- they will overflow the stack on large inputs+----------------------------------------------------------- ++-- | @many p@ applies the parser @p@ /zero/ or more times. Returns a+-- list of the returned values of @p@.+--+-- > identifier = do{ c <- letter+-- > ; cs <- many (alphaNum <|> char '_')+-- > ; return (c:cs)+-- > }+many :: GenParser tok st a -> GenParser tok st [a]+many p+ = do{ xs <- manyAccum (:) p+ ; return (reverse xs)+ }++-- | @skipMany p@ applies the parser @p@ /zero/ or more times, skipping+-- its result.+--+-- > spaces = skipMany space+skipMany :: GenParser tok st a -> GenParser tok st ()+skipMany p+ = do{ manyAccum (\x xs -> []) p+ ; return ()+ }++manyAccum :: (a -> [a] -> [a]) -> GenParser tok st a -> GenParser tok st [a]+manyAccum accum (Parser p)+ = Parser (\state -> + let walk xs state r = case r of+ Empty (Error err) -> Ok xs state err+ Empty ok -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."+ Consumed (Error err) -> Error err+ Consumed (Ok x state' err) -> let ys = accum x xs+ in seq ys (walk ys state' (p state'))+ in case (p state) of+ Empty reply -> case reply of+ Ok x state' err -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."+ Error err -> Empty (Ok [] state err)+ consumed -> Consumed $ walk [] state consumed)++++-----------------------------------------------------------+-- Parsers unfolded for speed: +-- tokens+----------------------------------------------------------- ++{- specification of @tokens@:+tokens showss nextposs s+ = scan s+ where+ scan [] = return s+ scan (c:cs) = do{ token show nextpos c <?> shows s; scan cs } ++ show c = shows [c]+ nextpos pos c = nextposs pos [c]+-}++tokens :: Eq tok => ([tok] -> String) -> (SourcePos -> [tok] -> SourcePos) -> [tok] -> GenParser tok st [tok]+tokens shows nextposs s+ = Parser (\state@(State input pos user) -> + let+ ok cs = let newpos = nextposs pos s+ newstate = State cs newpos user+ in seq newpos $ seq newstate $ + (Ok s newstate (newErrorUnknown newpos))+ + errEof = Error (setErrorMessage (Expect (shows s))+ (newErrorMessage (SysUnExpect "") pos))+ errExpect c = Error (setErrorMessage (Expect (shows s))+ (newErrorMessage (SysUnExpect (shows [c])) pos))++ walk [] cs = ok cs+ walk xs [] = errEof+ walk (x:xs) (c:cs)| x == c = walk xs cs+ | otherwise = errExpect c++ walk1 [] cs = Empty (ok cs)+ walk1 xs [] = Empty (errEof)+ walk1 (x:xs) (c:cs)| x == c = Consumed (walk xs cs)+ | otherwise = Empty (errExpect c)++ in walk1 s input)++
+ Text/ParserCombinators/Parsec/Token.hs view
@@ -0,0 +1,675 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Token+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : Antoine Latter <aslatter@gmail.com>+-- Stability : provisional+-- Portability : non-portable (uses existentially quantified data constructors)+--+-- A helper module to parse lexical elements (tokens).+-- +-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Token+ ( LanguageDef (..)+ , TokenParser (..)+ , makeTokenParser+ ) where++import Data.Char (isAlpha,toLower,toUpper,isSpace,digitToInt)+import Data.List (nub,sort)+import Text.ParserCombinators.Parsec+++-----------------------------------------------------------+-- Language Definition+-----------------------------------------------------------++-- | The @LanguageDef@ type is a record that contains all parameterizable+-- features of the 'Text.ParserCombinators.Parsec.Token' module. The module+-- 'Text.ParserCombinators.Parsec.Language' contains some default definitions.+data LanguageDef st + = LanguageDef {+ -- | Describes the start of a block comment. Use the empty string if the+ -- language doesn't support block comments. For example \"\/*\".+ commentStart :: String++ -- | Describes the end of a block comment. Use the empty string if the+ -- language doesn't support block comments. For example \"*\/\".+ , commentEnd :: String++ -- | Describes the start of a line comment. Use the empty string if the+ -- language doesn't support line comments. For example \"\/\/\".+ , commentLine :: String++ -- | Set to 'True' if the language supports nested block comments.+ , nestedComments :: Bool ++ -- | This parser should accept any start characters of identifiers. For+ -- example @letter \<|> char \"_\"@.+ , identStart :: CharParser st Char++ -- | This parser should accept any legal tail characters of identifiers.+ -- For example @alphaNum \<|> char \"_\"@.+ , identLetter :: CharParser st Char++ -- | This parser should accept any start characters of operators. For+ -- example @oneOf \":!#$%&*+.\/\<=>?\@\\\\^|-~\"@+ , opStart :: CharParser st Char++ -- | This parser should accept any legal tail characters of operators.+ -- Note that this parser should even be defined if the language doesn't+ -- support user-defined operators, or otherwise the 'reservedOp'+ -- parser won't work correctly.+ , opLetter :: CharParser st Char++ -- | The list of reserved identifiers.+ , reservedNames :: [String]++ -- | The list of reserved operators.+ , reservedOpNames:: [String]++ -- | Set to 'True' if the language is case sensitive.+ , caseSensitive :: Bool+ } + +-----------------------------------------------------------+-- A first class module: TokenParser+-----------------------------------------------------------++-- | The type of the record that holds lexical parsers.+data TokenParser st+ = TokenParser {+ -- | This lexeme parser parses a legal identifier. Returns the identifier+ -- string. This parser will fail on identifiers that are reserved+ -- words. Legal identifier (start) characters and reserved words are+ -- defined in the 'LanguageDef' that is passed to+ -- 'makeTokenParser'. An @identifier@ is treated as+ -- a single token using 'try'.+ identifier :: CharParser st String++ -- | 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 'try'.+ , reserved :: String -> CharParser st ()++ -- | This lexeme parser parses a legal operator. Returns the name of the+ -- operator. This parser will fail on any operators that are reserved+ -- operators. Legal operator (start) characters and reserved operators+ -- are defined in the 'LanguageDef' that is passed to+ -- 'makeTokenParser'. An @operator@ is treated as a+ -- single token using 'try'.+ , operator :: CharParser st String++ -- |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+ -- 'try'.+ , reservedOp :: String -> CharParser st ()+++ -- | This lexeme parser parses a single literal character. Returns the+ -- literal character value. This parsers deals correctly with escape+ -- sequences. The literal character is parsed according to the grammar+ -- rules defined in the Haskell report (which matches most programming+ -- languages quite closely).+ , charLiteral :: CharParser st Char++ -- | This lexeme parser parses a literal string. Returns the literal+ -- string value. This parsers deals correctly with escape sequences and+ -- gaps. The literal string is parsed according to the grammar rules+ -- defined in the Haskell report (which matches most programming+ -- languages quite closely).+ , stringLiteral :: CharParser st String++ -- | This lexeme parser parses a natural number (a positive whole+ -- number). Returns the value of the number. The number can be+ -- specified in 'decimal', 'hexadecimal' or+ -- 'octal'. The number is parsed according to the grammar+ -- rules in the Haskell report.+ , natural :: CharParser st Integer++ -- | This lexeme parser parses an integer (a whole number). This parser+ -- is like 'natural' except that it can be prefixed with+ -- sign (i.e. \'-\' or \'+\'). Returns the value of the number. The+ -- number can be specified in 'decimal', 'hexadecimal'+ -- or 'octal'. The number is parsed according+ -- to the grammar rules in the Haskell report.+ , integer :: CharParser st Integer++ -- | This lexeme parser parses a floating point value. Returns the value+ -- of the number. The number is parsed according to the grammar rules+ -- defined in the Haskell report.+ , float :: CharParser st Double++ -- | This lexeme parser parses either 'natural' or a 'float'.+ -- Returns the value of the number. This parsers deals with+ -- any overlap in the grammar rules for naturals and floats. The number+ -- is parsed according to the grammar rules defined in the Haskell report.+ , naturalOrFloat :: CharParser st (Either Integer Double)++ -- | Parses a positive whole number in the decimal system. Returns the+ -- value of the number.+ , decimal :: CharParser st Integer++ -- | Parses a positive whole number in the hexadecimal system. The number+ -- should be prefixed with \"0x\" or \"0X\". Returns the value of the+ -- number.+ , hexadecimal :: CharParser st Integer++ -- | Parses a positive whole number in the octal system. The number+ -- should be prefixed with \"0o\" or \"0O\". Returns the value of the+ -- number.+ , octal :: CharParser st Integer+++ -- | Lexeme parser @symbol s@ parses 'string' @s@ and skips+ -- trailing white space.+ , symbol :: String -> CharParser st String++ -- | @lexeme p@ first applies parser @p@ and than the 'whiteSpace'+ -- parser, returning the value of @p@. Every lexical+ -- token (lexeme) is defined using @lexeme@, this way every parse+ -- starts at a point without white space. Parsers that use @lexeme@ are+ -- called /lexeme/ parsers in this document.+ --+ -- The only point where the 'whiteSpace' parser should be+ -- called explicitly is the start of the main parser in order to skip+ -- any leading white space.+ --+ -- > mainParser = do{ whiteSpace+ -- > ; ds <- many (lexeme digit)+ -- > ; eof+ -- > ; return (sum ds)+ -- > }+ , lexeme :: forall a. CharParser st a -> CharParser st a++ -- | Parses any white space. White space consists of /zero/ or more+ -- occurrences of a 'space', a line comment or a block (multi+ -- line) comment. Block comments may be nested. How comments are+ -- started and ended is defined in the 'LanguageDef'+ -- that is passed to 'makeTokenParser'.+ , whiteSpace :: CharParser st ()++++ -- | Lexeme parser @parens p@ parses @p@ enclosed in parenthesis,+ -- returning the value of @p@.+ , parens :: forall a. CharParser st a -> CharParser st a++ -- | Lexeme parser @braces p@ parses @p@ enclosed in braces (\'{\' and+ -- \'}\'), returning the value of @p@.+ , braces :: forall a. CharParser st a -> CharParser st a++ -- | Lexeme parser @angles p@ parses @p@ enclosed in angle brackets (\'\<\'+ -- and \'>\'), returning the value of @p@.+ , angles :: forall a. CharParser st a -> CharParser st a++ -- | Lexeme parser @brackets p@ parses @p@ enclosed in brackets (\'[\'+ -- and \']\'), returning the value of @p@.+ , brackets :: forall a. CharParser st a -> CharParser st a++ -- | DEPRECATED: Use 'brackets'.+ , squares :: forall a. CharParser st a -> CharParser st a+++ -- | Lexeme parser |semi| parses the character \';\' and skips any+ -- trailing white space. Returns the string \";\".+ , semi :: CharParser st String++ -- | Lexeme parser @comma@ parses the character \',\' and skips any+ -- trailing white space. Returns the string \",\".+ , comma :: CharParser st String++ -- | Lexeme parser @colon@ parses the character \':\' and skips any+ -- trailing white space. Returns the string \":\".+ , colon :: CharParser st String++ -- | Lexeme parser @dot@ parses the character \'.\' and skips any+ -- trailing white space. Returns the string \".\".+ , dot :: CharParser st String++ -- | Lexeme parser @semiSep p@ parses /zero/ or more occurrences of @p@+ -- separated by 'semi'. Returns a list of values returned by+ -- @p@.+ , semiSep :: forall a . CharParser st a -> CharParser st [a]++ -- | Lexeme parser @semiSep1 p@ parses /one/ or more occurrences of @p@+ -- separated by 'semi'. Returns a list of values returned by @p@.+ , semiSep1 :: forall a . CharParser st a -> CharParser st [a]++ -- | Lexeme parser @commaSep p@ parses /zero/ or more occurrences of+ -- @p@ separated by 'comma'. Returns a list of values returned+ -- by @p@.+ , commaSep :: forall a . CharParser st a -> CharParser st [a]++ -- | Lexeme parser @commaSep1 p@ parses /one/ or more occurrences of+ -- @p@ separated by 'comma'. Returns a list of values returned+ -- by @p@.+ , commaSep1 :: forall a . CharParser st a -> CharParser st [a]+ }++-----------------------------------------------------------+-- Given a LanguageDef, create a token parser.+-----------------------------------------------------------++-- | The expression @makeTokenParser language@ creates a 'TokenParser'+-- 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+-- appropiate language definition and selects the lexical parsers that+-- are needed from the resulting 'TokenParser'.+--+-- > module Main where+-- >+-- > import Text.ParserCombinators.Parsec+-- > import qualified Text.ParserCombinators.Parsec.Token as P+-- > import Text.ParserCombinators.Parsec.Language (haskellDef)+-- >+-- > -- The parser+-- > ...+-- >+-- > expr = parens expr+-- > <|> identifier+-- > <|> ...+-- >+-- >+-- > -- The lexer+-- > lexer = P.makeTokenParser haskellDef+-- >+-- > parens = P.parens lexer+-- > braces = P.braces lexer+-- > identifier = P.identifier lexer+-- > reserved = P.reserved lexer+-- > ...+makeTokenParser :: LanguageDef st -> TokenParser st+makeTokenParser languageDef+ = TokenParser{ identifier = identifier+ , reserved = reserved+ , operator = operator+ , reservedOp = reservedOp+ + , charLiteral = charLiteral+ , stringLiteral = stringLiteral+ , natural = natural+ , integer = integer+ , float = float+ , naturalOrFloat = naturalOrFloat+ , decimal = decimal+ , hexadecimal = hexadecimal+ , octal = octal+ + , symbol = symbol+ , lexeme = lexeme+ , whiteSpace = whiteSpace+ + , parens = parens+ , braces = braces+ , angles = angles+ , brackets = brackets+ , squares = brackets+ , semi = semi+ , comma = comma+ , colon = colon+ , dot = dot+ , semiSep = semiSep+ , semiSep1 = semiSep1+ , commaSep = commaSep+ , commaSep1 = commaSep1+ }+ where+ + -----------------------------------------------------------+ -- Bracketing+ -----------------------------------------------------------+ parens p = between (symbol "(") (symbol ")") p+ braces p = between (symbol "{") (symbol "}") p+ angles p = between (symbol "<") (symbol ">") p+ brackets p = between (symbol "[") (symbol "]") p++ semi = symbol ";" + comma = symbol ","+ dot = symbol "."+ colon = symbol ":"++ commaSep p = sepBy p comma+ semiSep p = sepBy p semi++ commaSep1 p = sepBy1 p comma+ semiSep1 p = sepBy1 p semi+++ -----------------------------------------------------------+ -- Chars & Strings+ -----------------------------------------------------------+ -- charLiteral :: CharParser st Char+ charLiteral = lexeme (between (char '\'') + (char '\'' <?> "end of character")+ characterChar )+ <?> "character"++ characterChar = charLetter <|> charEscape + <?> "literal character"++ charEscape = do{ char '\\'; escapeCode }+ charLetter = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))++++ -- stringLiteral :: CharParser st String+ stringLiteral = lexeme (+ do{ str <- between (char '"') + (char '"' <?> "end of string")+ (many stringChar) + ; return (foldr (maybe id (:)) "" str)+ }+ <?> "literal string")++ -- stringChar :: CharParser st (Maybe Char)+ stringChar = do{ c <- stringLetter; return (Just c) }+ <|> stringEscape + <?> "string character"+ + stringLetter = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))++ stringEscape = do{ char '\\'+ ; do{ escapeGap ; return Nothing }+ <|> do{ escapeEmpty; return Nothing }+ <|> do{ esc <- escapeCode; return (Just esc) }+ }+ + escapeEmpty = char '&'+ escapeGap = do{ many1 space+ ; char '\\' <?> "end of string gap"+ }+ + + + -- escape codes+ escapeCode = charEsc <|> charNum <|> charAscii <|> charControl+ <?> "escape code"++ -- charControl :: CharParser st Char+ charControl = do{ char '^'+ ; code <- upper+ ; return (toEnum (fromEnum code - fromEnum 'A'))+ }++ -- charNum :: CharParser st Char + charNum = do{ code <- decimal + <|> do{ char 'o'; number 8 octDigit }+ <|> do{ char 'x'; number 16 hexDigit }+ ; return (toEnum (fromInteger code))+ }++ charEsc = choice (map parseEsc escMap)+ where+ parseEsc (c,code) = do{ char c; return code }+ + charAscii = choice (map parseAscii asciiMap)+ where+ parseAscii (asc,code) = try (do{ string asc; return code })+++ -- escape code tables+ escMap = zip ("abfnrtv\\\"\'") ("\a\b\f\n\r\t\v\\\"\'")+ asciiMap = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2) ++ ascii2codes = ["BS","HT","LF","VT","FF","CR","SO","SI","EM",+ "FS","GS","RS","US","SP"]+ ascii3codes = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL",+ "DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB",+ "CAN","SUB","ESC","DEL"]++ ascii2 = ['\BS','\HT','\LF','\VT','\FF','\CR','\SO','\SI',+ '\EM','\FS','\GS','\RS','\US','\SP']+ ascii3 = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK',+ '\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK',+ '\SYN','\ETB','\CAN','\SUB','\ESC','\DEL']+++ -----------------------------------------------------------+ -- Numbers+ -----------------------------------------------------------+ -- naturalOrFloat :: CharParser st (Either Integer Double)+ naturalOrFloat = lexeme (natFloat) <?> "number"++ float = lexeme floating <?> "float"+ integer = lexeme int <?> "integer"+ natural = lexeme nat <?> "natural"+++ -- floats+ floating = do{ n <- decimal + ; fractExponent n+ }+++ natFloat = do{ char '0'+ ; zeroNumFloat+ }+ <|> decimalFloat+ + zeroNumFloat = do{ n <- hexadecimal <|> octal+ ; return (Left n)+ }+ <|> decimalFloat+ <|> fractFloat 0+ <|> return (Left 0) + + decimalFloat = do{ n <- decimal+ ; option (Left n) + (fractFloat n)+ }++ fractFloat n = do{ f <- fractExponent n+ ; return (Right f)+ }+ + fractExponent n = do{ fract <- fraction+ ; expo <- option 1.0 exponent'+ ; return ((fromInteger n + fract)*expo)+ }+ <|>+ do{ expo <- exponent'+ ; return ((fromInteger n)*expo)+ }++ fraction = do{ char '.'+ ; digits <- many1 digit <?> "fraction"+ ; return (foldr op 0.0 digits)+ }+ <?> "fraction"+ where+ op d f = (f + fromIntegral (digitToInt d))/10.0+ + exponent' = do{ oneOf "eE"+ ; f <- sign+ ; e <- decimal <?> "exponent"+ ; return (power (f e))+ }+ <?> "exponent"+ where+ power e | e < 0 = 1.0/power(-e)+ | otherwise = fromInteger (10^e)+++ -- integers and naturals+ int = do{ f <- lexeme sign+ ; n <- nat+ ; return (f n)+ }+ + -- sign :: CharParser st (Integer -> Integer)+ sign = (char '-' >> return negate) + <|> (char '+' >> return id) + <|> return id++ nat = zeroNumber <|> decimal+ + zeroNumber = do{ char '0'+ ; hexadecimal <|> octal <|> decimal <|> return 0+ }+ <?> "" ++ decimal = number 10 digit + hexadecimal = do{ oneOf "xX"; number 16 hexDigit }+ octal = do{ oneOf "oO"; number 8 octDigit }++ -- number :: Integer -> CharParser st Char -> CharParser st Integer+ number base baseDigit+ = do{ digits <- many1 baseDigit+ ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits+ ; seq n (return n)+ } ++ -----------------------------------------------------------+ -- Operators & reserved ops+ -----------------------------------------------------------+ reservedOp name = + lexeme $ try $+ do{ string name+ ; notFollowedBy (opLetter languageDef) <?> ("end of " ++ show name)+ }++ operator =+ lexeme $ try $+ do{ name <- oper+ ; if (isReservedOp name)+ then unexpected ("reserved operator " ++ show name)+ else return name+ }+ + oper =+ do{ c <- (opStart languageDef)+ ; cs <- many (opLetter languageDef)+ ; return (c:cs)+ }+ <?> "operator"+ + isReservedOp name =+ isReserved (sort (reservedOpNames languageDef)) name + + + -----------------------------------------------------------+ -- Identifiers & Reserved words+ -----------------------------------------------------------+ reserved name =+ lexeme $ try $+ do{ caseString name+ ; notFollowedBy (identLetter languageDef) <?> ("end of " ++ show name)+ }++ caseString name+ | caseSensitive languageDef = string name+ | otherwise = do{ walk name; return name }+ where+ walk [] = return ()+ walk (c:cs) = do{ caseChar c <?> msg; walk cs }+ + caseChar c | isAlpha c = char (toLower c) <|> char (toUpper c)+ | otherwise = char c+ + msg = show name+ ++ identifier =+ lexeme $ try $+ do{ name <- ident+ ; if (isReservedName name)+ then unexpected ("reserved word " ++ show name)+ else return name+ }+ + + ident + = do{ c <- identStart languageDef+ ; cs <- many (identLetter languageDef)+ ; return (c:cs)+ }+ <?> "identifier"++ isReservedName name+ = isReserved theReservedNames caseName+ where+ caseName | caseSensitive languageDef = name+ | otherwise = map toLower name++ + isReserved names name + = scan names+ where+ scan [] = False+ scan (r:rs) = case (compare r name) of+ LT -> scan rs+ EQ -> True+ GT -> False++ theReservedNames+ | caseSensitive languageDef = sort names+ | otherwise = sort (map (map toLower) names)+ where+ names = reservedNames languageDef+ +++ -----------------------------------------------------------+ -- White space & symbols+ -----------------------------------------------------------+ symbol name+ = lexeme (string name)++ lexeme p + = do{ x <- p; whiteSpace; return x }+ + + --whiteSpace + whiteSpace + | noLine && noMulti = skipMany (simpleSpace <?> "")+ | noLine = skipMany (simpleSpace <|> multiLineComment <?> "")+ | noMulti = skipMany (simpleSpace <|> oneLineComment <?> "")+ | otherwise = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")+ where+ noLine = null (commentLine languageDef)+ noMulti = null (commentStart languageDef) + + + simpleSpace =+ skipMany1 (satisfy isSpace) + + oneLineComment =+ do{ try (string (commentLine languageDef))+ ; skipMany (satisfy (/= '\n'))+ ; return ()+ }++ multiLineComment =+ do { try (string (commentStart languageDef))+ ; inComment+ }++ inComment + | nestedComments languageDef = inCommentMulti+ | otherwise = inCommentSingle+ + inCommentMulti + = do{ try (string (commentEnd languageDef)) ; return () }+ <|> do{ multiLineComment ; inCommentMulti }+ <|> do{ skipMany1 (noneOf startEnd) ; inCommentMulti }+ <|> do{ oneOf startEnd ; inCommentMulti }+ <?> "end of comment" + where+ startEnd = nub (commentEnd languageDef ++ commentStart languageDef)++ inCommentSingle+ = do{ try (string (commentEnd languageDef)); return () }+ <|> do{ skipMany1 (noneOf startEnd) ; inCommentSingle }+ <|> do{ oneOf startEnd ; inCommentSingle }+ <?> "end of comment"+ where+ startEnd = nub (commentEnd languageDef ++ commentStart languageDef)+
+ parsec2.cabal view
@@ -0,0 +1,49 @@+cabal-version: >= 1.2+name: parsec2+version: 1.0.0+license: BSD3+license-file: LICENSE+author: Daan Leijen <daan@cs.uu.nl>+maintainer: Antoine Latter <aslatter@gmail.com>+homepage: http://www.cs.uu.nl/~daan/parsec.html+category: Parsing+synopsis: Monadic parser combinators+description:+ Parsec is designed from scratch as an industrial-strength parser+ library. It is simple, safe, well documented (on the package+ homepage), has extensive libraries and good error messages,+ and is also fast.+ .+ This package is a maintained fork of version 2.1 of the parsec+ package, intended to preserve its simplicity and portability.+build-type: Simple+extra-source-files: CHANGELOG+cabal-version: >= 1.6+library {+ exposed-modules:+ Text.ParserCombinators.Parsec.Error,+ Text.ParserCombinators.Parsec.Char,+ Text.ParserCombinators.Parsec.Combinator,+ Text.ParserCombinators.Parsec.Expr,+ Text.ParserCombinators.Parsec.Perm,+ Text.ParserCombinators.Parsec.Pos,+ Text.ParserCombinators.Parsec.Prim,+ Text.ParserCombinators.Parsec+ build-depends: base<5+ extensions: ExistentialQuantification+ if !impl(nhc98) {+ extensions: PolymorphicComponents+ exposed-modules:+ Text.ParserCombinators.Parsec.Language,+ Text.ParserCombinators.Parsec.Token+ }+}+source-repository head {+ type: darcs+ location: http://code.haskell.org/parsec2/parsec2+}+source-repository this {+ type: darcs+ location: http://code.haskell.org/parsec2/parsec2+ tag: 1.0.0+}