1 module pegged.examples.c;
2 
3 import pegged.grammar;
4 
5 enum Cgrammar = `
6 C:
7 
8 TranslationUnit <- ExternalDeclaration (:Spacing ExternalDeclaration)*
9 
10 ExternalDeclaration < FunctionDefinition / Declaration
11 
12 FunctionDefinition < DeclarationSpecifiers? Declarator DeclarationList? CompoundStatement
13 
14 PrimaryExpression < Identifier
15                   / CharLiteral
16                   / StringLiteral
17                   / FloatLiteral
18                   / IntegerLiteral
19                   / '(' Expression ')'
20 
21 PostfixExpression < PrimaryExpression ( '[' Expression ']'
22                                       / '(' ')'
23                                       / '(' ArgumentExpressionList ')'
24                                       / '.' Identifier
25                                       / "->" Identifier
26                                       / "++"
27                                       / "--"
28                                       )*
29 
30 ArgumentExpressionList < AssignmentExpression (',' AssignmentExpression)*
31 
32 UnaryExpression < PostfixExpression
33                 / IncrementExpression
34                 / DecrementExpression
35                 / UnaryOperator CastExpression
36                 / "sizeof" UnaryExpression
37                 / "sizeof" '(' TypeName ')'
38 
39 IncrementExpression < PlusPlus UnaryExpression
40 PlusPlus <- "++"
41 DecrementExpression < "--" UnaryExpression
42 
43 UnaryOperator <- [-&*+~!]
44 
45 CastExpression < UnaryExpression
46                / '(' TypeName ')' CastExpression
47 
48 MultiplicativeExpression    < CastExpression ([*%/] MultiplicativeExpression)*
49 
50 AdditiveExpression          < MultiplicativeExpression ([-+] AdditiveExpression)*
51 
52 ShiftExpression             < AdditiveExpression (("<<" / ">>") ShiftExpression)*
53 
54 RelationalExpression        < ShiftExpression (("<=" / ">=" / "<" / ">") RelationalExpression)*
55 
56 EqualityExpression          < RelationalExpression (("==" / "!=") EqualityExpression)*
57 
58 ANDExpression               < EqualityExpression ('&' ANDExpression)*
59 
60 ExclusiveORExpression       < ANDExpression ('^' ExclusiveORExpression)*
61 
62 InclusiveORExpression       < ExclusiveORExpression ('|' InclusiveORExpression)*
63 
64 LogicalANDExpression        < InclusiveORExpression ("&&" LogicalANDExpression)*
65 
66 LogicalORExpression         < LogicalANDExpression ("||" LogicalORExpression)*
67 
68 ConditionalExpression       < LogicalORExpression ('?' Expression ':' ConditionalExpression)?
69 
70 AssignmentExpression < UnaryExpression AssignmentOperator AssignmentExpression
71                      / ConditionalExpression
72 
73 AssignmentOperator <- "=" / "*=" / "/=" / "%=" / "+=" / "-=" / "<<=" / ">>=" / "&=" / "^=" / "|="
74 
75 Expression < AssignmentExpression (',' AssignmentExpression)*
76 
77 ConstantExpression <- ConditionalExpression
78 
79 #
80 # C declaration rules
81 #
82 
83 Declaration < DeclarationSpecifiers InitDeclaratorList? ';'
84 
85 DeclarationSpecifiers < ( StorageClassSpecifier
86                         / TypeSpecifier
87                         / TypeQualifier
88                         ) DeclarationSpecifiers?
89 
90 InitDeclaratorList < InitDeclarator (',' InitDeclarator)*
91 
92 InitDeclarator < Declarator ('=' Initializer)?
93 
94 StorageClassSpecifier <- "typedef" / "extern" / "static" / "auto" / "register"
95 
96 TypeSpecifier <- "void"
97                / "char" / "short" / "int" / "long"
98                / "float" / "double"
99                / "signed" / "unsigned"
100                / StructOrUnionSpecifier
101                / EnumSpecifier
102                #/ TypedefName # To reactivate with an associated semantic action:
103                # - keep a list of typedef'd names
104                # - and verify that the read identifier is already defined
105 
106 StructOrUnionSpecifier < ("struct" / "union") ( Identifier ('{' StructDeclarationList '}')?
107                                               / '{' StructDeclarationList '}')
108 
109 StructDeclarationList <- StructDeclaration (:Spacing StructDeclaration)*
110 
111 StructDeclaration < SpecifierQualifierList StructDeclaratorList ';'
112 
113 SpecifierQualifierList <- (TypeQualifier / TypeSpecifier) (:Spacing (TypeQualifier / TypeSpecifier))*
114 
115 StructDeclaratorList < StructDeclarator (',' StructDeclarator)*
116 
117 StructDeclarator < ( Declarator ConstantExpression?
118                    / ConstantExpression)
119 
120 EnumSpecifier < "enum" ( Identifier ('{' EnumeratorList '}')?
121                        / '{' EnumeratorList '}')
122 
123 EnumeratorList < Enumerator (',' Enumerator)*
124 
125 Enumerator < EnumerationConstant ('=' ConstantExpression)?
126 
127 EnumerationConstant <- Identifier
128 
129 TypeQualifier <- "const" / "volatile"
130 
131 Declarator < Pointer? DirectDeclarator
132 
133 DirectDeclarator < (Identifier / '(' Declarator ')') ( '[' ']'
134                                                      / '[' ConstantExpression ']'
135                                                      / '(' ')'
136                                                      / '(' ParameterTypeList ')'
137                                                      / '(' IdentifierList ')'
138                                                      )*
139 
140 Pointer < ('*' TypeQualifier*)*
141 
142 TypeQualifierList <- TypeQualifier (:Spacing TypeQualifier)*
143 
144 ParameterTypeList < ParameterList (',' "...")?
145 
146 ParameterList < ParameterDeclaration (',' ParameterDeclaration)*
147 
148 ParameterDeclaration < DeclarationSpecifiers (Declarator / AbstractDeclarator)?
149 
150 IdentifierList < Identifier (',' Identifier)*
151 
152 TypeName < SpecifierQualifierList AbstractDeclarator?
153 
154 AbstractDeclarator < Pointer DirectAbstractDeclarator
155                    / DirectAbstractDeclarator
156                    / Pointer
157 
158 DirectAbstractDeclarator < ('(' AbstractDeclarator ')'
159                            / '[' ']'
160                            / '[' ConstantExpression ']'
161                            / '(' ')'
162                            / '(' ParameterTypeList ')'
163                            )
164                            ( '[' ']'
165                            / '[' ConstantExpression ']'
166                            / '(' ')'
167                            / '(' ParameterTypeList ')'
168                            )*
169 
170 TypedefName <- Identifier
171 
172 Initializer < AssignmentExpression
173             / '{' InitializerList ','? '}'
174 
175 InitializerList < Initializer (',' Initializer)*
176 
177 #
178 # C statement rules
179 #
180 
181 Statement < LabeledStatement
182           / CompoundStatement
183           / ExpressionStatement
184           / IfStatement
185           / SwitchStatement
186           / IterationStatement
187           / GotoStatement
188           / ContinueStatement
189           / BreakStatement
190           / ReturnStatement
191 
192 LabeledStatement < Identifier ':' Statement
193                  / 'case' ConstantExpression ':' Statement
194                  / 'default' ':' Statement
195 
196 CompoundStatement < '{' '}'
197                   / '{' DeclarationList '}'
198                   / '{' StatementList '}'
199                   / '{' DeclarationList StatementList '}'
200 
201 DeclarationList <- Declaration (:Spacing Declaration)*
202 
203 StatementList <- Statement (:Spacing Statement)*
204 
205 ExpressionStatement < Expression? ';'
206 
207 IfStatement < "if" '(' Expression ')' Statement ('else' Statement)?
208 
209 SwitchStatement < "switch" '(' Expression ')' Statement
210 
211 IterationStatement < WhileStatement / DoStatement / ForStatement
212 
213 WhileStatement < "while" '(' Expression ')' Statement
214 
215 DoStatement < "do" Statement "while" '(' Expression ')' ';'
216 
217 ForStatement < "for" '(' Expression? ';' Expression? ';' Expression? ')' Statement
218 
219 GotoStatement < "goto" Identifier ';'
220 
221 ContinueStatement < "continue" ';'
222 
223 BreakStatement < "break" ';'
224 
225 ReturnStatement < Return Expression? :';'
226 
227 Return <- "return"
228 
229 # The following comes from me, not an official C grammar
230 
231 Identifier <~ !Keyword [a-zA-Z_] [a-zA-Z0-9_]*
232 
233 Keyword <- "auto" / "break" / "case" / "char" / "const" / "continue"
234          / "default" / "double" / "do" / "else" / "enum" / "extern"
235          / "float" / "for" / "goto" / "if" / "inline" / "int" / "long"
236          / "register" / "restrict" / "return" / "short" / "signed"
237          / "sizeof" / "static" / "struct" / "switch" / "typedef" / "union"
238          / "unsigned" / "void" / "volatile" / "while"
239          / "_Bool" / "_Complex" / "_Imaginary"
240 
241 Spacing <~ (space / endOfLine / Comment)*
242 
243 Comment <~ "//" (!endOfLine .)* endOfLine
244 
245 StringLiteral <~ doublequote (DQChar)* doublequote
246 
247 DQChar <- EscapeSequence
248         / !doublequote .
249 
250 EscapeSequence <~ backslash ( quote
251                             / doublequote
252                             / backslash
253                             / [abfnrtv]
254                             )
255 
256 CharLiteral <~ quote (!quote (EscapeSequence / .)) quote
257 
258 IntegerLiteral <~ Sign? Integer IntegerSuffix?
259 
260 Integer <~ digit+
261 
262 IntegerSuffix <- "Lu" / "LU" / "uL" / "UL"
263                / "L" / "u" / "U"
264 
265 FloatLiteral <~ Sign? Integer "." Integer? (("e" / "E") Sign? Integer)?
266 
267 Sign <- "-" / "+"
268 `;