src/: Enhance `definst' to allow general BVL syntax.
[sod] / src / codegen-proto.lisp
1 ;;; -*-lisp-*-
2 ;;;
3 ;;; Code generation protocol
4 ;;;
5 ;;; (c) 2009 Straylight/Edgeware
6 ;;;
7
8 ;;;----- Licensing notice ---------------------------------------------------
9 ;;;
10 ;;; This file is part of the Sensible Object Design, an object system for C.
11 ;;;
12 ;;; SOD is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
16 ;;;
17 ;;; SOD is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
21 ;;;
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with SOD; if not, write to the Free Software Foundation,
24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
25
26 (cl:in-package #:sod)
27
28 ;;;--------------------------------------------------------------------------
29 ;;; Temporary names.
30
31 ;; Protocol.
32
33 (export 'format-temporary-name)
34 (defgeneric format-temporary-name (var stream)
35 (:documentation
36 "Write the name of a temporary variable VAR to STREAM."))
37
38 (export 'var-in-use-p)
39 (defgeneric var-in-use-p (var)
40 (:documentation
41 "Answer whether VAR is currently being used. See `with-temporary-var'.")
42 (:method (var)
43 "Non-temporary variables are always in use."
44 (declare (ignore var))
45 t))
46 (defgeneric (setf var-in-use-p) (value var)
47 (:documentation
48 "Record whether VAR is currently being used. See `with-temporary-var'."))
49
50 ;; Root class.
51
52 (export '(temporary-name temp-tag))
53 (defclass temporary-name ()
54 ((tag :initarg :tag :reader temp-tag))
55 (:documentation
56 "Base class for temporary variable and argument names."))
57
58 ;; Important temporary names.
59
60 (export '(*sod-ap* *sod-master-ap*))
61 (defparameter *sod-ap*
62 (make-instance 'temporary-name :tag "sod__ap"))
63 (defparameter *sod-master-ap*
64 (make-instance 'temporary-name :tag "sod__master_ap"))
65 (defparameter *sod-tmp-ap*
66 (make-instance 'temporary-name :tag "sod__tmp_ap"))
67 (defparameter *sod-tmp-val*
68 (make-instance 'temporary-name :tag "sod__t"))
69
70 ;;;--------------------------------------------------------------------------
71 ;;; Instructions.
72
73 ;; Classes.
74
75 (export 'inst)
76 (defclass inst () ()
77 (:documentation
78 "A base class for instructions.
79
80 An `instruction' is anything which might be useful to string into a code
81 generator. Both statements and expressions can be represented by trees of
82 instructions. The `definst' macro is a convenient way of defining new
83 instructions.
84
85 The only important protocol for instructions is output, which is achieved
86 by calling `print-object' with `*print-escape*' nil.
87
88 This doesn't really do very much, but it acts as a handy marker for
89 instruction subclasses."))
90
91 (export 'inst-metric)
92 (defgeneric inst-metric (inst)
93 (:documentation
94 "Returns a `metric' describing how complicated INST is.
95
96 The default metric of an inst node is simply 1; `inst' subclasses
97 generated by `definst' (q.v.) have an automatically generated method which
98 returns one plus the sum of the metrics of the node's children.
99
100 This isn't intended to be a particularly rigorous definition. Its purpose
101 is to allow code generators to make decisions about inlining or calling
102 code fairly simply.")
103 (:method ((inst t))
104 (declare (ignore inst))
105 1)
106 (:method ((inst null))
107 (declare (ignore inst))
108 1)
109 (:method ((inst list))
110 (reduce #'+ inst :key #'inst-metric)))
111
112 ;; Instruction definition.
113
114 (export 'definst)
115 (defmacro definst (code (streamvar &key export) args &body body)
116 "Define an instruction type and describe how to output it.
117
118 An `inst' can represent any structured piece of output syntax: a
119 statement, expression or declaration, for example. This macro defines the
120 following things:
121
122 * A class `CODE-inst' to represent the instruction.
123
124 * Instance slots named after the ARGS, with matching keyword initargs,
125 and `inst-ARG' readers.
126
127 * A constructor `make-CODE-inst' which accepts the ARGS (as an ordinary
128 BVL) as arguments and returns a fresh instance.
129
130 * A print method, which prints a diagnostic dump if `*print-escape*' is
131 set, or invokes the BODY (with STREAMVAR bound to the output stream)
132 otherwise. The BODY is expected to produce target code at this
133 point.
134
135 If EXPORT is non-nil, then export the `CODE-inst' and `make-CODE-inst'
136 symbols."
137
138 (let* ((inst-var (gensym "INST"))
139 (class-name (symbolicate code '-inst))
140 (constructor-name (symbolicate 'make- code '-inst))
141 (slots (mapcan (lambda (arg)
142 (if (listp arg) (list (car arg))
143 (let ((name (symbol-name arg)))
144 (if (and (plusp (length name))
145 (char/= (char name 0) #\&))
146 (list arg)
147 nil))))
148 args))
149 (keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
150 slots)))
151 `(progn
152 (defclass ,class-name (inst)
153 ,(mapcar (lambda (slot key)
154 `(,slot :initarg ,key
155 :reader ,(symbolicate 'inst- slot)))
156 slots keys))
157 (defun ,constructor-name (,@args)
158 (make-instance ',class-name ,@(mappend #'list keys slots)))
159 (defmethod inst-metric ((,inst-var ,class-name))
160 (with-slots (,@slots) ,inst-var
161 (+ 1 ,@(mapcar (lambda (slot) `(inst-metric ,slot)) slots))))
162 (defmethod print-object ((,inst-var ,class-name) ,streamvar)
163 (with-slots (,@slots) ,inst-var
164 (if *print-escape*
165 (print-unreadable-object (,inst-var ,streamvar :type t)
166 (format stream "~@<~@{~S ~@_~S~^ ~_~}~:>"
167 ,@(mappend #'list keys slots)))
168 (block ,code ,@body))))
169 ,@(and export `((export '(,class-name ,constructor-name
170 ,@(mapcar (lambda (slot)
171 (symbolicate 'inst- slot))
172 slots)))))
173 ',code)))
174
175 ;; Formatting utilities.
176
177 (defun format-compound-statement* (stream child morep thunk)
178 "Underlying function for `format-compound-statement'."
179 (cond ((typep child 'block-inst)
180 (funcall thunk stream)
181 (write-char #\space stream)
182 (princ child stream)
183 (when morep (write-char #\space stream)))
184 (t
185 (pprint-logical-block (stream nil)
186 (funcall thunk stream)
187 (write-char #\space stream)
188 (pprint-indent :block 2 stream)
189 (pprint-newline :linear stream)
190 (princ child stream)
191 (pprint-indent :block 0 stream)
192 (case morep
193 (:space
194 (write-char #\space stream)
195 (pprint-newline :linear stream))
196 ((t)
197 (pprint-newline :mandatory stream)))))))
198
199 (export 'format-compound-statement)
200 (defmacro format-compound-statement
201 ((stream child &optional morep) &body body)
202 "Format a compound statement to STREAM.
203
204 The introductory material is printed by BODY. The CHILD is formatted
205 properly according to whether it's a `block-inst'. If MOREP is true, then
206 allow for more stuff following the child."
207 `(format-compound-statement* ,stream ,child ,morep
208 (lambda (,stream) ,@body)))
209
210 ;; Important instruction classes.
211
212 ;; HACK: Some of the slot names we'd like to use are external symbols in our
213 ;; package or the `common-lisp' package. Use gensyms for these slot names to
214 ;; prevent them from leaking.
215
216 (definst var (stream :export t) (name #1=#:type &optional init)
217 (pprint-c-type #1# stream name)
218 (when init
219 (format stream " = ~A" init))
220 (write-char #\; stream))
221
222 (definst function (stream :export t) (name #1=#:type body)
223 (pprint-logical-block (stream nil)
224 (princ "static " stream)
225 (pprint-c-type #1# stream name)
226 (format stream "~:@_~A~:@_~:@_" body)))
227
228 ;; Expression statements.
229 (definst expr (stream :export t) (#1=#:expr)
230 (format stream "~A;" #1#))
231 (definst set (stream :export t) (var #1=#:expr)
232 (format stream "~@<~A = ~@_~2I~A;~:>" var #1#))
233 (definst update (stream :export t) (var op #1=#:expr)
234 (format stream "~@<~A ~A= ~@_~2I~A;~:>" var op #1#))
235
236 ;; Special kinds of expressions.
237 (definst call (stream :export t) (#1=#:func &rest args)
238 (format stream "~A(~@<~{~A~^, ~_~}~:>)" #1# args))
239
240 ;; Simple statements.
241 (definst return (stream :export t) (#1=#:expr)
242 (format stream "return~@[ (~A)~];" #1#))
243 (definst break (stream :export t) ()
244 (format stream "break;"))
245 (definst continue (stream :export t) ()
246 (format stream "continue;"))
247
248 ;; Compound statements.
249
250 (definst block (stream :export t) (decls body)
251 (format stream "{~:@_~@< ~2I~@[~{~A~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}"
252 decls body))
253
254 (definst if (stream :export t) (#1=#:cond conseq &optional alt)
255 (format-compound-statement (stream conseq alt)
256 (format stream "if (~A)" #1#))
257 (when alt
258 (format-compound-statement (stream alt)
259 (write-string "else" stream))))
260
261 (definst while (stream :export t) (#1=#:cond body)
262 (format-compound-statement (stream body)
263 (format stream "while (~A)" #1#)))
264
265 (definst do-while (stream :export t) (body #1=#:cond)
266 (format-compound-statement (stream body :space)
267 (write-string "do" stream))
268 (format stream "while (~A);" #1#))
269
270 ;;;--------------------------------------------------------------------------
271 ;;; Code generation.
272
273 ;; Accessors.
274
275 (export 'codegen-functions)
276 (defgeneric codegen-functions (codegen)
277 (:documentation
278 "Return the list of `function-inst's of completed functions."))
279
280 (export 'ensure-var)
281 (defgeneric ensure-var (codegen name type &optional init)
282 (:documentation
283 "Add a variable to CODEGEN's list.
284
285 The variable is called NAME (which should be comparable using `equal' and
286 print to an identifier) and has the given TYPE. If INIT is present and
287 non-nil it is an expression `inst' used to provide the variable with an
288 initial value."))
289
290 (export '(emit-inst emit-insts))
291 (defgeneric emit-inst (codegen inst)
292 (:documentation
293 "Add INST to the end of CODEGEN's list of instructions."))
294 (defgeneric emit-insts (codegen insts)
295 (:documentation
296 "Add a list of INSTS to the end of CODEGEN's list of instructions.")
297 (:method (codegen insts)
298 (dolist (inst insts) (emit-inst codegen inst))))
299
300 (export '(emit-decl emit-decls))
301 (defgeneric emit-decl (codegen inst)
302 (:documentation
303 "Add INST to the end of CODEGEN's list of declarations."))
304 (defgeneric emit-decls (codegen insts)
305 (:documentation
306 "Add a list of INSTS to the end of CODEGEN's list of declarations."))
307
308 (export 'codegen-push)
309 (defgeneric codegen-push (codegen)
310 (:documentation
311 "Pushes the current code generation state onto a stack.
312
313 The state consists of the accumulated variables and instructions."))
314
315 (export 'codegen-pop)
316 (defgeneric codegen-pop (codegen)
317 (:documentation
318 "Pops a saved state off of the CODEGEN's stack.
319
320 Returns the newly accumulated variables and instructions as lists, as
321 separate values."))
322
323 (export 'codegen-add-function)
324 (defgeneric codegen-add-function (codegen function)
325 (:documentation
326 "Adds a function to CODEGEN's list.
327
328 Actually, we're not picky: FUNCTION can be any kind of object that you're
329 willing to find in the list returned by `codegen-functions'."))
330
331 (export 'temporary-var)
332 (defgeneric temporary-var (codegen type)
333 (:documentation
334 "Return the name of a temporary variable.
335
336 The temporary variable will have the given TYPE, and will be marked
337 in-use. You should clear the in-use flag explicitly when you've finished
338 with the variable -- or, better, use `with-temporary-var' to do the
339 cleanup automatically."))
340
341 (export 'codegen-build-function)
342 (defun codegen-build-function (codegen name type vars insts)
343 "Build a function and add it to CODEGEN's list.
344
345 Returns the function's name."
346 (codegen-add-function codegen
347 (make-function-inst name type
348 (make-block-inst vars insts)))
349 name)
350
351 (export 'codegen-pop-block)
352 (defgeneric codegen-pop-block (codegen)
353 (:documentation
354 "Makes a block (`block-inst') out of the completed code in CODEGEN.")
355 (:method (codegen)
356 (multiple-value-bind (vars insts) (codegen-pop codegen)
357 (make-block-inst vars insts))))
358
359 (export 'codegen-pop-function)
360 (defgeneric codegen-pop-function (codegen name type)
361 (:documentation
362 "Makes a function out of the completed code in CODEGEN.
363
364 The NAME can be any object you like. The TYPE should be a function type
365 object which includes argument names. The return value is the NAME.")
366 (:method (codegen name type)
367 (multiple-value-bind (vars insts) (codegen-pop codegen)
368 (codegen-build-function codegen name type vars insts))))
369
370 (export 'with-temporary-var)
371 (defmacro with-temporary-var ((codegen var type) &body body)
372 "Evaluate BODY with VAR bound to a temporary variable name.
373
374 During BODY, VAR will be marked in-use; when BODY ends, VAR will be marked
375 available for re-use."
376 (multiple-value-bind (doc decls body) (parse-body body :docp nil)
377 (declare (ignore doc))
378 `(let ((,var (temporary-var ,codegen ,type)))
379 ,@decls
380 (unwind-protect
381 (progn ,@body)
382 (setf (var-in-use-p ,var) nil)))))
383
384 ;;;--------------------------------------------------------------------------
385 ;;; Code generation idioms.
386
387 (export 'deliver-expr)
388 (defun deliver-expr (codegen target expr)
389 "Emit code to deliver the value of EXPR to the TARGET.
390
391 The TARGET may be one of the following.
392
393 * `:void', indicating that the value is to be discarded. The expression
394 will still be evaluated.
395
396 * `:void-return', indicating that the value is to be discarded (as for
397 `:void') and furthermore a `return' from the current function should
398 be forced after computing the value.
399
400 * `:return', indicating that the value is to be returned from the
401 current function.
402
403 * A variable name, indicating that the value is to be stored in the
404 variable.
405
406 In the cases of `:return', `:void' and `:void-return' targets, it is valid
407 for EXPR to be nil; this signifies that no computation needs to be
408 performed. Variable-name targets require an expression."
409
410 (case target
411 (:return (emit-inst codegen (make-return-inst expr)))
412 (:void (when expr (emit-inst codegen (make-expr-inst expr))))
413 (:void-return (when expr (emit-inst codegen (make-expr-inst expr)))
414 (emit-inst codegen (make-return-inst nil)))
415 (t (emit-inst codegen (make-set-inst target expr)))))
416
417 (export 'convert-stmts)
418 (defun convert-stmts (codegen target type func)
419 "Invoke FUNC to deliver a value to a non-`:return' target.
420
421 FUNC is a function which accepts a single argument, a non-`:return'
422 target, and generates statements which deliver a value (see
423 `deliver-expr') of the specified TYPE to this target. In general, the
424 generated code will have the form
425
426 setup instructions...
427 (deliver-expr CODEGEN TARGET (compute value...))
428 cleanup instructions...
429
430 where the cleanup instructions are essential to the proper working of the
431 generated program.
432
433 The `convert-stmts' function will call FUNC to generate code, and arrange
434 that its value is correctly delivered to TARGET, regardless of what the
435 TARGET is -- i.e., it lifts the restriction to non-`:return' targets. It
436 does this by inventing a new temporary variable."
437
438 (case target
439 (:return (with-temporary-var (codegen var type)
440 (funcall func var)
441 (deliver-expr codegen target var)))
442 (:void-return (funcall func :void)
443 (emit-inst codegen (make-return-inst nil)))
444 (t (funcall func target))))
445
446 (export 'deliver-call)
447 (defun deliver-call (codegen target func &rest args)
448 "Emit a statement to call FUNC with ARGS and deliver the result to TARGET."
449 (deliver-expr codegen target (apply #'make-call-inst func args)))
450
451 ;;;----- That's all, folks --------------------------------------------------