(vars
&key (codegen (gensym "CODEGEN-"))
(methods (gensym "METHODS-")))
- &key properties
+ &key properties return-type
((:around around-func) '#'funcall)
((:first-method first-method-func) nil firstp)
((:methods methods-func) '#'funcall))
All of these variables, and the VARS, are available in the functions
described below.
+ If a RETURN-TYPE is given, it's a C-type S-expression: a method is defined
+ on `check-aggregating-message-type' to check the that the message's return
+ type matches RETURN-TYPE.
+
The AROUND, FIRST-METHOD, and METHODS are function designators (probably
`lambda' forms) providing pieces of the aggregating behaviour.
the appropriate direct method and deliver its return value to TARGET,
which defaults to `:void'."
- (with-gensyms (type msg combvar target arg-names args
+ (with-gensyms (type msg combvar target arg-names args want-type
meth targ func call-methfunc
aroundfunc fmethfunc methfunc)
`(progn
(cadr prop)))
properties))))
+ ;; If a particular return type is wanted, check that.
+ ,@(and return-type
+ `((defmethod check-aggregating-message-type
+ ((,msg aggregating-message)
+ (,combvar (eql ',comb))
+ (,type c-function-type))
+ (let ((,want-type (c-type ,return-type)))
+ (unless (c-type-equal-p (c-type-subtype ,type)
+ ,want-type)
+ (error "Messages with `~(~A~)' combination ~
+ must return `~A'."
+ ,combvar ,want-type)))
+ (call-next-method))))
+
;; Define the main kernel-compuation method.
(defmethod compute-aggregating-message-kernel
((,msg aggregating-message) (,combvar (eql ',comb))
;;;--------------------------------------------------------------------------
;;; Fixed aggregating method combinations.
-(flet ((check (comb want type)
- (unless (eq (c-type-subtype type) want)
- (error "Messages with `~A' combination must return `~A'."
- (string-downcase comb) want))))
- (defmethod check-aggregating-message-type
- ((message aggregating-message)
- (combination (eql :progn))
- (type c-function-type))
- (check combination c-type-void type)
- (call-next-method))
- (defmethod check-aggregating-message-type
- ((message aggregating-message)
- (combination (eql :and))
- (type c-function-type))
- (check combination c-type-int type)
- (call-next-method))
- (defmethod check-aggregating-message-type
- ((message aggregating-message)
- (combination (eql :or))
- (type c-function-type))
- (check combination c-type-int type)
- (call-next-method)))
-
-(define-aggregating-method-combination :progn (nil))
+(define-aggregating-method-combination :progn (nil)
+ :return-type void)
(define-aggregating-method-combination :sum ((acc val) :codegen codegen)
:first-method (lambda (invoke)
(make-set-inst acc val) nil))))
(define-aggregating-method-combination :and ((ret val) :codegen codegen)
+ :return-type int
:around (lambda (body)
(codegen-push codegen)
(deliver-expr codegen ret 0)
(make-break-inst) nil))))
(define-aggregating-method-combination :or ((ret val) :codegen codegen)
+ :return-type int
:around (lambda (body)
(codegen-push codegen)
(deliver-expr codegen ret 1)