parsec (empty) → 2.0
raw patch · 13 files changed
+1892/−0 lines, 13 filesdep +basebuild-type:Customsetup-changed
Dependencies added: base
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- Text/ParserCombinators/Parsec.hs +54/−0
- Text/ParserCombinators/Parsec/Char.hs +75/−0
- Text/ParserCombinators/Parsec/Combinator.hs +152/−0
- Text/ParserCombinators/Parsec/Error.hs +164/−0
- Text/ParserCombinators/Parsec/Expr.hs +123/−0
- Text/ParserCombinators/Parsec/Language.hs +124/−0
- Text/ParserCombinators/Parsec/Perm.hs +122/−0
- Text/ParserCombinators/Parsec/Pos.hs +99/−0
- Text/ParserCombinators/Parsec/Prim.hs +456/−0
- Text/ParserCombinators/Parsec/Token.hs +473/−0
- parsec.cabal +27/−0
+ 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,2 @@+import Distribution.Simple+main = defaultMainWithHooks defaultUserHooks
+ 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 : daan@cs.uu.nl+-- 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,75 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Char+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : daan@cs.uu.nl+-- 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, noneOf :: [Char] -> CharParser st Char+oneOf cs = satisfy (\c -> elem c cs)+noneOf cs = satisfy (\c -> not (elem c cs))++spaces :: CharParser st ()+spaces = skipMany space <?> "white space" ++space, newline, tab :: CharParser st Char+space = satisfy (isSpace) <?> "space"+newline = char '\n' <?> "new-line"+tab = char '\t' <?> "tab"++upper, lower, alphaNum, letter, digit, hexDigit, octDigit :: CharParser st Char+upper = satisfy (isUpper) <?> "uppercase letter"+lower = satisfy (isLower) <?> "lowercase letter"+alphaNum = satisfy (isAlphaNum) <?> "letter or digit"+letter = satisfy (isAlpha) <?> "letter"+digit = satisfy (isDigit) <?> "digit"+hexDigit = satisfy (isHexDigit) <?> "hexadecimal digit"+octDigit = satisfy (isOctDigit) <?> "octal digit"++char :: Char -> CharParser st Char+char c = satisfy (==c) <?> show [c]++anyChar :: CharParser st Char+anyChar = satisfy (const True)++-----------------------------------------------------------+-- Primitive character parsers+-----------------------------------------------------------+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 :: String -> CharParser st String+string s = tokens show updatePosString s
+ Text/ParserCombinators/Parsec/Combinator.hs view
@@ -0,0 +1,152 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Combinator+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : daan@cs.uu.nl+-- Stability : provisional+-- Portability : portable+--+-- Commonly used generic combinators+-- +-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Combinator+ ( choice+ , count+ , between+ , option, 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 :: [GenParser tok st a] -> GenParser tok st a+choice ps = foldr (<|>) mzero ps++option :: a -> GenParser tok st a -> GenParser tok st a+option x p = p <|> return x++optional :: GenParser tok st a -> GenParser tok st ()+optional p = do{ p; return ()} <|> return ()++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 :: GenParser tok st a -> GenParser tok st ()+skipMany1 p = do{ p; skipMany p }+{-+skipMany p = scan+ where+ scan = do{ p; scan } <|> return ()+-}++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 [])+-}++sepBy1,sepBy :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]+sepBy p sep = sepBy1 p sep <|> return []+sepBy1 p sep = do{ x <- p+ ; xs <- many (sep >> p)+ ; return (x:xs)+ }++sepEndBy1, sepEndBy :: 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 = sepEndBy1 p sep <|> return []+++endBy1,endBy :: 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 = many (do{ x <- p; sep; return x })++count :: Int -> GenParser tok st a -> GenParser tok st [a]+count n p | n <= 0 = return []+ | otherwise = sequence (replicate n p)+++chainr,chainl :: 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 = chainl1 p op <|> return x++chainr1,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 = scan+ where+ scan = do{ x <- p; rest x }+ + rest x = do{ f <- op+ ; y <- scan+ ; return (f x y)+ }+ <|> return x++-----------------------------------------------------------+-- Tricky combinators+-----------------------------------------------------------+anyToken :: Show tok => GenParser tok st tok+anyToken = tokenPrim show (\pos tok toks -> pos) Just++eof :: Show tok => GenParser tok st ()+eof = notFollowedBy anyToken <?> "end of input" ++notFollowedBy :: Show tok => GenParser tok st tok -> GenParser tok st () +notFollowedBy p = try (do{ c <- p; unexpected (show [c]) }+ <|> return ()+ )++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 :: 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,164 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Error+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : daan@cs.uu.nl+-- 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 + +-----------------------------------------------------------+-- Messages+----------------------------------------------------------- +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)+ +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)+ + +-----------------------------------------------------------+-- Parse Errors+----------------------------------------------------------- +data ParseError = ParseError !SourcePos [Message]++errorPos :: ParseError -> SourcePos+errorPos (ParseError pos msgs)+ = pos+ +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,123 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Expr+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : daan@cs.uu.nl+-- 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+-----------------------------------------------------------+data Assoc = AssocNone + | AssocLeft+ | AssocRight+ +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))++type OperatorTable t st a = [[Operator t st a]]++++-----------------------------------------------------------+-- Convert an OperatorTable and basic term parser into+-- a full fledged expression parser+-----------------------------------------------------------+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,124 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Language+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : daan@cs.uu.nl+-- 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+----------------------------------------------------------- +haskellStyle :: LanguageDef st+haskellStyle= emptyDef + { commentStart = "{-"+ , commentEnd = "-}"+ , commentLine = "--"+ , nestedComments = True+ , identStart = letter+ , identLetter = alphaNum <|> oneOf "_'"+ , opStart = opLetter haskellStyle+ , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~" + , reservedOpNames= []+ , reservedNames = []+ , caseSensitive = True + } + +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+----------------------------------------------------------- +haskell :: TokenParser st+haskell = makeTokenParser haskellDef++haskellDef :: LanguageDef st+haskellDef = haskell98Def+ { identLetter = identLetter haskell98Def <|> char '#'+ , reservedNames = reservedNames haskell98Def ++ + ["foreign","import","export","primitive"+ ,"_ccall_","_casm_"+ ,"forall"+ ]+ }+ +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+----------------------------------------------------------- +mondrian :: TokenParser st+mondrian = makeTokenParser mondrianDef++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,122 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Perm+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : daan@cs.uu.nl+-- 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+---------------------------------------------------------------}+(<||>) :: PermParser tok st (a -> b) -> GenParser tok st a -> PermParser tok st b+(<||>) perm p = add perm p ++(<$$>) :: (a -> b) -> GenParser tok st a -> PermParser tok st b+(<$$>) f p = newperm f <||> p++(<|?>) :: PermParser tok st (a -> b) -> (a, GenParser tok st a) -> PermParser tok st b+(<|?>) perm (x,p) = addopt perm x p++(<$?>) :: (a -> b) -> (a, GenParser tok st a) -> PermParser tok st b+(<$?>) f (x,p) = newperm f <|?> (x,p)++++{---------------------------------------------------------------+ The permutation tree+---------------------------------------------------------------}+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)+++-- transform a permutation tree into a normal parser+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,99 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Pos+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : daan@cs.uu.nl+-- 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++data SourcePos = SourcePos SourceName !Line !Column+ deriving (Eq,Ord)+ ++newPos :: SourceName -> Line -> Column -> SourcePos+newPos sourceName line column+ = SourcePos sourceName line column++initialPos :: SourceName -> SourcePos+initialPos sourceName+ = newPos sourceName 1 1++sourceName :: SourcePos -> SourceName+sourceName (SourcePos name line column) = name ++sourceLine :: SourcePos -> Line+sourceLine (SourcePos name line column) = line++sourceColumn :: SourcePos -> Column+sourceColumn (SourcePos name line column) = column++incSourceLine :: SourcePos -> Line -> SourcePos+incSourceLine (SourcePos name line column) n = SourcePos name (line+n) column++incSourceColumn :: SourcePos -> Column -> SourcePos+incSourceColumn (SourcePos name line column) n = SourcePos name line (column+n)++setSourceName :: SourcePos -> SourceName -> SourcePos+setSourceName (SourcePos name line column) n = SourcePos n line column++setSourceLine :: SourcePos -> Line -> SourcePos+setSourceLine (SourcePos name line column) n = SourcePos name n column++setSourceColumn :: SourcePos -> Column -> SourcePos+setSourceColumn (SourcePos name line column) n = SourcePos name line n++-----------------------------------------------------------+-- Update source positions on characters+-----------------------------------------------------------+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,456 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Prim+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : daan@cs.uu.nl+-- 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 <|>++(<?>) :: GenParser tok st a -> String -> GenParser tok st a+p <?> msg = label p msg++(<|>) :: GenParser tok st a -> GenParser tok st a -> GenParser tok st a+p1 <|> p2 = mplus p1 p2+++-----------------------------------------------------------+-- User state combinators+-----------------------------------------------------------+getState :: GenParser tok st st+getState = do{ state <- getParserState+ ; return (stateUser state)+ }++setState :: st -> GenParser tok st ()+setState st = do{ updateParserState (\(State input pos _) -> State input pos st)+ ; return ()+ }++updateState :: (st -> st) -> GenParser tok st ()+updateState f = do{ updateParserState (\(State input pos user) -> State input pos (f user))+ ; return ()+ }+++-----------------------------------------------------------+-- Parser state combinators+-----------------------------------------------------------+getPosition :: GenParser tok st SourcePos+getPosition = do{ state <- getParserState; return (statePos state) }++getInput :: GenParser tok st [tok]+getInput = do{ state <- getParserState; return (stateInput state) }+++setPosition :: SourcePos -> GenParser tok st ()+setPosition pos = do{ updateParserState (\(State input _ user) -> State input pos user)+ ; return ()+ }+ +setInput :: [tok] -> GenParser tok st ()+setInput input = do{ updateParserState (\(State _ pos user) -> State input pos user)+ ; return ()+ }++getParserState :: GenParser tok st (State tok st)+getParserState = updateParserState id ++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)+ }++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 :: GenParser tok () a -> SourceName -> [tok] -> Either ParseError a+parse p name input+ = runParser p () name 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 :: 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+-}+++-----------------------------------------------------------+-- Primitive Parsers: +-- try, token(Prim), label, unexpected and updateState+-----------------------------------------------------------+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+ )++ +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++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 :: (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)))+ + +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 :: GenParser tok st a -> GenParser tok st [a]+many p+ = do{ xs <- manyAccum (:) p+ ; return (reverse xs)+ }++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,473 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.ParserCombinators.Parsec.Token+-- Copyright : (c) Daan Leijen 1999-2001+-- License : BSD-style (see the file libraries/parsec/LICENSE)+-- +-- Maintainer : daan@cs.uu.nl+-- 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+-----------------------------------------------------------+data LanguageDef st + = LanguageDef + { commentStart :: String+ , commentEnd :: String+ , commentLine :: String+ , nestedComments :: Bool + , identStart :: CharParser st Char+ , identLetter :: CharParser st Char+ , opStart :: CharParser st Char+ , opLetter :: CharParser st Char+ , reservedNames :: [String]+ , reservedOpNames:: [String]+ , caseSensitive :: Bool+ } + +-----------------------------------------------------------+-- A first class module: TokenParser+-----------------------------------------------------------+data TokenParser st+ = TokenParser{ identifier :: CharParser st String+ , reserved :: String -> CharParser st ()+ , operator :: CharParser st String+ , reservedOp :: String -> CharParser st ()+ + , charLiteral :: CharParser st Char+ , stringLiteral :: CharParser st String+ , natural :: CharParser st Integer+ , integer :: CharParser st Integer+ , float :: CharParser st Double+ , naturalOrFloat :: CharParser st (Either Integer Double)+ , decimal :: CharParser st Integer+ , hexadecimal :: CharParser st Integer+ , octal :: CharParser st Integer+ + , symbol :: String -> CharParser st String+ , lexeme :: forall a. CharParser st a -> CharParser st a+ , whiteSpace :: CharParser st () + + , parens :: forall a. CharParser st a -> CharParser st a + , braces :: forall a. CharParser st a -> CharParser st a+ , angles :: forall a. CharParser st a -> CharParser st a+ , brackets :: forall a. CharParser st a -> CharParser st a+ -- "squares" is deprecated+ , squares :: forall a. CharParser st a -> CharParser st a ++ , semi :: CharParser st String+ , comma :: CharParser st String+ , colon :: CharParser st String+ , dot :: CharParser st String+ , semiSep :: forall a . CharParser st a -> CharParser st [a]+ , semiSep1 :: forall a . CharParser st a -> CharParser st [a]+ , commaSep :: forall a . CharParser st a -> CharParser st [a]+ , commaSep1 :: forall a . CharParser st a -> CharParser st [a] + }++-----------------------------------------------------------+-- Given a LanguageDef, create a token parser.+-----------------------------------------------------------+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 = sortedNames+ | otherwise = map (map toLower) sortedNames+ where+ sortedNames = sort (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)+
+ parsec.cabal view
@@ -0,0 +1,27 @@+name: parsec+version: 2.0+license: BSD3+license-file: LICENSE+author: Daan Leijen <daan@cs.uu.nl>+maintainer: Daan Leijen <daan@cs.uu.nl>+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.+exposed-modules:+ Text.ParserCombinators.Parsec.Error,+ Text.ParserCombinators.Parsec.Char,+ Text.ParserCombinators.Parsec.Combinator,+ Text.ParserCombinators.Parsec.Expr,+ Text.ParserCombinators.Parsec.Language,+ Text.ParserCombinators.Parsec.Perm,+ Text.ParserCombinators.Parsec.Pos,+ Text.ParserCombinators.Parsec.Prim,+ Text.ParserCombinators.Parsec.Token,+ Text.ParserCombinators.Parsec+build-depends: base+extensions: ExistentialQuantification, PolymorphicComponents