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