Resurrect guile-mescc with guile-2.1.5.
[mes.git] / module / language / c / parser.mes
1 ;;; -*-scheme-*-
2
3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; parser.mes: This file is part of Mes.
7 ;;;
8 ;;; Mes is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
12 ;;;
13 ;;; Mes is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;;; GNU General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;;; parser.mes is a translation of cgram.y to Dominique Boucher's LALR.
24 ;;; It parses a minimal int main () {}, see examples/main.c
25
26 ;;; Code:
27
28 (cond-expand
29   (guile
30    (use-modules (system base lalr)))
31   (mes
32    (mes-use-module (mes lalr))))
33
34 (gc)
35 (define c-parser
36   (lalr-parser
37
38    (lbrace rbrace lparen rparen lbracket rbracket semicolon colon dot comma
39            =
40            Identifier NumericLiteral StringLiteral
41            break case continue goto label
42            return switch
43            for
44            If else
45            (left: or && ! * / + -)
46            (left: bool double float enum void int struct)
47            (left: < > <= >=)
48            (left: ++ --)
49            (nonassoc: == !=)
50            )
51    
52    (program
53     (translation-unit *eoi*) : `(root ,@$1))
54
55    (translation-unit
56     (external-declaration) : `(,$1)
57     (translation-unit external-declaration) : `(,@$1 ,@$2))
58
59    (external-declaration
60     (function-definition) : $1
61     (declaration) : $1
62     (error semicolon) : (begin (syntax-error "external declaration" @1 $1) '()))
63
64    (function-definition
65     (declarator compound-statement) : `(function ,$1 (signature int (formals)) ,$2)
66     (declaration-specifiers declarator compound-statement) : `(function ,$2 (signature ,$1 (formals)) ,$3)
67     (declaration-specifiers declarator declaration-list compound-statement) : `(function ,$2 (signature ,$1 ,$3) ,$4))
68
69    (declaration
70     (declaration-specifiers semicolon) : `(,$1)
71     (declaration-specifiers init-declarator-list semicolon): `((,@$1 ,@$2))
72     )
73
74    (declaration-list
75     (declaration) : `(formals ,@$1)
76     (declaration-list declaration) : `(,@$1 ,@(cdr $2)))
77
78    (declaration-specifiers
79     ;;(storage-class-specifier) : `(,$1)
80     (type-specifier) : `(,$1)
81     ;;(type-qualifier) : `($1)
82     ;;(storage-class-specifier declaration-specifiers) : (cons $1 $2)
83     (type-specifier declaration-specifiers) : `(,$1 ,$2)
84     ;;(type-qualifier declaration-specifiers) : (cons $1 $2)
85     )
86
87    ;; (storage_class_specifier
88    ;;  (auto)
89    ;;  (extern)
90    ;;  (register)
91    ;;  (static)
92    ;;  (typedef))
93    
94    (type-specifier
95     ;; (char) : $1
96     ;; (double) : $1
97     ;; (void) : $1
98     ;; (float)
99     (int) : 'int
100     ;; (long)
101     ;; (short)
102     ;; (unsigned)
103     ;; (struct-or-enum-specifier)
104     ;; (enum-specifier)
105     ;; (type-name)
106     )
107
108    ;; (type-qualifier
109    ;;  (const)
110    ;;  (volatile))
111
112    ;; struct_or_union_specifier:
113    ;;              struct_or_union_ident lbrace struct_declaration_list rbrace
114    ;;           |  struct_or_union_ident
115    ;;           ;
116
117    ;; struct_or_union_ident: struct_or_union
118    ;;           | struct_or_union Identifier
119    ;;           ;
120
121    ;; struct_or_union:   STRUCT                         { ; }
122    ;;           |  UNION                                { ; }
123    ;;           ;
124    
125    ;; struct_declaration_list: struct_declaration
126    ;;           |  struct_declaration_list struct_declaration
127    ;;           ;
128
129    (init-declarator-list
130     ;; (init-declarator %prec comma) : `(,$1) HUH?
131     (init-declarator) : `(,$1)
132     (init-declarator-list comma init-declarator) : `(,$1)
133     )
134    ;; init_declarator_list:     init_declarator %prec comma
135    ;;           |  init_declarator_list comma init_declarator
136    ;;           ;
137
138    (init-declarator
139     (declarator) : $1
140     (declarator = initializer) : `(= ,$1 ,$3)
141     ;;          | error { yyerror("init declarator error"); }
142     )
143
144    ;; struct_declaration: specifier_qualifier_list struct_declarator_list semicolon
145    ;;           ;
146
147    ;; specifier_qualifier_list: type_specifier
148    ;;           |  type_qualifier
149    ;;           |  type_specifier specifier_qualifier_list
150    ;;           | type_qualifier specifier_qualifier_list
151    ;;           ;
152
153    ;; struct_declarator_list: struct_declarator
154    ;;           |  struct_declarator_list comma struct_declarator
155    ;;           ;
156
157    ;; struct_declarator: declarator
158    ;;           |  COLON constant_expression            { ; }
159    ;;           |  declarator COLON constant_expression
160    ;;           ;
161
162    ;; enum_specifier:      ENUM Identifier lbrace enumerator_list rbrace        { ; }
163    ;;           |  ENUM lbrace enumerator_list rbrace           { ; }
164    ;;           |  ENUM Identifier                              { ; }
165    ;;           ;
166
167    ;; enumerator_list:   enumerator
168    ;;           |  enumerator_list comma enumerator
169    ;;           ;
170
171    ;; enumerator:                  Identifier
172    ;;           |  Identifier EQ constant_expression
173    ;;           ;
174
175    (declarator
176     (direct-declarator) : $1
177     ;;(pointer direct-declarator)
178     )
179
180    (direct-declarator
181     (Identifier) : $1
182     ;; (lparen declarator rparen)
183     ;; (direct-declarator lbracket rbracket)
184     ;; (direct-declarator lbracket constant-expression rbracket)
185     ;; (lbracket constant-expression rbracket)
186     ;; (direct-declarator lparen parameter-type-list rparen)
187     (direct-declarator lparen rparen) : $1
188     ;; (direct-declarator lparen identifier-list rparen)
189     )
190
191    ;; pointer:     STAR                                 { ; }
192    ;;           |  STAR pointer                         { ; }
193    ;;           |  STAR type_qualifier_list             { ; }
194    ;;           |  STAR type_qualifier_list pointer     { ; }
195    ;;           ;
196
197    ;; type_qualifier_list: type_qualifier
198    ;;           |  type_qualifier_list type_qualifier
199    ;;           ;
200
201    ;; parameter_type_list: parameter_list
202    ;;           | parameter_list comma ELLIPSIS
203    ;;           ;
204
205    ;; parameter_list:      parameter_declaration
206    ;;           |  parameter_list comma parameter_declaration
207    ;;           ;
208
209    ;; parameter_declaration:
210    ;;              declaration_specifiers declarator
211    ;;           |  declaration_specifiers
212    ;;           |  declaration_specifiers abstract_declarator
213    ;;           ;
214
215    ;; identifier_list:        Identifier
216    ;;           |  identifier_list comma Identifier
217    ;;           |  error { yyerror("identifier list error"); }
218    ;;           ;
219
220    (initializer
221     ;;(assignment-expression %prec comma) HUH?
222     (assignment-expression) : $1
223     ;; initializer:       assignment_expression %prec comma
224     ;;          |  lbrace initializer_list rbrace               { ; }
225     ;;          |  lbrace initializer_list comma rbrace         { ; }
226     ;;          ;
227     )
228
229    ;; initializer_list:         initializer %prec comma
230    ;;           |  initializer_list comma initializer
231    ;;           ;
232
233    ;; type_name:           specifier_qualifier_list
234    ;;           |  specifier_qualifier_list abstract_declarator
235    ;;           ;
236
237    ;; abstract_declarator:      pointer
238    ;;           |  direct_abstract_declarator
239    ;;           |  pointer direct_abstract_declarator
240    ;;           ;
241
242    ;; direct_abstract_declarator:
243    ;;              lparen abstract_declarator rparen            { ; }
244    ;;           |  lbrace rbrace                                { ; }
245    ;;           |  direct_abstract_declarator lbrace rbrace
246    ;;           |  lbrace constant_expression rbrace            { ; }
247    ;;           |  direct_abstract_declarator lbrace constant_expression rbrace
248    ;;           |  lparen rparen                                { ; }
249    ;;           |  direct_abstract_declarator lparen rparen
250    ;;           |  lparen parameter_list rparen                 { ; }
251    ;;           |  direct_abstract_declarator lparen parameter_list rparen
252    ;;           ;
253
254    
255    (statement
256     ;;(labeled-statement) 
257     (expression-statement) : $1
258     (compound-statement) : $1
259     ;;(selection-statement)
260     (iteration-statement) : $1
261     (jump-statement) : $1
262     (semicolon) : '()
263     (error semicolon) : (begin (syntax-error "statement error" @1 $1) '())
264     (error rbrace) : (begin (syntax-error "statement error" @1 $1) '()))
265                 
266
267    ;; labeled_statement:
268    ;;              Identifier COLON statement
269    ;;           |  CASE x COLON statement               { ; }
270    ;;           |  DEFAULT COLON statement              { ; }
271    ;;           ;
272
273    (expression-statement
274     (x semicolon) : $1)
275
276    (compound-statement
277     (lbrace rbrace) : '(compound)
278     (lbrace declaration-list rbrace) : `(compound ,$2)
279     (lbrace statement-list rbrace) :  `(compound ,@$2)
280     (lbrace declaration-list statement-list rbrace) : `(compound ,$2 ,@$3))
281
282    (statement-list
283     (statement) : `(,$1)
284     (statement-list statement) : `(,@$1 ,$2))
285    
286    ;; selection_statement:
287    ;;              IF lparen x rparen statement                 { ; }
288    ;;           |  IF lparen x rparen statement ELSE statement  { ; }
289    ;;           |  SWITCH lparen x rparen statement             { ; }
290    ;;           ;
291
292    (iteration-statement
293     ;; iteration_statement:
294     ;;             WHILE lparen x rparen statement              { ; }
295     ;;          |  DO statement WHILE lparen x rparen semicolon { ; }
296     (for lparen forcntrl rparen statement) : `(for ,@$3 ,$5))
297    
298    (forcntrl
299     ;;          | semicolon semicolon x                         { ; }
300     ;;          | semicolon x semicolon                         { ; }
301     ;;          | semicolon x semicolon x                               { ; }
302     ;;          | x semicolon semicolon
303     ;;          | x semicolon semicolon x
304     ;;          | x semicolon x semicolon
305     (x semicolon x semicolon x) : `((start ,$1) (test ,$3) (step ,$5)))
306
307    (jump-statement
308     (goto Identifier semicolon) : `(goto ,$2)
309     (continue semicolon) : '(continue)
310     (break semicolon) : '(break)
311     (return semicolon) : '(return)
312     (return x semicolon) : `(return ,$2))
313
314    (x
315     (assignment-expression) : $1
316     (x comma assignment-expression) : `(,$1 ,@$3))
317                 
318    (assignment-expression
319     (equality-expression) : $1 ;; skip some
320     ;;(conditional-expression) : $1
321     (unary-expression assignment-operator assignment-expression) : `(,$2 ,$1 ,$3))
322
323    (assignment-operator
324     (=) : '=)
325    ;;           |  PLUSEQ                               { ; }
326    ;;           |  MINUSEQ                              { ; }
327    ;;           |  MUEQ                                 { ; }
328    ;;           |  DIVEQ                                { ; }
329    ;;           |  MODEQ                                { ; }
330    ;;           |  SLEQ                         { ; }
331    ;;           |  SREQ                         { ; }
332    ;;           |  ANEQ                         { ; }
333    ;;           |  OREQ                         { ; }
334    ;;           |  XOREQ                                { ; }
335    ;;           ;
336
337    ;; conditional_expression: logical_or_expression
338    ;;           |  logical_or_expression IF_THEN x COLON conditional_expression
339    ;;           ;
340
341    ;; constant_expression: conditional_expression
342    ;;           ;
343
344    ;; logical_or_expression: logical_and_expression
345    ;;           |  logical_or_expression OROR logical_and_expression
346    ;;           ;
347
348    ;; logical_and_expression: inclusive_or_expression
349    ;;           |  logical_and_expression ANDAND inclusive_or_expression
350    ;;           ;
351
352    ;; inclusive_or_expression: exclusive_or_expression
353    ;;           |  inclusive_or_expression OR exclusive_or_expression
354    ;;           ;
355
356    ;; exclusive_or_expression: and_expression
357    ;;           |  exclusive_or_expression XOR and_expression
358    ;;           ;
359
360    ;; and_expression: equality_expression
361    ;;           |  and_expression AND equality_expression
362    ;;           ;
363
364    (equality-expression
365     (relational-expression) : $1
366     (equality-expression == relational-expression) : `(== ,$1 ,$3)
367     (equality-expression != relational-expression) : `(!= ,$1 ,$3))
368
369    (relational-expression
370     (shift-expression) : $1
371     (relational-expression < shift-expression) : `(< ,$1 ,$3)
372     (relational-expression <= shift-expression) : `(<= ,$1 ,$3)
373     (relational-expression > shift-expression) : `(> ,$1 ,$3)
374     (relational-expression >= shift-expression) : `(>= ,$1 ,$3))
375
376    (shift-expression
377     (unary-expression) : $1 ;; skip some
378     ;; shift_expression: additive_expression
379     ;;          |  shift_expression LTLT additive_expression
380     ;;          |  shift_expression GTGT additive_expression
381     ;;          ;
382     )
383    ;; additive_expression: multiplicative_expression
384    ;;           |  additive_expression PLUS multiplicative_expression
385    ;;           |  additive_expression MINUS multiplicative_expression
386    ;;           ;
387
388    ;; multiplicative_expression: cast_expression
389    ;;           |  multiplicative_expression STAR cast_expression
390    ;;           |  multiplicative_expression DIV cast_expression
391    ;;           |  multiplicative_expression MOD cast_expression
392    ;;           ;
393
394    ;; cast_expression:   unary_expression
395    ;;           |  lparen type_name rparen cast_expression      { ; }
396    ;;           ;
397
398    (unary-expression
399     (postfix-expression) : $1
400     (++ unary-expression) : `(++x ,$2)
401     (-- unary-expression) : `(--x ,$2)
402    ;;           |  SIZEOF unary_expression              { ; }
403    ;;           |  SIZEOF lparen type_name rparen %prec SIZEOF  { ; }
404    ;;           |  STAR cast_expression                 { ; }
405    ;;           |  AND cast_expression                  { ; }
406    ;;           |  MINUS cast_expression                { ; }
407    ;;           |  PLUS cast_expression                 { ; }
408    ;;           |  NEG cast_expression                  { ; }
409    ;;           |  NOT cast_expression                  { ; }
410    ;;           ;
411     )
412
413    (postfix-expression
414     (primary-expression) : $1
415     ;;          |  postfix_expression lbracket x rbracket
416     (postfix-expression lparen rparen) : `(call ,$1 (arguments))
417     (postfix-expression lparen argument-expression-list rparen) : `(call ,$1 ,$3)
418     ;;          |  postfix_expression FOLLOW Identifier
419     ;;          |  postfix_expression DOT Identifier
420     (postfix-expression ++) : `(x++ ,$1)
421     (postfix-expression --) : `(x-- ,$1)
422     )
423
424    (primary-expression
425     (Identifier): $1
426     (NumericLiteral) : $1
427     ;; INT_LITERAL
428     ;; CHAR_LITERAL
429     ;; FLOAT_LITERAL
430     ;; STRING_LITERAL
431     (StringLiteral) : $1
432     ;; lparen x rparen
433     )
434    ;;           
435
436    (argument-expression-list
437     (assignment-expression) : `(arguments ,$1)
438     (argument-expression-list comma assignment-expression): `(,@$1 ,@(cdr $3)))))