15
15
* along with this program. If not, see <http://www.gnu.org/licenses/>.
16
16
*/
17
17
18
- /*
19
- * Visual Basic 6.0 Grammar for ANTLR4
20
- *
21
- * This is an approximate grammar for Visual Basic 6.0, derived
22
- * from the Visual Basic 6.0 language reference
23
- * http://msdn.microsoft.com/en-us/library/aa338033%28v=vs.60%29.aspx
24
- * and tested against MSDN VB6 statement examples as well as several Visual
25
- * Basic 6.0 code repositories.
26
- *
27
- * Characteristics:
28
- *
29
- * 1. This grammar is line-based and takes into account whitespace, so that
30
- * member calls (e.g. "A.B") are distinguished from contextual object calls
31
- * in WITH statements (e.g. "A .B").
32
- *
33
- * 2. Keywords can be used as identifiers depending on the context, enabling
34
- * e.g. "A.Type", but not "Type.B".
35
- *
36
- *
37
- * Known limitations:
38
- *
39
- * 1. Preprocessor statements (#if, #else, ...) must not interfere with regular
40
- * statements.
41
- *
42
- * Change log:
43
- *
44
- * v1.4 Rubberduck
45
- * - renamed to VBA; goal is to support VBA, and a shorter name is more practical.
46
- * - added moduleDeclarations rule, moved moduleOptions there; options can now be
47
- * located anywhere in declarations section, without breaking the parser.
48
- * - added support for Option Compare Database.
49
- * - added support for VBA 7.0 PtrSafe attribute for Declare statements.
50
- * - implemented a fileNumber rule to locate identifier usages in file numbers.
51
- * - added support for anonymous declarations in With blocks (With New Something)
52
- * - blockStmt rules being sorted alphabetically was wrong. moved implicit call statement last.
53
- * - '!' in dictionary call statement rule gets picked up as a type hint; changed member call
54
- * to accept '!' as well as '.', but this complicates resolving the '!' shorthand syntax.
55
- * - added a subscripts rule in procedure calls, to avoid breaking the parser with
56
- * a function call that returns an array that is immediately accessed.
57
- * - added missing macroConstStmt (#CONST) rule.
58
- * - amended selectCaseStmt rules to support all valid syntaxes.
59
- * - blockStmt is now illegal in declarations section.
60
- * - added ON_LOCAL_ERROR token, to support legacy ON LOCAL ERROR statements.
61
- * - added additional typeHint? token to declareStmt, to support "Declare Function Foo$".
62
- * - modified WS lexer rule to correctly account for line continuations;
63
- * - modified multi-word lexer rules to use WS lexer token instead of ' '; this makes
64
- * the grammar support "Option _\n Explicit" and other keywords being specified on multiple lines.
65
- * - modified moduleOption rules to account for WS token in corresponding lexer rules.
66
- * - modified NEWLINE lexer rule to properly support instructions separator (':').
67
- * - tightened DATELITERAL lexer rule to the format enforced by the VBE, because "#fn: Close #"
68
- * in "Dim fn: fn = FreeFile: Open "filename" For Output As #fn: Close #fn" was picked up as a date literal.
69
- * - redefined IDENTIFIER lexer rule to support non-Latin characters (e.g. Japanese)
70
- * - made seekStmt, lockStmt, unlockStmt, getStmt and widthStmt accept a fileNumber (needed to support '#')
71
- * - fixed precompiler directives, which can now be nested. they still can't interfere with other blocks though.
72
- * - optional parameters can be a valueStmt.
73
- * - added support for Octal and Currency literals.
74
- * - implemented proper specs for DATELITERAL.
75
- * - added comments to parse tree (removes known limitation #2).
76
- * - macroConstStmt now allowed in blockStmt.
77
- * - allow type hints for parameters.
78
- * - fix operator precedence (in valueStmt)
79
- * - remove PLUS_EQ and MINUS_EQ since that's not supported in VBA
80
- * - remove PLUS valueStmt since that is not needed
81
- *
82
- *======================================================================================
83
- *
84
- * v1.3
85
- * - call statement precedence
86
- *
87
- * v1.2
88
- * - refined call statements
89
- *
90
- * v1.1
91
- * - precedence of operators and of ELSE in select statements
92
- * - optimized member calls
93
- *
94
- * v1.0 Initial revision
95
- */
18
+ /* VBA grammar based on Microsoft's [MS-VBAL]: VBA Language Specification. */
96
19
97
20
grammar VBA ;
98
21
@@ -102,30 +25,30 @@ startRule : module EOF;
102
25
103
26
module :
104
27
WS ?
105
- endOfLine*
106
- (moduleHeader endOfLine* )?
107
- moduleConfig? endOfLine*
108
- moduleAttributes? endOfLine*
109
- moduleDeclarations? endOfLine*
110
- moduleBody? endOfLine*
28
+ endOfStatement
29
+ (moduleHeader endOfStatement )?
30
+ moduleConfig? endOfStatement
31
+ moduleAttributes? endOfStatement
32
+ moduleDeclarations? endOfStatement
33
+ moduleBody? endOfStatement
111
34
WS ?
112
35
;
113
36
114
37
moduleHeader : VERSION WS DOUBLELITERAL WS CLASS ;
115
38
116
39
moduleConfig :
117
- BEGIN endOfLine*
40
+ BEGIN endOfStatement
118
41
moduleConfigElement+
119
42
END
120
43
;
121
44
122
45
moduleConfigElement :
123
- ambiguousIdentifier WS ? EQ WS ? literal endOfLine*
46
+ ambiguousIdentifier WS ? EQ WS ? literal endOfStatement
124
47
;
125
48
126
- moduleAttributes : (attributeStmt endOfLine+ )+;
49
+ moduleAttributes : (attributeStmt endOfStatement )+;
127
50
128
- moduleDeclarations : moduleDeclarationsElement (endOfLine+ moduleDeclarationsElement)* endOfLine* ;
51
+ moduleDeclarations : moduleDeclarationsElement (endOfStatement moduleDeclarationsElement)* endOfStatement ;
129
52
130
53
moduleOption :
131
54
OPTION_BASE WS SHORTLITERAL # optionBaseStmt
@@ -152,7 +75,7 @@ macroStmt :
152
75
| macroIfThenElseStmt;
153
76
154
77
moduleBody :
155
- moduleBodyElement (endOfLine+ moduleBodyElement)* endOfLine* ;
78
+ moduleBodyElement (endOfStatement moduleBodyElement)* endOfStatement ;
156
79
157
80
moduleBodyElement :
158
81
functionStmt
@@ -588,7 +511,7 @@ implicitCallStmt_InBlock :
588
511
| iCS_B_ProcedureCall
589
512
;
590
513
591
- iCS_B_MemberProcedureCall : implicitCallStmt_InStmt? ' .' ambiguousIdentifier typeHint? (WS argsCall)? dictionaryCallStmt? (WS ? LPAREN subscripts RPAREN )*;
514
+ iCS_B_MemberProcedureCall : implicitCallStmt_InStmt? ' .' ambiguousIdentifier typeHint? (WS argsCall)? ( WS ? dictionaryCallStmt) ? (WS ? LPAREN subscripts RPAREN )*;
592
515
593
516
// parantheses are forbidden in case of args
594
517
// variables cannot be called in blocks
@@ -604,15 +527,15 @@ implicitCallStmt_InStmt :
604
527
| iCS_S_DictionaryCall
605
528
;
606
529
607
- iCS_S_VariableOrProcedureCall : ambiguousIdentifier typeHint? dictionaryCallStmt? (WS ? LPAREN subscripts RPAREN )*;
530
+ iCS_S_VariableOrProcedureCall : ambiguousIdentifier typeHint? ( WS ? dictionaryCallStmt) ? (WS ? LPAREN subscripts RPAREN )*;
608
531
609
- iCS_S_ProcedureOrArrayCall : (ambiguousIdentifier | baseType) typeHint? WS ? LPAREN WS ? (argsCall WS ?)? RPAREN dictionaryCallStmt? (WS ? LPAREN subscripts RPAREN )*;
532
+ iCS_S_ProcedureOrArrayCall : (ambiguousIdentifier | baseType) typeHint? WS ? LPAREN WS ? (argsCall WS ?)? RPAREN ( WS ? dictionaryCallStmt) ? (WS ? LPAREN subscripts RPAREN )*;
610
533
611
- iCS_S_MembersCall : (iCS_S_VariableOrProcedureCall | iCS_S_ProcedureOrArrayCall)? iCS_S_MemberCall+ dictionaryCallStmt? (WS ? LPAREN subscripts RPAREN )*;
534
+ iCS_S_MembersCall : (iCS_S_VariableOrProcedureCall | iCS_S_ProcedureOrArrayCall)? ( iCS_S_MemberCall WS ?)+ ( WS ? dictionaryCallStmt) ? (WS ? LPAREN subscripts RPAREN )*;
612
535
613
- iCS_S_MemberCall : (' .' | ' !' ) (iCS_S_VariableOrProcedureCall | iCS_S_ProcedureOrArrayCall);
536
+ iCS_S_MemberCall : (' .' | ' !' ) WS ? (iCS_S_VariableOrProcedureCall | iCS_S_ProcedureOrArrayCall);
614
537
615
- iCS_S_DictionaryCall : dictionaryCallStmt;
538
+ iCS_S_DictionaryCall : WS ? dictionaryCallStmt;
616
539
617
540
618
541
// atomic call statements ----------------------------------
@@ -621,7 +544,7 @@ argsCall : (argCall? WS? (',' | ';') WS?)* argCall (WS? (',' | ';') WS? argCall?
621
544
622
545
argCall : LPAREN ? ((BYVAL | BYREF | PARAMARRAY ) WS )? RPAREN ? valueStmt;
623
546
624
- dictionaryCallStmt : ' !' ambiguousIdentifier typeHint?;
547
+ dictionaryCallStmt : ' !' WS ? ambiguousIdentifier typeHint?;
625
548
626
549
627
550
// atomic rules for statements
0 commit comments