Skip to content
Snippets Groups Projects
Commit c9afe45f authored by rtoy's avatar rtoy
Browse files

compiler/globaldb.lisp:

o Add a documentation type for the typed-structure class.

pcl/cmucl-documentation.lisp:
o Use the new type to add documentation support for structures of type
  list and vector.
parent 26acdd0b
No related branches found
No related tags found
No related merge requests found
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.51 2004/09/08 02:10:55 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.52 2005/11/10 17:43:15 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -1140,6 +1140,7 @@
(define-info-class typed-structure)
(define-info-type typed-structure info t nil)
(define-info-type typed-structure documentation (or string null))
(define-info-class declaration)
(define-info-type declaration recognized boolean)
......
......@@ -4,7 +4,7 @@
;;; the public domain, and is provided 'as is'.
(file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cmucl-documentation.lisp,v 1.14 2005/07/13 13:43:35 rtoy Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cmucl-documentation.lisp,v 1.15 2005/11/10 17:43:33 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -97,10 +97,19 @@
(when class
(plist-value class 'documentation)))))
#+nil
(defmethod documentation ((x symbol) (doc-type (eql 'structure)))
(when (eq (info type kind x) :instance)
(values (info type documentation x))))
(defmethod documentation ((x symbol) (doc-type (eql 'structure)))
(cond ((eq (info type kind x) :instance)
(values (info type documentation x)))
((info typed-structure info x)
(values (info typed-structure documentation x)))
(t
(simple-program-error "~@<~S is not the name of a structure type.~@:>" x))))
(defmethod (setf documentation) (new-value (x kernel::structure-class) (doc-type (eql 't)))
(setf (info type documentation (kernel:%class-name x)) new-value))
......@@ -121,11 +130,20 @@
(setf (plist-value class 'documentation) new-value)
(setf (info type documentation x) new-value)))))
#+nil
(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'structure)))
(unless (eq (info type kind x) :instance)
(simple-program-error "~@<~S is not the name of a structure type.~@:>" x))
(setf (info type documentation x) new-value))
(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'structure)))
(cond ((eq (info type kind x) :instance)
(setf (info type documentation x) new-value))
((info typed-structure info x)
(setf (info typed-structure documentation x) new-value))
(t
(simple-program-error "~@<~S is not the name of a structure type.~@:>" x))))
;;; Variables.
(defmethod documentation ((x symbol) (doc-type (eql 'variable)))
(values (info variable documentation x)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment