X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/f83bdc196329851f493b8e7a0931543357109884..dd70f526c9e295c511e3031c7a203057825bb88f:/gffi/virtual-slots.lisp diff --git a/gffi/virtual-slots.lisp b/gffi/virtual-slots.lisp index 162b4f4..3025e93 100644 --- a/gffi/virtual-slots.lisp +++ b/gffi/virtual-slots.lisp @@ -20,7 +20,7 @@ ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: virtual-slots.lisp,v 1.9 2007-06-15 12:23:39 espen Exp $ +;; $Id: virtual-slots.lisp,v 1.11 2007-11-08 13:49:26 espen Exp $ (in-package "GFFI") @@ -205,10 +205,8 @@ #-sbcl setter #+sbcl (etypecase setter - (symbol #'(lambda (object value) (funcall setter object value))) - (list #'(lambda (object value) - ;; Setter is a (setf ...) form and thus takes the - ;; value as the first argument + (symbol #'(lambda (value object) (funcall setter value object))) + (list #'(lambda (value object) (funcall setter value object))) (function setter)))) @@ -241,7 +239,8 @@ #-clisp (defmethod initialize-internal-slot-functions ((slotd effective-virtual-slot-definition)) - #?-(sbcl>= 0 9 15) ; Delayed to avoid recursive call of finalize-inheritanze +;; #?-(sbcl>= 0 9 15) ; Delayed to avoid recursive call of finalize-inheritanze + #+nil ;; 2007-11-08: done this for all implementations (setf (slot-value slotd 'reader-function) (compute-slot-reader-function slotd) (slot-value slotd 'boundp-function) (compute-slot-boundp-function slotd) @@ -319,22 +318,23 @@ ;; of finalize-instance being called recursivly we have to delay the ;; initialization of slot functions until after an instance has been ;; created. -#?(or (sbcl>= 0 9 15) (featurep :clisp)) +;; 2007-11-08: done this for all implementations +;; #?(or (sbcl>= 0 9 15) (featurep :clisp)) (defmethod slot-unbound (class (slotd effective-virtual-slot-definition) (name (eql 'reader-function))) (declare (ignore class)) (setf (slot-value slotd name) (compute-slot-reader-function slotd))) -#?(or (sbcl>= 0 9 15) (featurep :clisp)) +;; #?(or (sbcl>= 0 9 15) (featurep :clisp)) (defmethod slot-unbound (class (slotd effective-virtual-slot-definition) (name (eql 'boundp-function))) (declare (ignore class)) (setf (slot-value slotd name) (compute-slot-boundp-function slotd))) -#?(or (sbcl>= 0 9 15) (featurep :clisp)) +;; #?(or (sbcl>= 0 9 15) (featurep :clisp)) (defmethod slot-unbound (class (slotd effective-virtual-slot-definition) (name (eql 'writer-function))) (declare (ignore class)) (setf (slot-value slotd name) (compute-slot-writer-function slotd))) -#?(or (sbcl>= 0 9 15) (featurep :clisp)) +;; #?(or (sbcl>= 0 9 15) (featurep :clisp)) (defmethod slot-unbound (class (slotd effective-virtual-slot-definition) (name (eql 'makunbound-function))) (declare (ignore class)) (setf (slot-value slotd name) (compute-slot-makunbound-function slotd)))