diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,7 +1,13 @@ Version change log. -=0.10= +=0.11.1= +Fixed binary operator precedence in the parser. See +=0.11= +Added a simple quasi-quoter for ECMAScript (see +Language.ECMAScript3.Syntax.QuasiQuote) + +=0.10= The ParenExpr constructor was removed from the Expression AST (WARNING: might break some builds). The pretty printer was rewritten to automatically parenthesize sub-expressions based on operator diff --git a/language-ecmascript.cabal b/language-ecmascript.cabal --- a/language-ecmascript.cabal +++ b/language-ecmascript.cabal @@ -1,5 +1,5 @@ Name: language-ecmascript -Version: 0.10 +Version: 0.11.1 Cabal-Version: >= 1.10 Copyright: (c) 2007-2012 Brown University, (c) 2008-2010 Claudiu Saftoiu, (c) 2012 Stevens Institute of Technology @@ -21,7 +21,7 @@ Includes a parser, pretty-printer, and basic building blocks for more sophisticated tools. - This package used to be called WebBits. + This package supercedes package WebBits. Source-repository head type: git @@ -30,7 +30,7 @@ Source-repository this type: git location: git://github.com/jswebtools/language-ecmascript.git - tag: 0.9.1 + tag: 0.11.1 Library Hs-Source-Dirs: @@ -44,7 +44,9 @@ syb >= 0.1, uniplate >= 1.6 && <1.7, data-default >= 0.4 && <0.6, - QuickCheck >= 2.4.1.1 + QuickCheck >= 2.5, + template-haskell, + charset >= 0.3.2.1 ghc-options: -fwarn-incomplete-patterns Exposed-Modules: @@ -55,8 +57,11 @@ Language.ECMAScript3.Syntax Language.ECMAScript3.Syntax.Annotations Language.ECMAScript3.Syntax.Arbitrary + Language.ECMAScript3.Syntax.QuasiQuote Language.ECMAScript3.Analysis.Environment Language.ECMAScript3.Analysis.LabelSets + Language.ECMAScript3.Parser.Type + Language.ECMAScript3.Parser.State Default-Extensions: DeriveDataTypeable, ScopedTypeVariables, DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts Default-Language: Haskell2010 @@ -76,7 +81,8 @@ filepath, HUnit, data-default >=0.4 && <0.6, - QuickCheck >= 2.4.1.1 + QuickCheck >= 2.5, + charset >= 0.3.2.1 Default-Extensions: DeriveDataTypeable, ScopedTypeVariables, DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts Default-Language: Haskell2010 ghc-options: @@ -96,8 +102,8 @@ directory, filepath, HUnit, - data-default >=0.4 && <0.5, - QuickCheck >= 2.4.1.1, + data-default >=0.4 && <0.6, + QuickCheck >= 2.5, uniplate >= 1.6 && <1.7 Default-Extensions: DeriveDataTypeable, ScopedTypeVariables, DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts Default-Language: Haskell2010 diff --git a/src/Language/ECMAScript3/Lexer.hs b/src/Language/ECMAScript3/Lexer.hs --- a/src/Language/ECMAScript3/Lexer.hs +++ b/src/Language/ECMAScript3/Lexer.hs @@ -11,9 +11,14 @@ import Prelude hiding (lex) import Text.Parsec import qualified Text.Parsec.Token as T +import Language.ECMAScript3.Parser.State +import Language.ECMAScript3.Parser.Type +import Control.Monad.Identity +identifierStart :: Stream s Identity Char => Parser s Char identifierStart = letter <|> oneOf "$_" +javascriptDef :: Stream s Identity Char =>T.GenLanguageDef s ParserState Identity javascriptDef = T.LanguageDef "/*" "*/" @@ -35,31 +40,55 @@ "[", "]", "{", "}", "(", ")"," T.GenTokenParser s ParserState Identity lex = T.makeTokenParser javascriptDef -- everything but commaSep and semiSep +identifier :: Stream s Identity Char => Parser s String identifier = T.identifier lex +reserved :: Stream s Identity Char => String -> Parser s () reserved = T.reserved lex +operator :: Stream s Identity Char => Parser s String operator = T.operator lex +reservedOp :: Stream s Identity Char => String -> Parser s () reservedOp = T.reservedOp lex +charLiteral :: Stream s Identity Char => Parser s Char charLiteral = T.charLiteral lex -stringLiteral = T.stringLiteral lex +stringLiteral :: Stream s Identity Char => Parser s String +stringLiteral = T.stringLiteral lex +natural :: Stream s Identity Char => Parser s Integer natural = T.natural lex +integer :: Stream s Identity Char => Parser s Integer integer = T.integer lex -float = T.float lex -naturalOrFloat = T.naturalOrFloat lex +float :: Stream s Identity Char => Parser s Double +float = T.float lex +naturalOrFloat :: Stream s Identity Char => Parser s (Either Integer Double) +naturalOrFloat = T.naturalOrFloat lex +decimal :: Stream s Identity Char => Parser s Integer decimal = T.decimal lex +hexadecimal :: Stream s Identity Char => Parser s Integer hexadecimal = T.hexadecimal lex -octal = T.octal lex -symbol = T.symbol lex +octal :: Stream s Identity Char => Parser s Integer +octal = T.octal lex +symbol :: Stream s Identity Char => String -> Parser s String +symbol = T.symbol lex +whiteSpace :: Stream s Identity Char => Parser s () whiteSpace = T.whiteSpace lex +parens :: Stream s Identity Char => Parser s a -> Parser s a parens = T.parens lex +braces :: Stream s Identity Char => Parser s a -> Parser s a braces = T.braces lex +squares :: Stream s Identity Char => Parser s a -> Parser s a squares = T.squares lex +semi :: Stream s Identity Char => Parser s String semi = T.semi lex +comma :: Stream s Identity Char => Parser s String comma = T.comma lex -colon = T.colon lex +colon :: Stream s Identity Char => Parser s String +colon = T.colon lex +dot :: Stream s Identity Char => Parser s String dot = T.dot lex +brackets :: Stream s Identity Char => Parser s a -> Parser s a brackets = T.brackets lex +lexeme :: Stream s Identity Char => Parser s a -> Parser s a lexeme = T.lexeme lex diff --git a/src/Language/ECMAScript3/Parser.hs b/src/Language/ECMAScript3/Parser.hs --- a/src/Language/ECMAScript3/Parser.hs +++ b/src/Language/ECMAScript3/Parser.hs @@ -18,10 +18,14 @@ -- debugging, remove the next 2 lines , mkDecimal , intLen + , parseObjectLit + , Parser ) where import Language.ECMAScript3.Lexer hiding (identifier) import qualified Language.ECMAScript3.Lexer as Lexer +import Language.ECMAScript3.Parser.State +import Language.ECMAScript3.Parser.Type import Language.ECMAScript3.Syntax import Language.ECMAScript3.Syntax.Annotations import Data.Default @@ -38,27 +42,24 @@ type ParsedStatement = Statement SourcePos type ParsedExpression = Expression SourcePos -type CharParser a = ParsecT String ParserState Identity a - -- These parsers can store some arbitrary state -type StatementParser = CharParser ParsedStatement -type ExpressionParser = CharParser ParsedExpression --- the statement label stack -type ParserState = [String] +type StatementParser s = Parser s ParsedStatement +type ExpressionParser s = Parser s ParsedExpression + initialParserState :: ParserState initialParserState = [] -- | checks if the label is not yet on the stack, if it is -- throws -- an error; otherwise it pushes it onto the stack -pushLabel :: String -> CharParser () +pushLabel :: String -> Parser s () pushLabel lab = do labs <- getState pos <- getPosition if lab `elem` labs then fail $ "Duplicate label at " ++ show pos else putState (lab:labs) -popLabel :: CharParser () +popLabel :: Parser s () popLabel = modifyState safeTail where safeTail [] = [] safeTail (_:xs) = xs @@ -66,14 +67,14 @@ clearLabels :: ParserState -> ParserState clearLabels _ = [] -withFreshLabelStack :: CharParser a -> CharParser a +withFreshLabelStack :: Parser s a -> Parser s a withFreshLabelStack p = do oldState <- getState putState $ clearLabels oldState a <- p putState oldState return a -identifier :: CharParser (Id SourcePos) +identifier :: Stream s Identity Char => Parser s (Id SourcePos) identifier = liftM2 Id getPosition Lexer.identifier @@ -88,7 +89,7 @@ -- reserved-word, we truly have a syntax error. Since input has been consumed, -- <|> will not try its alternate in parseExpression, and we will fail. -parseIfStmt:: StatementParser +parseIfStmt:: Stream s Identity Char => StatementParser s parseIfStmt = do pos <- getPosition reserved "if" @@ -100,7 +101,7 @@ return $ IfStmt pos test consequent alternate) <|> return (IfSingleStmt pos test consequent)) -parseSwitchStmt:: StatementParser +parseSwitchStmt :: Stream s Identity Char => StatementParser s parseSwitchStmt = let parseDefault = do pos <- getPosition @@ -128,7 +129,7 @@ checkClauses clauses return (SwitchStmt pos test clauses) -parseWhileStmt:: StatementParser +parseWhileStmt:: Stream s Identity Char => StatementParser s parseWhileStmt = do pos <- getPosition reserved "while" @@ -136,7 +137,7 @@ body <- parseStatement return (WhileStmt pos test body) -parseDoWhileStmt:: StatementParser +parseDoWhileStmt:: Stream s Identity Char => StatementParser s parseDoWhileStmt = do pos <- getPosition reserved "do" @@ -146,7 +147,7 @@ optional semi return (DoWhileStmt pos body test) -parseContinueStmt:: StatementParser +parseContinueStmt:: Stream s Identity Char => StatementParser s parseContinueStmt = do pos <- getPosition reserved "continue" @@ -158,7 +159,7 @@ optional semi return $ ContinueStmt pos id -parseBreakStmt:: StatementParser +parseBreakStmt:: Stream s Identity Char => StatementParser s parseBreakStmt = do pos <- getPosition reserved "break" @@ -170,19 +171,19 @@ optional semi return $ BreakStmt pos id -parseBlockStmt:: StatementParser +parseBlockStmt:: Stream s Identity Char => StatementParser s parseBlockStmt = do pos <- getPosition statements <- braces (many parseStatement) return (BlockStmt pos statements) -parseEmptyStmt:: StatementParser +parseEmptyStmt:: Stream s Identity Char => StatementParser s parseEmptyStmt = do pos <- getPosition semi return (EmptyStmt pos) -parseLabelledStmt:: StatementParser +parseLabelledStmt:: Stream s Identity Char => StatementParser s parseLabelledStmt = do pos <- getPosition -- Lookahead for the colon. If we don't see it, we are parsing an identifier @@ -195,7 +196,7 @@ popLabel return (LabelledStmt pos label statement) -parseExpressionStmt:: StatementParser +parseExpressionStmt:: Stream s Identity Char => StatementParser s parseExpressionStmt = do pos <- getPosition expr <- parseListExpr -- TODO: spec 12.4? @@ -203,7 +204,7 @@ return $ ExprStmt pos expr -parseForInStmt:: StatementParser +parseForInStmt:: Stream s Identity Char => StatementParser s parseForInStmt = let parseInit = (reserved "var" >> liftM ForInVar identifier) <|> liftM ForInLVal lvalue @@ -217,7 +218,7 @@ body <- parseStatement return $ ForInStmt pos init expr body -parseForStmt:: StatementParser +parseForStmt:: Stream s Identity Char => StatementParser s parseForStmt = let parseInit = (reserved "var" >> liftM VarInit (parseVarDecl `sepBy` comma)) <|> liftM ExprInit parseListExpr @@ -234,7 +235,7 @@ stmt <- parseStatement return $ ForStmt pos init test iter stmt -parseTryStmt:: StatementParser +parseTryStmt:: Stream s Identity Char => StatementParser s parseTryStmt = let parseCatchClause = do pos <- getPosition reserved "catch" @@ -253,7 +254,7 @@ else fail $ "A try statement should have at least a catch\ \ or a finally block, at " ++ show pos -parseThrowStmt:: StatementParser +parseThrowStmt:: Stream s Identity Char => StatementParser s parseThrowStmt = do pos <- getPosition reserved "throw" @@ -261,7 +262,7 @@ optional semi return (ThrowStmt pos expr) -parseReturnStmt:: StatementParser +parseReturnStmt:: Stream s Identity Char => StatementParser s parseReturnStmt = do pos <- getPosition reserved "return" @@ -269,7 +270,7 @@ optional semi return (ReturnStmt pos expr) -parseWithStmt:: StatementParser +parseWithStmt:: Stream s Identity Char => StatementParser s parseWithStmt = do pos <- getPosition reserved "with" @@ -277,13 +278,14 @@ stmt <- parseStatement return (WithStmt pos context stmt) +parseVarDecl :: Stream s Identity Char => Parser s (VarDecl SourcePos) parseVarDecl = do pos <- getPosition id <- identifier init <- (reservedOp "=" >> liftM Just parseExpression) <|> return Nothing return (VarDecl pos id init) -parseVarDeclStmt:: StatementParser +parseVarDeclStmt:: Stream s Identity Char => StatementParser s parseVarDeclStmt = do pos <- getPosition reserved "var" @@ -291,7 +293,7 @@ optional semi return (VarDeclStmt pos decls) -parseFunctionStmt:: StatementParser +parseFunctionStmt:: Stream s Identity Char => StatementParser s parseFunctionStmt = do pos <- getPosition name <- try (reserved "function" >> identifier) -- ambiguity with FuncExpr @@ -301,7 +303,7 @@ "function body in { ... }" return (FunctionStmt pos name args body) -parseStatement:: StatementParser +parseStatement:: Stream s Identity Char => StatementParser s parseStatement = parseIfStmt <|> parseSwitchStmt <|> parseWhileStmt <|> parseDoWhileStmt <|> parseContinueStmt <|> parseBreakStmt <|> parseBlockStmt <|> parseEmptyStmt <|> parseForInStmt <|> parseForStmt @@ -331,32 +333,33 @@ --{{{ Primary expressions -parseThisRef:: ExpressionParser +parseThisRef:: Stream s Identity Char => ExpressionParser s parseThisRef = do pos <- getPosition reserved "this" return (ThisRef pos) -parseNullLit:: ExpressionParser +parseNullLit:: Stream s Identity Char => ExpressionParser s parseNullLit = do pos <- getPosition reserved "null" return (NullLit pos) -parseBoolLit:: ExpressionParser +parseBoolLit:: Stream s Identity Char => ExpressionParser s parseBoolLit = do pos <- getPosition let parseTrueLit = reserved "true" >> return (BoolLit pos True) parseFalseLit = reserved "false" >> return (BoolLit pos False) parseTrueLit <|> parseFalseLit -parseVarRef:: ExpressionParser +parseVarRef:: Stream s Identity Char => ExpressionParser s parseVarRef = liftM2 VarRef getPosition identifier -parseArrayLit:: ExpressionParser +parseArrayLit:: Stream s Identity Char => ExpressionParser s parseArrayLit = liftM2 ArrayLit getPosition (squares (parseExpression `sepEndBy` comma)) - + +parseFuncExpr :: Stream s Identity Char => ExpressionParser s parseFuncExpr = do pos <- getPosition reserved "function" @@ -375,17 +378,20 @@ allEscapes:: String allEscapes = map fst escapeChars +parseEscapeChar :: Stream s Identity Char => Parser s Char parseEscapeChar = do c <- oneOf allEscapes let (Just c') = lookup c escapeChars -- will succeed due to line above return c' +parseAsciiHexChar :: Stream s Identity Char => Parser s Char parseAsciiHexChar = do char 'x' d1 <- hexDigit d2 <- hexDigit return ((chr.fst.head.readHex) (d1:d2:"")) +parseUnicodeHexChar :: Stream s Identity Char => Parser s Char parseUnicodeHexChar = do char 'u' liftM (chr.fst.head.readHex) @@ -410,7 +416,7 @@ else return (c:cs)) <|> liftM2 (:) anyChar (parseStringLit' endWith) -parseStringLit:: ExpressionParser +parseStringLit:: Stream s Identity Char => ExpressionParser s parseStringLit = do pos <- getPosition -- parseStringLit' takes as an argument the quote-character that opened the @@ -425,14 +431,14 @@ --}}} -parseRegexpLit:: ExpressionParser +parseRegexpLit:: Stream s Identity Char => ExpressionParser s parseRegexpLit = do let parseFlags = do flags <- many (oneOf "mgi") return $ \f -> f ('g' `elem` flags) ('i' `elem` flags) - let parseEscape :: CharParser Char + let parseEscape :: Stream s Identity Char => Parser s Char parseEscape = char '\\' >> anyChar - let parseChar :: CharParser Char + let parseChar :: Stream s Identity Char => Parser s Char parseChar = noneOf "/" let parseRe = (char '/' >> return "") <|> (do char '\\' @@ -448,7 +454,7 @@ spaces -- crucial for Parsec.Token parsers return $ flags (RegexpLit pos pat) -parseObjectLit:: ExpressionParser +parseObjectLit:: Stream s Identity Char => ExpressionParser s parseObjectLit = let parseProp = do -- Parses a string, identifier or integer as the property name. I @@ -465,7 +471,7 @@ return $ ObjectLit pos props --{{{ Parsing numbers. From pg. 17-18 of ECMA-262. - +hexLit :: Stream s Identity Char => Parser s (Bool, Double) hexLit = do try (string "0x") digits <- many1 (oneOf "0123456789abcdefABCDEF") @@ -477,18 +483,16 @@ mkDecimal whole frac fracLen exp = ((fromInteger whole) + ((fromInteger frac) * (10 ^^ (-fracLen)))) * (10 ^^ exp) --- mkDecimal:: Double -> Double -> Int -> Double --- mkDecimal w f e = if f >= 1.0 --- then mkDecimal w (f / 10.0) e --- else (w + f) * (10.0 ^^ e) - +exponentPart :: Stream s Identity Char => Parser s Integer exponentPart = do oneOf "eE" (char '+' >> decimal) <|> (char '-' >> negate `fmap` decimal) <|> decimal --wrap a parser's result in a Just: +jparser :: Stream s Identity Char => Parser s a -> Parser s (Maybe a) jparser = liftM Just +decLit :: Stream s Identity Char => Parser s (Bool, Double) decLit = (do whole <- decimal mfrac <- option Nothing (jparser (char '.' >> decimal)) @@ -508,7 +512,7 @@ intLen i | i `div` 10 < 1 = 1 intLen i | otherwise = 1 + intLen (i `div` 10) -parseNumLit:: ExpressionParser +parseNumLit:: Stream s Identity Char => ExpressionParser s parseNumLit = do pos <- getPosition (isint, num) <- lexeme $ hexLit <|> decLit @@ -542,20 +546,23 @@ -- Expression Parsers ------------------------------------------------------------------------------- -parseParenExpr:: ExpressionParser +parseParenExpr:: Stream s Identity Char => ExpressionParser s parseParenExpr = parens parseListExpr -- everything above expect functions +parseExprForNew :: Stream s Identity Char => ExpressionParser s parseExprForNew = parseThisRef <|> parseNullLit <|> parseBoolLit <|> parseStringLit <|> parseArrayLit <|> parseParenExpr <|> parseNewExpr <|> parseNumLit <|> parseRegexpLit <|> parseObjectLit <|> parseVarRef -- all the expression parsers defined above +parseSimpleExpr' :: Stream s Identity Char => ExpressionParser s parseSimpleExpr' = parseThisRef <|> parseNullLit <|> parseBoolLit <|> parseStringLit <|> parseArrayLit <|> parseParenExpr <|> parseFuncExpr <|> parseNumLit <|> parseRegexpLit <|> parseObjectLit <|> parseVarRef +parseNewExpr :: Stream s Identity Char => ExpressionParser s parseNewExpr = (do pos <- getPosition reserved "new" @@ -571,6 +578,8 @@ e <- parseNewExpr "expression (3)" parseSimpleExpr (Just e) +parseSimpleExprForNew :: Stream s Identity Char + =>(Maybe ParsedExpression) -> ExpressionParser s parseSimpleExprForNew (Just e) = ((dotRef e <|> bracketRef e) >>= parseSimpleExprForNew . Just) <|> return e @@ -581,7 +590,8 @@ --}}} makeInfixExpr str constr = Infix parser AssocLeft where - parser:: CharParser (Expression SourcePos -> Expression SourcePos -> Expression SourcePos) + parser:: Stream s Identity Char + => Parser s (Expression SourcePos -> Expression SourcePos -> Expression SourcePos) parser = do pos <- getPosition reservedOp str @@ -589,6 +599,7 @@ -- apparently, expression tables can't handle immediately-nested prefixes +parsePrefixedExpr :: Stream s Identity Char => ExpressionParser s parsePrefixedExpr = do pos <- getPosition op <- optionMaybe $ (reservedOp "!" >> return PrefixLNot) <|> @@ -606,24 +617,19 @@ innerExpr <- parsePrefixedExpr return (PrefixExpr pos op innerExpr) -exprTable:: [[Operator String ParserState Identity ParsedExpression]] +exprTable:: Stream s Identity Char => [[Operator s ParserState Identity ParsedExpression]] exprTable = - [ [ makeInfixExpr "==" OpEq - , makeInfixExpr "!=" OpNEq - , makeInfixExpr "===" OpStrictEq - , makeInfixExpr "!==" OpStrictNEq + [ [ makeInfixExpr "*" OpMul + , makeInfixExpr "/" OpDiv + , makeInfixExpr "%" OpMod ] - - , [ makeInfixExpr "||" OpLOr ] - - , [ makeInfixExpr "&&" OpLAnd ] - - , [ makeInfixExpr "|" OpBOr ] - - , [ makeInfixExpr "^" OpBXor ] - - , [ makeInfixExpr "&" OpBAnd ] - + , [ makeInfixExpr "+" OpAdd + , makeInfixExpr "-" OpSub + ] + , [ makeInfixExpr "<<" OpLShift + , makeInfixExpr ">>" OpSpRShift + , makeInfixExpr ">>>" OpZfRShift + ] , [ makeInfixExpr "<" OpLT , makeInfixExpr "<=" OpLEq , makeInfixExpr ">" OpGT @@ -631,42 +637,39 @@ , makeInfixExpr "instanceof" OpInstanceof , makeInfixExpr "in" OpIn ] - - , [ makeInfixExpr "<<" OpLShift - , makeInfixExpr ">>" OpSpRShift - , makeInfixExpr ">>>" OpZfRShift - ] - - , [ makeInfixExpr "+" OpAdd - , makeInfixExpr "-" OpSub - ] - - , [ makeInfixExpr "*" OpMul - , makeInfixExpr "/" OpDiv - , makeInfixExpr "%" OpMod + , [ makeInfixExpr "==" OpEq + , makeInfixExpr "!=" OpNEq + , makeInfixExpr "===" OpStrictEq + , makeInfixExpr "!==" OpStrictNEq ] + , [ makeInfixExpr "&" OpBAnd ] + , [ makeInfixExpr "^" OpBXor ] + , [ makeInfixExpr "|" OpBOr ] + , [ makeInfixExpr "&&" OpLAnd ] + , [ makeInfixExpr "||" OpLOr ] ] +parseExpression' :: Stream s Identity Char => ExpressionParser s parseExpression' = buildExpressionParser exprTable parsePrefixedExpr "simple expression" -asLValue :: SourcePos +asLValue :: Stream s Identity Char + => SourcePos -> Expression SourcePos - -> CharParser (LValue SourcePos) + -> Parser s (LValue SourcePos) asLValue p' e = case e of VarRef p (Id _ x) -> return (LVar p x) DotRef p e (Id _ x) -> return (LDot p e x) BracketRef p e1 e2 -> return (LBracket p e1 e2) otherwise -> fail $ "expected a left-value at " ++ show p' -lvalue :: CharParser (LValue SourcePos) +lvalue :: Stream s Identity Char => Parser s (LValue SourcePos) lvalue = do p <- getPosition e <- parseSimpleExpr Nothing asLValue p e - -unaryAssignExpr :: CharParser ParsedExpression +unaryAssignExpr :: Stream s Identity Char => ExpressionParser s unaryAssignExpr = do p <- getPosition let prefixInc = do @@ -686,8 +689,8 @@ postfixInc e <|> postfixDec e <|> return e prefixInc <|> prefixDec <|> other - -parseTernaryExpr':: CharParser (ParsedExpression,ParsedExpression) +parseTernaryExpr':: Stream s Identity Char + => Parser s (ParsedExpression,ParsedExpression) parseTernaryExpr' = do reservedOp "?" l <- assignExpr @@ -695,7 +698,7 @@ r <- assignExpr return (l,r) -parseTernaryExpr:: ExpressionParser +parseTernaryExpr:: Stream s Identity Char => ExpressionParser s parseTernaryExpr = do e <- parseExpression' e' <- optionMaybe parseTernaryExpr' @@ -704,24 +707,21 @@ Just (l,r) -> do p <- getPosition return $ CondExpr p e l r - -assignOp :: CharParser AssignOp -assignOp = - (reservedOp "=" >> return OpAssign) <|> - (reservedOp "+=" >> return OpAssignAdd) <|> - (reservedOp "-=" >> return OpAssignSub) <|> - (reservedOp "*=" >> return OpAssignMul) <|> - (reservedOp "/=" >> return OpAssignDiv) <|> - (reservedOp "%=" >> return OpAssignMod) <|> - (reservedOp "<<=" >> return OpAssignLShift) <|> - (reservedOp ">>=" >> return OpAssignSpRShift) <|> - (reservedOp ">>>=" >> return OpAssignZfRShift) <|> - (reservedOp "&=" >> return OpAssignBAnd) <|> - (reservedOp "^=" >> return OpAssignBXor) <|> - (reservedOp "|=" >> return OpAssignBOr) - +assignOp :: Stream s Identity Char => Parser s AssignOp +assignOp = (reservedOp "=" >> return OpAssign) + <|>(reservedOp "+=" >> return OpAssignAdd) + <|>(reservedOp "-=" >> return OpAssignSub) + <|>(reservedOp "*=" >> return OpAssignMul) + <|>(reservedOp "/=" >> return OpAssignDiv) + <|>(reservedOp "%=" >> return OpAssignMod) + <|>(reservedOp "<<=" >> return OpAssignLShift) + <|>(reservedOp ">>=" >> return OpAssignSpRShift) + <|>(reservedOp ">>>=" >> return OpAssignZfRShift) + <|>(reservedOp "&=" >> return OpAssignBAnd) + <|>(reservedOp "^=" >> return OpAssignBXor) + <|>(reservedOp "|=" >> return OpAssignBOr) -assignExpr :: ExpressionParser +assignExpr :: Stream s Identity Char => ExpressionParser s assignExpr = do p <- getPosition lhs <- parseTernaryExpr @@ -732,22 +732,23 @@ return (AssignExpr p op lhs rhs) assign <|> return lhs -parseExpression:: ExpressionParser +parseExpression:: Stream s Identity Char => ExpressionParser s parseExpression = assignExpr +parseListExpr :: Stream s Identity Char => ExpressionParser s parseListExpr = assignExpr `sepBy1` comma >>= \exprs -> case exprs of [expr] -> return expr es -> liftM2 ListExpr getPosition (return es) -parseScript:: CharParser (JavaScript SourcePos) +parseScript:: Stream s Identity Char => Parser s (JavaScript SourcePos) parseScript = do whiteSpace liftM2 Script getPosition (parseStatement `sepBy` whiteSpace) -- | Parse from a stream; same as 'Text.Parsec.parse' -parse :: Stream s Identity t - => Parsec s [String] a -- ^ The parser to use +parse :: Stream s Identity Char + => Parser s a -- ^ The parser to use -> SourceName -- ^ Name of the source file -> s -- ^ the stream to parse, usually a 'String' -> Either ParseError a diff --git a/src/Language/ECMAScript3/Parser/State.hs b/src/Language/ECMAScript3/Parser/State.hs new file mode 100644 --- /dev/null +++ b/src/Language/ECMAScript3/Parser/State.hs @@ -0,0 +1,4 @@ +module Language.ECMAScript3.Parser.State where + +-- the statement label stack +type ParserState = [String] diff --git a/src/Language/ECMAScript3/Parser/Type.hs b/src/Language/ECMAScript3/Parser/Type.hs new file mode 100644 --- /dev/null +++ b/src/Language/ECMAScript3/Parser/Type.hs @@ -0,0 +1,7 @@ +module Language.ECMAScript3.Parser.Type where + +import Language.ECMAScript3.Parser.State +import Text.Parsec +import Control.Monad.Identity + +type Parser s a = ParsecT s ParserState Identity a diff --git a/src/Language/ECMAScript3/Syntax/QuasiQuote.hs b/src/Language/ECMAScript3/Syntax/QuasiQuote.hs new file mode 100644 --- /dev/null +++ b/src/Language/ECMAScript3/Syntax/QuasiQuote.hs @@ -0,0 +1,45 @@ +-- | Experimental and very simple quasi-quotation of ECMAScript in +-- Haskell. Doesn't support anti-quotation as of now. + +{-# LANGUAGE FlexibleContexts #-} +module Language.ECMAScript3.Syntax.QuasiQuote (js, jsexpr, jsstmt) where + +import qualified Language.Haskell.TH as TH +import Language.Haskell.TH.Quote +import Text.Parsec hiding (parse) +import Control.Monad.Identity +import Data.Data (Data) + +import Language.ECMAScript3.Syntax +import Language.ECMAScript3.Parser + +jsexpr :: QuasiQuoter +jsexpr = QuasiQuoter {quoteExp = quoteJSExpr} + +jsstmt :: QuasiQuoter +jsstmt = QuasiQuoter {quoteExp = quoteJSStmt} + +js :: QuasiQuoter +js = QuasiQuoter {quoteExp = quoteJS} + +quoteJSExpr :: String -> TH.ExpQ +quoteJSExpr = quoteCommon parseExpression + +quoteJSStmt :: String -> TH.ExpQ +quoteJSStmt = quoteCommon parseStatement + +quoteJS :: String -> TH.ExpQ +quoteJS = quoteCommon parseScript + +quoteCommon :: Data a => Parser String a -> String -> TH.ExpQ +quoteCommon p s = do loc <- TH.location + let fname = TH.loc_filename loc + let (line, col) = TH.loc_start loc + let p2 = (getPosition >>= \pos -> + setPosition $ (flip setSourceName) fname $ + (flip setSourceLine) line $ + (flip setSourceColumn) col $ pos) >> p + case parse p2 "" s of + Left err -> do TH.report True $ show err + return $ TH.UnboxedTupE [] + Right x -> dataToExpQ (const Nothing) x