chiark
/
gitweb
/
~mdw
/
sod
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
64a6094
)
src/method-aggregate.lisp: Let `custom' methods have weird return types.
author
Mark Wooding
<mdw@distorted.org.uk>
Tue, 17 Nov 2015 17:24:21 +0000
(17:24 +0000)
committer
Mark Wooding
<mdw@distorted.org.uk>
Tue, 17 Nov 2015 20:34:13 +0000
(20:34 +0000)
src/method-aggregate.lisp
patch
|
blob
|
blame
|
history
diff --git
a/src/method-aggregate.lisp
b/src/method-aggregate.lisp
index 37454f862743c3358919b45118f5e08ee2df13fa..9446820b1e189e3a99c749fbd02470757ceb7097 100644
(file)
--- a/
src/method-aggregate.lisp
+++ b/
src/method-aggregate.lisp
@@
-424,6
+424,7
@@
(defmethod aggregating-message-properties
((message aggregating-message) (combination (eql :custom)))
'(:retvar :id
:valvar :id
((message aggregating-message) (combination (eql :custom)))
'(:retvar :id
:valvar :id
+ :methty :type
:decls :fragment
:before :fragment
:first :fragment
:decls :fragment
:before :fragment
:first :fragment
@@
-431,16
+432,22
@@
(defmethod aggregating-message-properties
:after :fragment
:count :id))
:after :fragment
:count :id))
+(defmethod aggregating-message-method-return-type
+ ((message aggregating-message) (combination (eql :custom)))
+ (getf (sod-message-plist message) :methty
+ (c-type-subtype (sod-message-type message))))
+
(defmethod compute-aggregating-message-kernel
((message aggregating-message) (combination (eql :custom))
codegen target methods arg-names
(defmethod compute-aggregating-message-kernel
((message aggregating-message) (combination (eql :custom))
codegen target methods arg-names
- &key (retvar "sod_ret") (valvar "sod_val")
+ &key (retvar "sod_ret") (valvar "sod_val")
(methty nil methtyp)
decls before each (first each) after count)
(let* ((type (c-type-subtype (sod-message-type message)))
decls before each (first each) after count)
(let* ((type (c-type-subtype (sod-message-type message)))
- (not-void-p (not (eq type c-type-void))))
- (when not-void-p
- (ensure-var codegen retvar type)
- (ensure-var codegen valvar type))
+ (methty (if methtyp methty type)))
+ (unless (eq type c-type-void)
+ (ensure-var codegen retvar type))
+ (unless (eq methty c-type-void)
+ (ensure-var codegen valvar methty))
(when count
(ensure-var codegen count c-type-size-t (length methods)))
(when decls
(when count
(ensure-var codegen count c-type-size-t (length methods)))
(when decls
@@
-448,7
+455,8
@@
(defmethod compute-aggregating-message-kernel
(labels ((maybe-emit (fragment)
(when fragment (emit-inst codegen fragment)))
(invoke (method fragment)
(labels ((maybe-emit (fragment)
(when fragment (emit-inst codegen fragment)))
(invoke (method fragment)
- (invoke-method codegen (if not-void-p valvar :void)
+ (invoke-method codegen
+ (if (eq methty c-type-void) :void valvar)
arg-names method)
(maybe-emit fragment)))
(maybe-emit before)
arg-names method)
(maybe-emit fragment)))
(maybe-emit before)