9fe8fcd0af0e839b8e6bfd7ce125a318c7502c16
[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 (srfi srfi-1))
31    ;;(use-modules (system base lalr))
32    (use-modules (ice-9 match)))
33   (mes
34    (mes-use-module (mes base-0))
35    (mes-use-module (mes base))
36    (mes-use-module (mes quasiquote))
37    (mes-use-module (mes let))
38    (mes-use-module (mes scm))
39
40    (mes-use-module (srfi srfi-0))
41
42    (mes-use-module (mes syntax))
43
44    (mes-use-module (mes record-0))
45    (mes-use-module (mes record))
46    (mes-use-module (srfi srfi-9))
47    (mes-use-module (mes lalr-0))
48    (mes-use-module (mes lalr))
49    (mes-use-module (srfi srfi-1))
50    (mes-use-module (mes match))
51
52    (mes-use-module (rnrs bytevectors))
53    (mes-use-module (mes elf))
54    (mes-use-module (mes libc-i386))))
55
56 (gc)
57 (define c-parser
58   (lalr-parser
59
60    (lbrace rbrace lparen rparen lbracket rbracket semicolon colon dot comma
61            =
62            Identifier NumericLiteral StringLiteral
63            break case continue goto label
64            return switch
65            for
66            If else
67            (left: or && ! * / + -)
68            (left: bool double float enum void int struct)
69            (left: < > <= >=)
70            (left: ++ --)
71            (nonassoc: == !=)
72            )
73    
74    (program
75     (translation-unit *eoi*) : `(root ,@$1))
76
77    (translation-unit
78     (external-declaration) : `(,$1)
79     (translation-unit external-declaration) : `(,@$1 ,@$2))
80
81    (external-declaration
82     (function-definition) : $1
83     (declaration) : $1
84     (error semicolon) : (begin (syntax-error "external declaration" @1 $1) '()))
85
86    (function-definition
87     (declarator compound-statement) : `(function ,$1 (signature int (formals)) ,$2)
88     (declaration-specifiers declarator compound-statement) : `(function ,$2 (signature ,$1 (formals)) ,$3)
89     (declaration-specifiers declarator declaration-list compound-statement) : `(function ,$2 (signature ,$1 ,$3) ,$4))
90
91    (declaration
92     (declaration-specifiers semicolon) : `(,$1)
93     (declaration-specifiers init-declarator-list semicolon): `((,@$1 ,@$2))
94     )
95
96    (declaration-list
97     (declaration) : `(formals ,@$1)
98     (declaration-list declaration) : `(,@$1 ,@(cdr $2)))
99
100    (declaration-specifiers
101     ;;(storage-class-specifier) : `(,$1)
102     (type-specifier) : `(,$1)
103     ;;(type-qualifier) : `($1)
104     ;;(storage-class-specifier declaration-specifiers) : (cons $1 $2)
105     (type-specifier declaration-specifiers) : `(,$1 ,$2)
106     ;;(type-qualifier declaration-specifiers) : (cons $1 $2)
107     )
108
109    ;; (storage_class_specifier
110    ;;  (auto)
111    ;;  (extern)
112    ;;  (register)
113    ;;  (static)
114    ;;  (typedef))
115    
116    (type-specifier
117     ;; (char) : $1
118     ;; (double) : $1
119     ;; (void) : $1
120     ;; (float)
121     (int) : 'int
122     ;; (long)
123     ;; (short)
124     ;; (unsigned)
125     ;; (struct-or-enum-specifier)
126     ;; (enum-specifier)
127     ;; (type-name)
128     )
129
130    ;; (type-qualifier
131    ;;  (const)
132    ;;  (volatile))
133
134    ;; struct_or_union_specifier:
135    ;;              struct_or_union_ident lbrace struct_declaration_list rbrace
136    ;;           |  struct_or_union_ident
137    ;;           ;
138
139    ;; struct_or_union_ident: struct_or_union
140    ;;           | struct_or_union Identifier
141    ;;           ;
142
143    ;; struct_or_union:   STRUCT                         { ; }
144    ;;           |  UNION                                { ; }
145    ;;           ;
146    
147    ;; struct_declaration_list: struct_declaration
148    ;;           |  struct_declaration_list struct_declaration
149    ;;           ;
150
151    (init-declarator-list
152     ;; (init-declarator %prec comma) : `(,$1) HUH?
153     (init-declarator) : `(,$1)
154     (init-declarator-list comma init-declarator) : `(,$1)
155     )
156    ;; init_declarator_list:     init_declarator %prec comma
157    ;;           |  init_declarator_list comma init_declarator
158    ;;           ;
159
160    (init-declarator
161     (declarator) : $1
162     (declarator = initializer) : `(= ,$1 ,$3)
163     ;;          | error { yyerror("init declarator error"); }
164     )
165
166    ;; struct_declaration: specifier_qualifier_list struct_declarator_list semicolon
167    ;;           ;
168
169    ;; specifier_qualifier_list: type_specifier
170    ;;           |  type_qualifier
171    ;;           |  type_specifier specifier_qualifier_list
172    ;;           | type_qualifier specifier_qualifier_list
173    ;;           ;
174
175    ;; struct_declarator_list: struct_declarator
176    ;;           |  struct_declarator_list comma struct_declarator
177    ;;           ;
178
179    ;; struct_declarator: declarator
180    ;;           |  COLON constant_expression            { ; }
181    ;;           |  declarator COLON constant_expression
182    ;;           ;
183
184    ;; enum_specifier:      ENUM Identifier lbrace enumerator_list rbrace        { ; }
185    ;;           |  ENUM lbrace enumerator_list rbrace           { ; }
186    ;;           |  ENUM Identifier                              { ; }
187    ;;           ;
188
189    ;; enumerator_list:   enumerator
190    ;;           |  enumerator_list comma enumerator
191    ;;           ;
192
193    ;; enumerator:                  Identifier
194    ;;           |  Identifier EQ constant_expression
195    ;;           ;
196
197    (declarator
198     (direct-declarator) : $1
199     ;;(pointer direct-declarator)
200     )
201
202    (direct-declarator
203     (Identifier) : $1
204     ;; (lparen declarator rparen)
205     ;; (direct-declarator lbracket rbracket)
206     ;; (direct-declarator lbracket constant-expression rbracket)
207     ;; (lbracket constant-expression rbracket)
208     ;; (direct-declarator lparen parameter-type-list rparen)
209     (direct-declarator lparen rparen) : $1
210     ;; (direct-declarator lparen identifier-list rparen)
211     )
212
213    ;; pointer:     STAR                                 { ; }
214    ;;           |  STAR pointer                         { ; }
215    ;;           |  STAR type_qualifier_list             { ; }
216    ;;           |  STAR type_qualifier_list pointer     { ; }
217    ;;           ;
218
219    ;; type_qualifier_list: type_qualifier
220    ;;           |  type_qualifier_list type_qualifier
221    ;;           ;
222
223    ;; parameter_type_list: parameter_list
224    ;;           | parameter_list comma ELLIPSIS
225    ;;           ;
226
227    ;; parameter_list:      parameter_declaration
228    ;;           |  parameter_list comma parameter_declaration
229    ;;           ;
230
231    ;; parameter_declaration:
232    ;;              declaration_specifiers declarator
233    ;;           |  declaration_specifiers
234    ;;           |  declaration_specifiers abstract_declarator
235    ;;           ;
236
237    ;; identifier_list:        Identifier
238    ;;           |  identifier_list comma Identifier
239    ;;           |  error { yyerror("identifier list error"); }
240    ;;           ;
241
242    (initializer
243     ;;(assignment-expression %prec comma) HUH?
244     (assignment-expression) : $1
245     ;; initializer:       assignment_expression %prec comma
246     ;;          |  lbrace initializer_list rbrace               { ; }
247     ;;          |  lbrace initializer_list comma rbrace         { ; }
248     ;;          ;
249     )
250
251    ;; initializer_list:         initializer %prec comma
252    ;;           |  initializer_list comma initializer
253    ;;           ;
254
255    ;; type_name:           specifier_qualifier_list
256    ;;           |  specifier_qualifier_list abstract_declarator
257    ;;           ;
258
259    ;; abstract_declarator:      pointer
260    ;;           |  direct_abstract_declarator
261    ;;           |  pointer direct_abstract_declarator
262    ;;           ;
263
264    ;; direct_abstract_declarator:
265    ;;              lparen abstract_declarator rparen            { ; }
266    ;;           |  lbrace rbrace                                { ; }
267    ;;           |  direct_abstract_declarator lbrace rbrace
268    ;;           |  lbrace constant_expression rbrace            { ; }
269    ;;           |  direct_abstract_declarator lbrace constant_expression rbrace
270    ;;           |  lparen rparen                                { ; }
271    ;;           |  direct_abstract_declarator lparen rparen
272    ;;           |  lparen parameter_list rparen                 { ; }
273    ;;           |  direct_abstract_declarator lparen parameter_list rparen
274    ;;           ;
275
276    
277    (statement
278     ;;(labeled-statement) 
279     (expression-statement) : $1
280     (compound-statement) : $1
281     ;;(selection-statement)
282     (iteration-statement) : $1
283     (jump-statement) : $1
284     (semicolon) : '()
285     (error semicolon) : (begin (syntax-error "statement error" @1 $1) '())
286     (error rbrace) : (begin (syntax-error "statement error" @1 $1) '()))
287                 
288
289    ;; labeled_statement:
290    ;;              Identifier COLON statement
291    ;;           |  CASE x COLON statement               { ; }
292    ;;           |  DEFAULT COLON statement              { ; }
293    ;;           ;
294
295    (expression-statement
296     (x semicolon) : $1)
297
298    (compound-statement
299     (lbrace rbrace) : '(compound)
300     (lbrace declaration-list rbrace) : `(compound ,$2)
301     (lbrace statement-list rbrace) :  `(compound ,@$2)
302     (lbrace declaration-list statement-list rbrace) : `(compound ,$2 ,@$3))
303
304    (statement-list
305     (statement) : `(,$1)
306     (statement-list statement) : `(,@$1 ,$2))
307    
308    ;; selection_statement:
309    ;;              IF lparen x rparen statement                 { ; }
310    ;;           |  IF lparen x rparen statement ELSE statement  { ; }
311    ;;           |  SWITCH lparen x rparen statement             { ; }
312    ;;           ;
313
314    (iteration-statement
315     ;; iteration_statement:
316     ;;             WHILE lparen x rparen statement              { ; }
317     ;;          |  DO statement WHILE lparen x rparen semicolon { ; }
318     (for lparen forcntrl rparen statement) : `(for ,@$3 ,$5))
319    
320    (forcntrl
321     ;;          | semicolon semicolon x                         { ; }
322     ;;          | semicolon x semicolon                         { ; }
323     ;;          | semicolon x semicolon x                               { ; }
324     ;;          | x semicolon semicolon
325     ;;          | x semicolon semicolon x
326     ;;          | x semicolon x semicolon
327     (x semicolon x semicolon x) : `((start ,$1) (test ,$3) (step ,$5)))
328
329    (jump-statement
330     (goto Identifier semicolon) : `(goto ,$2)
331     (continue semicolon) : '(continue)
332     (break semicolon) : '(break)
333     (return semicolon) : '(return)
334     (return x semicolon) : `(return ,$2))
335
336    (x
337     (assignment-expression) : $1
338     (x comma assignment-expression) : `(,$1 ,@$3))
339                 
340    (assignment-expression
341     (equality-expression) : $1 ;; skip some
342     ;;(conditional-expression) : $1
343     (unary-expression assignment-operator assignment-expression) : `(,$2 ,$1 ,$3))
344
345    (assignment-operator
346     (=) : '=)
347    ;;           |  PLUSEQ                               { ; }
348    ;;           |  MINUSEQ                              { ; }
349    ;;           |  MUEQ                                 { ; }
350    ;;           |  DIVEQ                                { ; }
351    ;;           |  MODEQ                                { ; }
352    ;;           |  SLEQ                         { ; }
353    ;;           |  SREQ                         { ; }
354    ;;           |  ANEQ                         { ; }
355    ;;           |  OREQ                         { ; }
356    ;;           |  XOREQ                                { ; }
357    ;;           ;
358
359    ;; conditional_expression: logical_or_expression
360    ;;           |  logical_or_expression IF_THEN x COLON conditional_expression
361    ;;           ;
362
363    ;; constant_expression: conditional_expression
364    ;;           ;
365
366    ;; logical_or_expression: logical_and_expression
367    ;;           |  logical_or_expression OROR logical_and_expression
368    ;;           ;
369
370    ;; logical_and_expression: inclusive_or_expression
371    ;;           |  logical_and_expression ANDAND inclusive_or_expression
372    ;;           ;
373
374    ;; inclusive_or_expression: exclusive_or_expression
375    ;;           |  inclusive_or_expression OR exclusive_or_expression
376    ;;           ;
377
378    ;; exclusive_or_expression: and_expression
379    ;;           |  exclusive_or_expression XOR and_expression
380    ;;           ;
381
382    ;; and_expression: equality_expression
383    ;;           |  and_expression AND equality_expression
384    ;;           ;
385
386    (equality-expression
387     (relational-expression) : $1
388     (equality-expression == relational-expression) : `(== ,$1 ,$3)
389     (equality-expression != relational-expression) : `(!= ,$1 ,$3))
390
391    (relational-expression
392     (shift-expression) : $1
393     (relational-expression < shift-expression) : `(< ,$1 ,$3)
394     (relational-expression <= shift-expression) : `(<= ,$1 ,$3)
395     (relational-expression > shift-expression) : `(> ,$1 ,$3)
396     (relational-expression >= shift-expression) : `(>= ,$1 ,$3))
397
398    (shift-expression
399     (unary-expression) : $1 ;; skip some
400     ;; shift_expression: additive_expression
401     ;;          |  shift_expression LTLT additive_expression
402     ;;          |  shift_expression GTGT additive_expression
403     ;;          ;
404     )
405    ;; additive_expression: multiplicative_expression
406    ;;           |  additive_expression PLUS multiplicative_expression
407    ;;           |  additive_expression MINUS multiplicative_expression
408    ;;           ;
409
410    ;; multiplicative_expression: cast_expression
411    ;;           |  multiplicative_expression STAR cast_expression
412    ;;           |  multiplicative_expression DIV cast_expression
413    ;;           |  multiplicative_expression MOD cast_expression
414    ;;           ;
415
416    ;; cast_expression:   unary_expression
417    ;;           |  lparen type_name rparen cast_expression      { ; }
418    ;;           ;
419
420    (unary-expression
421     (postfix-expression) : $1
422     (++ unary-expression) : `(++x ,$2)
423     (-- unary-expression) : `(--x ,$2)
424    ;;           |  SIZEOF unary_expression              { ; }
425    ;;           |  SIZEOF lparen type_name rparen %prec SIZEOF  { ; }
426    ;;           |  STAR cast_expression                 { ; }
427    ;;           |  AND cast_expression                  { ; }
428    ;;           |  MINUS cast_expression                { ; }
429    ;;           |  PLUS cast_expression                 { ; }
430    ;;           |  NEG cast_expression                  { ; }
431    ;;           |  NOT cast_expression                  { ; }
432    ;;           ;
433     )
434
435    (postfix-expression
436     (primary-expression) : $1
437     ;;          |  postfix_expression lbracket x rbracket
438     (postfix-expression lparen rparen) : `(call ,$1 (arguments))
439     (postfix-expression lparen argument-expression-list rparen) : `(call ,$1 ,$3)
440     ;;          |  postfix_expression FOLLOW Identifier
441     ;;          |  postfix_expression DOT Identifier
442     (postfix-expression ++) : `(x++ ,$1)
443     (postfix-expression --) : `(x-- ,$1)
444     )
445
446    (primary-expression
447     (Identifier): $1
448     (NumericLiteral) : $1
449     ;; INT_LITERAL
450     ;; CHAR_LITERAL
451     ;; FLOAT_LITERAL
452     ;; STRING_LITERAL
453     (StringLiteral) : $1
454     ;; lparen x rparen
455     )
456    ;;           
457
458    (argument-expression-list
459     (assignment-expression) : `(arguments ,$1)
460     (argument-expression-list comma assignment-expression): `(,@$1 ,@(cdr $3)))))