Hello,
I noticed a problem using ECL and custom SETF expanders which does not
occur when using SBCL.
When compiling a file which uses a custom SETF expander, invoking the
SETF function inside functions compiled at the same time work fine.
However, at the REPL, or in interpreted code, an error occurs that the
SETF function doesn't exist.
I here attach:
- The test case (setf-test-1.lisp)
- (setf-test-1.txt) ECL test compiling the file, loading it, testing
that TEST works and then erroring at REPL SETF
- (setf-test-2.txt) ECL test loading the file without compilation,
showing that TEST fails as well as REPL SETF test
- (setf-test-3.txt) SBCL test compiling the file, loading it, testing
that TEST works as well as REPL SETF, where both do
- (setf-test-4.txt) SBCL test loading uncompiled file, testing that
TEST works as well as REPL SETF (where both also work).
- (setf-test-5.txt) ECL and SBCL comparision if inverting the order of
DEFUN and DEFINE-SETF-EXPANDER (in which case SBCL behaves the same
and ECL SETF function finally works, but it doesn't seem to be using
the custom macro anymore).
Another interesting difference is that if I define the SETF expander
before the get/set accessor DEFUNs, in SBCL the same behaviour is
observed, where GET-SETF-EXPANSION shows the unexpanded macros. With
ECL, the code works if I do this inversion, but the GET-SETF-EXPANSION
then seems to show the standard expander without using the custom macro.
A reason wich made me try this is that it should be possible by being
careful to define global macros used by a SETF expansion such that it
also be possible to define lexically scoped custom SETF expansions by
overriding the global macros used in the expansion by MACROLET. This
for instance could be used in performance-critical code to have a
WITH-INLINE-ACCESSORS type macro such that SETF expansion in a block of
code produces inline C access, etc.
Of course an alternative yet less general approach could be using
inline accessor functions, but it appears that despite using DECLAIM
INLINE directives explicit function calls are always occuring. In any
case, it can be a nice feature to allow dynamically scoped custom SETF
expansions, especially with the power this provides using custom macros.
Thanks,
--
Matt
(defmacro define-global-setf-expander (accessor)
(let ((getter-macro (intern
(format nil "~A-SETF-GETTER-MACRO" accessor)))
(setter-macro (intern
(format nil "~A-SETF-SETTER-MACRO" accessor))))
`(progn
(defmacro ,setter-macro (obj val)
`(funcall #'(setf ,',accessor) ,obj ,val))
(defmacro ,getter-macro (obj)
`(,',accessor ,obj))
(define-setf-expander ,accessor (object)
(let ((store (gensym))
(targ (gensym)))
(values (list store)
(list object)
(list targ)
(list ',setter-macro targ store)
(list ',getter-macro targ)))))))
(defparameter *foo* '(0))
(defun foo-val (o)
(car o))
(defun (setf foo-val) (v o)
(setf (car o) v))
(define-global-setf-expander foo-val)
(defun test ()
(setf (foo-val *foo*) 1))
behemoth$ /usr/local/ecl/bin/ecl
;;; Loading #P"/usr/local/ecl/lib/ecl-10.7.1/asdf.fas"
;;; Loading #P"/usr/local/ecl/lib/ecl-10.7.1/cmp.fas"
ECL (Embeddable Common-Lisp) 10.7.1
Copyright (C) 1984 Taiichi Yuasa and Masami Hagiya
Copyright (C) 1993 Giuseppe Attardi
Copyright (C) 2000 Juan J. Garcia-Ripoll
ECL is free software, and you are welcome to redistribute it
under certain conditions; see file 'Copyright' for details.
Type :h for Help.
Top level in: #<process SI:TOP-LEVEL 0810afc0>.
> (compile-file "/tmp/setf-test.lisp")
;;;
;;; Compiling /tmp/setf-test.lisp.
;;; OPTIMIZE levels: Safety=2, Space=0, Speed=3, Debug=0
;;;
;;; Compiling (DEFMACRO DEFINE-GLOBAL-SETF-EXPANDER ...).
;;; Compiling (DEFPARAMETER *FOO* ...).
;;; Compiling (DEFUN FOO-VAL ...).
;;; Compiling (DEFUN (SETF FOO-VAL) ...).
;;; Compiling (DEFINE-GLOBAL-SETF-EXPANDER FOO-VAL).
;;; Compiling (DEFINE-GLOBAL-SETF-EXPANDER FOO-VAL).
;;; Compiling (DEFUN TEST ...).
;;; End of Pass 1.
;;; Emitting code for DEFINE-GLOBAL-SETF-EXPANDER.
;;; Emitting code for FOO-VAL.
;;; Emitting code for (SETF FOO-VAL).
;;; Emitting code for FOO-VAL-SETF-SETTER-MACRO.
;;; Emitting code for FOO-VAL-SETF-GETTER-MACRO.
;;; Emitting code for FOO-VAL.
;;; Emitting code for TEST.
;;; Note:
;;; Invoking external command:
;;; gcc "-I/usr/local/ecl/include/" -march=i686 -O2 -g -fPIC -Dnetbsd -O2
-w -c "/tmp/setf-test.c" -o "/tmp/setf-test.o"
;;;
;;; Note:
;;; Invoking external command:
;;; gcc -o "/tmp/setf-test.fas" -L"/usr/local/ecl/lib/" "/tmp/setf-test.o"
"-Wl,--rpath,/usr/local/ecl/lib/" -shared -g -g -lecl -lpthread -lm
;;;
;;; Finished compiling /tmp/setf-test.lisp.
;;;
#P"/tmp/setf-test.fas"
NIL
NIL
> (load "/tmp/setf-test")
;;; Loading #P"/tmp/setf-test.fas"
#P"/tmp/setf-test.fas"
> (test
)
1
> *foo*
(1)
> (foo-val *foo*)
1
> (setf (foo-val *foo*) 2)
The function (SETF FOO-VAL) is undefined.
Available restarts:
1. (RESTART-TOPLEVEL) Go back to Top-Level REPL.
Broken at SI:BYTECODES. [Evaluation of: (SETF (FOO-VAL *FOO*) 2)] In: #<process
SI:TOP-LEVEL 0810afc0>.
>> :q
Top level in: #<process SI:TOP-LEVEL 0810afc0>.
> (get-setf-expansion '(foo-val *foo*))
(#:G112)
(*FOO*)
(#:G113)
(FOO-VAL-SETF-SETTER-MACRO #:G113 #:G112)
(FOO-VAL-SETF-GETTER-MACRO #:G113)
> (macroexpand '(foo-val-setf-setter-macro o v))
(FUNCALL #'(SETF FOO-VAL) O V)
T
> (apropos 'foo-val)
FOO-VAL Function
FOO-VAL-SETF-GETTER-MACRO Macro
FOO-VAL-SETF-SETTER-MACRO Macro
> (describe 'foo-val)
FOO-VAL - internal symbol in COMMON-LISP-USER package
-----------------------------------------------------------------------------
FOO-VAL [Function]
-----------------------------------------------------------------------------
FOO-VAL [Setf]
-----------------------------------------------------------------------------
>
behemoth$ /usr/local/ecl/bin/ecl
;;; Loading #P"/usr/local/ecl/lib/ecl-10.7.1/asdf.fas"
;;; Loading #P"/usr/local/ecl/lib/ecl-10.7.1/cmp.fas"
ECL (Embeddable Common-Lisp) 10.7.1
Copyright (C) 1984 Taiichi Yuasa and Masami Hagiya
Copyright (C) 1993 Giuseppe Attardi
Copyright (C) 2000 Juan J. Garcia-Ripoll
ECL is free software, and you are welcome to redistribute it
under certain conditions; see file 'Copyright' for details.
Type :h for Help.
Top level in: #<process SI:TOP-LEVEL 0810afc0>.
> (load "/tmp/setf-test.lisp")
;;; Loading "/tmp/setf-test.lisp"
#P"/tmp/setf-test.lisp"
> (test)
The function (SETF FOO-VAL) is undefined.
Available restarts:
1. (RESTART-TOPLEVEL) Go back to Top-Level REPL.
Broken at TEST. In: #<process SI:TOP-LEVEL 0810afc0>.
File: #P"/tmp/setf-test.lisp" (Position #NIL)
>> :q
Top level in: #<process SI:TOP-LEVEL 0810afc0>.
> *foo*
(0)
> (foo-val *foo*)
0
> (setf (foo-val *foo*) 1)
The function (SETF FOO-VAL) is undefined.
Available restarts:
1. (RESTART-TOPLEVEL) Go back to Top-Level REPL.
Broken at SI:BYTECODES. [Evaluation of: (SETF (FOO-VAL *FOO*) 1)] In: #<process
SI:TOP-LEVEL 0810afc0>.
>> ^D
SBCL:
* (load "/tmp/setf-test-1.lisp")
STYLE-WARNING: defining setf macro for FOO-VAL when (SETF FOO-VAL) is fbound
T
* *foo*
(0)
* (foo-val *foo*)
0
* (test)
1
* (foo-val *foo*)
1
* (setf (foo-val *foo*) 2)
2
SBCL
* (compile-file "/tmp/setf-test-1.lisp")
; compiling file "/tmp/setf-test-1.lisp" (written 14 JUL 2010 07:17:06 PM):
; compiling (DEFMACRO DEFINE-GLOBAL-SETF-EXPANDER ...)
; compiling (DEFPARAMETER *FOO* ...)
; compiling (DEFUN FOO-VAL ...)
; compiling (DEFUN (SETF FOO-VAL) ...)
; compiling (DEFINE-GLOBAL-SETF-EXPANDER FOO-VAL)
; compiling (DEFUN TEST ...)
; /tmp/setf-test-1.fasl written
; compilation finished in 0:00:00.228
#P"/tmp/setf-test-1.fasl"
NIL
NIL
* (load "/tmp/setf-test-1")
WARNING:
defining setf macro for FOO-VAL when (SETF FOO-VAL) was previously treated
as a function
T
* (setf (foo-val *foo*) 2)
2
*
ECL, defining the expander before DEFUN.
Now calling the SETF function works but it also seems
to no longer rely on our custom expander MACRO.
> (load "/tmp/setf-test")
;;; Loading #P"/tmp/setf-test.fas"
#P"/tmp/setf-test.fas"
> (test)
1
> (get-setf-expansion '(foo-val *foo*))
(#:G110)
(*FOO*)
(#:G111)
(FUNCALL #'(SETF FOO-VAL) #:G111 #:G110)
(FOO-VAL #:G110)
> (setf (foo-val *foo*) 2)
2
> *foo*
(2)
> ^D
SBCL, defining the expander before DEFUN
behemoth$ sbcl
Couldn't stat /proc/curproc/file; is /proc mounted?
This is SBCL 1.0.30, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.
SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses. See the CREDITS and COPYING files in the
distribution for more information.
Couldn't stat /proc/curproc/file; is /proc mounted?
* (load "/tmp/setf-test.lisp")
T
* (get-setf-expansion '(foo-val *foo*))
(#:G640)
(*FOO*)
(#:G641)
(FOO-VAL-SETF-SETTER-MACRO #:G641 #:G640)
(FOO-VAL-SETF-GETTER-MACRO #:G641)
* (setf (foo-val *foo*) 3)
3
* (test)
1
------------------------------------------------------------------------------
This SF.net email is sponsored by Sprint
What will you do first with EVO, the first 4G phone?
Visit sprint.com/first -- http://p.sf.net/sfu/sprint-com-first
_______________________________________________
Ecls-list mailing list
Ecls-list@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/ecls-list
