Commit | Line | Data |
---|---|---|
e75eb63d MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Aggregating method combinations | |
4 | ;;; | |
5 | ;;; (c) 2015 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
e0808c47 | 10 | ;;; This file is part of the Sensible Object Design, an object system for C. |
e75eb63d 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 | ;;; Classes and protocol. | |
30 | ||
7f2917d2 MW |
31 | (export '(aggregating-message |
32 | sod-message-combination sod-message-kernel-function)) | |
e75eb63d MW |
33 | (defclass aggregating-message (simple-message) |
34 | ((combination :initarg :combination :type keyword | |
7f2917d2 | 35 | :reader sod-message-combination) |
88e0b18b | 36 | (plist :type list :accessor sod-message-plist) |
7f2917d2 | 37 | (kernel-function :type function :reader sod-message-kernel-function)) |
e75eb63d MW |
38 | (:documentation |
39 | "Message class for aggregating method combinations. | |
40 | ||
41 | An aggregating method combination invokes the primary methods in order, | |
42 | most-specific first, collecting their return values, and combining them | |
43 | together in some way to produce a result for the effective method as a | |
44 | whole. | |
45 | ||
46 | Mostly, this is done by initializing an accumulator to some appropriate | |
47 | value, updating it with the result of each primary method in turn, and | |
48 | finally returning some appropriate output function of it. The order is | |
49 | determined by the `:most-specific' property, which may have the value | |
50 | `:first' or `:last'. | |
51 | ||
52 | The `progn' method combination is implemented as a slightly weird special | |
53 | case of an aggregating method combination with a trivial state. More | |
54 | typical combinations are `:sum', `:product', `:min', `:max', `:and', and | |
55 | `:or'. Finally, there's a `custom' combination which uses user-supplied | |
56 | code fragments to stitch everything together.")) | |
57 | ||
58 | (export 'aggregating-message-properties) | |
59 | (defgeneric aggregating-message-properties (message combination) | |
60 | (:documentation | |
61 | "Return a description of the properties needed by the method COMBINATION. | |
62 | ||
63 | The description should be a plist of alternating property name and type | |
64 | keywords. The named properties will be looked up in the pset supplied at | |
65 | initialization time, and supplied to `compute-aggregating-message-kernel' | |
66 | as keyword arguments. Defaults can be supplied in method BVLs. | |
67 | ||
68 | The default is not to capture any property values. | |
69 | ||
70 | The reason for this is as not to retain the pset beyond message object | |
71 | initialization.") | |
72 | (:method (message combination) nil)) | |
73 | ||
74 | (export 'compute-aggregating-message-kernel) | |
75 | (defgeneric compute-aggregating-message-kernel | |
76 | (message combination codegen target methods arg-names &key) | |
77 | (:documentation | |
78 | "Determine how to aggregate the direct methods for an aggregating message. | |
79 | ||
80 | The return value is a function taking arguments (CODEGEN TARGET ARG-NAMES | |
81 | METHODS): it should emit, to CODEGEN, an appropriate effective-method | |
82 | kernel which invokes the listed direct METHODS, in the appropriate order, | |
83 | collects and aggregates their values, and delivers to TARGET the final | |
84 | result of the method kernel. | |
85 | ||
86 | The easy way to implement this method is to use the macro | |
87 | `define-aggregating-method-combination'.")) | |
88 | ||
89 | (export 'check-aggregating-message-type) | |
90 | (defgeneric check-aggregating-message-type (message combination type) | |
91 | (:documentation | |
92 | "Check that TYPE is an acceptable function TYPE for the COMBINATION. | |
93 | ||
94 | For example, `progn' messages must return `void', while `and' and `or' | |
95 | messages must return `int'.") | |
96 | (:method (message combination type) | |
97 | t)) | |
98 | ||
64a6094b MW |
99 | (defgeneric aggregating-message-method-return-type (message combination) |
100 | (:documentation | |
101 | "Return the primary method return type for this MESSAGE and COMBINATION.") | |
102 | (:method ((message aggregating-message) (combination t)) | |
103 | (c-type-subtype (sod-message-type message)))) | |
104 | ||
d7887906 | 105 | (export 'aggregating-effective-method) |
e75eb63d MW |
106 | (defclass aggregating-effective-method (simple-effective-method) () |
107 | (:documentation "Effective method counterpart to `aggregating-message'.")) | |
108 | ||
b07535d8 MW |
109 | (defgeneric aggregating-message-always-live-p (message combination) |
110 | (:documentation | |
111 | "Return whether the method combination can work without primary methods. | |
112 | ||
113 | Return non-nil if the corresponding effective method should be considered | |
114 | live even if it doesn't have any methods.") | |
115 | (:method ((message aggregating-message) (combination t)) nil)) | |
116 | ||
117 | (defmethod effective-method-live-p ((method aggregating-effective-method)) | |
118 | (or (let* ((message (effective-method-message method)) | |
119 | (comb (sod-message-combination message))) | |
120 | (aggregating-message-always-live-p message comb)) | |
121 | (call-next-method))) | |
122 | ||
e75eb63d MW |
123 | ;;;-------------------------------------------------------------------------- |
124 | ;;; Implementation. | |
125 | ||
126 | (defmethod check-message-type ((message aggregating-message) type) | |
127 | (with-slots (combination) message | |
128 | (check-aggregating-message-type message combination type))) | |
129 | ||
7f2917d2 | 130 | (defmethod sod-message-effective-method-class ((message aggregating-message)) |
e75eb63d MW |
131 | 'aggregating-effective-method) |
132 | ||
133 | (defmethod simple-method-body | |
134 | ((method aggregating-effective-method) codegen target) | |
135 | (let ((argument-names (effective-method-basic-argument-names method)) | |
136 | (primary-methods (effective-method-primary-methods method))) | |
7f2917d2 | 137 | (funcall (sod-message-kernel-function (effective-method-message method)) |
e75eb63d MW |
138 | codegen target argument-names primary-methods))) |
139 | ||
140 | (defmethod shared-initialize :before | |
141 | ((message aggregating-message) slot-names &key pset) | |
142 | (declare (ignore slot-names)) | |
88e0b18b | 143 | (with-slots (combination plist kernel-function) message |
e75eb63d MW |
144 | (let ((most-specific (get-property pset :most-specific :keyword :first)) |
145 | (comb (get-property pset :combination :keyword))) | |
146 | ||
147 | ;; Check that we've been given a method combination and make sure it | |
148 | ;; actually exists. | |
149 | (unless comb | |
a1985b3c | 150 | (error "The `combination' property is required")) |
e75eb63d MW |
151 | (unless (some (lambda (method) |
152 | (let* ((specs (method-specializers method)) | |
153 | (message-spec (car specs)) | |
154 | (combination-spec (cadr specs))) | |
155 | (and (typep message-spec 'class) | |
156 | (typep message message-spec) | |
157 | (typep combination-spec 'eql-specializer) | |
158 | (eq (eql-specializer-object combination-spec) | |
159 | comb)))) | |
160 | (generic-function-methods | |
161 | #'compute-aggregating-message-kernel)) | |
a1985b3c | 162 | (error "Unknown method combination `~(~A~)'" comb)) |
e75eb63d MW |
163 | (setf combination comb) |
164 | ||
165 | ;; Make sure the ordering is actually valid. | |
166 | (unless (member most-specific '(:first :last)) | |
a1985b3c | 167 | (error "The `most_specific' property must be `first' or `last'")) |
e75eb63d MW |
168 | |
169 | ;; Set up the function which will compute the kernel. | |
170 | (let ((magic (cons nil nil)) | |
171 | (keys nil)) | |
172 | ||
173 | ;; Collect the property values wanted by the method combination. | |
174 | (do ((want (aggregating-message-properties message comb) | |
175 | (cddr want))) | |
176 | ((endp want)) | |
177 | (let* ((name (car want)) | |
178 | (type (cadr want)) | |
179 | (prop (get-property pset name type magic))) | |
180 | (unless (eq prop magic) | |
181 | (setf keys (list* name prop keys))))) | |
88e0b18b | 182 | (setf plist keys) |
e75eb63d MW |
183 | |
184 | ;; Set the kernel function for later. | |
185 | (setf kernel-function | |
186 | (lambda (codegen target arg-names methods) | |
187 | (apply #'compute-aggregating-message-kernel | |
188 | message comb | |
189 | codegen target | |
190 | (ecase most-specific | |
191 | (:first methods) | |
192 | (:last (setf methods (reverse methods)))) | |
193 | arg-names | |
88e0b18b | 194 | plist))))))) |
e75eb63d | 195 | |
64a6094b MW |
196 | (defmethod check-method-type |
197 | ((method sod-method) (message aggregating-message) | |
198 | (type c-function-type)) | |
199 | (let ((wanted (aggregating-message-method-return-type | |
200 | message (sod-message-combination message))) | |
201 | (msgtype (sod-message-type message))) | |
b70cb6d8 MW |
202 | (check-method-return-type type wanted) |
203 | (check-method-argument-lists type msgtype))) | |
64a6094b | 204 | |
e75eb63d MW |
205 | ;;;-------------------------------------------------------------------------- |
206 | ;;; Utilities. | |
207 | ||
208 | (export 'define-aggregating-method-combination) | |
209 | (defmacro define-aggregating-method-combination | |
210 | (comb | |
211 | (vars | |
212 | &key (codegen (gensym "CODEGEN-")) | |
213 | (methods (gensym "METHODS-"))) | |
7b78999c | 214 | &key properties return-type |
e75eb63d | 215 | ((:around around-func) '#'funcall) |
b07535d8 | 216 | ((:empty empty-func) nil emptyp) |
e75eb63d MW |
217 | ((:first-method first-method-func) nil firstp) |
218 | ((:methods methods-func) '#'funcall)) | |
219 | "Utility macro for definining aggregating method combinations. | |
220 | ||
221 | The VARS are a list of variable names to be bound to temporary variable | |
222 | objects of the method's return type. Additional keyword arguments define | |
223 | variables names to be bound to other possibly interesting values: | |
224 | ||
225 | * CODEGEN is the `codegen' object passed at effective-method computation | |
226 | time; and | |
227 | ||
228 | * METHODS is the list of primary methods, in the order in which they | |
229 | should be invoked. Note that this list must be non-empty, since | |
230 | otherwise the method on `compute-effective-method-body' specialized to | |
231 | `simple-effective-method' will suppress the method entirely. | |
232 | ||
233 | The PROPERTIES, if specified, are a list of properties to be collected | |
234 | during message-object initialization; items in the list have the form | |
235 | ||
236 | (([KEYWORD] NAME) TYPE [DEFAULT] [SUPPLIEDP]) | |
237 | ||
238 | similar to a `&key' BVL entry, except for the additional TYPE entry. In | |
239 | particular, a symbolic NAME may be written in place of a singleton list. | |
240 | The KEYWORD names the property as it should be looked up in the pset, | |
241 | while the NAME names a variable to which the property value or default is | |
242 | bound. | |
243 | ||
244 | All of these variables, and the VARS, are available in the functions | |
245 | described below. | |
246 | ||
7b78999c MW |
247 | If a RETURN-TYPE is given, it's a C-type S-expression: a method is defined |
248 | on `check-aggregating-message-type' to check the that the message's return | |
249 | type matches RETURN-TYPE. | |
250 | ||
b07535d8 MW |
251 | If an EMPTY function is given, then (a) it's OK if there are no primary |
252 | methods, because (b) the EMPTY function is called to set the return | |
253 | value variable in this case. Note that EMPTY is only called when there | |
254 | are no primary methods. | |
255 | ||
e75eb63d MW |
256 | The AROUND, FIRST-METHOD, and METHODS are function designators (probably |
257 | `lambda' forms) providing pieces of the aggregating behaviour. | |
258 | ||
259 | The AROUND function is called first, with a single argument BODY, though | |
260 | the variables above are also in scope. It is expected to emit code to | |
261 | CODEGEN which invokes the METHODS in the appropriate order, and arranges | |
262 | to store the aggregated return value in the first of the VARS. | |
263 | ||
264 | It may call BODY as a function in order to assist with this; let ARGS be | |
265 | the list of arguments supplied to it. The default behaviour is to call | |
266 | BODY with no arguments. The BODY function first calls FIRST-METHOD, | |
267 | passing it as arguments a function INVOKE and the ARGS which were passed | |
268 | to BODY, and then calls METHODS once for each remaining method, again | |
269 | passing an INVOKE function and the ARGS. If FIRST-METHOD is not | |
270 | specified, then the METHODS function is used for all of the methods. If | |
271 | METHODS is not specified, then the behaviour is simply to call INVOKE | |
272 | immediately. (See the definition of the `:progn' method combination.) | |
273 | ||
274 | Calling (funcall INVOKE [TARGET]) emits instructions to CODEGEN to call | |
275 | the appropriate direct method and deliver its return value to TARGET, | |
276 | which defaults to `:void'." | |
277 | ||
7b78999c | 278 | (with-gensyms (type msg combvar target arg-names args want-type |
e75eb63d | 279 | meth targ func call-methfunc |
b07535d8 | 280 | aroundfunc fmethfunc methfunc bodyfunc) |
e75eb63d MW |
281 | `(progn |
282 | ||
283 | ;; If properties are listed, arrange for them to be collected. | |
284 | ,@(and properties | |
285 | `((defmethod aggregating-message-properties | |
286 | ((,msg aggregating-message) (,combvar (eql ',comb))) | |
287 | ',(mapcan (lambda (prop) | |
288 | (list (let* ((name (car prop)) | |
289 | (names (if (listp name) name | |
290 | (list name)))) | |
291 | (if (cddr names) (car names) | |
292 | (intern (car names) :keyword))) | |
293 | (cadr prop))) | |
294 | properties)))) | |
295 | ||
7b78999c MW |
296 | ;; If a particular return type is wanted, check that. |
297 | ,@(and return-type | |
298 | `((defmethod check-aggregating-message-type | |
299 | ((,msg aggregating-message) | |
300 | (,combvar (eql ',comb)) | |
301 | (,type c-function-type)) | |
302 | (let ((,want-type (c-type ,return-type))) | |
303 | (unless (c-type-equal-p (c-type-subtype ,type) | |
304 | ,want-type) | |
305 | (error "Messages with `~(~A~)' combination ~ | |
a1985b3c | 306 | must return `~A'" |
7b78999c MW |
307 | ,combvar ,want-type))) |
308 | (call-next-method)))) | |
309 | ||
b07535d8 MW |
310 | ;; If there is an EMPTY function then the effective method is always |
311 | ;; live. | |
312 | ,@(and emptyp | |
313 | `((defmethod aggregating-message-always-live-p | |
314 | ((,msg aggregating-message) | |
315 | (,combvar (eql ',comb))) | |
316 | t))) | |
317 | ||
e75eb63d MW |
318 | ;; Define the main kernel-compuation method. |
319 | (defmethod compute-aggregating-message-kernel | |
320 | ((,msg aggregating-message) (,combvar (eql ',comb)) | |
321 | ,codegen ,target ,methods ,arg-names | |
322 | &key ,@(mapcar (lambda (prop) (cons (car prop) (cddr prop))) | |
323 | properties)) | |
324 | (declare (ignore ,combvar)) | |
325 | ||
326 | ;; Declare the necessary variables and give names to the functions | |
327 | ;; supplied by the caller. | |
328 | (let* (,@(and vars | |
b07535d8 MW |
329 | `((,type (c-type-subtype (sod-message-type ,msg))) |
330 | (,(car vars) (temporary-var ,codegen ,type)))) | |
e75eb63d | 331 | ,@(mapcar (lambda (var) |
b07535d8 MW |
332 | (list var `(and ,methods |
333 | (temporary-var ,codegen ,type)))) | |
334 | (cdr vars)) | |
e75eb63d MW |
335 | (,aroundfunc ,around-func) |
336 | (,methfunc ,methods-func) | |
337 | (,fmethfunc ,(if firstp first-method-func methfunc))) | |
338 | ||
b07535d8 MW |
339 | (flet ((,bodyfunc () |
340 | (funcall ,aroundfunc | |
341 | (lambda (&rest ,args) | |
342 | (flet ((,call-methfunc (,func ,meth) | |
343 | ;; Call FUNC, passing it an INVOKE | |
344 | ;; function which will generate a | |
345 | ;; call to METH. | |
346 | (apply ,func | |
347 | (lambda | |
348 | (&optional (,targ :void)) | |
349 | (invoke-method ,codegen | |
350 | ,targ | |
351 | ,arg-names | |
352 | ,meth)) | |
353 | ,args))) | |
354 | ||
355 | ;; The first method might need special | |
356 | ;; handling. | |
357 | (,call-methfunc ,fmethfunc (car ,methods)) | |
358 | ||
359 | ;; Call the remaining methods in the right | |
360 | ;; order. | |
361 | (dolist (,meth (cdr ,methods)) | |
362 | (,call-methfunc ,methfunc ,meth))))))) | |
363 | ||
364 | ;; Arrange to release the temporaries when we're finished with | |
365 | ;; them. | |
366 | (unwind-protect | |
367 | (progn | |
368 | ||
369 | ;; If there are no direct methods, then just do the | |
370 | ;; empty-effective-method thing to set the return | |
371 | ;; variable. Otherwise, wrap AROUND round the main body. | |
372 | ,(if emptyp | |
373 | `(if (null ,methods) | |
374 | (funcall ,empty-func) | |
375 | (,bodyfunc)) | |
376 | `(,bodyfunc)) | |
e75eb63d MW |
377 | |
378 | ;; Outside the AROUND function now, deliver the final | |
379 | ;; result to the right place. | |
380 | (deliver-expr ,codegen ,target ,(car vars))) | |
381 | ||
b07535d8 MW |
382 | ;; Finally, release the temporary variables. |
383 | ,@(mapcar (lambda (var) | |
384 | `(when ,var (setf (var-in-use-p ,var) nil))) | |
385 | vars))))) | |
e75eb63d MW |
386 | |
387 | ',comb))) | |
388 | ||
389 | ;;;-------------------------------------------------------------------------- | |
390 | ;;; Fixed aggregating method combinations. | |
391 | ||
7b78999c | 392 | (define-aggregating-method-combination :progn (nil) |
b07535d8 MW |
393 | :return-type void |
394 | :empty (lambda () nil)) | |
e75eb63d MW |
395 | |
396 | (define-aggregating-method-combination :sum ((acc val) :codegen codegen) | |
b07535d8 | 397 | :empty (lambda () (emit-inst codegen (make-set-inst acc 0))) |
e75eb63d MW |
398 | :first-method (lambda (invoke) |
399 | (funcall invoke val) | |
400 | (emit-inst codegen (make-set-inst acc val))) | |
401 | :methods (lambda (invoke) | |
402 | (funcall invoke val) | |
403 | (emit-inst codegen (make-update-inst acc #\+ val)))) | |
404 | ||
405 | (define-aggregating-method-combination :product ((acc val) :codegen codegen) | |
b07535d8 | 406 | :empty (lambda () (emit-inst codegen (make-set-inst acc 1))) |
e75eb63d MW |
407 | :first-method (lambda (invoke) |
408 | (funcall invoke val) | |
409 | (emit-inst codegen (make-set-inst acc val))) | |
410 | :methods (lambda (invoke) | |
411 | (funcall invoke val) | |
412 | (emit-inst codegen (make-update-inst acc #\* val)))) | |
413 | ||
414 | (define-aggregating-method-combination :min ((acc val) :codegen codegen) | |
415 | :first-method (lambda (invoke) | |
416 | (funcall invoke val) | |
417 | (emit-inst codegen (make-set-inst acc val))) | |
418 | :methods (lambda (invoke) | |
419 | (funcall invoke val) | |
420 | (emit-inst codegen (make-if-inst (format nil "~A > ~A" acc val) | |
167524b5 | 421 | (make-set-inst acc val))))) |
e75eb63d MW |
422 | |
423 | (define-aggregating-method-combination :max ((acc val) :codegen codegen) | |
424 | :first-method (lambda (invoke) | |
425 | (funcall invoke val) | |
426 | (emit-inst codegen (make-set-inst acc val))) | |
427 | :methods (lambda (invoke) | |
428 | (funcall invoke val) | |
429 | (emit-inst codegen (make-if-inst (format nil "~A < ~A" acc val) | |
167524b5 | 430 | (make-set-inst acc val))))) |
e75eb63d | 431 | |
ad303446 | 432 | (define-aggregating-method-combination :and ((ret) :codegen codegen) |
b07535d8 | 433 | :empty (lambda () (emit-inst codegen (make-set-inst ret 1))) |
e75eb63d MW |
434 | :around (lambda (body) |
435 | (codegen-push codegen) | |
e75eb63d | 436 | (funcall body) |
e75eb63d MW |
437 | (emit-inst codegen |
438 | (make-do-while-inst (codegen-pop-block codegen) 0))) | |
439 | :methods (lambda (invoke) | |
ad303446 MW |
440 | (funcall invoke ret) |
441 | (emit-inst codegen (make-if-inst (format nil "!~A" ret) | |
167524b5 | 442 | (make-break-inst))))) |
e75eb63d | 443 | |
ad303446 | 444 | (define-aggregating-method-combination :or ((ret) :codegen codegen) |
b07535d8 | 445 | :empty (lambda () (emit-inst codegen (make-set-inst ret 0))) |
e75eb63d MW |
446 | :around (lambda (body) |
447 | (codegen-push codegen) | |
e75eb63d | 448 | (funcall body) |
e75eb63d MW |
449 | (emit-inst codegen |
450 | (make-do-while-inst (codegen-pop-block codegen) 0))) | |
451 | :methods (lambda (invoke) | |
ad303446 | 452 | (funcall invoke ret) |
167524b5 | 453 | (emit-inst codegen (make-if-inst ret (make-break-inst))))) |
e75eb63d MW |
454 | |
455 | ;;;-------------------------------------------------------------------------- | |
456 | ;;; A customizable aggregating method combination. | |
457 | ||
458 | (defmethod aggregating-message-properties | |
459 | ((message aggregating-message) (combination (eql :custom))) | |
460 | '(:retvar :id | |
461 | :valvar :id | |
e6245830 | 462 | :methty :type |
b07535d8 | 463 | :empty :fragment |
e75eb63d MW |
464 | :decls :fragment |
465 | :before :fragment | |
466 | :first :fragment | |
467 | :each :fragment | |
05170d7a MW |
468 | :after :fragment |
469 | :count :id)) | |
e75eb63d | 470 | |
e6245830 MW |
471 | (defmethod aggregating-message-method-return-type |
472 | ((message aggregating-message) (combination (eql :custom))) | |
473 | (getf (sod-message-plist message) :methty | |
474 | (c-type-subtype (sod-message-type message)))) | |
475 | ||
b07535d8 MW |
476 | (defmethod aggregating-message-always-live-p |
477 | ((message aggregating-message) (combination (eql :custom))) | |
478 | (getf (sod-message-plist message) :empty)) | |
479 | ||
e75eb63d MW |
480 | (defmethod compute-aggregating-message-kernel |
481 | ((message aggregating-message) (combination (eql :custom)) | |
482 | codegen target methods arg-names | |
e6245830 | 483 | &key (retvar "sod_ret") (valvar "sod_val") (methty nil methtyp) |
b07535d8 | 484 | empty decls before each (first each) after count) |
e75eb63d | 485 | (let* ((type (c-type-subtype (sod-message-type message))) |
e6245830 MW |
486 | (methty (if methtyp methty type))) |
487 | (unless (eq type c-type-void) | |
488 | (ensure-var codegen retvar type)) | |
b07535d8 MW |
489 | (unless (or (null methods) |
490 | (eq methty c-type-void)) | |
e6245830 | 491 | (ensure-var codegen valvar methty)) |
b07535d8 | 492 | (when (and methods count) |
d84f7ee7 | 493 | (ensure-var codegen count c-type-size-t (length methods))) |
b07535d8 | 494 | (when (and methods decls) |
e75eb63d MW |
495 | (emit-decl codegen decls)) |
496 | (labels ((maybe-emit (fragment) | |
497 | (when fragment (emit-inst codegen fragment))) | |
498 | (invoke (method fragment) | |
e6245830 MW |
499 | (invoke-method codegen |
500 | (if (eq methty c-type-void) :void valvar) | |
e75eb63d MW |
501 | arg-names method) |
502 | (maybe-emit fragment))) | |
b07535d8 MW |
503 | (cond ((and empty (null methods)) |
504 | (emit-inst codegen empty)) | |
505 | (t | |
506 | (maybe-emit before) | |
507 | (invoke (car methods) first) | |
508 | (dolist (method (cdr methods)) (invoke method each)) | |
509 | (maybe-emit after))) | |
e75eb63d MW |
510 | (deliver-expr codegen target retvar)))) |
511 | ||
512 | ;;;----- That's all, folks -------------------------------------------------- |