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