src/{codegen,method}-impl.lisp: Allow non-variables in `vars' lists.
[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;;;
dea4d055 10;;; This file is part of the Sensble 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
dea4d055
MW
52(export 'temporary-name)
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 variables.
1f1d88f5
MW
59
60(defparameter *temporary-index* 0
61 "Index for temporary name generation.
62
63 This is automatically reset to zero before the output functions are
64 invoked to write a file. This way, we can ensure that the same output
9ec578d9
MW
65 file is always produced from the same input.")
66
67(define-clear-the-decks reset-codegen-index
68 (setf *temporary-index* 0))
1f1d88f5 69
dea4d055 70;; Important temporary names.
1f1d88f5 71
dea4d055 72(export '(*sod-ap* *sod-master-ap*))
1f1d88f5
MW
73(defparameter *sod-ap*
74 (make-instance 'temporary-name :tag "sod__ap"))
75(defparameter *sod-master-ap*
76 (make-instance 'temporary-name :tag "sod__master_ap"))
77
78;;;--------------------------------------------------------------------------
79;;; Instructions.
80
dea4d055
MW
81;; Classes.
82
83(export 'inst)
1f1d88f5
MW
84(defclass inst () ()
85 (:documentation
86 "A base class for instructions.
87
88 An `instruction' is anything which might be useful to string into a code
9ec578d9
MW
89 generator. Both statements and expressions can be represented by trees of
90 instructions. The `definst' macro is a convenient way of defining new
91 instructions.
1f1d88f5
MW
92
93 The only important protocol for instructions is output, which is achieved
3109662a 94 by calling `print-object' with `*print-escape*' nil.
1f1d88f5
MW
95
96 This doesn't really do very much, but it acts as a handy marker for
97 instruction subclasses."))
98
dea4d055 99(export 'inst-metric)
1f1d88f5
MW
100(defgeneric inst-metric (inst)
101 (:documentation
102 "Returns a `metric' describing how complicated INST is.
103
3109662a
MW
104 The default metric of an inst node is simply 1; `inst' subclasses
105 generated by `definst' (q.v.) have an automatically generated method which
106 returns one plus the sum of the metrics of the node's children.
1f1d88f5
MW
107
108 This isn't intended to be a particularly rigorous definition. Its purpose
109 is to allow code generators to make decisions about inlining or calling
110 code fairly simply.")
9ec578d9
MW
111 (:method ((inst t))
112 (declare (ignore inst))
113 1)
114 (:method ((inst null))
1d8cc67a 115 (declare (ignore inst))
9ec578d9
MW
116 1)
117 (:method ((inst list))
118 (reduce #'+ inst :key #'inst-metric)))
1f1d88f5 119
dea4d055
MW
120;; Instruction definition.
121
122(export 'definst)
418752c5 123(defmacro definst (code (streamvar &key export) args &body body)
1f1d88f5
MW
124 "Define an instruction type and describe how to output it.
125
3109662a
MW
126 An `inst' can represent any structured piece of output syntax: a
127 statement, expression or declaration, for example. This macro defines the
128 following things:
1f1d88f5 129
3109662a 130 * A class `CODE-inst' to represent the instruction.
1f1d88f5
MW
131
132 * Instance slots named after the ARGS, with matching keyword initargs,
3109662a 133 and `inst-ARG' readers.
1f1d88f5 134
3109662a 135 * A constructor `make-CODE-inst' which accepts the ARGS (in order, not
1f1d88f5
MW
136 with keywords) as arguments and returns a fresh instance.
137
3109662a 138 * A print method, which prints a diagnostic dump if `*print-escape*' is
1f1d88f5
MW
139 set, or invokes the BODY (with STREAMVAR bound to the output stream)
140 otherwise. The BODY is expected to produce target code at this
418752c5
MW
141 point.
142
143 If EXPORT is non-nil, then export the `CODE-inst' and `make-CODE-inst'
144 symbols."
1f1d88f5
MW
145
146 (let ((inst-var (gensym "INST"))
147 (class-name (symbolicate code '-inst))
418752c5 148 (constructor-name (symbolicate 'make- code '-inst))
1f1d88f5
MW
149 (keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
150 args)))
151 `(progn
152 (defclass ,class-name (inst)
153 ,(mapcar (lambda (arg key)
154 `(,arg :initarg ,key :reader ,(symbolicate 'inst- arg)))
155 args keys))
418752c5 156 (defun ,constructor-name (,@args)
1f1d88f5
MW
157 (make-instance ',class-name ,@(mappend #'list keys args)))
158 (defmethod inst-metric ((,inst-var ,class-name))
159 (with-slots (,@args) ,inst-var
160 (+ 1 ,@(mapcar (lambda (arg) `(inst-metric ,arg)) args))))
161 (defmethod print-object ((,inst-var ,class-name) ,streamvar)
162 (with-slots (,@args) ,inst-var
163 (if *print-escape*
164 (print-unreadable-object (,inst-var ,streamvar :type t)
165 (format stream "~@<~@{~S ~@_~S~^ ~_~}~:>"
166 ,@(mappend #'list keys args)))
418752c5
MW
167 (progn ,@body))))
168 ,@(and export `((export '(,class-name ,constructor-name))))
169 ',code)))
1f1d88f5 170
dea4d055
MW
171;; Important instruction classes.
172
418752c5 173(definst var (stream :export t) (name type init)
dea4d055
MW
174 (pprint-c-type type stream name)
175 (when init
176 (format stream " = ~A" init)))
418752c5 177(definst set (stream :export t) (var expr)
dea4d055 178 (format stream "~@<~A = ~@_~2I~A;~:>" var expr))
b559689b
MW
179(definst update (stream :export t) (var op expr)
180 (format stream "~@<~A ~A= ~@_~2I~A;~:>" var op expr))
418752c5 181(definst return (stream :export t) (expr)
dea4d055 182 (format stream "return~@[ (~A)~];" expr))
b559689b
MW
183(definst break (stream :export t) ()
184 (format stream "break;"))
185(definst continue (stream :export t) ()
186 (format stream "continue;"))
418752c5 187(definst expr (stream :export t) (expr)
dea4d055 188 (format stream "~A;" expr))
418752c5 189(definst block (stream :export t) (decls body)
dea4d055
MW
190 (format stream "{~:@_~@< ~2I~@[~{~A;~:@_~}~:@_~]~{~A~^~:@_~}~:>~:@_}"
191 decls body))
418752c5 192(definst function (stream :export t) (name type body)
dea4d055
MW
193 (pprint-logical-block (stream nil)
194 (princ "static " stream)
195 (pprint-c-type type stream name)
196 (format stream "~:@_~A~:@_~:@_" body)))
197
198;; Formatting utilities.
199
1f1d88f5 200(defun format-compound-statement* (stream child morep thunk)
3109662a 201 "Underlying function for `format-compound-statement'."
1f1d88f5
MW
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))
dea4d055 219 ((t)
1f1d88f5
MW
220 (pprint-newline :mandatory stream)))))))
221
dea4d055 222(export 'format-compound-statement)
1f1d88f5
MW
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
3109662a 228 properly according to whether it's a `block-inst'. If MOREP is true, then
1f1d88f5
MW
229 allow for more stuff following the child."
230 `(format-compound-statement* ,stream ,child ,morep
231 (lambda (,stream) ,@body)))
232
233;;;--------------------------------------------------------------------------
dea4d055 234;;; Code generation.
1f1d88f5 235
dea4d055 236;; Accessors.
1f1d88f5 237
dea4d055
MW
238(export 'codegen-functions)
239(defgeneric codegen-functions (codegen)
1f1d88f5 240 (:documentation
3109662a 241 "Return the list of `function-inst's of completed functions."))
1f1d88f5 242
dea4d055 243(export 'ensure-var)
1f1d88f5
MW
244(defgeneric ensure-var (codegen name type &optional init)
245 (:documentation
246 "Add a variable to CODEGEN's list.
247
3109662a 248 The variable is called NAME (which should be comparable using `equal' and
1f1d88f5 249 print to an identifier) and has the given TYPE. If INIT is present and
3109662a 250 non-nil it is an expression `inst' used to provide the variable with an
dea4d055 251 initial value."))
1f1d88f5 252
dea4d055
MW
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))))
1f1d88f5 262
dea4d055 263(export 'codegen-push)
1f1d88f5
MW
264(defgeneric codegen-push (codegen)
265 (:documentation
266 "Pushes the current code generation state onto a stack.
267
dea4d055 268 The state consists of the accumulated variables and instructions."))
1f1d88f5 269
dea4d055 270(export 'codegen-pop)
1f1d88f5
MW
271(defgeneric codegen-pop (codegen)
272 (:documentation
273 "Pops a saved state off of the CODEGEN's stack.
274
275 Returns the newly accumulated variables and instructions as lists, as
dea4d055 276 separate values."))
1f1d88f5 277
dea4d055 278(export 'codegen-add-function)
1f1d88f5
MW
279(defgeneric codegen-add-function (codegen function)
280 (:documentation
281 "Adds a function to CODEGEN's list.
282
283 Actually, we're not picky: FUNCTION can be any kind of object that you're
3109662a 284 willing to find in the list returned by `codegen-functions'."))
dea4d055
MW
285
286(export 'temporary-var)
287(defgeneric temporary-var (codegen type)
288 (:documentation
289 "Return the name of a temporary variable.
290
291 The temporary variable will have the given TYPE, and will be marked
292 in-use. You should clear the in-use flag explicitly when you've finished
3109662a
MW
293 with the variable -- or, better, use `with-temporary-var' to do the
294 cleanup automatically."))
1f1d88f5 295
dea4d055 296(export 'codegen-build-function)
1f1d88f5
MW
297(defun codegen-build-function (codegen name type vars insts)
298 "Build a function and add it to CODEGEN's list.
299
300 Returns the function's name."
301 (codegen-add-function codegen
302 (make-function-inst name type
303 (make-block-inst vars insts)))
304 name)
305
dea4d055
MW
306(export 'codegen-pop-block)
307(defgeneric codegen-pop-block (codegen)
308 (:documentation
3109662a 309 "Makes a block (`block-inst') out of the completed code in CODEGEN.")
dea4d055
MW
310 (:method (codegen)
311 (multiple-value-bind (vars insts) (codegen-pop codegen)
312 (make-block-inst vars insts))))
313
314(export 'codegen-pop-function)
1f1d88f5
MW
315(defgeneric codegen-pop-function (codegen name type)
316 (:documentation
317 "Makes a function out of the completed code in CODEGEN.
318
319 The NAME can be any object you like. The TYPE should be a function type
320 object which includes argument names. The return value is the NAME.")
dea4d055 321 (:method (codegen name type)
1f1d88f5
MW
322 (multiple-value-bind (vars insts) (codegen-pop codegen)
323 (codegen-build-function codegen name type vars insts))))
324
dea4d055 325(export 'with-temporary-var)
1f1d88f5
MW
326(defmacro with-temporary-var ((codegen var type) &body body)
327 "Evaluate BODY with VAR bound to a temporary variable name.
328
329 During BODY, VAR will be marked in-use; when BODY ends, VAR will be marked
9ec578d9 330 available for re-use."
1f1d88f5
MW
331 `(let ((,var (temporary-var ,codegen ,type)))
332 (unwind-protect
333 (progn ,@body)
334 (setf (var-in-use-p ,var) nil))))
335
336;;;--------------------------------------------------------------------------
337;;; Code generation idioms.
338
dea4d055 339(export 'deliver-expr)
1f1d88f5
MW
340(defun deliver-expr (codegen target expr)
341 "Emit code to deliver the value of EXPR to the TARGET.
342
343 The TARGET may be one of the following.
344
3109662a 345 * `:void', indicating that the value is to be discarded. The expression
1f1d88f5
MW
346 will still be evaluated.
347
3109662a
MW
348 * `:void-return', indicating that the value is to be discarded (as for
349 `:void') and furthermore a `return' from the current function should
350 be forced after computing the value.
1f1d88f5 351
3109662a
MW
352 * `:return', indicating that the value is to be returned from the
353 current function.
1f1d88f5
MW
354
355 * A variable name, indicating that the value is to be stored in the
356 variable.
357
3109662a
MW
358 In the cases of `:return', `:void' and `:void-return' targets, it is valid
359 for EXPR to be nil; this signifies that no computation needs to be
360 performed. Variable-name targets require an expression."
1f1d88f5
MW
361
362 (case target
363 (:return (emit-inst codegen (make-return-inst expr)))
364 (:void (when expr (emit-inst codegen (make-expr-inst expr))))
365 (:void-return (when expr (emit-inst codegen (make-expr-inst expr)))
366 (emit-inst codegen (make-return-inst nil)))
367 (t (emit-inst codegen (make-set-inst target expr)))))
368
dea4d055 369(export 'convert-stmts)
1f1d88f5 370(defun convert-stmts (codegen target type func)
3109662a 371 "Invoke FUNC to deliver a value to a non-`:return' target.
1f1d88f5 372
3109662a
MW
373 FUNC is a function which accepts a single argument, a non-`:return'
374 target, and generates statements which deliver a value (see
375 `deliver-expr') of the specified TYPE to this target. In general, the
376 generated code will have the form
1f1d88f5
MW
377
378 setup instructions...
3109662a 379 (deliver-expr CODEGEN TARGET (compute value...))
1f1d88f5
MW
380 cleanup instructions...
381
382 where the cleanup instructions are essential to the proper working of the
383 generated program.
384
3109662a
MW
385 The `convert-stmts' function will call FUNC to generate code, and arrange
386 that its value is correctly delivered to TARGET, regardless of what the
387 TARGET is -- i.e., it lifts the restriction to non-`:return' targets. It
388 does this by inventing a new temporary variable."
1f1d88f5
MW
389
390 (case target
391 (:return (with-temporary-var (codegen var type)
392 (funcall func var)
393 (deliver-expr codegen target var)))
394 (:void-return (funcall func :void)
395 (emit-inst codegen (make-return-inst nil)))
396 (t (funcall func target))))
397
398;;;----- That's all, folks --------------------------------------------------