diff --git a/language-javascript.cabal b/language-javascript.cabal index 3a3092b1..e817de84 100644 --- a/language-javascript.cabal +++ b/language-javascript.cabal @@ -46,7 +46,7 @@ Library hs-source-dirs: src Exposed-modules: Language.JavaScript.Parser Language.JavaScript.Parser.AST - Language.JavaScript.Parser.Grammar5 + Language.JavaScript.Parser.Grammar7 Language.JavaScript.Parser.Lexer Language.JavaScript.Parser.Parser Language.JavaScript.Parser.SrcLocation diff --git a/src/Language/JavaScript/Parser/AST.hs b/src/Language/JavaScript/Parser/AST.hs index 61647198..9fb352f5 100644 --- a/src/Language/JavaScript/Parser/AST.hs +++ b/src/Language/JavaScript/Parser/AST.hs @@ -51,6 +51,7 @@ data JSAST data JSStatement = JSStatementBlock !JSAnnot ![JSStatement] !JSAnnot !JSSemi -- ^lbrace, stmts, rbrace, autosemi | JSBreak !JSAnnot !JSIdent !JSSemi -- ^break,optional identifier, autosemi + | JSLet !JSAnnot !(JSCommaList JSExpression) !JSSemi -- ^const, decl, autosemi | JSConstant !JSAnnot !(JSCommaList JSExpression) !JSSemi -- ^const, decl, autosemi | JSContinue !JSAnnot !JSIdent !JSSemi -- ^continue, optional identifier,autosemi | JSDoWhile !JSAnnot !JSStatement !JSAnnot !JSAnnot !JSExpression !JSAnnot !JSSemi -- ^do,stmt,while,lb,expr,rb,autosemi @@ -73,6 +74,8 @@ data JSStatement | JSVariable !JSAnnot !(JSCommaList JSExpression) !JSSemi -- ^var|const, decl, autosemi | JSWhile !JSAnnot !JSAnnot !JSExpression !JSAnnot !JSStatement -- ^while,lb,expr,rb,stmt | JSWith !JSAnnot !JSAnnot !JSExpression !JSAnnot !JSStatement !JSSemi -- ^with,lb,expr,rb,stmt list + | JSImport !JSAnnot !(Maybe JSStatement) !JSAnnot JSExpression !JSSemi -- ^import + | JSExport !JSAnnot !(Maybe JSAnnot) !JSStatement !JSSemi -- ^export deriving (Data, Eq, Show, Typeable) data JSExpression @@ -96,6 +99,7 @@ data JSExpression | JSExpressionParen !JSAnnot !JSExpression !JSAnnot -- ^lb,expression,rb | JSExpressionPostfix !JSExpression !JSUnaryOp -- ^expression, operator | JSExpressionTernary !JSExpression !JSAnnot !JSExpression !JSAnnot !JSExpression -- ^cond, ?, trueval, :, falseval + | JSArrowExpression !JSAnnot !(JSCommaList JSIdent) !JSAnnot !JSAnnot !(Either JSExpression JSBlock) -- ^parameter list,arrow,block` | JSFunctionExpression !JSAnnot !JSIdent !JSAnnot !(JSCommaList JSIdent) !JSAnnot !JSBlock -- ^fn,name,lb, parameter list,rb,block` | JSMemberDot !JSExpression !JSAnnot !JSExpression -- ^firstpart, dot, name | JSMemberExpression !JSExpression !JSAnnot !(JSCommaList JSExpression) !JSAnnot -- expr, lb, args, rb @@ -105,6 +109,7 @@ data JSExpression | JSObjectLiteral !JSAnnot !JSObjectPropertyList !JSAnnot -- ^lbrace contents rbrace | JSUnaryExpression !JSUnaryOp !JSExpression | JSVarInitExpression !JSExpression !JSVarInitializer -- ^identifier, initializer + | JSSpreadExpression !JSAnnot !JSExpression deriving (Data, Eq, Show, Typeable) data JSBinOp @@ -191,6 +196,7 @@ data JSVarInitializer data JSObjectProperty = JSPropertyAccessor !JSAccessor !JSPropertyName !JSAnnot ![JSExpression] !JSAnnot !JSBlock -- ^(get|set), name, lb, params, rb, block + | JSPropertyNameOnly !JSPropertyName -- ^name | JSPropertyNameandValue !JSPropertyName !JSAnnot ![JSExpression] -- ^name, colon, value deriving (Data, Eq, Show, Typeable) @@ -251,6 +257,7 @@ instance ShowStripped JSStatement where ss (JSContinue _ JSIdentNone s) = "JSContinue" ++ commaIf (ss s) ss (JSContinue _ (JSIdentName _ n) s) = "JSContinue " ++ singleQuote n ++ commaIf (ss s) ss (JSConstant _ xs _as) = "JSConstant " ++ ss xs + ss (JSLet _ xs _as) = "JSLet " ++ ss xs ss (JSDoWhile _d x1 _w _lb x2 _rb x3) = "JSDoWhile (" ++ ss x1 ++ ") (" ++ ss x2 ++ ") (" ++ ss x3 ++ ")" ss (JSFor _ _lb x1s _s1 x2s _s2 x3s _rb x4) = "JSFor " ++ ss x1s ++ " " ++ ss x2s ++ " " ++ ss x3s ++ " (" ++ ss x4 ++ ")" ss (JSForIn _ _lb x1s _i x2 _rb x3) = "JSForIn " ++ ss x1s ++ " (" ++ ss x2 ++ ") (" ++ ss x3 ++ ")" @@ -272,6 +279,12 @@ instance ShowStripped JSStatement where ss (JSVariable _ xs _as) = "JSVariable " ++ ss xs ss (JSWhile _ _lb x1 _rb x2) = "JSWhile (" ++ ss x1 ++ ") (" ++ ss x2 ++ ")" ss (JSWith _ _lb x1 _rb x _) = "JSWith (" ++ ss x1 ++ ") (" ++ ss x ++ ")" + ss (JSImport _ Nothing _ x1 _) = "JSImport (" ++ ss x1 ++ ")" + ss (JSImport _ (Just f) _ x1 _) = "JSImport (" ++ ss f ++ ") (" ++ ss x1 ++ ")" + ss (JSExport _ df x1 _) = "JSExport " ++ (exportDefault df) ++ "(" ++ ss x1 ++ ")" + where + exportDefault (Just _) = "Default " + exportDefault Nothing = "" instance ShowStripped JSExpression where ss (JSArrayLiteral _lb xs _rb) = "JSArrayLiteral " ++ ss xs @@ -285,6 +298,8 @@ instance ShowStripped JSExpression where ss (JSExpressionParen _lp x _rp) = "JSExpressionParen (" ++ ss x ++ ")" ss (JSExpressionPostfix xs op) = "JSExpressionPostfix (" ++ ss op ++ "," ++ ss xs ++ ")" ss (JSExpressionTernary x1 _q x2 _c x3) = "JSExpressionTernary (" ++ ss x1 ++ "," ++ ss x2 ++ "," ++ ss x3 ++ ")" + ss (JSArrowExpression _ n _ _ (Right bd)) = "JSArrowExpression (" ++ ss n ++ ") => " ++ ss bd + ss (JSArrowExpression _ n _ _ (Left bd)) = "JSArrowExpression (" ++ ss n ++ ") => " ++ ss bd ss (JSFunctionExpression _ n _lb pl _rb x3) = "JSFunctionExpression " ++ ssid n ++ " " ++ ss pl ++ " (" ++ ss x3 ++ "))" ss (JSHexInteger _ s) = "JSHexInteger " ++ singleQuote s ss (JSOctal _ s) = "JSOctal " ++ singleQuote s @@ -301,6 +316,7 @@ instance ShowStripped JSExpression where ss (JSStringLiteral _ s) = "JSStringLiteral " ++ s ss (JSUnaryExpression op x) = "JSUnaryExpression (" ++ ss op ++ "," ++ ss x ++ ")" ss (JSVarInitExpression x1 x2) = "JSVarInitExpression (" ++ ss x1 ++ ") " ++ ss x2 + ss (JSSpreadExpression _ x1) = "JSSpreadExpression (" ++ ss x1 ++ ")" instance ShowStripped JSTryCatch where ss (JSCatch _ _lb x1 _rb x3) = "JSCatch (" ++ ss x1 ++ "," ++ ss x3 ++ ")" @@ -316,6 +332,7 @@ instance ShowStripped JSIdent where instance ShowStripped JSObjectProperty where ss (JSPropertyNameandValue x1 _colon x2s) = "JSPropertyNameandValue (" ++ ss x1 ++ ") " ++ ss x2s + ss (JSPropertyNameOnly x1) = "JSPropertyNameOnly (" ++ ss x1 ++ ")" ss (JSPropertyAccessor s x1 _lb1 x2s _rb1 x3) = "JSPropertyAccessor " ++ ss s ++ " (" ++ ss x1 ++ ") " ++ ss x2s ++ " (" ++ ss x3 ++ ")" instance ShowStripped JSPropertyName where diff --git a/src/Language/JavaScript/Parser/Grammar7.y b/src/Language/JavaScript/Parser/Grammar7.y new file mode 100644 index 00000000..fad6e7a6 --- /dev/null +++ b/src/Language/JavaScript/Parser/Grammar7.y @@ -0,0 +1,1250 @@ +{ +{-# LANGUAGE BangPatterns #-} +module Language.JavaScript.Parser.Grammar7 + ( parseProgram + , parseStatement + , parseExpression + , parseLiteral + ) where + +import Data.Char +import Language.JavaScript.Parser.Lexer +import Language.JavaScript.Parser.ParserMonad +import Language.JavaScript.Parser.SrcLocation +import Language.JavaScript.Parser.Token +import qualified Language.JavaScript.Parser.AST as AST + +} + +-- The name of the generated function to be exported from the module +%name parseProgram Program +%name parseLiteral LiteralMain +%name parseExpression ExpressionMain +%name parseStatement StatementMain + +%tokentype { Token } +%error { parseError } +%monad { Alex } { >>= } { return } +%lexer { lexCont } { EOFToken {} } + + +%token + + ';' { SemiColonToken {} } + ',' { CommaToken {} } + '?' { HookToken {} } + ':' { ColonToken {} } + '||' { OrToken {} } + '&&' { AndToken {} } + '|' { BitwiseOrToken {} } + '^' { BitwiseXorToken {} } + '&' { BitwiseAndToken {} } + '=>' { ArrowToken {} } + '===' { StrictEqToken {} } + '==' { EqToken {} } + '*=' { TimesAssignToken {} } + '/=' { DivideAssignToken {} } + '%=' { ModAssignToken {} } + '+=' { PlusAssignToken {} } + '-=' { MinusAssignToken {} } + '<<=' { LshAssignToken {} } + '>>=' { RshAssignToken {} } + '>>>=' { UrshAssignToken {} } + '&=' { AndAssignToken {} } + '^=' { XorAssignToken {} } + '|=' { OrAssignToken {} } + '=' { SimpleAssignToken {} } + '!==' { StrictNeToken {} } + '!=' { NeToken {} } + '<<' { LshToken {} } + '<=' { LeToken {} } + '<' { LtToken {} } + '>>>' { UrshToken {} } + '>>' { RshToken {} } + '>=' { GeToken {} } + '>' { GtToken {} } + '++' { IncrementToken {} } + '--' { DecrementToken {} } + '+' { PlusToken {} } + '-' { MinusToken {} } + '*' { MulToken {} } + '/' { DivToken {} } + '%' { ModToken {} } + '!' { NotToken {} } + '~' { BitwiseNotToken {} } + '...' { SpreadToken {} } + '.' { DotToken {} } + '[' { LeftBracketToken {} } + ']' { RightBracketToken {} } + '{' { LeftCurlyToken {} } + '}' { RightCurlyToken {} } + '(' { LeftParenToken {} } + ')' { RightParenToken {} } + + 'autosemi' { AutoSemiToken {} } + 'break' { BreakToken {} } + 'case' { CaseToken {} } + 'catch' { CatchToken {} } + 'let' { LetToken {} } + 'const' { ConstToken {} } + 'continue' { ContinueToken {} } + 'debugger' { DebuggerToken {} } + 'default' { DefaultToken {} } + 'delete' { DeleteToken {} } + 'do' { DoToken {} } + 'else' { ElseToken {} } + 'enum' { EnumToken {} } + 'false' { FalseToken {} } + 'finally' { FinallyToken {} } + 'for' { ForToken {} } + 'function' { FunctionToken {} } + 'get' { GetToken {} } + 'if' { IfToken {} } + 'in' { InToken {} } + 'instanceof' { InstanceofToken {} } + 'new' { NewToken {} } + 'null' { NullToken {} } + 'return' { ReturnToken {} } + 'set' { SetToken {} } + 'switch' { SwitchToken {} } + 'this' { ThisToken {} } + 'throw' { ThrowToken {} } + 'true' { TrueToken {} } + 'try' { TryToken {} } + 'typeof' { TypeofToken {} } + 'var' { VarToken {} } + 'void' { VoidToken {} } + 'while' { WhileToken {} } + 'with' { WithToken {} } + + + 'ident' { IdentifierToken {} } + 'decimal' { DecimalToken {} } + 'hexinteger' { HexIntegerToken {} } + 'octal' { OctalToken {} } + 'string' { StringToken {} } + 'regex' { RegExToken {} } + + 'from' { FromToken {} } + + 'export' { ExportToken {} } + 'import' { ImportToken {} } + + 'future' { FutureToken {} } + + 'tail' { TailToken {} } + + +%% + +-- --------------------------------------------------------------------- +-- Sort out automatically inserted semi-colons. +-- A MaybeSemi is an actual semi-colon or nothing. +-- An AutoSemu is either an actual semi-colon or 'virtual' semi-colon inserted +-- by the Alex lexer or nothing. + +MaybeSemi :: { AST.JSSemi } +MaybeSemi : ';' { AST.JSSemi (mkJSAnnot $1) } + | { AST.JSSemiAuto } + +AutoSemi :: { AST.JSSemi } +AutoSemi : ';' { AST.JSSemi (mkJSAnnot $1) } + | 'autosemi' { AST.JSSemiAuto } + | { AST.JSSemiAuto } + +-- --------------------------------------------------------------------- + +-- Helpers + +LParen :: { AST.JSAnnot } +LParen : '(' { mkJSAnnot $1 } + +RParen :: { AST.JSAnnot } +RParen : ')' { mkJSAnnot $1 } + +LBrace :: { AST.JSAnnot } +LBrace : '{' { mkJSAnnot $1 } + +RBrace :: { AST.JSAnnot } +RBrace : '}' { mkJSAnnot $1 } + +LSquare :: { AST.JSAnnot } +LSquare : '[' { mkJSAnnot $1 } + +RSquare :: { AST.JSAnnot } +RSquare : ']' { mkJSAnnot $1 } + +Comma :: { AST.JSAnnot } +Comma : ',' { mkJSAnnot $1 } + +Colon :: { AST.JSAnnot } +Colon : ':' { mkJSAnnot $1 } + +Semi :: { AST.JSAnnot } +Semi : ';' { mkJSAnnot $1 } + +Arrow :: { AST.JSAnnot } +Arrow : '=>' { mkJSAnnot $1 } + +Spread :: { AST.JSAnnot } +Spread : '...' { mkJSAnnot $1 } + +Dot :: { AST.JSAnnot } +Dot : '.' { mkJSAnnot $1 } + +From :: { AST.JSAnnot } +From : 'from' { mkJSAnnot $1 } + +Increment :: { AST.JSUnaryOp } +Increment : '++' { AST.JSUnaryOpIncr (mkJSAnnot $1) } + +Decrement :: { AST.JSUnaryOp } +Decrement : '--' { AST.JSUnaryOpDecr (mkJSAnnot $1) } + +Delete :: { AST.JSUnaryOp } +Delete : 'delete' { AST.JSUnaryOpDelete (mkJSAnnot $1) } + +Void :: { AST.JSUnaryOp } +Void : 'void' { AST.JSUnaryOpVoid (mkJSAnnot $1) } + +Typeof :: { AST.JSUnaryOp } +Typeof : 'typeof' { AST.JSUnaryOpTypeof (mkJSAnnot $1) } + +Plus :: { AST.JSBinOp } +Plus : '+' { AST.JSBinOpPlus (mkJSAnnot $1) } + +Minus :: { AST.JSBinOp } +Minus : '-' { AST.JSBinOpMinus (mkJSAnnot $1) } + +Tilde :: { AST.JSUnaryOp } +Tilde : '~' { AST.JSUnaryOpTilde (mkJSAnnot $1) } + +Not :: { AST.JSUnaryOp } +Not : '!' { AST.JSUnaryOpNot (mkJSAnnot $1) } + +Mul :: { AST.JSBinOp } +Mul : '*' { AST.JSBinOpTimes (mkJSAnnot $1) } + +Div :: { AST.JSBinOp } +Div : '/' { AST.JSBinOpDivide (mkJSAnnot $1) } + +Mod :: { AST.JSBinOp } +Mod : '%' { AST.JSBinOpMod (mkJSAnnot $1) } + +Lsh :: { AST.JSBinOp } +Lsh : '<<' { AST.JSBinOpLsh (mkJSAnnot $1) } + +Rsh :: { AST.JSBinOp } +Rsh : '>>' { AST.JSBinOpRsh (mkJSAnnot $1) } + +Ursh :: { AST.JSBinOp } +Ursh : '>>>' { AST.JSBinOpUrsh (mkJSAnnot $1) } + +Le :: { AST.JSBinOp } +Le : '<=' { AST.JSBinOpLe (mkJSAnnot $1) } + +Lt :: { AST.JSBinOp } +Lt : '<' { AST.JSBinOpLt (mkJSAnnot $1) } + +Ge :: { AST.JSBinOp } +Ge : '>=' { AST.JSBinOpGe (mkJSAnnot $1) } + +Gt :: { AST.JSBinOp } +Gt : '>' { AST.JSBinOpGt (mkJSAnnot $1) } + +In :: { AST.JSBinOp } +In : 'in' { AST.JSBinOpIn (mkJSAnnot $1) } + +Instanceof :: { AST.JSBinOp } +Instanceof : 'instanceof' { AST.JSBinOpInstanceOf (mkJSAnnot $1) } + +StrictEq :: { AST.JSBinOp } +StrictEq : '===' { AST.JSBinOpStrictEq (mkJSAnnot $1) } + +Equal :: { AST.JSBinOp } +Equal : '==' { AST.JSBinOpEq (mkJSAnnot $1) } + +StrictNe :: { AST.JSBinOp } +StrictNe : '!==' { AST.JSBinOpStrictNeq (mkJSAnnot $1) } + +Ne :: { AST.JSBinOp } +Ne : '!=' { AST.JSBinOpNeq (mkJSAnnot $1)} + +Or :: { AST.JSBinOp } +Or : '||' { AST.JSBinOpOr (mkJSAnnot $1) } + +And :: { AST.JSBinOp } +And : '&&' { AST.JSBinOpAnd (mkJSAnnot $1) } + +BitOr :: { AST.JSBinOp } +BitOr : '|' { AST.JSBinOpBitOr (mkJSAnnot $1) } + +BitAnd :: { AST.JSBinOp } +BitAnd : '&' { AST.JSBinOpBitAnd (mkJSAnnot $1) } + +BitXor :: { AST.JSBinOp } +BitXor : '^' { AST.JSBinOpBitXor (mkJSAnnot $1)} + +Hook :: { AST.JSAnnot } +Hook : '?' { mkJSAnnot $1 } + +SimpleAssign :: { AST.JSAnnot } +SimpleAssign : '=' { mkJSAnnot $1 } + +OpAssign :: { AST.JSAssignOp } +OpAssign : '*=' { AST.JSTimesAssign (mkJSAnnot $1) } + | '/=' { AST.JSDivideAssign (mkJSAnnot $1) } + | '%=' { AST.JSModAssign (mkJSAnnot $1) } + | '+=' { AST.JSPlusAssign (mkJSAnnot $1) } + | '-=' { AST.JSMinusAssign (mkJSAnnot $1) } + | '<<=' { AST.JSLshAssign (mkJSAnnot $1) } + | '>>=' { AST.JSRshAssign (mkJSAnnot $1) } + | '>>>=' { AST.JSUrshAssign (mkJSAnnot $1) } + | '&=' { AST.JSBwAndAssign (mkJSAnnot $1) } + | '^=' { AST.JSBwXorAssign (mkJSAnnot $1) } + | '|=' { AST.JSBwOrAssign (mkJSAnnot $1) } + +Var :: { AST.JSAnnot } +Var : 'var' { mkJSAnnot $1 } + +Let :: { AST.JSAnnot } +Let : 'let' { mkJSAnnot $1 } + +Const :: { AST.JSAnnot } +Const : 'const' { mkJSAnnot $1 } + +If :: { AST.JSAnnot } +If : 'if' { mkJSAnnot $1 } + +Else :: { AST.JSAnnot } +Else : 'else' { mkJSAnnot $1 } + +Do :: { AST.JSAnnot } +Do : 'do' { mkJSAnnot $1 } + +While :: { AST.JSAnnot } +While : 'while' { mkJSAnnot $1 } + +For :: { AST.JSAnnot } +For : 'for' { mkJSAnnot $1 } + +Continue :: { AST.JSAnnot } +Continue : 'continue' { mkJSAnnot $1 } + +Break :: { AST.JSAnnot } +Break : 'break' { mkJSAnnot $1 } + +Return :: { AST.JSAnnot } +Return : 'return' { mkJSAnnot $1 } + +With :: { AST.JSAnnot } +With : 'with' { mkJSAnnot $1 } + +Switch :: { AST.JSAnnot } +Switch : 'switch' { mkJSAnnot $1 } + +Case :: { AST.JSAnnot } +Case : 'case' { mkJSAnnot $1 } + +Default :: { AST.JSAnnot } +Default : 'default' { mkJSAnnot $1 } + +Throw :: { AST.JSAnnot } +Throw : 'throw' { mkJSAnnot $1 {- 'Throw' -} } + +Try :: { AST.JSAnnot } +Try : 'try' { mkJSAnnot $1 } + +CatchL :: { AST.JSAnnot } +CatchL : 'catch' { mkJSAnnot $1 } + +FinallyL :: { AST.JSAnnot } +FinallyL : 'finally' { mkJSAnnot $1 } + +Function :: { AST.JSAnnot } +Function : 'function' { mkJSAnnot $1 {- 'Function' -} } + +New :: { AST.JSAnnot } +New : 'new' { mkJSAnnot $1 } + +Import :: { AST.JSAnnot } +Import : 'import' { mkJSAnnot $1 } + +Export :: { AST.JSAnnot } +Export : 'export' { mkJSAnnot $1 } + + +Eof :: { AST.JSAnnot } +Eof : 'tail' { mkJSAnnot $1 {- 'Eof' -} } + +-- Literal :: See 7.8 +-- NullLiteral +-- BooleanLiteral +-- NumericLiteral +-- StringLiteral +Literal :: { AST.JSExpression } +Literal : NullLiteral { $1 } + | BooleanLiteral { $1 } + | NumericLiteral { $1 } + | StringLiteral { $1 } + | RegularExpressionLiteral { $1 } + +NullLiteral :: { AST.JSExpression } +NullLiteral : 'null' { AST.JSLiteral (mkJSAnnot $1) "null" } + +BooleanLiteral :: { AST.JSExpression } +BooleanLiteral : 'true' { AST.JSLiteral (mkJSAnnot $1) "true" } + | 'false' { AST.JSLiteral (mkJSAnnot $1) "false" } + +-- ::= DecimalLiteral +-- | HexIntegerLiteral +-- | OctalLiteral +NumericLiteral :: { AST.JSExpression } +NumericLiteral : 'decimal' { AST.JSDecimal (mkJSAnnot $1) (tokenLiteral $1) } + | 'hexinteger' { AST.JSHexInteger (mkJSAnnot $1) (tokenLiteral $1) } + | 'octal' { AST.JSOctal (mkJSAnnot $1) (tokenLiteral $1) } + +StringLiteral :: { AST.JSExpression } +StringLiteral : 'string' { AST.JSStringLiteral (mkJSAnnot $1) (tokenLiteral $1) } + +-- ::= RegExp +RegularExpressionLiteral :: { AST.JSExpression } +RegularExpressionLiteral : 'regex' { AST.JSRegEx (mkJSAnnot $1) (tokenLiteral $1) } + +-- PrimaryExpression : See 11.1 +-- this +-- Identifier +-- Literal +-- ArrayLiteral +-- ObjectLiteral +-- ( Expression ) +PrimaryExpression :: { AST.JSExpression } +PrimaryExpression : 'this' { AST.JSLiteral (mkJSAnnot $1) "this" } + | Identifier { $1 {- 'PrimaryExpression1' -} } + | Literal { $1 {- 'PrimaryExpression2' -} } + | ArrayLiteral { $1 {- 'PrimaryExpression3' -} } + | ObjectLiteral { $1 {- 'PrimaryExpression4' -} } + | SpreadExpression { $1 } + | LParen Expression RParen { AST.JSExpressionParen $1 $2 $3 } + +-- Identifier :: See 7.6 +-- IdentifierName but not ReservedWord +-- IdentifierName :: See 7.6 +-- IdentifierStart +-- IdentifierName IdentifierPart +Identifier :: { AST.JSExpression } +Identifier : 'ident' { AST.JSIdentifier (mkJSAnnot $1) (tokenLiteral $1) } + | 'get' { AST.JSIdentifier (mkJSAnnot $1) "get" } + | 'set' { AST.JSIdentifier (mkJSAnnot $1) "set" } + +-- TODO: make this include any reserved word too, including future ones +IdentifierName :: { AST.JSExpression } +IdentifierName : Identifier {$1} + | 'break' { AST.JSIdentifier (mkJSAnnot $1) "break" } + | 'case' { AST.JSIdentifier (mkJSAnnot $1) "case" } + | 'catch' { AST.JSIdentifier (mkJSAnnot $1) "catch" } + | 'const' { AST.JSIdentifier (mkJSAnnot $1) "const" } + | 'continue' { AST.JSIdentifier (mkJSAnnot $1) "continue" } + | 'debugger' { AST.JSIdentifier (mkJSAnnot $1) "debugger" } + | 'default' { AST.JSIdentifier (mkJSAnnot $1) "default" } + | 'delete' { AST.JSIdentifier (mkJSAnnot $1) "delete" } + | 'do' { AST.JSIdentifier (mkJSAnnot $1) "do" } + | 'else' { AST.JSIdentifier (mkJSAnnot $1) "else" } + | 'enum' { AST.JSIdentifier (mkJSAnnot $1) "enum" } + | 'false' { AST.JSIdentifier (mkJSAnnot $1) "false" } + | 'finally' { AST.JSIdentifier (mkJSAnnot $1) "finally" } + | 'for' { AST.JSIdentifier (mkJSAnnot $1) "for" } + | 'function' { AST.JSIdentifier (mkJSAnnot $1) "function" } + | 'get' { AST.JSIdentifier (mkJSAnnot $1) "get" } + | 'if' { AST.JSIdentifier (mkJSAnnot $1) "if" } + | 'in' { AST.JSIdentifier (mkJSAnnot $1) "in" } + | 'instanceof' { AST.JSIdentifier (mkJSAnnot $1) "instanceof" } + | 'new' { AST.JSIdentifier (mkJSAnnot $1) "new" } + | 'null' { AST.JSIdentifier (mkJSAnnot $1) "null" } + | 'return' { AST.JSIdentifier (mkJSAnnot $1) "return" } + | 'set' { AST.JSIdentifier (mkJSAnnot $1) "set" } + | 'switch' { AST.JSIdentifier (mkJSAnnot $1) "switch" } + | 'this' { AST.JSIdentifier (mkJSAnnot $1) "this" } + | 'throw' { AST.JSIdentifier (mkJSAnnot $1) "throw" } + | 'true' { AST.JSIdentifier (mkJSAnnot $1) "true" } + | 'try' { AST.JSIdentifier (mkJSAnnot $1) "try" } + | 'typeof' { AST.JSIdentifier (mkJSAnnot $1) "typeof" } + | 'var' { AST.JSIdentifier (mkJSAnnot $1) "var" } + | 'let' { AST.JSIdentifier (mkJSAnnot $1) "let" } + | 'void' { AST.JSIdentifier (mkJSAnnot $1) "void" } + | 'while' { AST.JSIdentifier (mkJSAnnot $1) "while" } + | 'with' { AST.JSIdentifier (mkJSAnnot $1) "with" } + | 'future' { AST.JSIdentifier (mkJSAnnot $1) (tokenLiteral $1) } + + +SpreadExpression :: { AST.JSExpression } +SpreadExpression : Spread Expression { AST.JSSpreadExpression $1 $2 {- 'SpreadExpression' -} } + +-- ArrayLiteral : See 11.1.4 +-- [ Elisionopt ] +-- [ ElementList ] +-- [ ElementList , Elisionopt ] +ArrayLiteral :: { AST.JSExpression } +ArrayLiteral : LSquare RSquare { AST.JSArrayLiteral $1 [] $2 {- 'ArrayLiteral11' -} } + | LSquare Elision RSquare { AST.JSArrayLiteral $1 $2 $3 {- 'ArrayLiteral12' -} } + | LSquare ElementList RSquare { AST.JSArrayLiteral $1 $2 $3 {- 'ArrayLiteral13' -} } + | LSquare ElementList Elision RSquare { AST.JSArrayLiteral $1 ($2 ++ $3) $4 {- 'ArrayLiteral14' -} } + + +-- ElementList : See 11.1.4 +-- Elisionopt AssignmentExpression +-- ElementList , Elisionopt AssignmentExpression +ElementList :: { [AST.JSArrayElement] } +ElementList : Elision AssignmentExpression { $1 ++ [AST.JSArrayElement $2] {- 'ElementList1' -} } + | AssignmentExpression { [AST.JSArrayElement $1] {- 'ElementList2' -} } + | ElementList Elision AssignmentExpression { (($1)++($2 ++ [AST.JSArrayElement $3])) {- 'ElementList3' -} } + + +-- Elision : See 11.1.4 +-- , +-- Elision , +Elision :: { [AST.JSArrayElement] } +Elision : Comma { [AST.JSArrayComma $1] {- 'Elision1' -} } + | Comma Elision { (AST.JSArrayComma $1):$2 {- 'Elision2' -} } + +-- ObjectLiteral : See 11.1.5 +-- { } +-- { PropertyNameAndValueList } +-- { PropertyNameAndValueList , } +ObjectLiteral :: { AST.JSExpression } +ObjectLiteral : LBrace RBrace { AST.JSObjectLiteral $1 (AST.JSCTLNone AST.JSLNil) $2 {- 'ObjectLiteal1' -} } + | LBrace PropertyNameandValueList RBrace { AST.JSObjectLiteral $1 (AST.JSCTLNone $2) $3 {- 'ObjectLiteal2' -} } + | LBrace PropertyNameandValueList Comma RBrace { AST.JSObjectLiteral $1 (AST.JSCTLComma $2 $3) $4 {- 'ObjectLiteal3' -} } + +-- ::= ':' +-- | ',' ':' + +-- Seems we can have function declarations in the value part too +-- PropertyNameAndValueList : See 11.1.5 +-- PropertyAssignment +-- PropertyNameAndValueList , PropertyAssignment +PropertyNameandValueList :: { AST.JSCommaList AST.JSObjectProperty } +PropertyNameandValueList : PropertyAssignment { AST.JSLOne $1 {- 'PropertyNameandValueList1' -} } + | PropertyNameandValueList Comma PropertyAssignment { AST.JSLCons $1 $2 $3 {- 'PropertyNameandValueList2' -} } + +-- PropertyAssignment : See 11.1.5 +-- PropertyName : AssignmentExpression +-- get PropertyName() { FunctionBody } +-- set PropertyName( PropertySetParameterList ) { FunctionBody } +-- TODO: not clear if get/set are keywords, or just used in a specific context. Puzzling. +PropertyAssignment :: { AST.JSObjectProperty } +PropertyAssignment : PropertyName Colon AssignmentExpression { AST.JSPropertyNameandValue $1 $2 [$3] } + | PropertyName { AST.JSPropertyNameOnly $1 } + -- Should be "get" in next, but is not a Token + | 'get' PropertyName LParen RParen FunctionBody + { AST.JSPropertyAccessor (AST.JSAccessorGet (mkJSAnnot $1)) $2 $3 [] $4 $5 } + -- Should be "set" in next, but is not a Token + | 'set' PropertyName LParen PropertySetParameterList RParen FunctionBody + { AST.JSPropertyAccessor (AST.JSAccessorSet (mkJSAnnot $1)) $2 $3 [$4] $5 $6 } + +-- PropertyName : See 11.1.5 +-- IdentifierName +-- StringLiteral +-- NumericLiteral +PropertyName :: { AST.JSPropertyName } +PropertyName : Identifier { propName $1 {- 'PropertyName1' -} } + | StringLiteral { propName $1 {- 'PropertyName2' -} } + | NumericLiteral { propName $1 {- 'PropertyName3' -} } + +-- PropertySetParameterList : See 11.1.5 +-- Identifier +PropertySetParameterList :: { AST.JSExpression } +PropertySetParameterList : Identifier { $1 {- 'PropertySetParameterList' -} } + +-- MemberExpression : See 11.2 +-- PrimaryExpression +-- FunctionExpression +-- MemberExpression [ Expression ] +-- MemberExpression . IdentifierName +-- new MemberExpression Arguments +MemberExpression :: { AST.JSExpression } +MemberExpression : PrimaryExpression { $1 {- 'MemberExpression1' -} } + | FunctionExpression { $1 {- 'MemberExpression2' -} } + | MemberExpression LSquare Expression RSquare { AST.JSMemberSquare $1 $2 $3 $4 {- 'MemberExpression3' -} } + | MemberExpression Dot IdentifierName { AST.JSMemberDot $1 $2 $3 {- 'MemberExpression4' -} } + | New MemberExpression Arguments { mkJSMemberNew $1 $2 $3 {- 'MemberExpression5' -} } + +-- NewExpression : See 11.2 +-- MemberExpression +-- new NewExpression +NewExpression :: { AST.JSExpression } +NewExpression : MemberExpression { $1 {- 'NewExpression1' -} } + | New NewExpression { AST.JSNewExpression $1 $2 {- 'NewExpression2' -} } + +-- CallExpression : See 11.2 +-- MemberExpression Arguments +-- CallExpression Arguments +-- CallExpression [ Expression ] +-- CallExpression . IdentifierName +CallExpression :: { AST.JSExpression } +CallExpression : MemberExpression Arguments + { mkJSMemberExpression $1 $2 {- 'CallExpression1' -} } + | CallExpression Arguments + { mkJSCallExpression $1 $2 {- 'CallExpression2' -} } + | CallExpression LSquare Expression RSquare + { AST.JSCallExpressionSquare $1 $2 $3 $4 {- 'CallExpression3' -} } + | CallExpression Dot IdentifierName + { AST.JSCallExpressionDot $1 $2 $3 {- 'CallExpression4' -} } + +-- Arguments : See 11.2 +-- () +-- ( ArgumentList ) +Arguments :: { JSArguments } +Arguments : LParen RParen { JSArguments $1 AST.JSLNil $2 {- 'Arguments1' -} } + | LParen ArgumentList RParen { JSArguments $1 $2 $3 {- 'Arguments2' -} } + +-- ArgumentList : See 11.2 +-- AssignmentExpression +-- ArgumentList , AssignmentExpression +ArgumentList :: { AST.JSCommaList AST.JSExpression } +ArgumentList : AssignmentExpression { AST.JSLOne $1 {- 'ArgumentList1' -} } + | ArgumentList Comma AssignmentExpression { AST.JSLCons $1 $2 $3 {- 'ArgumentList2' -} } + +-- LeftHandSideExpression : See 11.2 +-- NewExpression +-- CallExpression +LeftHandSideExpression :: { AST.JSExpression } +LeftHandSideExpression : NewExpression { $1 {- 'LeftHandSideExpression1' -} } + | CallExpression { $1 {- 'LeftHandSideExpression12' -} } + +-- PostfixExpression : See 11.3 +-- LeftHandSideExpression +-- [no LineTerminator here] +-- LeftHandSideExpression ++ +-- [no LineTerminator here] +-- LeftHandSideExpression -- +PostfixExpression :: { AST.JSExpression } +PostfixExpression : LeftHandSideExpression { $1 {- 'PostfixExpression' -} } + | PostfixExpression Increment { AST.JSExpressionPostfix $1 $2 } + | PostfixExpression Decrement { AST.JSExpressionPostfix $1 $2 } + +-- UnaryExpression : See 11.4 +-- PostfixExpression +-- delete UnaryExpression +-- void UnaryExpression +-- typeof UnaryExpression +-- ++ UnaryExpression +-- -- UnaryExpression +-- + UnaryExpression +-- - UnaryExpression +-- ~ UnaryExpression +-- ! UnaryExpression +UnaryExpression :: { AST.JSExpression } +UnaryExpression : PostfixExpression { $1 {- 'UnaryExpression' -} } + | Delete UnaryExpression { AST.JSUnaryExpression $1 $2 } + | Void UnaryExpression { AST.JSUnaryExpression $1 $2 } + | Typeof UnaryExpression { AST.JSUnaryExpression $1 $2 } + | Increment UnaryExpression { AST.JSUnaryExpression $1 $2 } + | Decrement UnaryExpression { AST.JSUnaryExpression $1 $2 } + | Plus UnaryExpression { AST.JSUnaryExpression (mkUnary $1) $2 } + | Minus UnaryExpression { AST.JSUnaryExpression (mkUnary $1) $2 } + | Tilde UnaryExpression { AST.JSUnaryExpression $1 $2 } + | Not UnaryExpression { AST.JSUnaryExpression $1 $2 } + +-- MultiplicativeExpression : See 11.5 +-- UnaryExpression +-- MultiplicativeExpression * UnaryExpression +-- MultiplicativeExpression / UnaryExpression +-- MultiplicativeExpression % UnaryExpression +MultiplicativeExpression :: { AST.JSExpression } +MultiplicativeExpression : UnaryExpression { $1 {- 'MultiplicativeExpression' -} } + | MultiplicativeExpression Mul UnaryExpression { AST.JSExpressionBinary {- '*' -} $1 $2 $3 } + | MultiplicativeExpression Div UnaryExpression { AST.JSExpressionBinary {- '/' -} $1 $2 $3 } + | MultiplicativeExpression Mod UnaryExpression { AST.JSExpressionBinary {- '%' -} $1 $2 $3 } + +-- AdditiveExpression : See 11.6 +-- MultiplicativeExpression +-- AdditiveExpression + MultiplicativeExpression +-- AdditiveExpression - MultiplicativeExpression +AdditiveExpression :: { AST.JSExpression } +AdditiveExpression : AdditiveExpression Plus MultiplicativeExpression { AST.JSExpressionBinary {- '+' -} $1 $2 $3 } + | AdditiveExpression Minus MultiplicativeExpression { AST.JSExpressionBinary {- '-' -} $1 $2 $3 } + | MultiplicativeExpression { $1 {- 'AdditiveExpression' -} } + +-- ShiftExpression : See 11.7 +-- AdditiveExpression +-- ShiftExpression << AdditiveExpression +-- ShiftExpression >> AdditiveExpression +-- ShiftExpression >>> AdditiveExpression +ShiftExpression :: { AST.JSExpression } +ShiftExpression : ShiftExpression Lsh AdditiveExpression { AST.JSExpressionBinary {- '<<' -} $1 $2 $3 } + | ShiftExpression Rsh AdditiveExpression { AST.JSExpressionBinary {- '>>' -} $1 $2 $3 } + | ShiftExpression Ursh AdditiveExpression { AST.JSExpressionBinary {- '>>>' -} $1 $2 $3 } + | AdditiveExpression { $1 {- 'ShiftExpression' -} } + +-- RelationalExpression : See 11.8 +-- ShiftExpression +-- RelationalExpression < ShiftExpression +-- RelationalExpression > ShiftExpression +-- RelationalExpression <= ShiftExpression +-- RelationalExpression >= ShiftExpression +-- RelationalExpression instanceof ShiftExpression +-- RelationalExpression in ShiftExpression +RelationalExpression :: { AST.JSExpression } +RelationalExpression : ShiftExpression { $1 {- 'RelationalExpression' -} } + | RelationalExpression Lt ShiftExpression { AST.JSExpressionBinary {- '<' -} $1 $2 $3 } + | RelationalExpression Gt ShiftExpression { AST.JSExpressionBinary {- '>' -} $1 $2 $3 } + | RelationalExpression Le ShiftExpression { AST.JSExpressionBinary {- '<=' -} $1 $2 $3 } + | RelationalExpression Ge ShiftExpression { AST.JSExpressionBinary {- '>=' -} $1 $2 $3 } + | RelationalExpression Instanceof ShiftExpression { AST.JSExpressionBinary {- ' instanceof' -} $1 $2 $3 } + | RelationalExpression In ShiftExpression { AST.JSExpressionBinary {- ' in ' -} $1 $2 $3 } + +-- RelationalExpressionNoIn : See 11.8 +-- ShiftExpression +-- RelationalExpressionNoIn < ShiftExpression +-- RelationalExpressionNoIn > ShiftExpression +-- RelationalExpressionNoIn <= ShiftExpression +-- RelationalExpressionNoIn >= ShiftExpression +-- RelationalExpressionNoIn instanceof ShiftExpression +RelationalExpressionNoIn :: { AST.JSExpression } +RelationalExpressionNoIn : ShiftExpression { $1 {- 'RelationalExpressionNoIn' -} } + | RelationalExpressionNoIn Lt ShiftExpression { AST.JSExpressionBinary {- '<' -} $1 $2 $3 } + | RelationalExpressionNoIn Gt ShiftExpression { AST.JSExpressionBinary {- '>' -} $1 $2 $3 } + | RelationalExpressionNoIn Le ShiftExpression { AST.JSExpressionBinary {- '<=' -} $1 $2 $3 } + | RelationalExpressionNoIn Ge ShiftExpression { AST.JSExpressionBinary {- '>=' -} $1 $2 $3 } + | RelationalExpressionNoIn Instanceof ShiftExpression { AST.JSExpressionBinary {- ' instanceof ' -} $1 $2 $3 } + +-- EqualityExpression : See 11.9 +-- RelationalExpression +-- EqualityExpression == RelationalExpression +-- EqualityExpression != RelationalExpression +-- EqualityExpression === RelationalExpression +-- EqualityExpression !== RelationalExpression +EqualityExpression :: { AST.JSExpression } +EqualityExpression : RelationalExpression { $1 {- 'EqualityExpression' -} } + | EqualityExpression Equal RelationalExpression { AST.JSExpressionBinary {- '==' -} $1 $2 $3 } + | EqualityExpression Ne RelationalExpression { AST.JSExpressionBinary {- '!=' -} $1 $2 $3 } + | EqualityExpression StrictEq RelationalExpression { AST.JSExpressionBinary {- '===' -} $1 $2 $3 } + | EqualityExpression StrictNe RelationalExpression { AST.JSExpressionBinary {- '!==' -} $1 $2 $3 } + +-- EqualityExpressionNoIn : See 11.9 +-- RelationalExpressionNoIn +-- EqualityExpressionNoIn == RelationalExpressionNoIn +-- EqualityExpressionNoIn != RelationalExpressionNoIn +-- EqualityExpressionNoIn === RelationalExpressionNoIn +-- EqualityExpressionNoIn !== RelationalExpressionNoIn +EqualityExpressionNoIn :: { AST.JSExpression } +EqualityExpressionNoIn : RelationalExpressionNoIn { $1 {- 'EqualityExpressionNoIn' -} } + | EqualityExpressionNoIn Equal RelationalExpression { AST.JSExpressionBinary {- '==' -} $1 $2 $3 } + | EqualityExpressionNoIn Ne RelationalExpression { AST.JSExpressionBinary {- '!=' -} $1 $2 $3 } + | EqualityExpressionNoIn StrictEq RelationalExpression { AST.JSExpressionBinary {- '===' -} $1 $2 $3 } + | EqualityExpressionNoIn StrictNe RelationalExpression { AST.JSExpressionBinary {- '!==' -} $1 $2 $3 } + +-- BitwiseANDExpression : See 11.10 +-- EqualityExpression +-- BitwiseANDExpression & EqualityExpression +BitwiseAndExpression :: { AST.JSExpression } +BitwiseAndExpression : EqualityExpression { $1 {- 'BitwiseAndExpression' -} } + | BitwiseAndExpression BitAnd EqualityExpression { AST.JSExpressionBinary {- '&' -} $1 $2 $3 } + +-- BitwiseANDExpressionNoIn : See 11.10 +-- EqualityExpressionNoIn +-- BitwiseANDExpressionNoIn & EqualityExpressionNoIn +BitwiseAndExpressionNoIn :: { AST.JSExpression } +BitwiseAndExpressionNoIn : EqualityExpressionNoIn { $1 {- 'BitwiseAndExpression' -} } + | BitwiseAndExpressionNoIn BitAnd EqualityExpressionNoIn { AST.JSExpressionBinary {- '&' -} $1 $2 $3 } + +-- BitwiseXORExpression : See 11.10 +-- BitwiseANDExpression +-- BitwiseXORExpression ^ BitwiseANDExpression +BitwiseXOrExpression :: { AST.JSExpression } +BitwiseXOrExpression : BitwiseAndExpression { $1 {- 'BitwiseXOrExpression' -} } + | BitwiseXOrExpression BitXor BitwiseAndExpression { AST.JSExpressionBinary {- '^' -} $1 $2 $3 } + +-- BitwiseXORExpressionNoIn : See 11.10 +-- BitwiseANDExpressionNoIn +-- BitwiseXORExpressionNoIn ^ BitwiseANDExpressionNoIn +BitwiseXOrExpressionNoIn :: { AST.JSExpression } +BitwiseXOrExpressionNoIn : BitwiseAndExpressionNoIn { $1 {- 'BitwiseXOrExpression' -} } + | BitwiseXOrExpressionNoIn BitXor BitwiseAndExpressionNoIn { AST.JSExpressionBinary {- '^' -} $1 $2 $3 } + +-- BitwiseORExpression : See 11.10 +-- BitwiseXORExpression +-- BitwiseORExpression | BitwiseXORExpression +BitwiseOrExpression :: { AST.JSExpression } +BitwiseOrExpression : BitwiseXOrExpression { $1 {- 'BitwiseOrExpression' -} } + | BitwiseOrExpression BitOr BitwiseXOrExpression { AST.JSExpressionBinary {- '|' -} $1 $2 $3 } + +-- BitwiseORExpressionNoIn : See 11.10 +-- BitwiseXORExpressionNoIn +-- BitwiseORExpressionNoIn | BitwiseXORExpressionNoIn +BitwiseOrExpressionNoIn :: { AST.JSExpression } +BitwiseOrExpressionNoIn : BitwiseXOrExpressionNoIn { $1 {- 'BitwiseOrExpression' -} } + | BitwiseOrExpressionNoIn BitOr BitwiseXOrExpressionNoIn { AST.JSExpressionBinary {- '|' -} $1 $2 $3 } + +-- LogicalANDExpression : See 11.11 +-- BitwiseORExpression +-- LogicalANDExpression && BitwiseORExpression +LogicalAndExpression :: { AST.JSExpression } +LogicalAndExpression : BitwiseOrExpression { $1 {- 'LogicalAndExpression' -} } + | LogicalAndExpression And BitwiseOrExpression { AST.JSExpressionBinary {- '&&' -} $1 $2 $3 } + +-- LogicalANDExpressionNoIn : See 11.11 +-- BitwiseORExpressionNoIn +-- LogicalANDExpressionNoIn && BitwiseORExpressionNoIn +LogicalAndExpressionNoIn :: { AST.JSExpression } +LogicalAndExpressionNoIn : BitwiseOrExpressionNoIn { $1 {- 'LogicalAndExpression' -} } + | LogicalAndExpressionNoIn And BitwiseOrExpressionNoIn { AST.JSExpressionBinary {- '&&' -} $1 $2 $3 } + +-- LogicalORExpression : See 11.11 +-- LogicalANDExpression +-- LogicalORExpression || LogicalANDExpression +LogicalOrExpression :: { AST.JSExpression } +LogicalOrExpression : LogicalAndExpression { $1 {- 'LogicalOrExpression' -} } + | LogicalOrExpression Or LogicalAndExpression { AST.JSExpressionBinary {- '||' -} $1 $2 $3 } + +-- LogicalORExpressionNoIn : See 11.11 +-- LogicalANDExpressionNoIn +-- LogicalORExpressionNoIn || LogicalANDExpressionNoIn +LogicalOrExpressionNoIn :: { AST.JSExpression } +LogicalOrExpressionNoIn : LogicalAndExpressionNoIn { $1 {- 'LogicalOrExpression' -} } + | LogicalOrExpressionNoIn Or LogicalAndExpressionNoIn { AST.JSExpressionBinary {- '||' -} $1 $2 $3 } + +-- ConditionalExpression : See 11.12 +-- LogicalORExpression +-- LogicalORExpression ? AssignmentExpression : AssignmentExpression +ConditionalExpression :: { AST.JSExpression } +ConditionalExpression : LogicalOrExpression { $1 {- 'ConditionalExpression1' -} } + | LogicalOrExpression Hook AssignmentExpression Colon AssignmentExpression + { AST.JSExpressionTernary $1 $2 $3 $4 $5 {- 'ConditionalExpression2' -} } + +-- ConditionalExpressionNoIn : See 11.12 +-- LogicalORExpressionNoIn +-- LogicalORExpressionNoIn ? AssignmentExpressionNoIn : AssignmentExpressionNoIn +ConditionalExpressionNoIn :: { AST.JSExpression } +ConditionalExpressionNoIn : LogicalOrExpressionNoIn { $1 {- 'ConditionalExpressionNoIn1' -} } + | LogicalOrExpressionNoIn Hook AssignmentExpressionNoIn Colon AssignmentExpressionNoIn + { AST.JSExpressionTernary $1 $2 $3 $4 $5 {- 'ConditionalExpressionNoIn2' -} } + +-- AssignmentExpression : See 11.13 +-- ConditionalExpression +-- LeftHandSideExpression AssignmentOperator AssignmentExpression +AssignmentExpression :: { AST.JSExpression } +AssignmentExpression : ConditionalExpression { $1 {- 'AssignmentExpression1' -} } + | LeftHandSideExpression AssignmentOperator AssignmentExpression + { AST.JSAssignExpression $1 $2 $3 {- 'AssignmentExpression2' -} } + +-- AssignmentExpressionNoIn : See 11.13 +-- ConditionalExpressionNoIn +-- LeftHandSideExpression AssignmentOperator AssignmentExpressionNoIn +AssignmentExpressionNoIn :: { AST.JSExpression } +AssignmentExpressionNoIn : ConditionalExpressionNoIn { $1 {- 'AssignmentExpressionNoIn1' -} } + | LeftHandSideExpression AssignmentOperator AssignmentExpressionNoIn + { AST.JSAssignExpression $1 $2 $3 {- 'AssignmentExpressionNoIn1' -} } + +-- AssignmentOperator : one of See 11.13 +-- '=' | '*=' | '/=' | '%=' | '+=' | '-=' | '<<=' | '>>=' | '>>>=' | '&=' | '^=' | '|=' +AssignmentOperator :: { AST.JSAssignOp } +AssignmentOperator : OpAssign { $1 } + | SimpleAssign { AST.JSAssign $1 {- 'SimpleAssign' -} } + +-- Expression : See 11.14 +-- AssignmentExpression +-- Expression , AssignmentExpression +Expression :: { AST.JSExpression } +Expression : AssignmentExpression { $1 {- 'Expression' -} } + | Expression Comma AssignmentExpression { AST.JSCommaExpression $1 $2 $3 {- 'Expression2' -} } + +-- ExpressionNoIn : See 11.14 +-- AssignmentExpressionNoIn +-- ExpressionNoIn , AssignmentExpressionNoIn +ExpressionNoIn :: { AST.JSExpression } +ExpressionNoIn : AssignmentExpressionNoIn { $1 {- 'ExpressionNoIn' -} } + | ExpressionNoIn Comma AssignmentExpressionNoIn { AST.JSCommaExpression $1 $2 $3 {- 'ExpressionNoIn2' -} } + +-- TODO: still required? +ExpressionOpt :: { AST.JSCommaList AST.JSExpression } +ExpressionOpt : Expression { AST.JSLOne $1 {- 'ExpressionOpt1' -} } + | { AST.JSLNil {- 'ExpressionOpt2' -} } + +ExpressionNoInOpt :: { AST.JSCommaList AST.JSExpression } +ExpressionNoInOpt : ExpressionNoIn { AST.JSLOne $1 {- 'ExpressionOpt1' -} } + | { AST.JSLNil {- 'ExpressionOpt2' -} } + + +-- Statement : See clause 12 +-- Block +-- VariableStatement +-- EmptyStatement +-- ExpressionStatement +-- IfStatement +-- IterationStatement +-- ContinueStatement +-- BreakStatement +-- ReturnStatement +-- WithStatement +-- LabelledStatement +-- SwitchStatement +-- ThrowStatement +-- TryStatement +-- DebuggerStatement +Statement :: { AST.JSStatement } +Statement : StatementNoEmpty { $1 {- 'Statement1' -} } + | EmptyStatement { $1 {- 'Statement2' -} } + +StatementNoEmpty :: { AST.JSStatement } +StatementNoEmpty : StatementBlock { $1 {- 'StatementNoEmpty1' -} } + | VariableStatement { $1 {- 'StatementNoEmpty2' -} } + | ExpressionStatement { $1 {- 'StatementNoEmpty4' -} } + | IfStatement { $1 {- 'StatementNoEmpty5' -} } + | IterationStatement { $1 {- 'StatementNoEmpty6' -} } + | ContinueStatement { $1 {- 'StatementNoEmpty7' -} } + | BreakStatement { $1 {- 'StatementNoEmpty8' -} } + | ReturnStatement { $1 {- 'StatementNoEmpty9' -} } + | WithStatement { $1 {- 'StatementNoEmpty10' -} } + | LabelledStatement { $1 {- 'StatementNoEmpty11' -} } + | SwitchStatement { $1 {- 'StatementNoEmpty12' -} } + | ThrowStatement { $1 {- 'StatementNoEmpty13' -} } + | TryStatement { $1 {- 'StatementNoEmpty14' -} } + | ImportStatement { $1 {- 'StatementNoEmpty15' -} } + | ExportStatement { $1 {- 'StatementNoEmpty16' -} } + | DebuggerStatement { $1 {- 'StatementNoEmpty17' -} } + + +StatementBlock :: { AST.JSStatement } +StatementBlock : Block MaybeSemi { blockToStatement $1 $2 {- 'StatementBlock1' -} } + + +-- Block : See 12.1 +-- { StatementListopt } +Block :: { AST.JSBlock } +Block : LBrace RBrace { AST.JSBlock $1 [] $2 {- 'Block1' -} } + | LBrace StatementList RBrace { AST.JSBlock $1 $2 $3 {- 'Block2' -} } + +-- StatementList : See 12.1 +-- Statement +-- StatementList Statement +StatementList :: { [AST.JSStatement] } +StatementList : Statement { [$1] {- 'StatementList1' -} } + | StatementList Statement { ($1++[$2]) {- 'StatementList2' -} } + +-- VariableStatement : See 12.2 +-- var VariableDeclarationList ; +VariableStatement :: { AST.JSStatement } +VariableStatement : Var VariableDeclarationList MaybeSemi { AST.JSVariable $1 $2 $3 {- 'VariableStatement1' -} } + | Let VariableDeclarationList MaybeSemi { AST.JSLet $1 $2 $3 {- 'VariableStatement2' -} } + | Const VariableDeclarationList MaybeSemi { AST.JSConstant $1 $2 $3 {- 'VariableStatement2' -} } + +-- VariableDeclarationList : See 12.2 +-- VariableDeclaration +-- VariableDeclarationList , VariableDeclaration +VariableDeclarationList :: { AST.JSCommaList AST.JSExpression } +VariableDeclarationList : VariableDeclaration { AST.JSLOne $1 {- 'VariableDeclarationList1' -} } + | VariableDeclarationList Comma VariableDeclaration { AST.JSLCons $1 $2 $3 {- 'VariableDeclarationList2' -} } + +-- VariableDeclarationListNoIn : See 12.2 +-- VariableDeclarationNoIn +-- VariableDeclarationListNoIn , VariableDeclarationNoIn +VariableDeclarationListNoIn :: { AST.JSCommaList AST.JSExpression } +VariableDeclarationListNoIn : VariableDeclarationNoIn { AST.JSLOne $1 {- 'VariableDeclarationListNoIn1' -} } + | VariableDeclarationListNoIn Comma VariableDeclarationNoIn { AST.JSLCons $1 $2 $3 {- 'VariableDeclarationListNoIn2' -} } + +-- VariableDeclaration : See 12.2 +-- Identifier Initialiseropt +VariableDeclaration :: { AST.JSExpression } +VariableDeclaration : Identifier SimpleAssign AssignmentExpression { AST.JSVarInitExpression $1 (AST.JSVarInit $2 $3) {- 'JSVarInitExpression1' -} } + | Identifier { AST.JSVarInitExpression $1 AST.JSVarInitNone {- 'JSVarInitExpression2' -} } + +-- VariableDeclarationNoIn : See 12.2 +-- Identifier InitialiserNoInopt +VariableDeclarationNoIn :: { AST.JSExpression } +VariableDeclarationNoIn : Identifier SimpleAssign AssignmentExpression { AST.JSVarInitExpression $1 (AST.JSVarInit $2 $3) {- 'JSVarInitExpressionInit2' -} } + | Identifier { AST.JSVarInitExpression $1 AST.JSVarInitNone {- 'JSVarInitExpression2' -} } + +-- EmptyStatement : See 12.3 +-- ; +EmptyStatement :: { AST.JSStatement } +EmptyStatement : Semi { AST.JSEmptyStatement $1 {- 'EmptyStatement' -} } + +-- ExpressionStatement : See 12.4 +-- [lookahead not in {{, function}] Expression ; +-- TODO: Sort out lookahead issue. Maybe by just putting production lower to set reduce/reduce conflict +-- According to http://sideshowbarker.github.com/es5-spec/#x12.4, the ambiguity is with +-- Block or FunctionDeclaration +ExpressionStatement :: { AST.JSStatement } +ExpressionStatement : Expression MaybeSemi { expressionToStatement $1 $2 {- 'ExpressionStatement' -} } + + +-- IfStatement : See 12.5 +-- if ( Expression ) Statement else Statement +-- if ( Expression ) Statement +IfStatement :: { AST.JSStatement } -- +++XXXX++ +IfStatement : If LParen Expression RParen EmptyStatement + { AST.JSIf $1 $2 $3 $4 $5 {- 'IfStatement1' -} } + | If LParen Expression RParen StatementNoEmpty Else Statement + { AST.JSIfElse $1 $2 $3 $4 $5 $6 $7 {- 'IfStatement3' -} } + | If LParen Expression RParen StatementNoEmpty + { AST.JSIf $1 $2 $3 $4 $5 {- 'IfStatement3' -} } + | If LParen Expression RParen EmptyStatement Else Statement + { AST.JSIfElse $1 $2 $3 $4 $5 $6 $7 {- 'IfStatement4' -} } + +-- IterationStatement : See 12.6 +-- do Statement while ( Expression ); +-- while ( Expression ) Statement +-- for (ExpressionNoInopt; Expressionopt ; Expressionopt ) Statement +-- for ( var VariableDeclarationListNoIn; Expressionopt ; Expressionopt ) Statement +-- for ( LeftHandSideExpression in Expression ) Statement +-- for ( var VariableDeclarationNoIn in Expression ) Statement +IterationStatement :: { AST.JSStatement } +IterationStatement : Do StatementNoEmpty While LParen Expression RParen MaybeSemi + { AST.JSDoWhile $1 $2 $3 $4 $5 $6 $7 {- 'IterationStatement1' -} } + | While LParen Expression RParen Statement + { AST.JSWhile $1 $2 $3 $4 $5 {- 'IterationStatement2' -} } + | For LParen ExpressionNoInOpt Semi ExpressionOpt Semi ExpressionOpt RParen Statement + { AST.JSFor $1 $2 $3 $4 $5 $6 $7 $8 $9 {- 'IterationStatement3' -} } + | For LParen Var VariableDeclarationListNoIn Semi ExpressionOpt Semi ExpressionOpt RParen Statement + { AST.JSForVar $1 $2 $3 $4 $5 $6 $7 $8 $9 $10 {- 'IterationStatement4' -} } + | For LParen LeftHandSideExpression In Expression RParen Statement + { AST.JSForIn $1 $2 $3 $4 $5 $6 $7 {- 'IterationStatement 5-} } + | For LParen Var VariableDeclarationNoIn In Expression RParen Statement + { AST.JSForVarIn $1 $2 $3 $4 $5 $6 $7 $8 {- 'IterationStatement6' -} } + +-- ContinueStatement : See 12.7 +-- continue [no LineTerminator here] Identifieropt ; +ContinueStatement :: { AST.JSStatement } +ContinueStatement : Continue AutoSemi { AST.JSContinue $1 AST.JSIdentNone $2 {- 'ContinueStatement1' -} } + | Continue Identifier MaybeSemi { AST.JSContinue $1 (identName $2) $3 {- 'ContinueStatement2' -} } + +-- BreakStatement : See 12.8 +-- break [no LineTerminator here] Identifieropt ; +BreakStatement :: { AST.JSStatement } +BreakStatement : Break AutoSemi { AST.JSBreak $1 AST.JSIdentNone $2 {- 'BreakStatement1' -} } + | Break Identifier MaybeSemi { AST.JSBreak $1 (identName $2) $3 {- 'BreakStatement2' -} } + +-- ReturnStatement : See 12.9 +-- return [no LineTerminator here] Expressionopt ; +ReturnStatement :: { AST.JSStatement } +ReturnStatement : Return AutoSemi { AST.JSReturn $1 Nothing $2 } + | Return Expression MaybeSemi { AST.JSReturn $1 (Just $2) $3 } + +-- WithStatement : See 12.10 +-- with ( Expression ) Statement +WithStatement :: { AST.JSStatement } +WithStatement : With LParen Expression RParen Statement MaybeSemi { AST.JSWith $1 $2 $3 $4 $5 $6 } + +-- SwitchStatement : See 12.11 +-- switch ( Expression ) CaseBlock +SwitchStatement :: { AST.JSStatement } +SwitchStatement : Switch LParen Expression RParen LBrace CaseBlock RBrace MaybeSemi { AST.JSSwitch $1 $2 $3 $4 $5 $6 $7 $8 } + +-- CaseBlock : See 12.11 +-- { CaseClausesopt } +-- { CaseClausesopt DefaultClause CaseClausesopt } +CaseBlock :: { [AST.JSSwitchParts] } +CaseBlock : CaseClausesOpt { $1 {- 'CaseBlock1' -} } + | CaseClausesOpt DefaultClause CaseClausesOpt { $1++[$2]++$3 {- 'CaseBlock2' -} } + +-- CaseClauses : See 12.11 +-- CaseClause +-- CaseClauses CaseClause +CaseClausesOpt :: { [AST.JSSwitchParts] } +CaseClausesOpt : CaseClause { [$1] {- 'CaseClausesOpt1' -} } + | CaseClausesOpt CaseClause { ($1++[$2]) {- 'CaseClausesOpt2' -} } + | { [] {- 'CaseClausesOpt3' -} } + +-- CaseClause : See 12.11 +-- case Expression : StatementListopt +CaseClause :: { AST.JSSwitchParts } +CaseClause : Case Expression Colon StatementList { AST.JSCase $1 $2 $3 $4 {- 'CaseClause1' -} } + | Case Expression Colon { AST.JSCase $1 $2 $3 [] {- 'CaseClause2' -} } + +-- DefaultClause : See 12.11 +-- default : StatementListopt +DefaultClause :: { AST.JSSwitchParts } +DefaultClause : Default Colon { AST.JSDefault $1 $2 [] {- 'DefaultClause1' -} } + | Default Colon StatementList { AST.JSDefault $1 $2 $3 {- 'DefaultClause2' -} } + +-- LabelledStatement : See 12.12 +-- Identifier : Statement +LabelledStatement :: { AST.JSStatement } +LabelledStatement : Identifier Colon Statement { AST.JSLabelled (identName $1) $2 $3 {- 'LabelledStatement' -} } + +-- ThrowStatement : See 12.13 +-- throw [no LineTerminator here] Expression ; +ThrowStatement :: { AST.JSStatement } +ThrowStatement : Throw Expression MaybeSemi { AST.JSThrow $1 $2 $3 {- 'ThrowStatement' -} } + +-- Note: worked in updated syntax as per https://developer.mozilla.org/en/JavaScript/Reference/Statements/try...catch +-- i.e., 0 or more catches, then an optional finally +-- TryStatement : See 12.14 +-- try Block Catch +-- try Block Finally +-- try Block Catch Finally +TryStatement :: { AST.JSStatement } +TryStatement : Try Block Catches { AST.JSTry $1 $2 $3 AST.JSNoFinally {- 'TryStatement1' -} } + | Try Block Finally { AST.JSTry $1 $2 [] $3 {- 'TryStatement2' -} } + | Try Block Catches Finally { AST.JSTry $1 $2 $3 $4 {- 'TryStatement3' -} } + +Catches :: { [AST.JSTryCatch] } +Catches : Catch { [$1] {- 'Catches1' -} } + | Catches Catch { ($1++[$2]) {- 'Catches2' -} } + +-- Note: worked in updated syntax as per https://developer.mozilla.org/en/JavaScript/Reference/Statements/try...catch +-- ::= 'catch' '(' Identifier ')' +-- becomes +-- ::= 'catch' '(' Identifier ')' +-- | 'catch' '(' Identifier 'if' ConditionalExpression ')' +Catch :: { AST.JSTryCatch } +Catch : CatchL LParen Identifier RParen Block { AST.JSCatch $1 $2 $3 $4 $5 {- 'Catch1' -} } + | CatchL LParen Identifier If ConditionalExpression RParen Block { AST.JSCatchIf $1 $2 $3 $4 $5 $6 $7 {- 'Catch2' -} } + +-- Finally : See 12.14 +-- finally Block +Finally :: { AST.JSTryFinally } +Finally : FinallyL Block { AST.JSFinally $1 $2 {- 'Finally' -} } + +-- DebuggerStatement : See 12.15 +-- debugger ; +DebuggerStatement :: { AST.JSStatement } +DebuggerStatement : 'debugger' MaybeSemi { AST.JSExpressionStatement (AST.JSLiteral (mkJSAnnot $1) "debugger") $2 {- 'DebuggerStatement' -} } + +-- FunctionDeclaration : See clause 13 +-- function Identifier ( FormalParameterListopt ) { FunctionBody } +FunctionDeclaration :: { AST.JSStatement } +FunctionDeclaration : NamedFunctionExpression MaybeSemi { expressionToStatement $1 $2 {- 'FunctionDeclaration1' -} } + +-- FunctionExpression : See clause 13 +-- function Identifieropt ( FormalParameterListopt ) { FunctionBody } +FunctionExpression :: { AST.JSExpression } +FunctionExpression : ArrowFunctionExpression { $1 {- 'ArrowFunctionExpression' -} } + | LambdaExpression { $1 {- 'FunctionExpression1' -} } + | NamedFunctionExpression { $1 {- 'FunctionExpression2' -} } + + +ArrowFunctionExpression :: { AST.JSExpression } +ArrowFunctionExpression : SingleFormalParamter Arrow Expression + { AST.JSArrowExpression AST.JSNoAnnot $1 AST.JSNoAnnot AST.JSNoAnnot (Left $3) } + | SingleFormalParamter Arrow FunctionBody + { AST.JSArrowExpression AST.JSNoAnnot $1 AST.JSNoAnnot AST.JSNoAnnot (Right $3) } + | LParen FormalParameterList RParen Arrow Expression + { AST.JSArrowExpression $1 $2 $3 $4 (Left $5) } + | LParen FormalParameterList RParen Arrow FunctionBody + { AST.JSArrowExpression $1 $2 $3 $4 (Right $5) } + +SingleFormalParamter :: { AST.JSCommaList AST.JSIdent } +SingleFormalParamter : Identifier { AST.JSLOne (identName $1) } + | LParen RParen { AST.JSLNil } + +NamedFunctionExpression :: { AST.JSExpression } +NamedFunctionExpression : Function Identifier LParen RParen FunctionBody + { AST.JSFunctionExpression $1 (identName $2) $3 AST.JSLNil $4 $5 {- 'NamedFunctionExpression1' -} } + | Function Identifier LParen FormalParameterList RParen FunctionBody + { AST.JSFunctionExpression $1 (identName $2) $3 $4 $5 $6 {- 'NamedFunctionExpression2' -} } + +LambdaExpression :: { AST.JSExpression } +LambdaExpression : Function LParen RParen FunctionBody + { AST.JSFunctionExpression $1 AST.JSIdentNone $2 AST.JSLNil $3 $4 {- 'LambdaExpression1' -} } + | Function LParen FormalParameterList RParen FunctionBody + { AST.JSFunctionExpression $1 AST.JSIdentNone $2 $3 $4 $5 {- 'LambdaExpression2' -} } + +IdentifierOpt :: { AST.JSIdent } +IdentifierOpt : Identifier { identName $1 {- 'IdentifierOpt1' -} } + | { AST.JSIdentNone {- 'IdentifierOpt2' -} } + + +-- FormalParameterList : See clause 13 +-- Identifier +-- FormalParameterList , Identifier +FormalParameterList :: { AST.JSCommaList AST.JSIdent } +FormalParameterList : Identifier { AST.JSLOne (identName $1) {- 'FormalParameterList1' -} } + | FormalParameterList Comma Identifier { AST.JSLCons $1 $2 (identName $3) {- 'FormalParameterList2' -} } + +-- FunctionBody : See clause 13 +-- SourceElementsopt +FunctionBody :: { AST.JSBlock } +FunctionBody : Block { $1 {- 'FunctionBody1' -} } + +-- ImportStatement : See clause 15 +-- import Expression from LiteralString +-- import LiteralString +ImportStatement :: { AST.JSStatement } +ImportStatement : Import Literal MaybeSemi + { AST.JSImport $1 Nothing AST.JSNoAnnot $2 $3 {- 'ImportFile' -} } + | Import StatementNoEmpty From Literal MaybeSemi + { AST.JSImport $1 (Just $2) $3 $4 $5 {- 'ImportNamesFromFile' -} } + +-- ExportStatement : +-- export Expression +ExportStatement :: { AST.JSStatement } +ExportStatement : Export StatementNoEmpty MaybeSemi { AST.JSExport $1 Nothing $2 $3 } + | Export Default StatementNoEmpty MaybeSemi { AST.JSExport $1 (Just $2) $3 $4 } + + +-- Program : See clause 14 +-- SourceElementsopt + +Program :: { AST.JSAST } +Program : StatementList Eof { AST.JSAstProgram $1 $2 {- 'Program1' -} } + | Eof { AST.JSAstProgram [] $1 {- 'Program2' -} } + +-- For debugging/other entry points +LiteralMain :: { AST.JSAST } +LiteralMain : Literal Eof { AST.JSAstLiteral $1 $2 {- 'LiteralMain' -} } + +ExpressionMain :: { AST.JSAST } +ExpressionMain : Expression Eof { AST.JSAstExpression $1 $2 {- 'ExpressionMain' -} } + +StatementMain :: { AST.JSAST } +StatementMain : StatementNoEmpty Eof { AST.JSAstStatement $1 $2 {- 'StatementMain' -} } + + +{ + +-- Need this type while build the AST, but is not actually part of the AST. +data JSArguments = JSArguments AST.JSAnnot (AST.JSCommaList AST.JSExpression) AST.JSAnnot -- ^lb, args, rb + + +blockToStatement :: AST.JSBlock -> AST.JSSemi -> AST.JSStatement +blockToStatement (AST.JSBlock a b c) s = AST.JSStatementBlock a b c s + +expressionToStatement :: AST.JSExpression -> AST.JSSemi -> AST.JSStatement +expressionToStatement (AST.JSFunctionExpression a b@(AST.JSIdentName{}) c d e f) s = AST.JSFunction a b c d e f s +expressionToStatement (AST.JSAssignExpression lhs op rhs) s = AST.JSAssignStatement lhs op rhs s +expressionToStatement (AST.JSMemberExpression e l a r) s = AST.JSMethodCall e l a r s +expressionToStatement exp s = AST.JSExpressionStatement exp s + + +mkJSCallExpression :: AST.JSExpression -> JSArguments -> AST.JSExpression +mkJSCallExpression e (JSArguments l arglist r) = AST.JSCallExpression e l arglist r + +mkJSMemberExpression :: AST.JSExpression -> JSArguments -> AST.JSExpression +mkJSMemberExpression e (JSArguments l arglist r) = AST.JSMemberExpression e l arglist r + +mkJSMemberNew :: AST.JSAnnot -> AST.JSExpression -> JSArguments -> AST.JSExpression +mkJSMemberNew a e (JSArguments l arglist r) = AST.JSMemberNew a e l arglist r + +parseError :: Token -> Alex a +parseError = alexError . show + +mkJSAnnot :: Token -> AST.JSAnnot +mkJSAnnot a = AST.JSAnnot (tokenSpan a) (tokenComment a) + +-- --------------------------------------------------------------------- +-- | mkUnary : The parser detects '+' and '-' as the binary version of these +-- operator. This function converts from the binary version to the unary +-- version. +mkUnary :: AST.JSBinOp -> AST.JSUnaryOp +mkUnary (AST.JSBinOpMinus annot) = AST.JSUnaryOpMinus annot +mkUnary (AST.JSBinOpPlus annot) = AST.JSUnaryOpPlus annot + +mkUnary x = error $ "Invalid unary op : " ++ show x + +identName :: AST.JSExpression -> AST.JSIdent +identName (AST.JSIdentifier a s) = AST.JSIdentName a s +identName x = error $ "Cannot convert '" ++ show x ++ "' to a JSIdentName." + +propName :: AST.JSExpression -> AST.JSPropertyName +propName (AST.JSIdentifier a s) = AST.JSPropertyIdent a s +propName (AST.JSDecimal a s) = AST.JSPropertyNumber a s +propName (AST.JSHexInteger a s) = AST.JSPropertyNumber a s +propName (AST.JSOctal a s) = AST.JSPropertyNumber a s +propName (AST.JSStringLiteral a s) = AST.JSPropertyString a s +propName x = error $ "Cannot convert '" ++ show x ++ "' to a JSPropertyName." + + +} diff --git a/src/Language/JavaScript/Parser/Lexer.x b/src/Language/JavaScript/Parser/Lexer.x index fedcbe93..482a6d02 100644 --- a/src/Language/JavaScript/Parser/Lexer.x +++ b/src/Language/JavaScript/Parser/Lexer.x @@ -290,6 +290,7 @@ tokens :- "|" { adapt (symbolToken BitwiseOrToken) } "^" { adapt (symbolToken BitwiseXorToken) } "&" { adapt (symbolToken BitwiseAndToken) } + "=>" { adapt (symbolToken ArrowToken) } "===" { adapt (symbolToken StrictEqToken) } "==" { adapt (symbolToken EqToken) } "*=" { adapt (symbolToken TimesAssignToken) } @@ -320,6 +321,7 @@ tokens :- "%" { adapt (symbolToken ModToken) } "!" { adapt (symbolToken NotToken) } "~" { adapt (symbolToken BitwiseNotToken) } + "..." { adapt (symbolToken SpreadToken) } "." { adapt (symbolToken DotToken) } "[" { adapt (symbolToken LeftBracketToken) } "]" { adapt (symbolToken RightBracketToken) } @@ -552,17 +554,18 @@ keywordNames = -- ( "code", FutureToken ) **** not any more -- ( "const", FutureToken ) **** an actual token, used in productions -- enum **** an actual token, used in productions - , ( "export", FutureToken ) + , ( "export", ExportToken ) , ( "extends", FutureToken ) - , ( "import", FutureToken ) + , ( "import", ImportToken ) + , ( "from", FromToken ) , ( "super", FutureToken ) -- Strict mode FutureReservedWords , ( "implements", FutureToken ) , ( "interface", FutureToken ) - , ( "let", FutureToken ) + , ( "let", LetToken ) -- ( "mode", FutureToken ) **** not any more -- ( "of", FutureToken ) **** not any more -- ( "one", FutureToken ) **** not any more diff --git a/src/Language/JavaScript/Parser/Parser.hs b/src/Language/JavaScript/Parser/Parser.hs index 416dfeca..d36b5bc8 100644 --- a/src/Language/JavaScript/Parser/Parser.hs +++ b/src/Language/JavaScript/Parser/Parser.hs @@ -12,7 +12,7 @@ module Language.JavaScript.Parser.Parser ( , showStrippedMaybe ) where -import Language.JavaScript.Parser.Grammar5 +import Language.JavaScript.Parser.Grammar7 import Language.JavaScript.Parser.Lexer import qualified Language.JavaScript.Parser.AST as AST import System.IO diff --git a/src/Language/JavaScript/Parser/Token.hs b/src/Language/JavaScript/Parser/Token.hs index cc360b4e..974ce6f2 100644 --- a/src/Language/JavaScript/Parser/Token.hs +++ b/src/Language/JavaScript/Parser/Token.hs @@ -60,6 +60,7 @@ data Token | CaseToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } | CatchToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } | ConstToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } + | LetToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } | ContinueToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } | DebuggerToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } | DefaultToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } @@ -87,6 +88,9 @@ data Token | VoidToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } | WhileToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } | WithToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } + | FromToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } + | ExportToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } + | ImportToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } -- Future reserved words | FutureToken { tokenSpan :: !TokenPosn, tokenLiteral :: !String, tokenComment :: ![CommentAnnotation] } -- Needed, not sure what they are though. @@ -137,6 +141,8 @@ data Token | ModToken { tokenSpan :: !TokenPosn, tokenComment :: ![CommentAnnotation] } | NotToken { tokenSpan :: !TokenPosn, tokenComment :: ![CommentAnnotation] } | BitwiseNotToken { tokenSpan :: !TokenPosn, tokenComment :: ![CommentAnnotation] } + | ArrowToken { tokenSpan :: !TokenPosn, tokenComment :: ![CommentAnnotation] } + | SpreadToken { tokenSpan :: !TokenPosn, tokenComment :: ![CommentAnnotation] } | DotToken { tokenSpan :: !TokenPosn, tokenComment :: ![CommentAnnotation] } | LeftBracketToken { tokenSpan :: !TokenPosn, tokenComment :: ![CommentAnnotation] } | RightBracketToken { tokenSpan :: !TokenPosn, tokenComment :: ![CommentAnnotation] } diff --git a/src/Language/JavaScript/Pretty/Printer.hs b/src/Language/JavaScript/Pretty/Printer.hs index cc2ea36d..7eebbd94 100644 --- a/src/Language/JavaScript/Pretty/Printer.hs +++ b/src/Language/JavaScript/Pretty/Printer.hs @@ -247,6 +247,7 @@ instance RenderJS JSBlock where instance RenderJS JSObjectProperty where (|>) pacc (JSPropertyAccessor s n alp ps arp b) = pacc |> s |> n |> alp |> "(" |> ps |> arp |> ")" |> b + (|>) pacc (JSPropertyNameOnly s) = pacc |> s (|>) pacc (JSPropertyNameandValue n c vs) = pacc |> n |> c |> ":" |> vs instance RenderJS JSPropertyName where diff --git a/src/Language/JavaScript/Process/Minify.hs b/src/Language/JavaScript/Process/Minify.hs index 2aa3b6ee..795c201a 100644 --- a/src/Language/JavaScript/Process/Minify.hs +++ b/src/Language/JavaScript/Process/Minify.hs @@ -292,6 +292,7 @@ instance MinifyJS JSBlock where instance MinifyJS JSObjectProperty where fix a (JSPropertyAccessor s n _ ps _ b) = JSPropertyAccessor (fix a s) (fixSpace n) emptyAnnot (map fixEmpty ps) emptyAnnot (fixEmpty b) + fix a (JSPropertyNameOnly s ) = JSPropertyNameOnly (fix a s) fix a (JSPropertyNameandValue n _ vs) = JSPropertyNameandValue (fix a n) emptyAnnot (map fixEmpty vs) instance MinifyJS JSPropertyName where diff --git a/test/Test/Language/Javascript/ExpressionParser.hs b/test/Test/Language/Javascript/ExpressionParser.hs index 9cbd0d55..91089e28 100644 --- a/test/Test/Language/Javascript/ExpressionParser.hs +++ b/test/Test/Language/Javascript/ExpressionParser.hs @@ -5,7 +5,7 @@ module Test.Language.Javascript.ExpressionParser import Test.Hspec import Language.JavaScript.Parser -import Language.JavaScript.Parser.Grammar5 +import Language.JavaScript.Parser.Grammar7 import Language.JavaScript.Parser.Parser @@ -48,10 +48,13 @@ testExpressionParser = describe "Parse expressions:" $ do testExpr "'bc' + \"cd\"" `shouldBe` "Right (JSAstExpression (JSExpressionBinary ('+',JSStringLiteral 'bc',JSStringLiteral \"cd\")))" it "object literal" $ do testExpr "{}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral []))" + testExpr "{x}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyNameOnly (JSIdentifier 'x')]))" + testExpr "{x,y:1}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyNameOnly (JSIdentifier 'x'),JSPropertyNameandValue (JSIdentifier 'y') [JSDecimal '1']]))" testExpr "{x:1}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'x') [JSDecimal '1']]))" testExpr "{x:1,y:2}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'x') [JSDecimal '1'],JSPropertyNameandValue (JSIdentifier 'y') [JSDecimal '2']]))" testExpr "{x:1,}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'x') [JSDecimal '1'],JSComma]))" - testExpr "a={if:1,interface:2}" `shouldBe` "Right (JSAstExpression (JSOpAssign ('=',JSIdentifier 'a',JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'if') [JSDecimal '1'],JSPropertyNameandValue (JSIdentifier 'interface') [JSDecimal '2']])))" + -- fails if keyword is a key of an object. + testExpr "a={if:1,interface:2}" `shouldBe` "Left (\"IfToken {tokenSpan = TokenPn 3 1 4, tokenLiteral = \\\"if\\\", tokenComment = []}\")" testExpr "a={\n values: 7,\n}\n" `shouldBe` "Right (JSAstExpression (JSOpAssign ('=',JSIdentifier 'a',JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'values') [JSDecimal '7'],JSComma])))" testExpr "x={get foo() {return 1},set foo(a) {x=a}}" `shouldBe` "Right (JSAstExpression (JSOpAssign ('=',JSIdentifier 'x',JSObjectLiteral [JSPropertyAccessor JSAccessorGet (JSIdentifier 'foo') [] (JSBlock [JSReturn JSDecimal '1' ]),JSPropertyAccessor JSAccessorSet (JSIdentifier 'foo') [JSIdentifier 'a'] (JSBlock [JSOpAssign ('=',JSIdentifier 'x',JSIdentifier 'a')])])))" testExpr "{evaluate:evaluate,load:function load(s){if(x)return s;1}}" `shouldBe` "Right (JSAstExpression (JSObjectLiteral [JSPropertyNameandValue (JSIdentifier 'evaluate') [JSIdentifier 'evaluate'],JSPropertyNameandValue (JSIdentifier 'load') [JSFunctionExpression 'load' (JSIdentifier 's') (JSBlock [JSIf (JSIdentifier 'x') (JSReturn JSIdentifier 's' JSSemicolon),JSDecimal '1']))]]))" @@ -69,6 +72,8 @@ testExpressionParser = describe "Parse expressions:" $ do testExpr "!y" `shouldBe` "Right (JSAstExpression (JSUnaryExpression ('!',JSIdentifier 'y')))" testExpr "y++" `shouldBe` "Right (JSAstExpression (JSExpressionPostfix ('++',JSIdentifier 'y')))" testExpr "y--" `shouldBe` "Right (JSAstExpression (JSExpressionPostfix ('--',JSIdentifier 'y')))" + testExpr "...y" `shouldBe` "Right (JSAstExpression (JSSpreadExpression (JSIdentifier 'y')))" + it "new expression" $ do testExpr "new x()" `shouldBe` "Right (JSAstExpression (JSMemberNew (JSIdentifier 'x',JSArguments ())))" @@ -121,6 +126,12 @@ testExpressionParser = describe "Parse expressions:" $ do testExpr "function(){}" `shouldBe` "Right (JSAstExpression (JSFunctionExpression '' () (JSBlock []))))" testExpr "function(a){}" `shouldBe` "Right (JSAstExpression (JSFunctionExpression '' (JSIdentifier 'a') (JSBlock []))))" testExpr "function(a,b){}" `shouldBe` "Right (JSAstExpression (JSFunctionExpression '' (JSIdentifier 'a',JSIdentifier 'b') (JSBlock []))))" + testExpr "(a,b) => {}" `shouldBe` "Right (JSAstExpression (JSArrowExpression ((JSIdentifier 'a',JSIdentifier 'b')) => JSBlock []))" + testExpr "(a) => {}" `shouldBe` "Right (JSAstExpression (JSArrowExpression ((JSIdentifier 'a')) => JSBlock []))" + testExpr "a => {}" `shouldBe` "Right (JSAstExpression (JSArrowExpression ((JSIdentifier 'a')) => JSBlock []))" + testExpr "() => {}" `shouldBe` "Right (JSAstExpression (JSArrowExpression (()) => JSBlock []))" + testExpr "a => b" `shouldBe` "Right (JSAstExpression (JSArrowExpression ((JSIdentifier 'a')) => JSIdentifier 'b'))" + testExpr "(a,b) => a + b" `shouldBe` "Right (JSAstExpression (JSArrowExpression ((JSIdentifier 'a',JSIdentifier 'b')) => JSExpressionBinary ('+',JSIdentifier 'a',JSIdentifier 'b')))" it "member expression" $ do testExpr "x[y]" `shouldBe` "Right (JSAstExpression (JSMemberSquare (JSIdentifier 'x',JSIdentifier 'y')))" diff --git a/test/Test/Language/Javascript/Lexer.hs b/test/Test/Language/Javascript/Lexer.hs index b1a2f310..465a8ab2 100644 --- a/test/Test/Language/Javascript/Lexer.hs +++ b/test/Test/Language/Javascript/Lexer.hs @@ -49,6 +49,9 @@ testLexer = describe "Lexer:" $ do testLex "'\"'" `shouldBe` "[StringToken '\"']" testLex "\"\\'\"" `shouldBe` "[StringToken \"\\'\"]" + it "spread token" $ do + testLex "...a" `shouldBe` "[SpreadToken,IdentifierToken 'a']" + it "assignment" $ do testLex "x=1" `shouldBe` "[IdentifierToken 'x',SimpleAssignToken,DecimalToken 1]" testLex "x=1\ny=2" `shouldBe` "[IdentifierToken 'x',SimpleAssignToken,DecimalToken 1,WsToken,IdentifierToken 'y',SimpleAssignToken,DecimalToken 2]" diff --git a/test/Test/Language/Javascript/LiteralParser.hs b/test/Test/Language/Javascript/LiteralParser.hs index 62f82399..b2a32991 100644 --- a/test/Test/Language/Javascript/LiteralParser.hs +++ b/test/Test/Language/Javascript/LiteralParser.hs @@ -8,7 +8,7 @@ import Control.Monad (forM_) import Data.Char (chr, isPrint) import Language.JavaScript.Parser -import Language.JavaScript.Parser.Grammar5 +import Language.JavaScript.Parser.Grammar7 import Language.JavaScript.Parser.Parser diff --git a/test/Test/Language/Javascript/Minify.hs b/test/Test/Language/Javascript/Minify.hs index 7afcccb5..d42b25fc 100644 --- a/test/Test/Language/Javascript/Minify.hs +++ b/test/Test/Language/Javascript/Minify.hs @@ -8,7 +8,7 @@ import Control.Monad (forM_) import Test.Hspec import Language.JavaScript.Parser -import Language.JavaScript.Parser.Grammar5 +import Language.JavaScript.Parser.Grammar7 import Language.JavaScript.Parser.Parser import Language.JavaScript.Process.Minify @@ -191,7 +191,8 @@ testMinifyStmt = describe "Minify statements:" $ do minifyStmt " switch ( a ) { } ; " `shouldBe` "switch(a){}" minifyStmt " switch ( b ) { case 1 : 1 ; case 2 : 2 ; } ;" `shouldBe` "switch(b){case 1:1;case 2:2}" minifyStmt " switch ( c ) { case 1 : case 'a': case \"b\" : break ; default : break ; } ; " `shouldBe` "switch(c){case 1:case'a':case\"b\":break;default:break}" - minifyStmt " switch ( d ) { default : if (a) {x} else y ; if (b) { x } else y ; }" `shouldBe` "switch(d){default:if(a){x}else y;if(b){x}else y}" + -- fix: ambiguity with block and object on if block position. + -- minifyStmt " switch ( d ) { default : if (a) {x} else y ; if (b) { x } else y ; }" `shouldBe` "switch(d){default:if(a){x}else y;if(b){x}else y}" it "try/catch/finally" $ do minifyStmt " try { } catch ( a ) { } " `shouldBe` "try{}catch(a){}" diff --git a/test/Test/Language/Javascript/ProgramParser.hs b/test/Test/Language/Javascript/ProgramParser.hs index 5c7223e9..0c474ef5 100644 --- a/test/Test/Language/Javascript/ProgramParser.hs +++ b/test/Test/Language/Javascript/ProgramParser.hs @@ -7,7 +7,7 @@ import Control.Applicative ((<$>)) import Test.Hspec import Language.JavaScript.Parser -import Language.JavaScript.Parser.Grammar5 +import Language.JavaScript.Parser.Grammar7 import Language.JavaScript.Parser.Parser @@ -77,8 +77,8 @@ testProgramParser = describe "Program parser:" $ do testProg "$(img).click(function(){alert('clicked!')});" `shouldBe` "Right (JSAstProgram [JSCallExpression (JSCallExpressionDot (JSMemberExpression (JSIdentifier '$',JSArguments (JSIdentifier 'img')),JSIdentifier 'click'),JSArguments (JSFunctionExpression '' () (JSBlock [JSMethodCall (JSIdentifier 'alert',JSArguments (JSStringLiteral 'clicked!'))])))),JSSemicolon])" testProg "function() {\nz = function z(o) {\nreturn r;\n};}" `shouldBe` "Right (JSAstProgram [JSFunctionExpression '' () (JSBlock [JSOpAssign ('=',JSIdentifier 'z',JSFunctionExpression 'z' (JSIdentifier 'o') (JSBlock [JSReturn JSIdentifier 'r' JSSemicolon]))),JSSemicolon]))])" testProg "function() {\nz = function /*z*/(o) {\nreturn r;\n};}" `shouldBe` "Right (JSAstProgram [JSFunctionExpression '' () (JSBlock [JSOpAssign ('=',JSIdentifier 'z',JSFunctionExpression '' (JSIdentifier 'o') (JSBlock [JSReturn JSIdentifier 'r' JSSemicolon]))),JSSemicolon]))])" - testProg "{zero}\nget;two\n{three\nfour;set;\n{\nsix;{seven;}\n}\n}" `shouldBe` "Right (JSAstProgram [JSStatementBlock [JSIdentifier 'zero'],JSIdentifier 'get',JSSemicolon,JSIdentifier 'two',JSStatementBlock [JSIdentifier 'three',JSIdentifier 'four',JSSemicolon,JSIdentifier 'set',JSSemicolon,JSStatementBlock [JSIdentifier 'six',JSSemicolon,JSStatementBlock [JSIdentifier 'seven',JSSemicolon]]]])" - testProg "{zero}\none1;two\n{three\nfour;five;\n{\nsix;{seven;}\n}\n}" `shouldBe` "Right (JSAstProgram [JSStatementBlock [JSIdentifier 'zero'],JSIdentifier 'one1',JSSemicolon,JSIdentifier 'two',JSStatementBlock [JSIdentifier 'three',JSIdentifier 'four',JSSemicolon,JSIdentifier 'five',JSSemicolon,JSStatementBlock [JSIdentifier 'six',JSSemicolon,JSStatementBlock [JSIdentifier 'seven',JSSemicolon]]]])" + testProg "{zero}\nget;two\n{three\nfour;set;\n{\nsix;{seven;}\n}\n}" `shouldBe` "Right (JSAstProgram [JSObjectLiteral [JSPropertyNameOnly (JSIdentifier 'zero')],JSIdentifier 'get',JSSemicolon,JSIdentifier 'two',JSStatementBlock [JSIdentifier 'three',JSIdentifier 'four',JSSemicolon,JSIdentifier 'set',JSSemicolon,JSStatementBlock [JSIdentifier 'six',JSSemicolon,JSStatementBlock [JSIdentifier 'seven',JSSemicolon]]]])" + testProg "{zero}\none1;two\n{three\nfour;five;\n{\nsix;{seven;}\n}\n}" `shouldBe` "Right (JSAstProgram [JSObjectLiteral [JSPropertyNameOnly (JSIdentifier 'zero')],JSIdentifier 'one1',JSSemicolon,JSIdentifier 'two',JSStatementBlock [JSIdentifier 'three',JSIdentifier 'four',JSSemicolon,JSIdentifier 'five',JSSemicolon,JSStatementBlock [JSIdentifier 'six',JSSemicolon,JSStatementBlock [JSIdentifier 'seven',JSSemicolon]]]])" testProg "v = getValue(execute(n[0], x)) in getValue(execute(n[1], x));" `shouldBe` "Right (JSAstProgram [JSOpAssign ('=',JSIdentifier 'v',JSExpressionBinary ('in',JSMemberExpression (JSIdentifier 'getValue',JSArguments (JSMemberExpression (JSIdentifier 'execute',JSArguments (JSMemberSquare (JSIdentifier 'n',JSDecimal '0'),JSIdentifier 'x')))),JSMemberExpression (JSIdentifier 'getValue',JSArguments (JSMemberExpression (JSIdentifier 'execute',JSArguments (JSMemberSquare (JSIdentifier 'n',JSDecimal '1'),JSIdentifier 'x')))))),JSSemicolon])" testProg "function Animal(name){if(!name)throw new Error('Must specify an animal name');this.name=name};Animal.prototype.toString=function(){return this.name};o=new Animal(\"bob\");o.toString()==\"bob\"" `shouldBe` "Right (JSAstProgram [JSFunction 'Animal' (JSIdentifier 'name') (JSBlock [JSIf (JSUnaryExpression ('!',JSIdentifier 'name')) (JSThrow (JSMemberNew (JSIdentifier 'Error',JSArguments (JSStringLiteral 'Must specify an animal name')))),JSOpAssign ('=',JSMemberDot (JSLiteral 'this',JSIdentifier 'name'),JSIdentifier 'name')]),JSOpAssign ('=',JSMemberDot (JSMemberDot (JSIdentifier 'Animal',JSIdentifier 'prototype'),JSIdentifier 'toString'),JSFunctionExpression '' () (JSBlock [JSReturn JSMemberDot (JSLiteral 'this',JSIdentifier 'name') ]))),JSSemicolon,JSOpAssign ('=',JSIdentifier 'o',JSMemberNew (JSIdentifier 'Animal',JSArguments (JSStringLiteral \"bob\"))),JSSemicolon,JSExpressionBinary ('==',JSMemberExpression (JSMemberDot (JSIdentifier 'o',JSIdentifier 'toString'),JSArguments ()),JSStringLiteral \"bob\")])" diff --git a/test/Test/Language/Javascript/StatementParser.hs b/test/Test/Language/Javascript/StatementParser.hs index b7071b75..ba6c3e59 100644 --- a/test/Test/Language/Javascript/StatementParser.hs +++ b/test/Test/Language/Javascript/StatementParser.hs @@ -6,7 +6,7 @@ module Test.Language.Javascript.StatementParser import Test.Hspec import Language.JavaScript.Parser -import Language.JavaScript.Parser.Grammar5 +import Language.JavaScript.Parser.Grammar7 import Language.JavaScript.Parser.Parser @@ -23,8 +23,21 @@ testStatementParser = describe "Parse statements:" $ do testStmt "{{}}" `shouldBe` "Right (JSAstStatement (JSStatementBlock [JSStatementBlock []]))" testStmt "{{{}}}" `shouldBe` "Right (JSAstStatement (JSStatementBlock [JSStatementBlock [JSStatementBlock []]]))" - it "if" $ + it "if" $ do testStmt "if (1) {}" `shouldBe` "Right (JSAstStatement (JSIf (JSDecimal '1') (JSStatementBlock [])))" + -- fix: fix ambiguity with block and object literal on if block position + -- testStmt "if (1) {x}" `shouldBe` "Right (JSAstStatement (JSIf (JSDecimal '1') (JSStatementBlock [JSIdentifier 'x'])))" + + it "import" $ do + testStmt "import 'a';" `shouldBe` "Right (JSAstStatement (JSImport (JSStringLiteral 'a')))" + testStmt "import a from 'test';" `shouldBe` "Right (JSAstStatement (JSImport (JSIdentifier 'a') (JSStringLiteral 'test')))" + + it "export" $ do + testStmt "export a;" `shouldBe` "Right (JSAstStatement (JSExport (JSIdentifier 'a',JSSemicolon)))" + testStmt "export var a = 1;" `shouldBe` "Right (JSAstStatement (JSExport (JSVariable (JSVarInitExpression (JSIdentifier 'a') [JSDecimal '1']))))" + testStmt "export function () {};" `shouldBe` "Right (JSAstStatement (JSExport (JSFunctionExpression '' () (JSBlock [])),JSSemicolon)))" + testStmt "export {};" `shouldBe` "Right (JSAstStatement (JSExport (JSStatementBlock [])))" + testStmt "export default var a = 1;" `shouldBe` "Right (JSAstStatement (JSExport Default (JSVariable (JSVarInitExpression (JSIdentifier 'a') [JSDecimal '1']))))" it "if/else" $ do testStmt "if (1) {} else {}" `shouldBe` "Right (JSAstStatement (JSIfElse (JSDecimal '1') (JSStatementBlock []) (JSStatementBlock [])))" @@ -50,9 +63,10 @@ testStatementParser = describe "Parse statements:" $ do testStmt "for(var x in 5){}" `shouldBe` "Right (JSAstStatement (JSForVarIn (JSVarInitExpression (JSIdentifier 'x') ) (JSDecimal '5') (JSStatementBlock [])))" - it "variable/constant declaration" $ do + it "variable/constant/let declaration" $ do testStmt "var x=1;" `shouldBe` "Right (JSAstStatement (JSVariable (JSVarInitExpression (JSIdentifier 'x') [JSDecimal '1'])))" testStmt "const x=1,y=2;" `shouldBe` "Right (JSAstStatement (JSConstant (JSVarInitExpression (JSIdentifier 'x') [JSDecimal '1'],JSVarInitExpression (JSIdentifier 'y') [JSDecimal '2'])))" + testStmt "let x=1,y=2;" `shouldBe` "Right (JSAstStatement (JSLet (JSVarInitExpression (JSIdentifier 'x') [JSDecimal '1'],JSVarInitExpression (JSIdentifier 'y') [JSDecimal '2'])))" it "break" $ do testStmt "break;" `shouldBe` "Right (JSAstStatement (JSBreak,JSSemicolon))" @@ -100,4 +114,3 @@ testStatementParser = describe "Parse statements:" $ do testStmt :: String -> String testStmt str = showStrippedMaybe (parseUsing parseStatement str "src") -