Coverage report: /home/ellis/comp/core/lib/syn/gen/c/print.lisp

KindCoveredAll%
expression0741 0.0
branch092 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; print.lisp --- SYN/GEN/C Code Printer
2
 
3
 ;; TODO
4
 
5
 ;;; Code:
6
 (in-package :syn/gen/c)
7
 
8
 ;;; Simply prints the ast, useful in REPL.
9
 (defun simple-print (tree)
10
   "Pretty prints C ast"
11
   (let ((ei (make-instance 'else-if-traverser))
12
         (ib (make-instance 'if-blocker))
13
         (db (make-instance 'decl-blocker))
14
         (rn (make-instance 'renamer))
15
         (pp (make-instance 'code-printer)))
16
     (progn
17
       (traverse ei tree 0)
18
       (traverse ib tree 0)
19
       (traverse db tree 0)
20
       (traverse rn tree 0)
21
       (traverse pp tree 0))))
22
 
23
 (with-code-printer
24
   (define-code-printer :before expression-statement
25
     (push-info 'expression-statement)
26
     (when (or (typep (node-slot expression) 'function-call)
27
               (typep (node-slot expression) 'infix-expression)
28
               (typep (node-slot expression) 'prefix-expression)
29
               (typep (node-slot expression) 'postfix-expression))
30
       (format stream "~&~a" indent)))
31
   (define-code-printer :after expression-statement
32
     (pop-info)
33
     (when (or (typep (node-slot expression) 'function-call)
34
               (typep (node-slot expression) 'infix-expression)
35
               (typep (node-slot expression) 'prefix-expression)
36
               (typep (node-slot expression) 'postfix-expression)
37
               (typep (node-slot expression) 'empty)
38
               (node-slot force-semicolon))
39
       (format stream ";")))
40
   ;; Compound-Statement
41
   (define-code-printer :before compound-statement
42
     ;; Begin new line (if not in 'for', 'while', or 'if' statement).
43
     ;; Open and close brackets if needed (managed with a traverser).
44
     (if (node-slot braces)
45
         (progn
46
           ;; do not start new line for these cases
47
           (if (or (eql (top-info) 'for)
48
                   (eql (top-info) 'while)
49
                   (eql (top-info) 'do)
50
                   (eql (top-info) 'if)
51
                   (eql (top-info) 'else)
52
                   (eql (top-info) 'function-definition))
53
               ;; simply append brace
54
               (format stream " {~%")
55
               ;; start new line+indent+brace
56
               (format stream "~&~a{~%" indent))
57
           ;; add info for following subnodes
58
           (push-info 'block)))
59
     ;; increase indent
60
     ++indent)
61
   (define-code-printer :self compound-statement
62
     (traverse %self (node-slot statements) %level))
63
   (define-code-printer :after compound-statement
64
     --indent
65
     (pop-info)
66
     (if (node-slot braces)
67
         (progn (format stream "~&~a}" indent))))
68
   (define-code-printer :after c-type
69
     (let ((info (top-info)))
70
       (when (and (node-slot type)
71
                  (not (eql info 'cast-expression))
72
                  (not (eql info 'funcall))
73
                  (not (eql info 'declaration-item)))
74
         (format stream " "))))
75
   (define-code-printer :self c-type
76
     (traverse %self (ast node) %level))
77
   (define-code-printer :before function-definition
78
     (push-info 'function-definition)
79
     (format stream "~&~%~A" indent))
80
   (define-code-printer :self function-definition
81
     (with-slots (parameter item body) node
82
       (format stream "~A ~A"
83
               (val
84
                (slot-value
85
                 (slot-value item 'type)
86
                 'type))
87
               (val (slot-value item 'identifier)))
88
       (format stream "(~{~A~^, ~})"
89
               (mapcar (lambda (x) (format nil "~A ~A" 
90
                                           (val
91
                                            (slot-value
92
                                             (slot-value x 'type)
93
                                             'type))
94
                                           (val (slot-value x 'identifier))))
95
                       (ast parameter)))
96
       (traverse %self body %level)))
97
   (define-code-printer :after function-definition
98
     (pop-info)
99
     (when (not (node-slot body))
100
       (format stream ";")))
101
   (define-code-printer :before parameter-list
102
     (unless (ast node)
103
       (format stream " void"))
104
     (push-sign 'skip-first))
105
   (define-code-printer :self parameter-list
106
     (format stream "~{~A~^, ~}" (ast node)))
107
   (define-code-printer :after parameter-list
108
     (when (eql (top-sign) 'skip-first)
109
       (pop-sign)))
110
   ;; (define-code-printer :before parameter
111
   ;;   (if (eql (top-sign) 'skip-first)
112
   ;;       (pop-sign)
113
   ;;       (format stream ", ")))
114
   (define-code-printer :before struct-definition
115
     (unless (eql (top-info) 'typedef)
116
       (format stream "~&~%"))
117
     (format stream "~Astruct " indent))
118
   (define-code-printer :after struct-definition
119
     (unless (eql (top-info) 'typedef)
120
       (format stream ";")))
121
   (define-code-printer :before enum-definition
122
     (if (or (eql (top-info) 'typedef)
123
             (eql (top-info) 'decl))
124
         (format stream "enum")
125
         (format stream "~&~Aenum" indent))
126
     (when (and (not (eql (top-info) 'decl))
127
                (> (length (slot-value (node-slot members) 'ast)) 3))
128
       (push-sign 'enum-break))
129
     (push-info 'enum-definition)
130
     ++indent)
131
   (define-code-printer :self enum-definition
132
     (format stream " {")
133
     (let ((lprinter (copy-object %self)))
134
       (setf (slot-value lprinter 'stream) nil)
135
       (format stream "~{~#[~;~A~:;~A,~]~}"
136
               (loop for x in (ast (node-slot members))
137
                     collect 
138
                        (format nil "~A~A~@[=~A~]"
139
                                (if (eql (top-sign) 'enum-break)
140
                                    (format nil "~%~A" indent)
141
                                    "")
142
                                (val (slot-value x 'identifier))
143
                                (std:when-let ((val (slot-value x 'value)))
144
                                  (traverse lprinter (val val) %level))))))
145
     --indent
146
     (if (eql (top-sign) 'enum-break)
147
         (progn
148
           (pop-sign)
149
           (format stream "~&}"))
150
         (format stream "}"))
151
     (std:when-let ((id (and (id node) (val (id node)))))
152
       (format stream " ~A" id)))
153
   (define-code-printer :after enum-definition
154
     (pop-info)
155
     (when (not (or (eql (top-info) 'typedef)
156
                    (eql (top-info) 'decl)))
157
       (format stream ";")))
158
   ;; (define-code-printer :before enum
159
   ;;   (if (eql (top-sign) 'first-enum)
160
   ;;       (progn
161
   ;;         (format stream " {")
162
   ;;         (pop-sign))
163
   ;;       (format stream ","))
164
   ;;   (if (eql (top-sign) 'enum-break)
165
   ;;       (format stream "~&~A" indent)
166
   ;;       (format stream " ")))
167
   (define-code-printer :before declaration-list
168
     (push-info 'decl)
169
     (if (node-slot braces)
170
         (progn
171
           (format stream "~&~A{" indent)
172
           ++indent)))
173
   (define-code-printer :self declaration-list
174
     (traverse %self (ast node) %level))
175
   (define-code-printer :after declaration-list
176
     (pop-info)
177
     (when (node-slot braces)
178
       --indent
179
       (format stream "~&~A}" indent)))
180
   (define-code-printer :before declaration-item
181
     (push-info 'declaration-item))
182
   (define-code-printer :self declaration-item
183
     (format stream "~A ~A~@[=~A~];~%"
184
             (val (slot-value (node-slot type) 'type))
185
             (val (node-slot identifier))
186
             (std:when-let ((val (node-slot value)))
187
               (val (val val)))))
188
   (define-code-printer :after declaration-item
189
     (pop-info))
190
   (define-code-printer :self declaration-value
191
     (traverse %self (ast node) %level))
192
   ;; TODO 2024-12-15: 
193
   (define-code-printer :before for-statement
194
     (push-info 'for))
195
   (define-code-printer :after for-statement
196
     (pop-info))
197
   ;; init test step
198
 
199
   ;; while - test
200
   ;; do
201
   ;; if
202
   ;; switch case
203
   ;; infix
204
   (define-code-printer :before infix-expression
205
     (if (or (eql (top-info) 'infix)
206
             (eql (top-info) 'oref)
207
             (eql (top-info) 'not)
208
             (eql (top-info) 'cast-expression)
209
             (eql (top-info) 'prefix))
210
         (format stream "("))
211
     (push-info 'infix)
212
     (cond ((eql (node-slot op) 'or)
213
            (push-sign '\|\|))
214
           ((eql (node-slot op) 'and)
215
            (push-sign '&&))
216
           (t (push-sign (node-slot op))))
217
     (push-sign 'skip-first))
218
   (define-code-printer :after infix-expression
219
     (pop-info)
220
     (pop-sign)
221
     (if (or (eql (top-info) 'infix)
222
             (eql (top-info) 'oref)
223
             (eql (top-info) 'not)
224
             (eql (top-info) 'cast-expression)
225
             (eql (top-info) 'prefix))
226
         (format stream ")")))
227
   ;; assignment
228
   (define-code-printer :before assignment-expression
229
     (cond
230
       ((eql (top-info) 'infix)
231
        (format stream "("))
232
       ((eql (top-info) 'expression-statement)
233
        (format stream "~&~A" indent)))
234
     (push-info 'assignment)
235
     (push-sign (node-slot op)))
236
   (define-code-printer :after assignment-expression
237
     (pop-info)
238
     (pop-sign)
239
     (cond
240
       ((eql (top-info) 'infix)
241
        (format stream ")"))
242
       ((eql (top-info) 'expression-statement)
243
        (format stream ";"))))
244
   ;; conditional
245
   (define-code-printer :before conditional-expression
246
     (when (eql (top-info) 'infix)
247
       (format stream "("))
248
     (push-info 'conditional))
249
   (define-code-printer :after conditional-expression
250
     (pop-info)
251
     (when (eql (top-info) 'infix)
252
       (format stream ")")))
253
   ;; jump
254
   (define-code-printer :before jump-statement
255
     (format stream "~&~A" indent)
256
     (push-info 'jump-statement))
257
   (define-code-printer :after jump-statement
258
     (format stream ";")
259
     (pop-info))
260
   ;; label
261
   (define-code-printer :before label-statement
262
     (format stream "~&"))
263
   (define-code-printer :after label-statement
264
     (format stream ":~%"))
265
   ;; specifier
266
   (define-code-printer :self specifier
267
     (traverse %self (ast node) %level))
268
   ;; float
269
   (define-code-printer :after float-type
270
     (format stream "f"))
271
   ;; pointer-ref
272
   ;; object-ref
273
   (define-code-printer :before object-reference
274
     (push-info 'oref))
275
   (define-code-printer :after object-reference
276
     (pop-info))
277
   ;; function-pointer
278
   (define-code-printer :before function-pointer
279
     (push-info 'function-pointer))
280
   (define-code-printer :after function-pointer
281
     (pop-info))
282
   ;; arrays
283
   (define-code-printer :before array-reference
284
     (push-info 'aref))
285
   (define-code-printer :after array-reference
286
     (pop-info))
287
   (define-code-printer :before clist
288
     (push-info 'skip-first)
289
     (format stream "{ "))
290
   (define-code-printer :after clist
291
     (format stream " }"))
292
   (define-code-printer :before prefix-expression
293
     (when (eql (top-info) 'aref)
294
       (format stream "("))
295
     (push-info 'prefix)
296
     (format stream "~A" (node-slot op)))
297
   (define-code-printer :after postfix-expression
298
     (format stream "~A" (node-slot op)))
299
   (define-code-printer :before not-expression
300
     (push-info 'not)
301
     (format stream "(not "))
302
   (define-code-printer :after not-expression
303
     (pop-info)
304
     (format stream ")"))
305
   ;; function
306
   (define-code-printer :before function-call
307
     (when (eql (info-size) 0)
308
       (format stream "~&"))
309
     (push-sign 'nested-funcall-sentinel)
310
     (push-sign 'skip-first-funcall))
311
   (define-code-printer :self function-call
312
     (format stream "~&~A" indent)
313
     (traverse %self (node-slot function) %level)
314
     (let ((arg-printer (std:copy-object %self)))
315
       (setf (slot-value arg-printer 'stream) nil)
316
       (format stream "(~{~A~^, ~})"
317
               (traverse arg-printer (node-slot syn/gen::arguments) %level))))
318
   (define-code-printer :after function-call
319
     (when (eql (top-sign) 'skip-first-funcall)
320
       (pop-sign))
321
     (if (eql (top-sign) 'nested-funcall-sentinel)
322
         (pop-sign)
323
         (warn "funcall top-sign missmatch"))
324
     (unless (eql (info-size) 0)
325
       (format stream ";")))
326
   ;; include
327
   (define-code-printer :self include
328
     (format stream (if (stringp (node-slot file))
329
                        "~&#include \"~A\""
330
                        "~&#include ~A")
331
             (node-slot file)))
332
   ;; cast
333
   (define-code-printer :before cast-expression
334
     (push-info 'cast-expression)
335
     (format stream "("))
336
   (define-code-printer :after cast-expression
337
     (pop-info)
338
     (format stream ")"))
339
   ;; typedef
340
   (define-code-printer :before typedef
341
     (push-info 'typedef)
342
     (format stream "~&~Atypedef " indent))
343
   (define-code-printer :self typedef
344
     (traverse %self (slot-value (node-slot declaration) 'identifier) %level)
345
     (format stream " ")
346
     (traverse %self (slot-value (slot-value (node-slot declaration) 'type) 'type) %level))
347
   (define-code-printer :after typedef
348
     (pop-info)
349
     (format stream ";"))
350
   ;; comment
351
   (define-code-printer :self comment
352
     (when (node-slot linebreak)
353
       (format stream "~&~A" indent))
354
     (format stream "~A" (node-slot chars))
355
     (format stream "~A" (node-slot comment)))
356
   ;; attr
357
   (define-code-printer :before attribute-expression
358
     (push-sign 'skip-first-attribute)
359
     (format stream "__attribute__ (("))
360
   (define-code-printer :after attribute-expression
361
     (when (eql (top-sign) 'skip-first-attribute)
362
       (pop-sign))
363
     (format stream "))")))