X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/e624583049d699c769e6c1cc31501d8a92292682..a1985b3cf0ca42f573b8599ec50a0f162a26c314:/src/method-aggregate.lisp?ds=inline diff --git a/src/method-aggregate.lisp b/src/method-aggregate.lisp index 9446820..eeea9df 100644 --- a/src/method-aggregate.lisp +++ b/src/method-aggregate.lisp @@ -133,7 +133,7 @@ ;; Check that we've been given a method combination and make sure it ;; actually exists. (unless comb - (error "The `combination' property is required.")) + (error "The `combination' property is required")) (unless (some (lambda (method) (let* ((specs (method-specializers method)) (message-spec (car specs)) @@ -145,12 +145,12 @@ comb)))) (generic-function-methods #'compute-aggregating-message-kernel)) - (error "Unknown method combination `~(~A~)'." comb)) + (error "Unknown method combination `~(~A~)'" comb)) (setf combination comb) ;; Make sure the ordering is actually valid. (unless (member most-specific '(:first :last)) - (error "The `most_specific' property must be `first' or `last'.")) + (error "The `most_specific' property must be `first' or `last'")) ;; Set up the function which will compute the kernel. (let ((magic (cons nil nil)) @@ -185,12 +185,8 @@ (let ((wanted (aggregating-message-method-return-type message (sod-message-combination message))) (msgtype (sod-message-type message))) - (unless (c-type-equal-p (c-type-subtype type) wanted) - (error "Method return type ~A doesn't match message ~A" - (c-type-subtype msgtype) (c-type-subtype type))) - (unless (argument-lists-compatible-p (c-function-arguments msgtype) - (c-function-arguments type)) - (error "Method arguments ~A don't match message ~A" type msgtype)))) + (check-method-return-type type wanted) + (check-method-argument-lists type msgtype))) ;;;-------------------------------------------------------------------------- ;;; Utilities. @@ -287,7 +283,7 @@ (unless (c-type-equal-p (c-type-subtype ,type) ,want-type) (error "Messages with `~(~A~)' combination ~ - must return `~A'." + must return `~A'" ,combvar ,want-type))) (call-next-method)))) @@ -379,7 +375,7 @@ :methods (lambda (invoke) (funcall invoke val) (emit-inst codegen (make-if-inst (format nil "~A > ~A" acc val) - (make-set-inst acc val) nil)))) + (make-set-inst acc val))))) (define-aggregating-method-combination :max ((acc val) :codegen codegen) :first-method (lambda (invoke) @@ -388,34 +384,28 @@ :methods (lambda (invoke) (funcall invoke val) (emit-inst codegen (make-if-inst (format nil "~A < ~A" acc val) - (make-set-inst acc val) nil)))) + (make-set-inst acc val))))) -(define-aggregating-method-combination :and ((ret val) :codegen codegen) - :return-type int +(define-aggregating-method-combination :and ((ret) :codegen codegen) :around (lambda (body) (codegen-push codegen) - (deliver-expr codegen ret 0) (funcall body) - (deliver-expr codegen ret 1) (emit-inst codegen (make-do-while-inst (codegen-pop-block codegen) 0))) :methods (lambda (invoke) - (funcall invoke val) - (emit-inst codegen (make-if-inst (format nil "!~A" val) - (make-break-inst) nil)))) + (funcall invoke ret) + (emit-inst codegen (make-if-inst (format nil "!~A" ret) + (make-break-inst))))) -(define-aggregating-method-combination :or ((ret val) :codegen codegen) - :return-type int +(define-aggregating-method-combination :or ((ret) :codegen codegen) :around (lambda (body) (codegen-push codegen) - (deliver-expr codegen ret 1) (funcall body) - (deliver-expr codegen ret 0) (emit-inst codegen (make-do-while-inst (codegen-pop-block codegen) 0))) :methods (lambda (invoke) - (funcall invoke val) - (emit-inst codegen (make-if-inst val (make-break-inst) nil)))) + (funcall invoke ret) + (emit-inst codegen (make-if-inst ret (make-break-inst))))) ;;;-------------------------------------------------------------------------- ;;; A customizable aggregating method combination.