[Sbcl-commits] CVS: sbcl/src/code condition.lisp,1.27,1.28

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

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

Modified Files:
	condition.lisp 
Log Message:
0.8alpha.0.36:
	A little tender loving care, applied to conditions:
	... make the implementation of DEFINE-CONDITION agree with the 
		documentation string: allow :DOCUMENTATION slot options 
		to work.
	... ANSI (and pfdietz :-) wants SLOT-EXISTS-P to work on 
		conditions; hook condition objects into CLOS enough to 
		talk about existence of slots: (new classes 
		CONDITION-{EFFECTIVE,DIRECT}-SLOT-DEFINITION, 
		CONDITION-CLASS, etc)
	... it's a bit ridiculous to have SLOT-EXISTS-P working on 
		conditions, and then not be able to do SLOT-VALUE, so
		do the work necessary to make CONDITION objects 
		more-or-less fully understood by PCL: (new methods on 
		COMPUTE-SLOTS, ALLOCATE-INSTANCE, SLOT-VALUE-USING-CLASS 
		and friends; new clauses in internal functions such as
		GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION;  
		adjustment of the braid to set up CLOS knowledge of the 
		new class hierarchy).


Index: condition.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/condition.lisp,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- condition.lisp	3 May 2003 12:14:09 -0000	1.27
+++ condition.lisp	19 May 2003 10:51:33 -0000	1.28
@@ -72,7 +72,9 @@
   ;; allocation of this slot, or NIL until defaulted
   (allocation nil :type (member :instance :class nil))
   ;; If ALLOCATION is :CLASS, this is a cons whose car holds the value.
-  (cell nil :type (or cons null)))
+  (cell nil :type (or cons null))
+  ;; slot documentation
+  (documentation nil :type (or string null)))
 
 ;;; KLUDGE: It's not clear to me why CONDITION-CLASS has itself listed
 ;;; in its CPL, while other classes derived from CONDITION-CLASS don't
@@ -428,6 +430,7 @@
 	       (slot-name (first spec))
 	       (allocation :instance)
 	       (initform-p nil)
+	       documentation
 	       initform)
 	  (collect ((initargs)
 		    (readers)
@@ -451,6 +454,13 @@
 		  (:initarg (initargs arg))
 		  (:allocation
 		   (setq allocation arg))
+		  (:documentation
+		   (when documentation
+		     (error "more than one :DOCUMENTATION in ~S" spec))
+		   (unless (stringp arg)
+		     (error "slot :DOCUMENTATION argument is not a string: ~S"
+			    arg))
+		   (setq documentation arg))
 		  (:type)
 		  (t
 		   (error "unknown slot option:~%  ~S" (first options))))))
@@ -463,6 +473,7 @@
 		     :readers ',(readers)
 		     :writers ',(writers)
 		     :initform-p ',initform-p
+		     :documentation ',documentation
 		     :initform
 		     ,(if (constantp initform)
 			  `',(eval initform)