0.9.7.25:
[sbcl.git] / src / pcl / defs.lisp
1 ;;;; This software is part of the SBCL system. See the README file for
2 ;;;; more information.
3
4 ;;;; This software is derived from software originally released by Xerox
5 ;;;; Corporation. Copyright and release statements follow. Later modifications
6 ;;;; to the software are in the public domain and are provided with
7 ;;;; absolutely no warranty. See the COPYING and CREDITS files for more
8 ;;;; information.
9
10 ;;;; copyright information from original PCL sources:
11 ;;;;
12 ;;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
13 ;;;; All rights reserved.
14 ;;;;
15 ;;;; Use and copying of this software and preparation of derivative works based
16 ;;;; upon this software are permitted. Any distribution of this software or
17 ;;;; derivative works must comply with all applicable United States export
18 ;;;; control laws.
19 ;;;;
20 ;;;; This software is made available AS IS, and Xerox Corporation makes no
21 ;;;; warranty about the software, its performance or its conformity to any
22 ;;;; specification.
23
24 (in-package "SB-PCL")
25 \f
26 ;;; (These are left over from the days when PCL was an add-on package
27 ;;; for a pre-CLOS Common Lisp. They shouldn't happen in a normal
28 ;;; build, of course, but they might happen if someone is experimenting
29 ;;; and debugging, and it's probably worth complaining if they do,
30 ;;; so we've left 'em in.)
31 (when (eq *boot-state* 'complete)
32   (error "Trying to load (or compile) PCL in an environment in which it~%~
33           has already been loaded. This doesn't work, you will have to~%~
34           get a fresh lisp (reboot) and then load PCL."))
35 (when *boot-state*
36   (cerror "Try loading (or compiling) PCL anyways."
37           "Trying to load (or compile) PCL in an environment in which it~%~
38            has already been partially loaded. This may not work, you may~%~
39            need to get a fresh lisp (reboot) and then load PCL."))
40 \f
41 #-sb-fluid (declaim (inline gdefinition))
42 (defun gdefinition (spec)
43   ;; This is null layer right now, but once FDEFINITION stops bypasssing
44   ;; fwrappers/encapsulations we can do that here.
45   (fdefinition spec))
46
47 (defun (setf gdefinition) (new-value spec)
48   ;; This is almost a null layer right now, but once (SETF
49   ;; FDEFINITION) stops bypasssing fwrappers/encapsulations we can do
50   ;; that here.
51   (sb-c::note-name-defined spec :function) ; FIXME: do we need this? Why?
52   (setf (fdefinition spec) new-value))
53 \f
54 ;;;; type specifier hackery
55
56 ;;; internal to this file
57 (defun coerce-to-class (class &optional make-forward-referenced-class-p)
58   (if (symbolp class)
59       (or (find-class class (not make-forward-referenced-class-p))
60           (ensure-class class))
61       class))
62
63 ;;; interface
64 (defun specializer-from-type (type &aux args)
65   (when (consp type)
66     (setq args (cdr type) type (car type)))
67   (cond ((symbolp type)
68          (or (and (null args) (find-class type))
69              (ecase type
70                (class    (coerce-to-class (car args)))
71                (prototype (make-instance 'class-prototype-specializer
72                                          :object (coerce-to-class (car args))))
73                (class-eq (class-eq-specializer (coerce-to-class (car args))))
74                (eql      (intern-eql-specializer (car args))))))
75         ;; FIXME: do we still need this?
76         ((and (null args) (typep type 'classoid))
77          (or (classoid-pcl-class type)
78              (ensure-non-standard-class (classoid-name type))))
79         ((specializerp type) type)))
80
81 ;;; interface
82 (defun type-from-specializer (specl)
83   (cond ((eq specl t)
84          t)
85         ((consp specl)
86          (unless (member (car specl) '(class prototype class-eq eql))
87            (error "~S is not a legal specializer type." specl))
88          specl)
89         ((progn
90            (when (symbolp specl)
91              ;;maybe (or (find-class specl nil) (ensure-class specl)) instead?
92              (setq specl (find-class specl)))
93            (or (not (eq *boot-state* 'complete))
94                (specializerp specl)))
95          (specializer-type specl))
96         (t
97          (error "~S is neither a type nor a specializer." specl))))
98
99 (defun type-class (type)
100   (declare (special *the-class-t*))
101   (setq type (type-from-specializer type))
102   (if (atom type)
103       (if (eq type t)
104           *the-class-t*
105           (error "bad argument to TYPE-CLASS"))
106       (case (car type)
107         (eql (class-of (cadr type)))
108         (prototype (class-of (cadr type))) ;?
109         (class-eq (cadr type))
110         (class (cadr type)))))
111
112 (defun class-eq-type (class)
113   (specializer-type (class-eq-specializer class)))
114
115 ;;; internal to this file..
116 ;;;
117 ;;; These functions are a pale imitation of their namesake. They accept
118 ;;; class objects or types where they should.
119 (defun *normalize-type (type)
120   (cond ((consp type)
121          (if (member (car type) '(not and or))
122              `(,(car type) ,@(mapcar #'*normalize-type (cdr type)))
123              (if (null (cdr type))
124                  (*normalize-type (car type))
125                  type)))
126         ((symbolp type)
127          (let ((class (find-class type nil)))
128            (if class
129                (let ((type (specializer-type class)))
130                  (if (listp type) type `(,type)))
131                `(,type))))
132         ((or (not (eq *boot-state* 'complete))
133              (specializerp type))
134          (specializer-type type))
135         (t
136          (error "~S is not a type." type))))
137
138 ;;; internal to this file...
139 (defun convert-to-system-type (type)
140   (case (car type)
141     ((not and or) `(,(car type) ,@(mapcar #'convert-to-system-type
142                                           (cdr type))))
143     ((class class-eq) ; class-eq is impossible to do right
144      (layout-classoid (class-wrapper (cadr type))))
145     (eql type)
146     (t (if (null (cdr type))
147            (car type)
148            type))))
149
150 ;;; Writing the missing NOT and AND clauses will improve the quality
151 ;;; of code generated by GENERATE-DISCRIMINATION-NET, but calling
152 ;;; SUBTYPEP in place of just returning (VALUES NIL NIL) can be very
153 ;;; slow. *SUBTYPEP is used by PCL itself, and must be fast.
154 ;;;
155 ;;; FIXME: SB-KERNEL has fast-and-not-quite-precise type code for use
156 ;;; in the compiler. Could we share some of it here?
157 (defun *subtypep (type1 type2)
158   (if (equal type1 type2)
159       (values t t)
160       (if (eq *boot-state* 'early)
161           (values (eq type1 type2) t)
162           (let ((*in-precompute-effective-methods-p* t))
163             (declare (special *in-precompute-effective-methods-p*))
164             ;; FIXME: *IN-PRECOMPUTE-EFFECTIVE-METHODS-P* is not a
165             ;; good name. It changes the way
166             ;; CLASS-APPLICABLE-USING-CLASS-P works.
167             (setq type1 (*normalize-type type1))
168             (setq type2 (*normalize-type type2))
169             (case (car type2)
170               (not
171                (values nil nil)) ; XXX We should improve this.
172               (and
173                (values nil nil)) ; XXX We should improve this.
174               ((eql wrapper-eq class-eq class)
175                (multiple-value-bind (app-p maybe-app-p)
176                    (specializer-applicable-using-type-p type2 type1)
177                  (values app-p (or app-p (not maybe-app-p)))))
178               (t
179                (subtypep (convert-to-system-type type1)
180                          (convert-to-system-type type2))))))))
181 \f
182 (defvar *built-in-class-symbols* ())
183 (defvar *built-in-wrapper-symbols* ())
184
185 (defun get-built-in-class-symbol (class-name)
186   (or (cadr (assq class-name *built-in-class-symbols*))
187       (let ((symbol (make-class-symbol class-name)))
188         (push (list class-name symbol) *built-in-class-symbols*)
189         symbol)))
190
191 (defun get-built-in-wrapper-symbol (class-name)
192   (or (cadr (assq class-name *built-in-wrapper-symbols*))
193       (let ((symbol (make-wrapper-symbol class-name)))
194         (push (list class-name symbol) *built-in-wrapper-symbols*)
195         symbol)))
196 \f
197 (pushnew '%class *var-declarations*)
198 (pushnew '%variable-rebinding *var-declarations*)
199
200 (defun variable-class (var env)
201   (caddr (var-declaration 'class var env)))
202
203 (defvar *name->class->slotd-table* (make-hash-table))
204
205 (defvar *standard-method-combination*)
206 \f
207 (defun plist-value (object name)
208   (getf (object-plist object) name))
209
210 (defun (setf plist-value) (new-value object name)
211   (if new-value
212       (setf (getf (object-plist object) name) new-value)
213       (progn
214         (remf (object-plist object) name)
215         nil)))
216 \f
217 ;;;; built-in classes
218
219 ;;; Grovel over SB-KERNEL::*BUILT-IN-CLASSES* in order to set
220 ;;; SB-PCL:*BUILT-IN-CLASSES*.
221 (/show "about to set up SB-PCL::*BUILT-IN-CLASSES*")
222 (defvar *built-in-classes*
223   (labels ((direct-supers (class)
224              (/noshow "entering DIRECT-SUPERS" (classoid-name class))
225              (if (typep class 'built-in-classoid)
226                  (built-in-classoid-direct-superclasses class)
227                  (let ((inherits (layout-inherits
228                                   (classoid-layout class))))
229                    (/noshow inherits)
230                    (list (svref inherits (1- (length inherits)))))))
231            (direct-subs (class)
232              (/noshow "entering DIRECT-SUBS" (classoid-name class))
233              (collect ((res))
234                (let ((subs (classoid-subclasses class)))
235                  (/noshow subs)
236                  (when subs
237                    (dohash (sub v subs)
238                      (declare (ignore v))
239                      (/noshow sub)
240                      (when (member class (direct-supers sub))
241                        (res sub)))))
242                (res))))
243     (mapcar (lambda (kernel-bic-entry)
244               (/noshow "setting up" kernel-bic-entry)
245               (let* ((name (car kernel-bic-entry))
246                      (class (find-classoid name))
247                      (prototype-form
248                       (getf (cdr kernel-bic-entry) :prototype-form)))
249                 (/noshow name class)
250                 `(,name
251                   ,(mapcar #'classoid-name (direct-supers class))
252                   ,(mapcar #'classoid-name (direct-subs class))
253                   ,(map 'list
254                         (lambda (x)
255                           (classoid-name
256                            (layout-classoid x)))
257                         (reverse
258                          (layout-inherits
259                           (classoid-layout class))))
260                   ,(if prototype-form
261                        (eval prototype-form)
262                        ;; This is the default prototype value which
263                        ;; was used, without explanation, by the CMU CL
264                        ;; code we're derived from. Evidently it's safe
265                        ;; in all relevant cases.
266                        42))))
267             (remove-if (lambda (kernel-bic-entry)
268                          (member (first kernel-bic-entry)
269                                  ;; I'm not sure why these are removed from
270                                  ;; the list, but that's what the original
271                                  ;; CMU CL code did. -- WHN 20000715
272                                  '(t function stream
273                                      file-stream string-stream)))
274                        sb-kernel::*built-in-classes*))))
275 (/noshow "done setting up SB-PCL::*BUILT-IN-CLASSES*")
276 \f
277 ;;;; the classes that define the kernel of the metabraid
278
279 (defclass t () ()
280   (:metaclass built-in-class))
281
282 (defclass function (t) ()
283   (:metaclass built-in-class))
284
285 (defclass stream (t) ()
286   (:metaclass built-in-class))
287
288 (defclass file-stream (stream) ()
289   (:metaclass built-in-class))
290
291 (defclass string-stream (stream) ()
292   (:metaclass built-in-class))
293
294 (defclass slot-object (t) ()
295   (:metaclass slot-class))
296
297 (defclass condition (slot-object) ()
298   (:metaclass condition-class))
299
300 (defclass structure-object (slot-object) ()
301   (:metaclass structure-class))
302
303 (defstruct (dead-beef-structure-object
304             (:constructor |STRUCTURE-OBJECT class constructor|)
305             (:copier nil)))
306
307 (defclass standard-object (slot-object) ())
308
309 (defclass funcallable-standard-object (standard-object function)
310   ()
311   (:metaclass funcallable-standard-class))
312
313 (defclass metaobject (standard-object) ())
314
315 (defclass generic-function (dependent-update-mixin
316                             definition-source-mixin
317                             metaobject
318                             funcallable-standard-object)
319   ((documentation
320     :initform nil
321     :initarg :documentation)
322    ;; We need to make a distinction between the methods initially set
323    ;; up by :METHOD options to DEFGENERIC and the ones set up later by
324    ;; DEFMETHOD, because ANSI specifies that executing DEFGENERIC on
325    ;; an already-DEFGENERICed function clears the methods set by the
326    ;; previous DEFGENERIC, but not methods set by DEFMETHOD. (Making
327    ;; this distinction seems a little kludgy, but it has the positive
328    ;; effect of making it so that loading a file a.lisp containing
329    ;; DEFGENERIC, then loading a second file b.lisp containing
330    ;; DEFMETHOD, then modifying and reloading a.lisp and/or b.lisp
331    ;; tends to leave the generic function in a state consistent with
332    ;; the most-recently-loaded state of a.lisp and b.lisp.)
333    (initial-methods
334     :initform ()
335     :accessor generic-function-initial-methods))
336   (:metaclass funcallable-standard-class))
337
338 (defclass standard-generic-function (generic-function)
339   ((name
340     :initform nil
341     :initarg :name
342     :reader generic-function-name)
343    (methods
344     :initform ()
345     :accessor generic-function-methods
346     :type list)
347    (method-class
348     :initarg :method-class
349     :accessor generic-function-method-class)
350    (method-combination
351     :initarg :method-combination
352     :accessor generic-function-method-combination)
353    (declarations
354     ;; KLUDGE: AMOP specifies :DECLARATIONS, while ANSI specifies
355     ;; :DECLARE.  Allow either (but FIXME: maybe a note or a warning
356     ;; might be appropriate).
357     :initarg :declarations
358     :initarg :declare
359     :initform ()
360     :accessor generic-function-declarations)
361    (arg-info
362     :initform (make-arg-info)
363     :reader gf-arg-info)
364    (dfun-state
365     :initform ()
366     :accessor gf-dfun-state))
367   (:metaclass funcallable-standard-class)
368   (:default-initargs :method-class *the-class-standard-method*
369                      :method-combination *standard-method-combination*))
370
371 (defclass method (metaobject) ())
372
373 (defclass standard-method (definition-source-mixin plist-mixin method)
374   ((generic-function
375     :initform nil
376     :accessor method-generic-function)
377 ;;;     (qualifiers
378 ;;;     :initform ()
379 ;;;     :initarg  :qualifiers
380 ;;;     :reader method-qualifiers)
381    (specializers
382     :initform ()
383     :initarg  :specializers
384     :reader method-specializers)
385    (lambda-list
386     :initform ()
387     :initarg  :lambda-list
388     :reader method-lambda-list)
389    (function
390     :initform nil
391     :initarg :function)                 ;no writer
392    (fast-function
393     :initform nil
394     :initarg :fast-function             ;no writer
395     :reader method-fast-function)
396    (documentation
397     :initform nil
398     :initarg :documentation)))
399
400 (defclass standard-accessor-method (standard-method)
401   ((slot-name :initform nil
402               :initarg :slot-name
403               :reader accessor-method-slot-name)
404    (slot-definition :initform nil
405                     :initarg :slot-definition
406                     :reader accessor-method-slot-definition)))
407
408 (defclass standard-reader-method (standard-accessor-method) ())
409 (defclass standard-writer-method (standard-accessor-method) ())
410 ;;; an extension, apparently.
411 (defclass standard-boundp-method (standard-accessor-method) ())
412
413 (defclass method-combination (metaobject)
414   ((documentation
415     :reader method-combination-documentation
416     :initform nil
417     :initarg :documentation)))
418
419 (defclass standard-method-combination (definition-source-mixin
420                                        method-combination)
421   ((type
422     :reader method-combination-type
423     :initarg :type)
424    (options
425     :reader method-combination-options
426     :initarg :options)))
427
428 (defclass long-method-combination (standard-method-combination)
429   ((function
430     :initarg :function
431     :reader long-method-combination-function)
432    (args-lambda-list
433     :initarg :args-lambda-list
434     :reader long-method-combination-args-lambda-list)))
435
436 (defclass short-method-combination (standard-method-combination)
437   ((operator
438     :reader short-combination-operator
439     :initarg :operator)
440    (identity-with-one-argument
441     :reader short-combination-identity-with-one-argument
442     :initarg :identity-with-one-argument)))
443
444 (defclass slot-definition (metaobject)
445   ((name
446     :initform nil
447     :initarg :name
448     :accessor slot-definition-name)
449    (initform
450     :initform nil
451     :initarg :initform
452     :accessor slot-definition-initform)
453    (initfunction
454     :initform nil
455     :initarg :initfunction
456     :accessor slot-definition-initfunction)
457    (readers
458     :initform nil
459     :initarg :readers
460     :accessor slot-definition-readers)
461    (writers
462     :initform nil
463     :initarg :writers
464     :accessor slot-definition-writers)
465    (initargs
466     :initform nil
467     :initarg :initargs
468     :accessor slot-definition-initargs)
469    (type
470     :initform t
471     :initarg :type
472     :accessor slot-definition-type)
473    (documentation
474     :initform nil
475     :initarg :documentation
476     ;; FIXME: should we export this, as an extension?
477     :accessor %slot-definition-documentation)
478    (class
479     :initform nil
480     :initarg :class
481     :accessor slot-definition-class)))
482
483 (defclass standard-slot-definition (slot-definition)
484   ((allocation
485     :initform :instance
486     :initarg :allocation
487     :accessor slot-definition-allocation)
488    (allocation-class
489     :initform nil
490     :initarg :allocation-class
491     :accessor slot-definition-allocation-class)))
492
493 (defclass condition-slot-definition (slot-definition)
494   ((allocation
495     :initform :instance
496     :initarg :allocation
497     :accessor slot-definition-allocation)
498    (allocation-class
499     :initform nil
500     :initarg :allocation-class
501     :accessor slot-definition-allocation-class)))
502
503 (defclass structure-slot-definition (slot-definition)
504   ((defstruct-accessor-symbol
505      :initform nil
506      :initarg :defstruct-accessor-symbol
507      :accessor slot-definition-defstruct-accessor-symbol)
508    (internal-reader-function
509      :initform nil
510      :initarg :internal-reader-function
511      :accessor slot-definition-internal-reader-function)
512    (internal-writer-function
513      :initform nil
514      :initarg :internal-writer-function
515      :accessor slot-definition-internal-writer-function)))
516
517 (defclass direct-slot-definition (slot-definition)
518   ())
519
520 (defclass effective-slot-definition (slot-definition)
521   ((reader-function ; (lambda (object) ...)
522     :accessor slot-definition-reader-function)
523    (writer-function ; (lambda (new-value object) ...)
524     :accessor slot-definition-writer-function)
525    (boundp-function ; (lambda (object) ...)
526     :accessor slot-definition-boundp-function)
527    (accessor-flags
528     :initform 0)))
529
530 (defclass standard-direct-slot-definition (standard-slot-definition
531                                            direct-slot-definition)
532   ())
533
534 (defclass standard-effective-slot-definition (standard-slot-definition
535                                               effective-slot-definition)
536   ((location ; nil, a fixnum, a cons: (slot-name . value)
537     :initform nil
538     :accessor slot-definition-location)))
539
540 (defclass condition-direct-slot-definition (condition-slot-definition
541                                             direct-slot-definition)
542   ())
543
544 (defclass condition-effective-slot-definition (condition-slot-definition
545                                                effective-slot-definition)
546   ())
547
548 (defclass structure-direct-slot-definition (structure-slot-definition
549                                             direct-slot-definition)
550   ())
551
552 (defclass structure-effective-slot-definition (structure-slot-definition
553                                                effective-slot-definition)
554   ())
555
556 (defclass specializer (metaobject)
557   ((type :initform nil :reader specializer-type)))
558
559 (defclass specializer-with-object (specializer) ())
560
561 (defclass exact-class-specializer (specializer) ())
562
563 (defclass class-eq-specializer (exact-class-specializer
564                                 specializer-with-object)
565   ((object :initarg :class
566            :reader specializer-class
567            :reader specializer-object)))
568
569 (defclass class-prototype-specializer (specializer-with-object)
570   ((object :initarg :class
571            :reader specializer-class
572            :reader specializer-object)))
573
574 (defclass eql-specializer (exact-class-specializer specializer-with-object)
575   ((object :initarg :object :reader specializer-object
576            :reader eql-specializer-object)))
577
578 (defvar *eql-specializer-table* (make-hash-table :test 'eql))
579
580 (defun intern-eql-specializer (object)
581   (or (gethash object *eql-specializer-table*)
582       (setf (gethash object *eql-specializer-table*)
583             (make-instance 'eql-specializer :object object))))
584
585 (defclass class (dependent-update-mixin
586                  definition-source-mixin
587                  specializer)
588   ((name
589     :initform nil
590     :initarg :name
591     :reader class-name)
592    (class-eq-specializer
593     :initform nil
594     :reader class-eq-specializer)
595    (direct-superclasses
596     :initform ()
597     :reader class-direct-superclasses)
598    ;; Note: The (CLASS-)DIRECT-SUBCLASSES for STRUCTURE-CLASSes and
599    ;; CONDITION-CLASSes are lazily computed whenever the subclass info
600    ;; becomes available, i.e. when the PCL class is created.
601    (direct-subclasses
602     :initform ()
603     :reader class-direct-subclasses)
604    (direct-methods
605     :initform (cons nil nil))
606    (documentation
607     :initform nil
608     :initarg :documentation)
609    (finalized-p
610     :initform nil
611     :reader class-finalized-p)))
612
613 (def!method make-load-form ((class class) &optional env)
614   ;; FIXME: should we not instead pass ENV to FIND-CLASS?  Probably
615   ;; doesn't matter while all our environments are the same...
616   (declare (ignore env))
617   (let ((name (class-name class)))
618     (unless (and name (eq (find-class name nil) class))
619       (error "~@<Can't use anonymous or undefined class as constant: ~S~:@>"
620              class))
621     `(find-class ',name)))
622
623 ;;; The class PCL-CLASS is an implementation-specific common
624 ;;; superclass of all specified subclasses of the class CLASS.
625 (defclass pcl-class (class)
626   ((class-precedence-list
627     :reader class-precedence-list)
628    ;; KLUDGE: see note in CPL-OR-NIL
629    (cpl-available-p
630     :reader cpl-available-p
631     :initform nil)
632    (can-precede-list
633     :initform ()
634     :reader class-can-precede-list)
635    (incompatible-superclass-list
636     :initform ()
637     :accessor class-incompatible-superclass-list)
638    (wrapper
639     :initform nil
640     :reader class-wrapper)
641    (prototype
642     :initform nil
643     :reader class-prototype)))
644
645 (defclass slot-class (pcl-class)
646   ((direct-slots
647     :initform ()
648     :accessor class-direct-slots)
649    (slots
650     :initform ()
651     :accessor class-slots)))
652
653 ;;; The class STD-CLASS is an implementation-specific common
654 ;;; superclass of the classes STANDARD-CLASS and
655 ;;; FUNCALLABLE-STANDARD-CLASS.
656 (defclass std-class (slot-class)
657   ())
658
659 (defclass standard-class (std-class)
660   ())
661
662 (defclass funcallable-standard-class (std-class)
663   ())
664
665 (defclass forward-referenced-class (pcl-class) ())
666
667 (defclass built-in-class (pcl-class) ())
668
669 (defclass condition-class (slot-class) ())
670
671 (defclass structure-class (slot-class)
672   ((defstruct-form
673      :initform ()
674      :accessor class-defstruct-form)
675    (defstruct-constructor
676      :initform nil
677      :accessor class-defstruct-constructor)
678    (from-defclass-p
679     :initform nil
680     :initarg :from-defclass-p)))
681
682 (defclass definition-source-mixin (standard-object)
683   ((source
684     :initform nil
685     :reader definition-source
686     :initarg :definition-source)))
687
688 (defclass plist-mixin (standard-object)
689   ((plist :initform () :accessor object-plist)))
690
691 (defclass dependent-update-mixin (plist-mixin) ())
692
693 (defparameter *early-class-predicates*
694   '((specializer specializerp)
695     (exact-class-specializer exact-class-specializer-p)
696     (class-eq-specializer class-eq-specializer-p)
697     (eql-specializer eql-specializer-p)
698     (class classp)
699     (slot-class slot-class-p)
700     (std-class std-class-p)
701     (standard-class standard-class-p)
702     (funcallable-standard-class funcallable-standard-class-p)
703     (condition-class condition-class-p)
704     (structure-class structure-class-p)
705     (forward-referenced-class forward-referenced-class-p)
706     (method method-p)
707     (standard-method standard-method-p)
708     (standard-accessor-method standard-accessor-method-p)
709     (standard-reader-method standard-reader-method-p)
710     (standard-writer-method standard-writer-method-p)
711     (standard-boundp-method standard-boundp-method-p)
712     (generic-function generic-function-p)
713     (standard-generic-function standard-generic-function-p)
714     (method-combination method-combination-p)
715     (long-method-combination long-method-combination-p)
716     (short-method-combination short-method-combination-p)))