summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreyChudnov <>2013-02-18 02:24:17 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2013-02-18 02:24:17 (GMT)
commit91ea23cf566b75a73841ae6d42c871bbae823c1e (patch)
tree297e89327f553a50fd075fb13970e80c691ec2e5
parentde9b6e7462e03e80e3b048a621677c4f6723137f (diff)
version 0.11.10.11.1
-rw-r--r--CHANGELOG8
-rw-r--r--language-ecmascript.cabal20
-rw-r--r--src/Language/ECMAScript3/Lexer.hs43
-rw-r--r--src/Language/ECMAScript3/Parser.hs217
-rw-r--r--src/Language/ECMAScript3/Parser/State.hs4
-rw-r--r--src/Language/ECMAScript3/Parser/Type.hs7
-rw-r--r--src/Language/ECMAScript3/Syntax/QuasiQuote.hs45
7 files changed, 221 insertions, 123 deletions
diff --git a/CHANGELOG b/CHANGELOG
index 428e776..85f051a 100644
--- 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
index 5ab4d60..cd0870a 100644
--- 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 @@ Description:
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 head
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 @@ Library
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 @@ Library
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 @@ Test-Suite unittest
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 @@ Test-Suite prettytest
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
index 2348994..cdaca57 100644
--- a/src/Language/ECMAScript3/Lexer.hs
+++ b/src/Language/ECMAScript3/Lexer.hs
@@ -11,9 +11,14 @@ module Language.ECMAScript3.Lexer(lexeme,identifier,reserved,operator,reservedOp
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 @@ javascriptDef =
"[", "]", "{", "}", "(", ")","</","instanceof"]
True -- case-sensitive
-lex :: T.TokenParser st
+lex :: Stream s Identity Char => 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
index 0dd1725..3e486c7 100644
--- a/src/Language/ECMAScript3/Parser.hs
+++ b/src/Language/ECMAScript3/Parser.hs
@@ -18,10 +18,14 @@ module Language.ECMAScript3.Parser
-- 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 @@ import Data.Maybe (isJust, isNothing, fromMaybe)
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 @@ popLabel = modifyState safeTail
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 @@ identifier =
-- 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 @@ parseIfStmt = do
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 @@ parseSwitchStmt =
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 @@ parseWhileStmt = do
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 @@ parseDoWhileStmt = do
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 @@ parseContinueStmt = do
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 @@ parseBreakStmt = do
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 @@ parseLabelledStmt = do
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 @@ parseExpressionStmt = do
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 @@ parseForInStmt =
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 @@ parseForStmt =
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 @@ parseTryStmt =
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 @@ parseThrowStmt = do
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 @@ parseReturnStmt = do
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 @@ parseWithStmt = do
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 @@ parseVarDeclStmt = do
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 @@ parseFunctionStmt = do
"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 @@ parseStatement = parseIfStmt <|> parseSwitchStmt <|> parseWhileStmt
--{{{ 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 @@ escapeChars =
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 @@ parseStringLit' endWith =
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 @@ parseStringLit = do
--}}}
-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 @@ parseRegexpLit = do
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 @@ parseObjectLit =
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 :: Integer -> Integer -> Integer -> Integer -> Double
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 @@ decLit =
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 @@ bracketRef e = brackets (withPos cstr parseExpression) <?> "[property-ref]"
-- 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 @@ parseSimpleExpr Nothing = do
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 @@ parseSimpleExprForNew Nothing = do
--}}}
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 @@ makeInfixExpr str constr = Infix parser AssocLeft where
-- 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 @@ parsePrefixedExpr = do
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 "+" OpAdd
+ , makeInfixExpr "-" OpSub
+ ]
+ , [ makeInfixExpr "<<" OpLShift
+ , makeInfixExpr ">>" OpSpRShift
+ , makeInfixExpr ">>>" OpZfRShift
]
-
- , [ makeInfixExpr "||" OpLOr ]
-
- , [ makeInfixExpr "&&" OpLAnd ]
-
- , [ makeInfixExpr "|" OpBOr ]
-
- , [ makeInfixExpr "^" OpBXor ]
-
- , [ makeInfixExpr "&" OpBAnd ]
-
, [ makeInfixExpr "<" OpLT
, makeInfixExpr "<=" OpLEq
, makeInfixExpr ">" OpGT
@@ -631,42 +637,39 @@ exprTable =
, 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 @@ unaryAssignExpr = do
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 @@ parseTernaryExpr' = do
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 @@ parseTernaryExpr = do
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)
-
-
-assignExpr :: ExpressionParser
+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 :: Stream s Identity Char => ExpressionParser s
assignExpr = do
p <- getPosition
lhs <- parseTernaryExpr
@@ -732,22 +732,23 @@ assignExpr = do
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
index 0000000..d92a114
--- /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] \ No newline at end of file
diff --git a/src/Language/ECMAScript3/Parser/Type.hs b/src/Language/ECMAScript3/Parser/Type.hs
new file mode 100644
index 0000000..df51eaa
--- /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 \ No newline at end of file
diff --git a/src/Language/ECMAScript3/Syntax/QuasiQuote.hs b/src/Language/ECMAScript3/Syntax/QuasiQuote.hs
new file mode 100644
index 0000000..6c17f4a
--- /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 \ No newline at end of file