Coverage report: /home/ellis/comp/core/lib/doc/package.lisp

KindCoveredAll%
expression33118 28.0
branch28 25.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; lib/doc/package.lisp --- Package Documentation
2
 
3
 ;; Package documentation abstractions and machinery
4
 
5
 ;;; Commentary:
6
 
7
 ;; We usually think of packages as composed of one or more files, but
8
 ;; this is not always the case in Lisp. Packages can be defined in a
9
 ;; REPL with no underlying source files, or via macros, which can
10
 ;; obfuscate the origin of a form.
11
 
12
 ;; The good news is that packages are 'real' objects that are exposed
13
 ;; to us after load-time. If we are willing to wait for the packages
14
 ;; to actually be loaded in a Lisp image before attempting to compile
15
 ;; 'package documentation' this makes everything incredibly easy with
16
 ;; SB-INTROSPECT and friends.
17
 
18
 ;; All that remains is to provide an interface for linking the various
19
 ;; downstream *-DOCUMENTATION objects with a compiled
20
 ;; PACKAGE-DEFINITION object.
21
 
22
 ;; The logical next step is linking PACKAGE-DOCUMENTATION objects with
23
 ;; other PACKAGE-DEFINITIONs.
24
 
25
 ;;; Code:
26
 (in-package :doc)
27
 
28
 (defclass package-documentation ()
29
   ((package :initform *package* :initarg :package :type package :accessor doc-package)
30
    (files :initform #() :initarg :files :type (array file-documentation) :accessor doc-files)
31
    (symbols :initform #() :initarg :symbols :type (array symbol-documentation) :accessor doc-symbols)))
32
 
33
 (defmethod name ((self package-documentation))
34
   (package-name (doc-package self)))
35
 
36
 (defun package-documentation (&optional (package *package*) (for :external))
37
   "Return a PACKAGE-DOCUMENTATION object from PACKAGE."
38
   (unless (packagep package)
39
     (if (or (null package) (eq t package))
40
         (setf package *package*)
41
         (setf package (find-package package))))
42
   (let ((paths)
43
         (symbols (make-array (package-external-symbol-count package)
44
                              :element-type 'symbol-documentation
45
                              :fill-pointer 0)))
46
     ;; TODO: we always want external symbols, we need XOR
47
     (case for
48
       (:internal (do-symbols* (s package)
49
                    (let ((doc (symbol-documentation s)))
50
                      (dolist (p (doc-files doc))
51
                        (pushnew p paths))
52
                      (vector-push-extend doc symbols 8))))
53
       (:external (do-external-symbols (s package)
54
                    (let ((doc (symbol-documentation s)))
55
                      (dolist (p (doc-files doc))
56
                        (pushnew p paths))
57
                      (vector-push doc symbols))))
58
       (t (loop for s being each present-symbol in package
59
                do (let ((doc (symbol-documentation s)))
60
                     (dolist (p (doc-files doc))
61
                       (unless (null p)
62
                         (pushnew p paths)))
63
                     (vector-push doc symbols)))))
64
     (make-instance 'package-documentation
65
       :package package
66
       :files (map 'vector (lambda (x) (unless (null x) (file-documentation x))) paths)
67
       :symbols symbols)))
68
 
69
 (defmethod print-object ((self package-documentation) stream)
70
   (with-slots (package files symbols) self
71
     (print-unreadable-object (self stream :type t)
72
       (format stream "~A :symbols ~A :files ~A" (package-name package) (length symbols) (length files)))))
73
 
74
 (defmethod describe-object ((self package-documentation) stream)
75
   (with-slots (package files symbols) self
76
     (print-standard-describe-header self stream)
77
     (describe package stream)
78
     (format stream "~%Files: ~S"
79
             (loop for f across files
80
                   collect (doc-path f)))
81
     (format stream "~%Symbol Docs: ")
82
     (pprint-tabular
83
      stream 
84
      (loop for s across symbols
85
            collect (doc-symbol s)))))
86
 
87
 (defmethod doc-dependents ((self package-documentation))
88
   (mapcar #'package-documentation (package-used-by-list (doc-package self))))
89
 
90
 (defmethod doc-dependencies ((self package-documentation))
91
   (mapcar #'package-documentation (package-use-list (doc-package self))))
92
 
93
 ;; (sb-introspect:allocation-information (make-instance 'package-documentation))
94
 ;; sb-introspect:definition-source
95
 
96
 ;; (sb-introspect::object-size-histogram :static)
97
 ;; (sb-introspect:find-definition-source (find-package :doc))
98
 ;; (sb-introspect:find-definition-sources-by-name 'std-error :condition)
99
 
100
 ;; (package-documentation)