0.9.16.25: build fix for CMUCL and older SBCLs

[sbcl.git] / src / pcl / slots.lisp

diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp
index 6b7b120..1b1326b 100644 (file)
--- a/src/pcl/slots.lisp
+++ b/src/pcl/slots.lisp
@@ -90,7 +90,7 @@
 
 (define-compiler-macro slot-value (&whole form object slot-name)
   (if (and (constantp slot-name)
-           (interned-symbol-p (eval slot-name)))
+           (interned-symbol-p (constant-form-value slot-name)))
       `(accessor-slot-value ,object ,slot-name)
       form))
 
@@ -105,7 +105,7 @@
 
 (define-compiler-macro set-slot-value (&whole form object slot-name new-value)
   (if (and (constantp slot-name)
-           (interned-symbol-p (eval slot-name)))
+           (interned-symbol-p (constant-form-value slot-name)))
       `(accessor-set-slot-value ,object ,slot-name ,new-value)
       form))
 
@@ -120,7 +120,7 @@
 
 (define-compiler-macro slot-boundp (&whole form object slot-name)
   (if (and (constantp slot-name)
-           (interned-symbol-p (eval slot-name)))
+           (interned-symbol-p (constant-form-value slot-name)))
       `(accessor-slot-boundp ,object ,slot-name)
       form))
 
@@ -136,9 +136,12 @@
   (let ((class (class-of object)))
     (not (null (find-slot-definition class slot-name)))))
 
+(defvar *unbound-slot-value-marker* (make-unprintable-object "unbound slot"))
+
 ;;; This isn't documented, but is used within PCL in a number of print
 ;;; object methods. (See NAMED-OBJECT-PRINT-FUNCTION.)
-(defun slot-value-or-default (object slot-name &optional (default "unbound"))
+(defun slot-value-or-default (object slot-name &optional
+                              (default *unbound-slot-value-marker*))
   (if (slot-boundp object slot-name)
       (slot-value object slot-name)
       default))
@@ -318,7 +321,16 @@
          instance))
 
 (defmethod slot-unbound ((class t) instance slot-name)
-  (error 'unbound-slot :name slot-name :instance instance))
+  (restart-case
+      (error 'unbound-slot :name slot-name :instance instance)
+    (use-value (v)
+      :report "Return a value as the slot-value."
+      :interactive read-evaluated-form
+      v)
+    (store-value (v)
+      :report "Store and return a value as the slot-value."
+      :interactive read-evaluated-form
+      (setf (slot-value instance slot-name) v))))
 
 (defun slot-unbound-internal (instance position)
   (values