1 %{
2 
3 /*
4  *  This file is part of the KDE libraries
5  *  Copyright (C) 1999-2000 Harri Porten (porten@kde.org)
6  *  Copyright (C) 2006, 2007 Apple Inc. All rights reserved.
7  *  Copyright (C) 2019 froglogic GmbH (contact@froglogic.com)
8  *
9  *  This library is free software; you can redistribute it and/or
10  *  modify it under the terms of the GNU Lesser General Public
11  *  License as published by the Free Software Foundation; either
12  *  version 2 of the License, or (at your option) any later version.
13  *
14  *  This library is distributed in the hope that it will be useful,
15  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
16  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17  *  Lesser General Public License for more details.
18  *
19  *  You should have received a copy of the GNU Lesser General Public
20  *  License along with this library; if not, write to the Free Software
21  *  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
22  *
23  */
24 
25 #include <string.h>
26 #include <stdlib.h>
27 #include <stdio.h>
28 #include "value.h"
29 #include "object.h"
30 #include "types.h"
31 #include "interpreter.h"
32 #include "nodes.h"
33 #include "makenodes.h"
34 #include "lexer.h"
35 #include "internal.h"
36 
37 // Not sure why, but yacc doesn't add this define along with the others.
38 #define yylloc kjsyylloc
39 
40 /* default values for bison */
41 #define YYDEBUG 0 // Set to 1 to debug a parse error.
42 #define kjsyydebug 0 // Set to 1 to debug a parse error.
43 #if !PLATFORM(DARWIN)
44     // avoid triggering warnings in older bison
45 #define YYERROR_VERBOSE
46 #endif
47 
48 extern int kjsyylex();
49 int kjsyyerror(const char *);
50 static bool allowAutomaticSemicolon();
51 
52 #define AUTO_SEMICOLON do { if (!allowAutomaticSemicolon()) YYABORT; } while (0)
53 #define DBG(l, s, e) (l)->setLoc((s).first_line, (e).last_line)
54 
55 #ifndef __GNUC__
56 #   define  __attribute__(x)
57 #endif
58 
59 using namespace KJS;
60 
61 %}
62 
63 %union {
64   int                 ival;
65   double              dval;
66   UString             *ustr;
67   Identifier          *ident;
68   Node                *node;
69   StatementNode       *stat;
70   ParameterNode       *param;
71   FunctionBodyNode    *body;
72   FuncDeclNode        *func;
73   FuncExprNode        *funcExpr;
74   ProgramNode         *prog;
75   AssignExprNode      *init;
76   SourceElementsNode  *srcs;
77   ArgumentsNode       *args;
78   ArgumentListNode    *alist;
79   VarDeclNode         *decl;
80   VarDeclListNode     *vlist;
81   CaseBlockNode       *cblk;
82   ClauseListNode      *clist;
83   CaseClauseNode      *ccl;
84   ElementNode         *elm;
85   Operator            op;
86   PropertyListNode   *plist;
87   PropertyNode       *pnode;
88   PropertyNameNode   *pname;
89   PackageNameNode     *pkgn;
90 }
91 
92 %start Program
93 
94 /* literals */
95 %token NULLTOKEN TRUETOKEN FALSETOKEN
96 
97 /* keywords */
98 %token BREAK CASE DEFAULT FOR NEW VAR CONSTTOKEN CONTINUE
99 %token FUNCTION RETURN VOIDTOKEN DELETETOKEN
100 %token IF THISTOKEN DO WHILE INTOKEN INSTANCEOF TYPEOF
101 %token SWITCH WITH RESERVED
102 %token THROW TRY CATCH FINALLY
103 %token DEBUGGER IMPORT
104 
105 /* give an if without an else higher precedence than an else to resolve the ambiguity */
106 %nonassoc IF_WITHOUT_ELSE
107 %nonassoc ELSE
108 
109 /* punctuators */
110 %token EQEQ NE                     /* == and != */
111 %token STREQ STRNEQ                /* === and !== */
112 %token LE GE                       /* < and > */
113 %token OR AND                      /* || and && */
114 %token PLUSPLUS MINUSMINUS         /* ++ and --  */
115 %token LSHIFT                      /* << */
116 %token RSHIFT URSHIFT              /* >> and >>> */
117 %token T_EXP                       /* ** */
118 %token PLUSEQUAL MINUSEQUAL        /* += and -= */
119 %token MULTEQUAL DIVEQUAL          /* *= and /= */
120 %token EXPEQUAL                    /* **= */
121 %token LSHIFTEQUAL                 /* <<= */
122 %token RSHIFTEQUAL URSHIFTEQUAL    /* >>= and >>>= */
123 %token ANDEQUAL MODEQUAL           /* &= and %= */
124 %token XOREQUAL OREQUAL            /* ^= and |= */
125 
126 /* terminal types */
127 %token <dval> NUMBER
128 %token <ustr> STRING
129 %token <ident> IDENT
130 
131 /* automatically inserted semicolon */
132 %token AUTOPLUSPLUS AUTOMINUSMINUS
133 
134 /* non-terminal types */
135 %type <node>  Literal ArrayLiteral
136 
137 %type <node>  PrimaryExpr PrimaryExprNoBrace
138 %type <node>  MemberExpr MemberExprNoBF /* BF => brace or function */
139 %type <node>  NewExpr NewExprNoBF
140 %type <node>  CallExpr CallExprNoBF
141 %type <node>  LeftHandSideExpr LeftHandSideExprNoBF
142 %type <node>  UpdateExpr UpdateExprNoBF UpdateExprCommon
143 %type <node>  UnaryExpr UnaryExprNoBF UnaryExprCommon
144 %type <node>  ExponentiationExpr ExponentiationExprNoBF
145 %type <node>  MultiplicativeExpr MultiplicativeExprNoBF
146 %type <node>  AdditiveExpr AdditiveExprNoBF
147 %type <node>  ShiftExpr ShiftExprNoBF
148 %type <node>  RelationalExpr RelationalExprNoIn RelationalExprNoBF
149 %type <node>  EqualityExpr EqualityExprNoIn EqualityExprNoBF
150 %type <node>  BitwiseANDExpr BitwiseANDExprNoIn BitwiseANDExprNoBF
151 %type <node>  BitwiseXORExpr BitwiseXORExprNoIn BitwiseXORExprNoBF
152 %type <node>  BitwiseORExpr BitwiseORExprNoIn BitwiseORExprNoBF
153 %type <node>  LogicalANDExpr LogicalANDExprNoIn LogicalANDExprNoBF
154 %type <node>  LogicalORExpr LogicalORExprNoIn LogicalORExprNoBF
155 %type <node>  ConditionalExpr ConditionalExprNoIn ConditionalExprNoBF
156 %type <node>  AssignmentExpr AssignmentExprNoIn AssignmentExprNoBF
157 %type <node>  Expr ExprNoIn ExprNoBF
158 %type <node>  ExprOpt ExprNoInOpt
159 
160 %type <stat>  Statement Block
161 %type <stat>  VariableStatement ConstStatement EmptyStatement ExprStatement
162 %type <stat>  IfStatement IterationStatement ContinueStatement
163 %type <stat>  BreakStatement ReturnStatement WithStatement
164 %type <stat>  SwitchStatement LabelledStatement
165 %type <stat>  ThrowStatement TryStatement
166 %type <stat>  DebuggerStatement ImportStatement
167 %type <stat>  SourceElement
168 
169 %type <init>  Initializer InitializerNoIn
170 %type <func>  FunctionDeclaration
171 %type <funcExpr>  FunctionExpr
172 %type <body>  FunctionBody
173 %type <srcs>  SourceElements
174 %type <param> FormalParameterList
175 %type <op>    AssignmentOperator
176 %type <args>  Arguments
177 %type <alist> ArgumentList
178 %type <vlist> VariableDeclarationList VariableDeclarationListNoIn ConstDeclarationList
179 %type <decl>  VariableDeclaration VariableDeclarationNoIn ConstDeclaration
180 %type <cblk>  CaseBlock
181 %type <ccl>   CaseClause DefaultClause
182 %type <clist> CaseClauses  CaseClausesOpt
183 %type <ival>  Elision ElisionOpt
184 %type <elm>   ElementList
185 %type <pname> PropertyName
186 %type <pnode> Property
187 %type <plist> PropertyList
188 %type <pkgn>  PackageName
189 %type <ident> Keywords
190 %type <ident> IdentifierName
191 %%
192 
193 Keywords:
194     BREAK                               { $$ = new Identifier("break"); }
195   | CASE                                { $$ = new Identifier("case"); }
196   | DEFAULT                             { $$ = new Identifier("default"); }
197   | FOR                                 { $$ = new Identifier("for"); }
198   | NEW                                 { $$ = new Identifier("new"); }
199   | VAR                                 { $$ = new Identifier("var"); }
200   | CONSTTOKEN                          { $$ = new Identifier("const"); }
201   | CONTINUE                            { $$ = new Identifier("continue"); }
202   | FUNCTION                            { $$ = new Identifier("function"); }
203   | RETURN                              { $$ = new Identifier("return"); }
204   | VOIDTOKEN                           { $$ = new Identifier("void"); }
205   | DELETETOKEN                         { $$ = new Identifier("delete"); }
206   | IF                                  { $$ = new Identifier("if"); }
207   | THISTOKEN                           { $$ = new Identifier("this"); }
208   | DO                                  { $$ = new Identifier("do"); }
209   | WHILE                               { $$ = new Identifier("while"); }
210   | INTOKEN                             { $$ = new Identifier("in"); }
211   | INSTANCEOF                          { $$ = new Identifier("instanceof"); }
212   | TYPEOF                              { $$ = new Identifier("typeof"); }
213   | SWITCH                              { $$ = new Identifier("switch"); }
214   | WITH                                { $$ = new Identifier("with"); }
215   | THROW                               { $$ = new Identifier("throw"); }
216   | TRY                                 { $$ = new Identifier("try"); }
217   | CATCH                               { $$ = new Identifier("catch"); }
218   | FINALLY                             { $$ = new Identifier("finally"); }
219   | DEBUGGER                            { $$ = new Identifier("debugger"); }
220   | IMPORT                              { $$ = new Identifier("import"); }
221   | NULLTOKEN                           { $$ = new Identifier("null"); }
222   | TRUETOKEN                           { $$ = new Identifier("true"); }
223   | FALSETOKEN                          { $$ = new Identifier("false"); }
224   | ELSE                                { $$ = new Identifier("else"); }
225 ;
226 
227 IdentifierName:
228     IDENT                               { $$ = $1; }
229   | Keywords                            { $$ = $1; }
230 ;
231 
232 Literal:
233     NULLTOKEN                           { $$ = new NullNode(); }
234   | TRUETOKEN                           { $$ = new BooleanNode(true); }
235   | FALSETOKEN                          { $$ = new BooleanNode(false); }
236   | NUMBER                              { $$ = new NumberNode($1); }
237   | STRING                              { $$ = new StringNode($1); }
238   | '/' /* regexp */                    {
239                                             Lexer& l = lexer();
240                                             if (!l.scanRegExp())
241                                                 YYABORT;
242                                             $$ = new RegExpNode(l.pattern(), l.flags());
243                                         }
244   | DIVEQUAL /* regexp with /= */       {
245                                             Lexer& l = lexer();
246                                             if (!l.scanRegExp())
247                                                 YYABORT;
248                                             $$ = new RegExpNode("=" + l.pattern(), l.flags());
249                                         }
250 ;
251 
252 PropertyName:
253     IdentifierName                      { $$ = new PropertyNameNode(*$1); }
254   | STRING                              { $$ = new PropertyNameNode(Identifier(*$1)); }
255   | NUMBER                              { $$ = new PropertyNameNode(Identifier(UString::from($1))); }
256 ;
257 
258 Property:
259     PropertyName ':' AssignmentExpr     { $$ = new PropertyNode($1, $3, PropertyNode::Constant); }
260   | IDENT IdentifierName '(' ')' {inFuncExpr();} FunctionBody  {
261           if (!makeGetterOrSetterPropertyNode($$, *$1, *$2, nullptr, $6))
262             YYABORT;
263         }
264   | IDENT IdentifierName '(' FormalParameterList ')' {inFuncExpr();} FunctionBody {
265           if (!makeGetterOrSetterPropertyNode($$, *$1, *$2, $4, $7))
266             YYABORT;
267         }
268 ;
269 
270 PropertyList:
271     Property                            { $$ = new PropertyListNode($1); }
272   | PropertyList ',' Property           { $$ = new PropertyListNode($3, $1); }
273 ;
274 
275 PrimaryExpr:
276     PrimaryExprNoBrace
277   | '{' '}'                             { $$ = new ObjectLiteralNode(); }
278   | '{' PropertyList '}'                { $$ = new ObjectLiteralNode($2); }
279   /* allow extra comma, see http://bugs.webkit.org/show_bug.cgi?id=5939 */
280   | '{' PropertyList ',' '}'            { $$ = new ObjectLiteralNode($2); }
281 ;
282 
283 PrimaryExprNoBrace:
284     THISTOKEN                           { $$ = new ThisNode(); }
285   | Literal
286   | ArrayLiteral
287   | IDENT                               { $$ = new VarAccessNode(*$1); }
288   | '(' Expr ')'                        { $$ = makeGroupNode($2); }
289 
290 ;
291 
292 ArrayLiteral:
293     '[' ElisionOpt ']'                  { $$ = new ArrayNode($2); }
294   | '[' ElementList ']'                 { $$ = new ArrayNode($2); }
295   | '[' ElementList ',' ElisionOpt ']'  { $$ = new ArrayNode($4, $2); }
296 ;
297 
298 ElementList:
299     ElisionOpt AssignmentExpr           { $$ = new ElementNode($1, $2); }
300   | ElementList ',' ElisionOpt AssignmentExpr
301                                         { $$ = new ElementNode($1, $3, $4); }
302 ;
303 
304 ElisionOpt:
305     /* nothing */                       { $$ = nullptr; }
306   | Elision
307 ;
308 
309 Elision:
310     ','                                 { $$ = 1; }
311   | Elision ','                         { $$ = $1 + 1; }
312 ;
313 
314 MemberExpr:
315     PrimaryExpr
316   | FunctionExpr                        { $$ = $1; }
317   | MemberExpr '[' Expr ']'             { $$ = new BracketAccessorNode($1, $3); }
318   | MemberExpr '.' IdentifierName       { $$ = new DotAccessorNode($1, *$3); }
319   | NEW MemberExpr Arguments            { $$ = new NewExprNode($2, $3); }
320 ;
321 
322 MemberExprNoBF:
323     PrimaryExprNoBrace
324   | MemberExprNoBF '[' Expr ']'         { $$ = new BracketAccessorNode($1, $3); }
325   | MemberExprNoBF '.' IdentifierName   { $$ = new DotAccessorNode($1, *$3); }
326   | NEW MemberExpr Arguments            { $$ = new NewExprNode($2, $3); }
327 ;
328 
329 NewExpr:
330     MemberExpr
331   | NEW NewExpr                         { $$ = new NewExprNode($2); }
332 ;
333 
334 NewExprNoBF:
335     MemberExprNoBF
336   | NEW NewExpr                         { $$ = new NewExprNode($2); }
337 ;
338 
339 CallExpr:
340     MemberExpr Arguments                { $$ = makeFunctionCallNode($1, $2); }
341   | CallExpr Arguments                  { $$ = makeFunctionCallNode($1, $2); }
342   | CallExpr '[' Expr ']'               { $$ = new BracketAccessorNode($1, $3); }
343   | CallExpr '.' IdentifierName         { $$ = new DotAccessorNode($1, *$3); }
344 ;
345 
346 CallExprNoBF:
347     MemberExprNoBF Arguments            { $$ = makeFunctionCallNode($1, $2); }
348   | CallExprNoBF Arguments              { $$ = makeFunctionCallNode($1, $2); }
349   | CallExprNoBF '[' Expr ']'           { $$ = new BracketAccessorNode($1, $3); }
350   | CallExprNoBF '.' IdentifierName     { $$ = new DotAccessorNode($1, *$3); }
351 ;
352 
353 Arguments:
354     '(' ')'                             { $$ = new ArgumentsNode(); }
355   | '(' ArgumentList ')'                { $$ = new ArgumentsNode($2); }
356 ;
357 
358 ArgumentList:
359     AssignmentExpr                      { $$ = new ArgumentListNode($1); }
360   | ArgumentList ',' AssignmentExpr     { $$ = new ArgumentListNode($1, $3); }
361 ;
362 
363 LeftHandSideExpr:
364     NewExpr
365   | CallExpr
366 ;
367 
368 LeftHandSideExprNoBF:
369     NewExprNoBF
370   | CallExprNoBF
371 ;
372 
373 UpdateExprCommon:
374     PLUSPLUS UnaryExpr                  { $$ = makePrefixNode($2, OpPlusPlus); }
375   | AUTOPLUSPLUS UnaryExpr              { $$ = makePrefixNode($2, OpPlusPlus); }
376   | MINUSMINUS UnaryExpr                { $$ = makePrefixNode($2, OpMinusMinus); }
377   | AUTOMINUSMINUS UnaryExpr            { $$ = makePrefixNode($2, OpMinusMinus); }
378 ;
379 
380 UpdateExpr:
381     LeftHandSideExpr
382   | LeftHandSideExpr PLUSPLUS           { $$ = makePostfixNode($1, OpPlusPlus); }
383   | LeftHandSideExpr MINUSMINUS         { $$ = makePostfixNode($1, OpMinusMinus); }
384   | UpdateExprCommon
385 ;
386 
387 UpdateExprNoBF:
388     LeftHandSideExprNoBF
389   | LeftHandSideExprNoBF PLUSPLUS       { $$ = makePostfixNode($1, OpPlusPlus); }
390   | LeftHandSideExprNoBF MINUSMINUS     { $$ = makePostfixNode($1, OpMinusMinus); }
391   | UpdateExprCommon
392 ;
393 
394 UnaryExprCommon:
395     DELETETOKEN UnaryExpr               { $$ = makeDeleteNode($2); }
396   | VOIDTOKEN UnaryExpr                 { $$ = new VoidNode($2); }
397   | TYPEOF UnaryExpr                    { $$ = makeTypeOfNode($2); }
398   | '+' UnaryExpr                       { $$ = makeUnaryPlusNode($2); }
399   | '-' UnaryExpr                       { $$ = makeNegateNode($2); }
400   | '~' UnaryExpr                       { $$ = makeBitwiseNotNode($2); }
401   | '!' UnaryExpr                       { $$ = makeLogicalNotNode($2); }
402 
403 UnaryExpr:
404     UpdateExpr
405   | UnaryExprCommon
406 ;
407 
408 UnaryExprNoBF:
409     UpdateExprNoBF
410   | UnaryExprCommon
411 ;
412 
413 ExponentiationExpr:
414     UnaryExpr
415   | UpdateExpr T_EXP ExponentiationExpr       { $$ = makeMultNode($1, $3, OpExp); }
416 ;
417 
418 ExponentiationExprNoBF:
419     UnaryExprNoBF
420   | UpdateExprNoBF T_EXP ExponentiationExpr   { $$ = makeMultNode($1, $3, OpExp); }
421 ;
422 
423 MultiplicativeExpr:
424     ExponentiationExpr
425   | MultiplicativeExpr '*' ExponentiationExpr  { $$ = makeMultNode($1, $3, OpMult); }
426   | MultiplicativeExpr '/' ExponentiationExpr  { $$ = makeMultNode($1, $3, OpDiv); }
427   | MultiplicativeExpr '%' ExponentiationExpr  { $$ = makeMultNode($1, $3, OpMod); }
428 ;
429 
430 MultiplicativeExprNoBF:
431     ExponentiationExprNoBF
432   | MultiplicativeExprNoBF '*' ExponentiationExpr
433                                         { $$ = makeMultNode($1, $3, OpMult); }
434   | MultiplicativeExprNoBF '/' ExponentiationExpr
435                                         { $$ = makeMultNode($1, $3, OpDiv); }
436   | MultiplicativeExprNoBF '%' ExponentiationExpr
437                                         { $$ = makeMultNode($1, $3, OpMod); }
438 ;
439 
440 AdditiveExpr:
441     MultiplicativeExpr
442   | AdditiveExpr '+' MultiplicativeExpr { $$ = makeAddNode($1, $3, OpPlus); }
443   | AdditiveExpr '-' MultiplicativeExpr { $$ = makeAddNode($1, $3, OpMinus); }
444 ;
445 
446 AdditiveExprNoBF:
447     MultiplicativeExprNoBF
448   | AdditiveExprNoBF '+' MultiplicativeExpr
449                                         { $$ = makeAddNode($1, $3, OpPlus); }
450   | AdditiveExprNoBF '-' MultiplicativeExpr
451                                         { $$ = makeAddNode($1, $3, OpMinus); }
452 ;
453 
454 ShiftExpr:
455     AdditiveExpr
456   | ShiftExpr LSHIFT AdditiveExpr       { $$ = makeShiftNode($1, $3, OpLShift); }
457   | ShiftExpr RSHIFT AdditiveExpr       { $$ = makeShiftNode($1, $3, OpRShift); }
458   | ShiftExpr URSHIFT AdditiveExpr      { $$ = makeShiftNode($1, $3, OpURShift); }
459 ;
460 
461 ShiftExprNoBF:
462     AdditiveExprNoBF
463   | ShiftExprNoBF LSHIFT AdditiveExpr   { $$ = makeShiftNode($1, $3, OpLShift); }
464   | ShiftExprNoBF RSHIFT AdditiveExpr   { $$ = makeShiftNode($1, $3, OpRShift); }
465   | ShiftExprNoBF URSHIFT AdditiveExpr  { $$ = makeShiftNode($1, $3, OpURShift); }
466 ;
467 
468 RelationalExpr:
469     ShiftExpr
470   | RelationalExpr '<' ShiftExpr        { $$ = makeRelationalNode($1, OpLess, $3); }
471   | RelationalExpr '>' ShiftExpr        { $$ = makeRelationalNode($1, OpGreater, $3); }
472   | RelationalExpr LE ShiftExpr         { $$ = makeRelationalNode($1, OpLessEq, $3); }
473   | RelationalExpr GE ShiftExpr         { $$ = makeRelationalNode($1, OpGreaterEq, $3); }
474   | RelationalExpr INSTANCEOF ShiftExpr { $$ = makeRelationalNode($1, OpInstanceOf, $3); }
475   | RelationalExpr INTOKEN ShiftExpr         { $$ = makeRelationalNode($1, OpIn, $3); }
476 ;
477 
478 RelationalExprNoIn:
479     ShiftExpr
480   | RelationalExprNoIn '<' ShiftExpr    { $$ = makeRelationalNode($1, OpLess, $3); }
481   | RelationalExprNoIn '>' ShiftExpr    { $$ = makeRelationalNode($1, OpGreater, $3); }
482   | RelationalExprNoIn LE ShiftExpr     { $$ = makeRelationalNode($1, OpLessEq, $3); }
483   | RelationalExprNoIn GE ShiftExpr     { $$ = makeRelationalNode($1, OpGreaterEq, $3); }
484   | RelationalExprNoIn INSTANCEOF ShiftExpr
485                                         { $$ = makeRelationalNode($1, OpInstanceOf, $3); }
486 ;
487 
488 RelationalExprNoBF:
489     ShiftExprNoBF
490   | RelationalExprNoBF '<' ShiftExpr    { $$ = makeRelationalNode($1, OpLess, $3); }
491   | RelationalExprNoBF '>' ShiftExpr    { $$ = makeRelationalNode($1, OpGreater, $3); }
492   | RelationalExprNoBF LE ShiftExpr     { $$ = makeRelationalNode($1, OpLessEq, $3); }
493   | RelationalExprNoBF GE ShiftExpr     { $$ = makeRelationalNode($1, OpGreaterEq, $3); }
494   | RelationalExprNoBF INSTANCEOF ShiftExpr
495                                         { $$ = makeRelationalNode($1, OpInstanceOf, $3); }
496   | RelationalExprNoBF INTOKEN ShiftExpr     { $$ = makeRelationalNode($1, OpIn, $3); }
497 ;
498 
499 EqualityExpr:
500     RelationalExpr
501   | EqualityExpr EQEQ RelationalExpr    { $$ = makeEqualNode($1, OpEqEq, $3); }
502   | EqualityExpr NE RelationalExpr      { $$ = makeEqualNode($1, OpNotEq, $3); }
503   | EqualityExpr STREQ RelationalExpr   { $$ = makeEqualNode($1, OpStrEq, $3); }
504   | EqualityExpr STRNEQ RelationalExpr  { $$ = makeEqualNode($1, OpStrNEq, $3);}
505 ;
506 
507 EqualityExprNoIn:
508     RelationalExprNoIn
509   | EqualityExprNoIn EQEQ RelationalExprNoIn
510                                         { $$ = makeEqualNode($1, OpEqEq, $3); }
511   | EqualityExprNoIn NE RelationalExprNoIn
512                                         { $$ = makeEqualNode($1, OpNotEq, $3); }
513   | EqualityExprNoIn STREQ RelationalExprNoIn
514                                         { $$ = makeEqualNode($1, OpStrEq, $3); }
515   | EqualityExprNoIn STRNEQ RelationalExprNoIn
516                                         { $$ = makeEqualNode($1, OpStrNEq, $3);}
517 ;
518 
519 EqualityExprNoBF:
520     RelationalExprNoBF
521   | EqualityExprNoBF EQEQ RelationalExpr
522                                         { $$ = makeEqualNode($1, OpEqEq, $3); }
523   | EqualityExprNoBF NE RelationalExpr  { $$ = makeEqualNode($1, OpNotEq, $3); }
524   | EqualityExprNoBF STREQ RelationalExpr
525                                         { $$ = makeEqualNode($1, OpStrEq, $3); }
526   | EqualityExprNoBF STRNEQ RelationalExpr
527                                         { $$ = makeEqualNode($1, OpStrNEq, $3);}
528 ;
529 
530 BitwiseANDExpr:
531     EqualityExpr
532   | BitwiseANDExpr '&' EqualityExpr     { $$ = makeBitOperNode($1, OpBitAnd, $3); }
533 ;
534 
535 BitwiseANDExprNoIn:
536     EqualityExprNoIn
537   | BitwiseANDExprNoIn '&' EqualityExprNoIn
538                                         { $$ = makeBitOperNode($1, OpBitAnd, $3); }
539 ;
540 
541 BitwiseANDExprNoBF:
542     EqualityExprNoBF
543   | BitwiseANDExprNoBF '&' EqualityExpr { $$ = makeBitOperNode($1, OpBitAnd, $3); }
544 ;
545 
546 BitwiseXORExpr:
547     BitwiseANDExpr
548   | BitwiseXORExpr '^' BitwiseANDExpr   { $$ = makeBitOperNode($1, OpBitXOr, $3); }
549 ;
550 
551 BitwiseXORExprNoIn:
552     BitwiseANDExprNoIn
553   | BitwiseXORExprNoIn '^' BitwiseANDExprNoIn
554                                         { $$ = makeBitOperNode($1, OpBitXOr, $3); }
555 ;
556 
557 BitwiseXORExprNoBF:
558     BitwiseANDExprNoBF
559   | BitwiseXORExprNoBF '^' BitwiseANDExpr
560                                         { $$ = makeBitOperNode($1, OpBitXOr, $3); }
561 ;
562 
563 BitwiseORExpr:
564     BitwiseXORExpr
565   | BitwiseORExpr '|' BitwiseXORExpr    { $$ = makeBitOperNode($1, OpBitOr, $3); }
566 ;
567 
568 BitwiseORExprNoIn:
569     BitwiseXORExprNoIn
570   | BitwiseORExprNoIn '|' BitwiseXORExprNoIn
571                                         { $$ = makeBitOperNode($1, OpBitOr, $3); }
572 ;
573 
574 BitwiseORExprNoBF:
575     BitwiseXORExprNoBF
576   | BitwiseORExprNoBF '|' BitwiseXORExpr
577                                         { $$ = makeBitOperNode($1, OpBitOr, $3); }
578 ;
579 
580 LogicalANDExpr:
581     BitwiseORExpr
582   | LogicalANDExpr AND BitwiseORExpr    { $$ = makeBinaryLogicalNode($1, OpAnd, $3); }
583 ;
584 
585 LogicalANDExprNoIn:
586     BitwiseORExprNoIn
587   | LogicalANDExprNoIn AND BitwiseORExprNoIn
588                                         { $$ = makeBinaryLogicalNode($1, OpAnd, $3); }
589 ;
590 
591 LogicalANDExprNoBF:
592     BitwiseORExprNoBF
593   | LogicalANDExprNoBF AND BitwiseORExpr
594                                         { $$ = makeBinaryLogicalNode($1, OpAnd, $3); }
595 ;
596 
597 LogicalORExpr:
598     LogicalANDExpr
599   | LogicalORExpr OR LogicalANDExpr     { $$ = makeBinaryLogicalNode($1, OpOr, $3); }
600 ;
601 
602 LogicalORExprNoIn:
603     LogicalANDExprNoIn
604   | LogicalORExprNoIn OR LogicalANDExprNoIn
605                                         { $$ = makeBinaryLogicalNode($1, OpOr, $3); }
606 ;
607 
608 LogicalORExprNoBF:
609     LogicalANDExprNoBF
610   | LogicalORExprNoBF OR LogicalANDExpr { $$ = makeBinaryLogicalNode($1, OpOr, $3); }
611 ;
612 
613 ConditionalExpr:
614     LogicalORExpr
615   | LogicalORExpr '?' AssignmentExpr ':' AssignmentExpr
616                                         { $$ = makeConditionalNode($1, $3, $5); }
617 ;
618 
619 ConditionalExprNoIn:
620     LogicalORExprNoIn
621   | LogicalORExprNoIn '?' AssignmentExprNoIn ':' AssignmentExprNoIn
622                                         { $$ = makeConditionalNode($1, $3, $5); }
623 ;
624 
625 ConditionalExprNoBF:
626     LogicalORExprNoBF
627   | LogicalORExprNoBF '?' AssignmentExpr ':' AssignmentExpr
628                                         { $$ = makeConditionalNode($1, $3, $5); }
629 ;
630 
631 AssignmentExpr:
632     ConditionalExpr
633   | LeftHandSideExpr AssignmentOperator AssignmentExpr
634                                         { $$ = makeAssignNode($1, $2, $3); }
635 ;
636 
637 AssignmentExprNoIn:
638     ConditionalExprNoIn
639   | LeftHandSideExpr AssignmentOperator AssignmentExprNoIn
640                                         { $$ = makeAssignNode($1, $2, $3); }
641 ;
642 
643 AssignmentExprNoBF:
644     ConditionalExprNoBF
645   | LeftHandSideExprNoBF AssignmentOperator AssignmentExpr
646                                         { $$ = makeAssignNode($1, $2, $3); }
647 ;
648 
649 AssignmentOperator:
650     '='                                 { $$ = OpEqual; }
651   | PLUSEQUAL                           { $$ = OpPlusEq; }
652   | MINUSEQUAL                          { $$ = OpMinusEq; }
653   | MULTEQUAL                           { $$ = OpMultEq; }
654   | DIVEQUAL                            { $$ = OpDivEq; }
655   | EXPEQUAL                            { $$ = OpExpEq; }
656   | LSHIFTEQUAL                         { $$ = OpLShift; }
657   | RSHIFTEQUAL                         { $$ = OpRShift; }
658   | URSHIFTEQUAL                        { $$ = OpURShift; }
659   | ANDEQUAL                            { $$ = OpAndEq; }
660   | XOREQUAL                            { $$ = OpXOrEq; }
661   | OREQUAL                             { $$ = OpOrEq; }
662   | MODEQUAL                            { $$ = OpModEq; }
663 ;
664 
665 Expr:
666     AssignmentExpr
667   | Expr ',' AssignmentExpr             { $$ = new CommaNode($1, $3); }
668 ;
669 
670 ExprNoIn:
671     AssignmentExprNoIn
672   | ExprNoIn ',' AssignmentExprNoIn     { $$ = new CommaNode($1, $3); }
673 ;
674 
675 ExprNoBF:
676     AssignmentExprNoBF
677   | ExprNoBF ',' AssignmentExpr         { $$ = new CommaNode($1, $3); }
678 ;
679 
680 Statement:
681     Block
682   | VariableStatement
683   | ConstStatement
684   | EmptyStatement
685   | ExprStatement
686   | IfStatement
687   | IterationStatement
688   | ContinueStatement
689   | BreakStatement
690   | ReturnStatement
691   | WithStatement
692   | SwitchStatement
693   | LabelledStatement
694   | ThrowStatement
695   | TryStatement
696   | DebuggerStatement
697   | ImportStatement
698 ;
699 
700 Block:
701     '{' '}'                             { $$ = new BlockNode(nullptr); DBG($$, @2, @2); }
702   | '{' SourceElements '}'              { $$ = new BlockNode($2); DBG($$, @3, @3); }
703 ;
704 
705 VariableStatement:
706     VAR VariableDeclarationList ';'     { $$ = new VarStatementNode($2); DBG($$, @1, @3); }
707   | VAR VariableDeclarationList error   { $$ = new VarStatementNode($2); DBG($$, @1, @2); AUTO_SEMICOLON; }
708 ;
709 
710 VariableDeclarationList:
711     VariableDeclaration                 { $$ = new VarDeclListNode($1); }
712   | VariableDeclarationList ',' VariableDeclaration
713                                         { $$ = new VarDeclListNode($1, $3); }
714 ;
715 
716 VariableDeclarationListNoIn:
717     VariableDeclarationNoIn             { $$ = new VarDeclListNode($1); }
718   | VariableDeclarationListNoIn ',' VariableDeclarationNoIn
719                                         { $$ = new VarDeclListNode($1, $3); }
720 ;
721 
722 VariableDeclaration:
723     IDENT                               { $$ = new VarDeclNode(*$1, nullptr, VarDeclNode::Variable); }
724   | IDENT Initializer                   { $$ = new VarDeclNode(*$1, $2, VarDeclNode::Variable); }
725 ;
726 
727 VariableDeclarationNoIn:
728     IDENT                               { $$ = new VarDeclNode(*$1, nullptr, VarDeclNode::Variable); }
729   | IDENT InitializerNoIn               { $$ = new VarDeclNode(*$1, $2, VarDeclNode::Variable); }
730 ;
731 
732 ConstStatement:
733     CONSTTOKEN ConstDeclarationList ';' { $$ = new VarStatementNode($2); DBG($$, @1, @3); }
734   | CONSTTOKEN ConstDeclarationList error
735                                         { $$ = new VarStatementNode($2); DBG($$, @1, @2); AUTO_SEMICOLON; }
736 ;
737 
738 ConstDeclarationList:
739     ConstDeclaration                    { $$ = new VarDeclListNode($1); }
740   | ConstDeclarationList ',' ConstDeclaration
741                                         { $$ = new VarDeclListNode($1, $3); }
742 ;
743 
744 ConstDeclaration:
745     IDENT                               { $$ = new VarDeclNode(*$1, 0, VarDeclNode::Constant); }
746   | IDENT Initializer                   { $$ = new VarDeclNode(*$1, $2, VarDeclNode::Constant); }
747 ;
748 
749 Initializer:
750     '=' AssignmentExpr                  { $$ = new AssignExprNode($2); }
751 ;
752 
753 InitializerNoIn:
754     '=' AssignmentExprNoIn              { $$ = new AssignExprNode($2); }
755 ;
756 
757 EmptyStatement:
758     ';'                                 { $$ = new EmptyStatementNode(); }
759 ;
760 
761 ExprStatement:
762     ExprNoBF ';'                        { $$ = new ExprStatementNode($1); DBG($$, @1, @2); }
763   | ExprNoBF error                      { $$ = new ExprStatementNode($1); DBG($$, @1, @1); AUTO_SEMICOLON; }
764 ;
765 
766 IfStatement:
767     IF '(' Expr ')' Statement %prec IF_WITHOUT_ELSE
768                                         { $$ = makeIfNode($3, $5, nullptr); DBG($$, @1, @4); }
769   | IF '(' Expr ')' Statement ELSE Statement
770                                         { $$ = makeIfNode($3, $5, $7); DBG($$, @1, @4); }
771 ;
772 
773 IterationStatement:
774     DO Statement WHILE '(' Expr ')' ';' { $$ = new DoWhileNode($2, $5); DBG($$, @1, @3);}
775   | DO Statement WHILE '(' Expr ')' error { $$ = new DoWhileNode($2, $5); DBG($$, @1, @3); AUTO_SEMICOLON; }
776   | WHILE '(' Expr ')' Statement        { $$ = new WhileNode($3, $5); DBG($$, @1, @4); }
777   | FOR '(' ExprNoInOpt ';' ExprOpt ';' ExprOpt ')' Statement
778                                         { $$ = new ForNode($3, $5, $7, $9); DBG($$, @1, @8); }
779   | FOR '(' VAR VariableDeclarationListNoIn ';' ExprOpt ';' ExprOpt ')' Statement
780                                         { $$ = new ForNode($4, $6, $8, $10); DBG($$, @1, @9); }
781   | FOR '(' LeftHandSideExpr INTOKEN Expr ')' Statement
782                                         {
783                                             Node *n = $3->nodeInsideAllParens();
784                                             if (!n->isLocation())
785                                                 YYABORT;
786                                             $$ = new ForInNode(n, $5, $7);
787                                             DBG($$, @1, @6);
788                                         }
789   | FOR '(' VAR IDENT INTOKEN Expr ')' Statement
790                                         { $$ = new ForInNode(*$4, nullptr, $6, $8); DBG($$, @1, @7); }
791   | FOR '(' VAR IDENT InitializerNoIn INTOKEN Expr ')' Statement
792                                         { $$ = new ForInNode(*$4, $5, $7, $9); DBG($$, @1, @8); }
793 ;
794 
795 ExprOpt:
796     /* nothing */                       { $$ = nullptr; }
797   | Expr
798 ;
799 
800 ExprNoInOpt:
801     /* nothing */                       { $$ = nullptr; }
802   | ExprNoIn
803 ;
804 
805 ContinueStatement:
806     CONTINUE ';'                        { $$ = new ContinueNode(); DBG($$, @1, @2); }
807   | CONTINUE error                      { $$ = new ContinueNode(); DBG($$, @1, @1); AUTO_SEMICOLON; }
808   | CONTINUE IDENT ';'                  { $$ = new ContinueNode(*$2); DBG($$, @1, @3); }
809   | CONTINUE IDENT error                { $$ = new ContinueNode(*$2); DBG($$, @1, @2); AUTO_SEMICOLON; }
810 ;
811 
812 BreakStatement:
813     BREAK ';'                           { $$ = new BreakNode(); DBG($$, @1, @2); }
814   | BREAK error                         { $$ = new BreakNode(); DBG($$, @1, @1); AUTO_SEMICOLON; }
815   | BREAK IDENT ';'                     { $$ = new BreakNode(*$2); DBG($$, @1, @3); }
816   | BREAK IDENT error                   { $$ = new BreakNode(*$2); DBG($$, @1, @2); AUTO_SEMICOLON; }
817 ;
818 
819 ReturnStatement:
820     RETURN ';'                          { $$ = new ReturnNode(nullptr); DBG($$, @1, @2); }
821   | RETURN error                        { $$ = new ReturnNode(nullptr); DBG($$, @1, @1); AUTO_SEMICOLON; }
822   | RETURN Expr ';'                     { $$ = new ReturnNode($2); DBG($$, @1, @3); }
823   | RETURN Expr error                   { $$ = new ReturnNode($2); DBG($$, @1, @2); AUTO_SEMICOLON; }
824 ;
825 
826 WithStatement:
827     WITH '(' Expr ')' Statement         { $$ = new WithNode($3, $5); DBG($$, @1, @4); }
828 ;
829 
830 SwitchStatement:
831     SWITCH '(' Expr ')' CaseBlock       { $$ = new SwitchNode($3, $5); DBG($$, @1, @4); }
832 ;
833 
834 CaseBlock:
835     '{' CaseClausesOpt '}'              { $$ = new CaseBlockNode($2, nullptr, nullptr); }
836   | '{' CaseClausesOpt DefaultClause CaseClausesOpt '}'
837                                         { $$ = new CaseBlockNode($2, $3, $4); }
838 ;
839 
840 CaseClausesOpt:
841     /* nothing */                       { $$ = nullptr; }
842   | CaseClauses
843 ;
844 
845 CaseClauses:
846     CaseClause                          { $$ = new ClauseListNode($1); }
847   | CaseClauses CaseClause              { $$ = new ClauseListNode($1, $2); }
848 ;
849 
850 CaseClause:
851     CASE Expr ':'                       { $$ = new CaseClauseNode($2); }
852   | CASE Expr ':' SourceElements        { $$ = new CaseClauseNode($2, $4); }
853 ;
854 
855 DefaultClause:
856     DEFAULT ':'                         { $$ = new CaseClauseNode(nullptr); }
857   | DEFAULT ':' SourceElements          { $$ = new CaseClauseNode(nullptr, $3); }
858 ;
859 
860 LabelledStatement:
861     IDENT ':' Statement                 { $$ = makeLabelNode(*$1, $3); }
862 ;
863 
864 ThrowStatement:
865     THROW Expr ';'                      { $$ = new ThrowNode($2); DBG($$, @1, @3); }
866   | THROW Expr error                    { $$ = new ThrowNode($2); DBG($$, @1, @2); AUTO_SEMICOLON; }
867 ;
868 
869 TryStatement:
870     TRY Block FINALLY Block             { $$ = new TryNode($2, CommonIdentifiers::shared()->nullIdentifier, 0, $4); DBG($$, @1, @2); }
871   | TRY Block CATCH '(' IDENT ')' Block { $$ = new TryNode($2, *$5, $7, nullptr); DBG($$, @1, @2); }
872   | TRY Block CATCH '(' IDENT ')' Block FINALLY Block
873                                         { $$ = new TryNode($2, *$5, $7, $9); DBG($$, @1, @2); }
874 ;
875 
876 DebuggerStatement:
877     DEBUGGER ';'                        { $$ = new EmptyStatementNode(); DBG($$, @1, @2); }
878   | DEBUGGER error                      { $$ = new EmptyStatementNode(); DBG($$, @1, @1); AUTO_SEMICOLON; }
879 ;
880 
881 PackageName:
882     IDENT                               { $$ = new PackageNameNode(*$1); }
883   | PackageName '.' IDENT               { $$ = new PackageNameNode($1, *$3); }
884 ;
885 
886 ImportStatement:
887     IMPORT PackageName '.' '*' ';'      { $$ = makeImportNode($2, true, nullptr);
888                                           DBG($$, @1, @5); }
889   | IMPORT PackageName '.' '*' error    { $$ = makeImportNode($2, true, nullptr);
890                                           DBG($$, @1, @5); AUTO_SEMICOLON; }
891   | IMPORT PackageName ';'              { $$ = makeImportNode($2, false, nullptr);
892                                           DBG($$, @1, @3); }
893   | IMPORT PackageName error            { $$ = makeImportNode($2, false, nullptr);
894                                           DBG($$, @1, @3); AUTO_SEMICOLON; }
895   | IMPORT IDENT '=' PackageName ';'    { $$ = makeImportNode($4, false, *$2);
896                                           DBG($$, @1, @5); }
897   | IMPORT IDENT '=' PackageName error  { $$ = makeImportNode($4, false, *$2);
898                                           DBG($$, @1, @5); AUTO_SEMICOLON; }
899 ;
900 
901 FunctionDeclaration:
902     FUNCTION IDENT '(' ')' {inFuncDecl();} FunctionBody { $$ = new FuncDeclNode(*$2, $6); }
903   | FUNCTION IDENT '(' FormalParameterList ')' {inFuncDecl();} FunctionBody
904                                         { $$ = new FuncDeclNode(*$2, $4, $7); }
905 ;
906 
907 FunctionExpr:
908     FUNCTION '(' ')' {inFuncExpr();} FunctionBody  {
909       $$ = new FuncExprNode(CommonIdentifiers::shared()->nullIdentifier, $5);
910     }
911   | FUNCTION '(' FormalParameterList ')' {inFuncExpr();} FunctionBody {
912       $$ = new FuncExprNode(CommonIdentifiers::shared()->nullIdentifier, $6, $3);
913     }
914   | FUNCTION IDENT '(' ')' {inFuncExpr();} FunctionBody { $$ = new FuncExprNode(*$2, $6); }
915   | FUNCTION IDENT '(' FormalParameterList ')' {inFuncExpr();} FunctionBody {
916       $$ = new FuncExprNode(*$2, $7, $4);
917     }
918 ;
919 
920 FormalParameterList:
921     IDENT                               { $$ = new ParameterNode(*$1); }
922   | FormalParameterList ',' IDENT       { $$ = new ParameterNode($1, *$3); }
923 ;
924 
925 FunctionBody:
926     '{' '}' /* not in spec */           { $$ = new FunctionBodyNode(nullptr); DBG($$, @1, @2); }
927   | '{' SourceElements '}'              { $$ = new FunctionBodyNode($2); DBG($$, @1, @3); }
928 ;
929 
930 Program:
931     /* not in spec */                   { parser().didFinishParsing(new ProgramNode(nullptr)); }
932   | SourceElements                      { parser().didFinishParsing(new ProgramNode($1)); }
933 ;
934 
935 SourceElements:
936     SourceElement                       { $$ = new SourceElementsNode($1); }
937   | SourceElements SourceElement        { $$ = new SourceElementsNode($1, $2); }
938 ;
939 
940 SourceElement:
941     FunctionDeclaration                 { $$ = $1; }
942   | Statement                           { $$ = $1; }
943 ;
944 
945 %%
946 
947 /* called by yyparse on error */
948 int yyerror(const char *)
949 {
950 // fprintf(stderr, "ERROR: %s at line %d\n", s, KJS::Lexer::curr()->lineNo());
951     return 1;
952 }
953 
954 /* may we automatically insert a semicolon ? */
allowAutomaticSemicolon()955 static bool allowAutomaticSemicolon()
956 {
957     return yychar == '}' || yychar == 0 || lexer().prevTerminator();
958 }
959 
960 // kate: indent-width 2; replace-tabs on; tab-width 4; space-indent on;
961