From 1f6e67a6eddcbacc218c05bf5a482373c2be978a Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Mon, 19 May 2003 19:16:26 +0000 Subject: [PATCH] Allow (SETF SLOT-VALUE) on read-only structure slots, like LW and ACL. Problem found by Christophe Rhodes. * src/pcl/low.lisp (structure-slotd-writer-function): Create a writer function for read-only slots. * src/pcl/braid.lisp (ensure-non-standard-class): Call structure-slotd-writer-function with additional arg. --- general-info/release-19a.txt | 2 ++ pcl/braid.lisp | 4 ++-- pcl/low.lisp | 14 ++++++++++---- 3 files changed, 14 insertions(+), 6 deletions(-) diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt index 8be4d1c4f..9a6224977 100644 --- a/general-info/release-19a.txt +++ b/general-info/release-19a.txt @@ -116,6 +116,8 @@ New in this release: - DEFMETHOD and DEFGENERIC detecting doubled lambda variables. - DEFGENERIC :ARGUMENT-PRECEDENCE-ORDER option checking. - SLOT-VALUE, (SETF SLOT-VALUE), SLOT-BOUNDP working with conditions. + - (SETF SLOT-VALUE) working on read-only structure slots like + in other implementations. * Improvements to Hemlock, the Emacs-like editor: diff --git a/pcl/braid.lisp b/pcl/braid.lisp index 98d63abdf..10d8f032d 100644 --- a/pcl/braid.lisp +++ b/pcl/braid.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.41 2003/05/15 15:43:56 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.42 2003/05/19 19:16:26 gerd Exp $") ;;; ;;; Bootstrapping the meta-braid. @@ -535,7 +535,7 @@ `(:internal-reader-function ,(structure-slotd-reader-function slotd) :internal-writer-function - ,(structure-slotd-writer-function slotd))) + ,(structure-slotd-writer-function name slotd))) :type ,(or (structure-slotd-type slotd) t) :initform ,(structure-slotd-init-form slotd) :initfunction ,(eval-form (structure-slotd-init-form slotd))))) diff --git a/pcl/low.lisp b/pcl/low.lisp index 0cfd04749..187864031 100644 --- a/pcl/low.lisp +++ b/pcl/low.lisp @@ -26,7 +26,7 @@ ;;; (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.29 2003/05/18 18:09:30 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.30 2003/05/19 19:16:26 gerd Exp $") ;;; ;;; This file contains optimized low-level constructs for PCL. @@ -462,9 +462,15 @@ the compiler as completely as possible. Currently this means that (defun structure-slotd-reader-function (slotd) (fdefinition (kernel:dsd-accessor slotd))) -(defun structure-slotd-writer-function (slotd) - (unless (kernel:dsd-read-only slotd) - (fdefinition `(setf ,(kernel:dsd-accessor slotd))))) +(defun structure-slotd-writer-function (type dsd) + (if (kernel:dsd-read-only dsd) + (multiple-value-bind (accessor offset data) + (kernel::slot-accessor-form (get-structure-dd type) dsd) + (compile-lambda + `(lambda (new-value kernel::object) + (setf (,accessor ,data ,offset) new-value) + new-value))) + (fdefinition `(setf ,(kernel:dsd-accessor dsd))))) (defun structure-slotd-type (slotd) (kernel:dsd-type slotd)) -- GitLab