[Sbcl-commits] CVS: sbcl/src/code target-defstruct.lisp,1.22,1.23

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv19494/src/code

Modified Files:
	target-defstruct.lisp 
Log Message:
0.pre8.64:
	Fix FIND-CLASS of compiled-but-not-loaded structure classes
	... slightly sucky hook variable in %TARGET-DEFSTRUCT, to be 
		used by PCL
	... ENSURE-NON-STANDARD-CLASS updated to cope with the 
		possibility that a CLASSOID exists but the accessor 
		functions aren't FBOUNDP.
	... (side benefit: redefinitions of structures are now reflected 
		in PCL classes)
	... test for FIND-CLASS non-breakage.


Index: target-defstruct.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-defstruct.lisp,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- target-defstruct.lisp	24 Mar 2003 18:39:01 -0000	1.22
+++ target-defstruct.lisp	17 Apr 2003 15:04:26 -0000	1.23
@@ -142,6 +142,10 @@
 
 ;;;; target-only parts of the DEFSTRUCT top level code
 
+;;; A list of hooks designating functions of one argument, the
+;;; classoid, to be called when a defstruct is evaluated.
+(defvar *defstruct-hooks* nil)
+
 ;;; Catch attempts to mess up definitions of symbols in the CL package.
 (defun protect-cl (symbol)
   (/show0 "entering PROTECT-CL, SYMBOL=..")
@@ -236,6 +240,11 @@
     (setf (fdocumentation (dd-name dd) 'type)
 	  (dd-doc dd)))
 
+  ;; the BOUNDP test here is to get past cold-init.
+  (when (boundp '*defstruct-hooks*)
+    (dolist (fun *defstruct-hooks*)
+      (funcall fun (find-classoid (dd-name dd)))))
+  
   (/show0 "leaving %TARGET-DEFSTRUCT")
   (values))