src/builtin.lisp, src/codegen-proto.lisp: Improve slot initialization.
[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 Sensble 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 (in order, not
128 with keywords) 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 (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))
148 (defun ,constructor-name (,@args)
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)))
159 (block ,code ,@body))))
160 ,@(and export `((export '(,class-name ,constructor-name
161 ,@(mapcar (lambda (arg)
162 (symbolicate 'inst- arg))
163 args)))))
164 ',code)))
165
166 ;; Important instruction classes.
167
168 ;; HACK: use a gensym for the `expr' and `type' slots to avoid leaking the
169 ;; slot names, since the symbol `expr' is exported from our package and
170 ;; `type' belongs to the `common-lisp' package.
171
172 (definst var (stream :export t) (name #1=#:type init)
173 (pprint-c-type #1# stream name)
174 (when init
175 (format stream " = ~A" init))
176 (write-char #\; stream))
177 (definst set (stream :export t) (var #1=#:expr)
178 (format stream "~@<~A = ~@_~2I~A;~:>" var #1#))
179 (definst update (stream :export t) (var op #1=#:expr)
180 (format stream "~@<~A ~A= ~@_~2I~A;~:>" var op #1#))
181 (definst return (stream :export t) (#1=#:expr)
182 (format stream "return~@[ (~A)~];" #1#))
183 (definst break (stream :export t) ()
184 (format stream "break;"))
185 (definst continue (stream :export t) ()
186 (format stream "continue;"))
187 (definst expr (stream :export t) (#1=#:expr)
188 (format stream "~A;" #1#))
189 (definst block (stream :export t) (decls body)
190 (format stream "{~:@_~@< ~2I~@[~{~A~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}"
191 decls body))
192 (definst function (stream :export t) (name #1=#:type body)
193 (pprint-logical-block (stream nil)
194 (princ "static " stream)
195 (pprint-c-type #1# stream name)
196 (format stream "~:@_~A~:@_~:@_" body)))
197
198 ;; Formatting utilities.
199
200 (defun format-compound-statement* (stream child morep thunk)
201 "Underlying function for `format-compound-statement'."
202 (cond ((typep child 'block-inst)
203 (funcall thunk stream)
204 (write-char #\space stream)
205 (princ child stream)
206 (when morep (write-char #\space stream)))
207 (t
208 (pprint-logical-block (stream nil)
209 (funcall thunk stream)
210 (write-char #\space stream)
211 (pprint-indent :block 2 stream)
212 (pprint-newline :linear stream)
213 (princ child stream)
214 (pprint-indent :block 0 stream)
215 (case morep
216 (:space
217 (write-char #\space stream)
218 (pprint-newline :linear stream))
219 ((t)
220 (pprint-newline :mandatory stream)))))))
221
222 (export 'format-compound-statement)
223 (defmacro format-compound-statement
224 ((stream child &optional morep) &body body)
225 "Format a compound statement to STREAM.
226
227 The introductory material is printed by BODY. The CHILD is formatted
228 properly according to whether it's a `block-inst'. If MOREP is true, then
229 allow for more stuff following the child."
230 `(format-compound-statement* ,stream ,child ,morep
231 (lambda (,stream) ,@body)))
232
233 ;;;--------------------------------------------------------------------------
234 ;;; Code generation.
235
236 ;; Accessors.
237
238 (export 'codegen-functions)
239 (defgeneric codegen-functions (codegen)
240 (:documentation
241 "Return the list of `function-inst's of completed functions."))
242
243 (export 'ensure-var)
244 (defgeneric ensure-var (codegen name type &optional init)
245 (:documentation
246 "Add a variable to CODEGEN's list.
247
248 The variable is called NAME (which should be comparable using `equal' and
249 print to an identifier) and has the given TYPE. If INIT is present and
250 non-nil it is an expression `inst' used to provide the variable with an
251 initial value."))
252
253 (export '(emit-inst emit-insts))
254 (defgeneric emit-inst (codegen inst)
255 (:documentation
256 "Add INST to the end of CODEGEN's list of instructions."))
257 (defgeneric emit-insts (codegen insts)
258 (:documentation
259 "Add a list of INSTS to the end of CODEGEN's list of instructions.")
260 (:method (codegen insts)
261 (dolist (inst insts) (emit-inst codegen inst))))
262
263 (export '(emit-decl emit-decls))
264 (defgeneric emit-decl (codegen inst)
265 (:documentation
266 "Add INST to the end of CODEGEN's list of declarations."))
267 (defgeneric emit-decls (codegen insts)
268 (:documentation
269 "Add a list of INSTS to the end of CODEGEN's list of declarations."))
270
271 (export 'codegen-push)
272 (defgeneric codegen-push (codegen)
273 (:documentation
274 "Pushes the current code generation state onto a stack.
275
276 The state consists of the accumulated variables and instructions."))
277
278 (export 'codegen-pop)
279 (defgeneric codegen-pop (codegen)
280 (:documentation
281 "Pops a saved state off of the CODEGEN's stack.
282
283 Returns the newly accumulated variables and instructions as lists, as
284 separate values."))
285
286 (export 'codegen-add-function)
287 (defgeneric codegen-add-function (codegen function)
288 (:documentation
289 "Adds a function to CODEGEN's list.
290
291 Actually, we're not picky: FUNCTION can be any kind of object that you're
292 willing to find in the list returned by `codegen-functions'."))
293
294 (export 'temporary-var)
295 (defgeneric temporary-var (codegen type)
296 (:documentation
297 "Return the name of a temporary variable.
298
299 The temporary variable will have the given TYPE, and will be marked
300 in-use. You should clear the in-use flag explicitly when you've finished
301 with the variable -- or, better, use `with-temporary-var' to do the
302 cleanup automatically."))
303
304 (export 'codegen-build-function)
305 (defun codegen-build-function (codegen name type vars insts)
306 "Build a function and add it to CODEGEN's list.
307
308 Returns the function's name."
309 (codegen-add-function codegen
310 (make-function-inst name type
311 (make-block-inst vars insts)))
312 name)
313
314 (export 'codegen-pop-block)
315 (defgeneric codegen-pop-block (codegen)
316 (:documentation
317 "Makes a block (`block-inst') out of the completed code in CODEGEN.")
318 (:method (codegen)
319 (multiple-value-bind (vars insts) (codegen-pop codegen)
320 (make-block-inst vars insts))))
321
322 (export 'codegen-pop-function)
323 (defgeneric codegen-pop-function (codegen name type)
324 (:documentation
325 "Makes a function out of the completed code in CODEGEN.
326
327 The NAME can be any object you like. The TYPE should be a function type
328 object which includes argument names. The return value is the NAME.")
329 (:method (codegen name type)
330 (multiple-value-bind (vars insts) (codegen-pop codegen)
331 (codegen-build-function codegen name type vars insts))))
332
333 (export 'with-temporary-var)
334 (defmacro with-temporary-var ((codegen var type) &body body)
335 "Evaluate BODY with VAR bound to a temporary variable name.
336
337 During BODY, VAR will be marked in-use; when BODY ends, VAR will be marked
338 available for re-use."
339 (multiple-value-bind (doc decls body) (parse-body body :docp nil)
340 (declare (ignore doc))
341 `(let ((,var (temporary-var ,codegen ,type)))
342 ,@decls
343 (unwind-protect
344 (progn ,@body)
345 (setf (var-in-use-p ,var) nil)))))
346
347 ;;;--------------------------------------------------------------------------
348 ;;; Code generation idioms.
349
350 (export 'deliver-expr)
351 (defun deliver-expr (codegen target expr)
352 "Emit code to deliver the value of EXPR to the TARGET.
353
354 The TARGET may be one of the following.
355
356 * `:void', indicating that the value is to be discarded. The expression
357 will still be evaluated.
358
359 * `:void-return', indicating that the value is to be discarded (as for
360 `:void') and furthermore a `return' from the current function should
361 be forced after computing the value.
362
363 * `:return', indicating that the value is to be returned from the
364 current function.
365
366 * A variable name, indicating that the value is to be stored in the
367 variable.
368
369 In the cases of `:return', `:void' and `:void-return' targets, it is valid
370 for EXPR to be nil; this signifies that no computation needs to be
371 performed. Variable-name targets require an expression."
372
373 (case target
374 (:return (emit-inst codegen (make-return-inst expr)))
375 (:void (when expr (emit-inst codegen (make-expr-inst expr))))
376 (:void-return (when expr (emit-inst codegen (make-expr-inst expr)))
377 (emit-inst codegen (make-return-inst nil)))
378 (t (emit-inst codegen (make-set-inst target expr)))))
379
380 (export 'convert-stmts)
381 (defun convert-stmts (codegen target type func)
382 "Invoke FUNC to deliver a value to a non-`:return' target.
383
384 FUNC is a function which accepts a single argument, a non-`:return'
385 target, and generates statements which deliver a value (see
386 `deliver-expr') of the specified TYPE to this target. In general, the
387 generated code will have the form
388
389 setup instructions...
390 (deliver-expr CODEGEN TARGET (compute value...))
391 cleanup instructions...
392
393 where the cleanup instructions are essential to the proper working of the
394 generated program.
395
396 The `convert-stmts' function will call FUNC to generate code, and arrange
397 that its value is correctly delivered to TARGET, regardless of what the
398 TARGET is -- i.e., it lifts the restriction to non-`:return' targets. It
399 does this by inventing a new temporary variable."
400
401 (case target
402 (:return (with-temporary-var (codegen var type)
403 (funcall func var)
404 (deliver-expr codegen target var)))
405 (:void-return (funcall func :void)
406 (emit-inst codegen (make-return-inst nil)))
407 (t (funcall func target))))
408
409 ;;;----- That's all, folks --------------------------------------------------