[cffi-devel] setf-expander of FOREIGN-SLOT-VALUE

The setf-expansion for nested FOREIGN-SLOT-VALUE calls ist not quite correct: CFFI> (macroexpand '(setf (foreign-slot-value (foreign-slot-value ptr `struct1 'slot1) `struct2 'slot2) val)) (LET* () (MULTIPLE-VALUE-BIND (#:G1997) VAL (PROGN (FOREIGN-SLOT-SET #:G1997 (FOREIGN-SLOT-VALUE PTR) 'STRUCT2 'SLOT2) #:G1997))) T ^^^^^^^^^^^^^^^^^^^^^^^^ Defining the expander like (define-setf-expander foreign-slot-value (ptr type slot-name &environment env) (multiple-value-bind (temps vals stores store-form access-form) (get-setf-expansion ptr env) (declare (ignore store-form stores)) (let ((type-tmp (gensym "TYPE-")) (slot-name-tmp (gensym "SLOT-NAME-")) (store (gensym "STORE-"))) (values `(,type-tmp ,slot-name-tmp ,@temps) `(,type ,slot-name ,@vals) `(,store) `(progn (foreign-slot-set ,store ,access-form ,type-tmp ,slot-name-tmp) ,store) `(foreign-slot-value ,access-form ,type-tmp ,slot-name-tmp))))) should do the job a bit better, though it might be optimized in some way (this is my first try to define a setf expander). Btw. the manual contains an example use of FOREIGN-SLOT-VALUE with the simplified syntax (foreign-slot-value ptr 'struct 'slot-1 'slot-2) I think CFFI has all the informations at hand to handle this, so will it be implemented one day? Regards, Marco Gidde

At least two more expanders should also be corrected: (define-setf-expander mem-ref (ptr type &optional (offset 0) &environment env) "SETF expander for MEM-REF that doesn't rebind TYPE. This is necessary for the compiler macro on MEM-SET to be able to open-code (SETF MEM-REF) forms." (multiple-value-bind (temps vals stores store-form access-form) (get-setf-expansion ptr env) (declare (ignore store-form stores)) (let ((type-tmp (gensym "TYPE-")) (offset-tmp (gensym "OFFSET-")) (store (gensym "STORE-"))) (values `(,type-tmp ,offset-tmp ,@temps) `(,type ,offset ,@vals) `(,store) `(progn (mem-set ,store ,access-form ,type-tmp ,offset-tmp) ,store) `(mem-ref ,access-form ,type-tmp ,offset-tmp))))) (define-setf-expander mem-aref (ptr type &optional (index 0) &environment env) "SETF expander for MEM-AREF." (multiple-value-bind (temps vals stores store-form access-form) (get-setf-expansion ptr env) (declare (ignore store-form stores)) (let ((type-tmp (gensym "TYPE-")) (index-tmp (gensym "INDEX-")) (store (gensym "STORE-"))) (values `(,type-tmp ,index-tmp ,@temps) `(,type ,index ,@vals) `(,store) `(progn ,(if (constantp type) (if (constantp index) `(mem-set ,store ,access-form ,type-tmp ,(* (eval index) (foreign-type-size (eval type)))) `(mem-set ,store ,access-form ,type-tmp (* ,index-tmp ,(foreign-type-size (eval type))))) `(mem-set ,store ,access-form ,type-tmp (* ,index-tmp (foreign-type-size ,type-tmp)))) ,store) `(mem-aref ,access-form ,type-tmp ,index-tmp))))) I guess the implementation dependend setf-expanders for %mem-ref should also be adapted. It's quite easy: instead of the first example in the CLHS take second ;-) Regards, Marco Gidde

Marco Gidde <marco.gidde@tiscali.de> writes:
At least two more expanders should also be corrected:
(define-setf-expander mem-ref (ptr type &optional (offset 0) &environment env) "SETF expander for MEM-REF that doesn't rebind TYPE. This is necessary for the compiler macro on MEM-SET to be able to open-code (SETF MEM-REF) forms."
Yes, thanks for the bug report! Things get a bit messier than your fix though because, like that docstring above says, we don't want to rebind the type (when it's constant) otherwise the compiler macro on MEM-SET won't kick in. The same applies for all the other setf expanders.
I guess the implementation dependend setf-expanders for %mem-ref should also be adapted. It's quite easy: instead of the first example in the CLHS take second ;-)
Yeah, that second example was most helpful. :-) Anyway, this should be fixed now and I added a couple of regression tests too. Thanks again. Changelog follows (with an unrelated tweak to load-foreign-library to accept pathnames, as pointed out by Kenny). Sun Sep 25 20:36:02 WEST 2005 Luis Oliveira <loliveira@common-lisp.net> * Fixed bogus getters in setf expanders. Bug report and initial bugfixes courtesy of Marco Gidde. - fixed setf expanders for mem-ref, mem-aref, and foreign-slot-value. (also mem-aref was evaluating the type argument twice) - likewise fixed cmucl's, openmcl's and sbcl's setf expanders for %mem-ref. - regression tests: mem-aref.eval-type-x2, mem-ref.nested, mem-aref.nested and struct.nested-setf. Sun Sep 25 05:42:42 WEST 2005 Luis Oliveira <loliveira@common-lisp.net> * load-foreign-library - extend load-foreign-library to accept a pathname as an argument. - change tests/bindings.lisp to pass a pathname. -- Luis Oliveira luismbo (@) gmail (.) com Equipa Portuguesa do Translation Project http://www.iro.umontreal.ca/translation/registry.cgi?team=pt

Luis Oliveira <luismbo@gmail.com> writes:
Things get a bit messier than your fix though because, like that docstring above says, we don't want to rebind the type (when it's constant) otherwise the compiler macro on MEM-SET won't kick in. The same applies for all the other setf expanders.
I was sure I missed something, but I just wanted to compile a simple example instead of diving too deep into CFFI and do some premature optimizations :-) Thanks for the fix! -- Marco Gidde

Marco Gidde <marco.gidde@tiscali.de> writes:
The setf-expansion for nested FOREIGN-SLOT-VALUE calls ist not quite correct: [...] should do the job a bit better, though it might be optimized in some way (this is my first try to define a setf expander).
Thanks, I'll have a look at this tomorrow. I need to read define-setf-expander's docs, heh. /My/ first try to define a setf expander was mem-aref's and that was just by looking at mem-ref's expander.
Btw. the manual contains an example use of FOREIGN-SLOT-VALUE with the simplified syntax
(foreign-slot-value ptr 'struct 'slot-1 'slot-2)
I think CFFI has all the informations at hand to handle this, so will it be implemented one day?
Yes, one day. :-) -- Luis Oliveira luismbo (@) gmail (.) com Equipa Portuguesa do Translation Project http://www.iro.umontreal.ca/translation/registry.cgi?team=pt
participants (2)
-
Luis Oliveira
-
Marco Gidde