From 9719063b661a99d2cc2a1d9b2ea7dd81145ded59 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 19 May 2003 14:05:17 +0000 Subject: [PATCH] 0.8alpha.0.37: Make MAKE-LOAD-FORM(-SAVING-SLOTS) vaguely conform ... and in the process, remind myself of just how horrible the :JUST-DUMP-IT-NORMALLY hack was. ... more methods on MAKE-LOAD-FORM; ... real, CLOS-based introspective definition of MAKE-LOAD-FORM-SAVING-SLOTS... ... which means that we have to hold off from using MLFSS until it's around, so make JUST-DUMP-IT-NORMALLY use :SB-JUST-DUMP-IT-NORMALLY rather than MLFSS in its definition for the target. Fix the type.impure.lisp test for the new definition of condition classes (oops). --- NEWS | 4 ++++ src/code/defbangstruct.lisp | 12 +++++++++++- src/code/target-defstruct.lisp | 8 +------- src/pcl/env.lisp | 30 ++++++++++++++++++++++++++++++ tests/type.impure.lisp | 1 + version.lisp-expr | 2 +- 6 files changed, 48 insertions(+), 9 deletions(-) diff --git a/NEWS b/NEWS index dadddb3..7dcd85a 100644 --- a/NEWS +++ b/NEWS @@ -1751,6 +1751,10 @@ changes in sbcl-0.8.0 relative to sbcl-0.8alpha.0 STRUCTURE-CLASS). ** SLOT-EXISTS-P now works on conditions, as well as structures and CLOS instances. + ** MAKE-LOAD-FORM now has the required methods on + STRUCTURE-OBJECT, CONDITION and STANDARD-OBJECT. + ** MAKE-LOAD-FORM-SAVING-SLOTS no longer returns a special + keyword, and now implements the SLOT-NAMES argument. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/code/defbangstruct.lisp b/src/code/defbangstruct.lisp index 7b9ba18..9ba54be 100644 --- a/src/code/defbangstruct.lisp +++ b/src/code/defbangstruct.lisp @@ -75,9 +75,19 @@ ;;; objects (defun just-dump-it-normally (object &optional (env nil env-p)) (declare (type structure!object object)) + (declare (ignorable env env-p)) + ;; KLUDGE: we require essentially three different behaviours of + ;; JUST-DUMP-IT-NORMALLY, two of which (host compiler's + ;; MAKE-LOAD-FORM, cross-compiler's MAKE-LOAD-FORM) are handled by + ;; the #+SB-XC-HOST clause. The #-SB-XC-HOST clause is the + ;; behaviour required by the target, before the CLOS-based + ;; MAKE-LOAD-FORM-SAVING-SLOTS is implemented. + #+sb-xc-host (if env-p (sb!xc:make-load-form-saving-slots object :environment env) - (sb!xc:make-load-form-saving-slots object))) + (sb!xc:make-load-form-saving-slots object)) + #-sb-xc-host + :sb-just-dump-it-normally) ;;; a MAKE-LOAD-FORM function for objects which don't use the load ;;; form system. This is used for LAYOUT objects because the special diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp index e9b5b60..c463637 100644 --- a/src/code/target-defstruct.lisp +++ b/src/code/target-defstruct.lisp @@ -395,7 +395,7 @@ res)) -;;; default PRINT-OBJECT and MAKE-LOAD-FORM methods +;;; default PRINT-OBJECT method (defun %default-structure-pretty-print (structure stream) (let* ((layout (%instance-layout structure)) @@ -468,12 +468,6 @@ (%default-structure-ugly-print structure stream)))) (def!method print-object ((x structure-object) stream) (default-structure-print x stream *current-level-in-print*)) - -(defun make-load-form-saving-slots (object &key slot-names environment) - (declare (ignore object environment)) - (if slot-names - (error "stub: MAKE-LOAD-FORM-SAVING-SLOTS :SLOT-NAMES not implemented") ; KLUDGE - :sb-just-dump-it-normally)) ;;;; testing structure types diff --git a/src/pcl/env.lisp b/src/pcl/env.lisp index 359ad30..d793f9a 100644 --- a/src/pcl/env.lisp +++ b/src/pcl/env.lisp @@ -132,3 +132,33 @@ (layout-classoid object))) `(classoid-layout (find-classoid ',pname)))) +(defmethod make-load-form ((object structure-object) &optional env) + (declare (ignore env)) + (error "~@" + object 'make-load-form)) + +(defmethod make-load-form ((object standard-object) &optional env) + (declare (ignore env)) + (error "~@" + object 'make-load-form)) + +(defmethod make-load-form ((object condition) &optional env) + (declare (ignore env)) + (error "~@" + object 'make-load-form)) + +(defun make-load-form-saving-slots (object &key slot-names environment) + (declare (ignore environment)) + (let ((class (class-of object))) + (collect ((inits)) + (dolist (slot (class-slots class)) + (let ((slot-name (slot-definition-name slot))) + (when (or (memq slot-name slot-names) + (and (null slot-names) + (eq :instance (slot-definition-allocation slot)))) + (if (slot-boundp-using-class class object slot) + (let ((value (slot-value-using-class class object slot))) + (inits `(setf (slot-value ,object ',slot-name) ',value))) + (inits `(slot-makunbound ,object ',slot-name)))))) + (values `(allocate-instance (find-class ',(class-name class))) + `(progn ,@(inits)))))) diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp index 7bd27fb..441f6ff 100644 --- a/tests/type.impure.lisp +++ b/tests/type.impure.lisp @@ -337,6 +337,7 @@ (find-class 'simple-condition)) (mapcar #'find-class '(simple-condition condition + sb-pcl::slot-object sb-kernel:instance t)))) diff --git a/version.lisp-expr b/version.lisp-expr index 6f119f9..7313c14 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8alpha.0.36" +"0.8alpha.0.37" -- 1.7.10.4