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