[armedbear-devel] Fwd: [armedbear-cvs] r13450 - trunk/abcl/src/org/armedbear/lisp

Erik Huelsmann ehuels at gmail.com
Sun Aug 7 20:21:43 UTC 2011

Hi Mark,

Maybe you want to check if CL-CONTAINERS now wants to load? At least we now
support SETF of APPLY with user-defined functions. And, yes, I did check
that the order of evaluation of the arguments remains in tact:

(defvar b 0)
--> B
(defun m () (incf b))
--> M

(defvar v nil)
(defun (SETF MYFUN) (new-value &rest rest) (setf v new-value))

(setf (apply #'myfun (list (m) (m) (m))) (m))
--> 4



---------- Forwarded message ----------
From: <ehuelsmann at common-lisp.net>
Date: Sun, Aug 7, 2011 at 10:18 PM
Subject: [armedbear-cvs] r13450 - trunk/abcl/src/org/armedbear/lisp
To: armedbear-cvs at common-lisp.net

Author: ehuelsmann
Date: Sun Aug  7 13:17:59 2011
New Revision: 13450

Fix #141 (SETF of APPLY not working with arbitrary function) by
"adding" the feature.


Modified: trunk/abcl/src/org/armedbear/lisp/late-setf.lisp
--- trunk/abcl/src/org/armedbear/lisp/late-setf.lisp    Sun Aug  7 07:20:58
2011        (r13449)
+++ trunk/abcl/src/org/armedbear/lisp/late-setf.lisp    Sun Aug  7 13:17:59
2011        (r13450)
@@ -88,11 +88,6 @@
              `(getf ,get ,ptemp ,@(if default `(,def-temp)))))))

 (define-setf-expander apply (functionoid &rest args)
-  (unless (and (listp functionoid)
-               (= (length functionoid) 2)
-               (eq (first functionoid) 'function)
-               (memq (second functionoid) '(aref bit sbit)))
-    (error "SETF of APPLY is only defined for #'AREF, #'BIT and #'SBIT."))
  (let ((function (second functionoid))
        (new-var (gensym))
        (vars (make-gensym-list (length args))))

armedbear-cvs mailing list
armedbear-cvs at common-lisp.net
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/armedbear-devel/attachments/20110807/7727ec00/attachment.html>

More information about the armedbear-devel mailing list