/[cmucl]/src/pcl/defs.lisp
ViewVC logotype

Contents of /src/pcl/defs.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.25 - (show annotations)
Mon Sep 9 16:08:58 2002 UTC (11 years, 7 months ago) by pmai
Branch: MAIN
Changes since 1.24: +0 -36 lines
Patch by Gerd Moellmann to remove further unused code from defs.lisp.
1 ;;;-*-Mode:LISP; Package:PCL -*-
2 ;;;
3 ;;; *************************************************************************
4 ;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
5 ;;; All rights reserved.
6 ;;;
7 ;;; Use and copying of this software and preparation of derivative works
8 ;;; based upon this software are permitted. Any distribution of this
9 ;;; software or derivative works must comply with all applicable United
10 ;;; States export control laws.
11 ;;;
12 ;;; This software is made available AS IS, and Xerox Corporation makes no
13 ;;; warranty about the software, its performance or its conformity to any
14 ;;; specification.
15 ;;;
16 ;;; Any person obtaining a copy of this software is requested to send their
17 ;;; name and post office or electronic mail address to:
18 ;;; CommonLoops Coordinator
19 ;;; Xerox PARC
20 ;;; 3333 Coyote Hill Rd.
21 ;;; Palo Alto, CA 94304
22 ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
23 ;;;
24 ;;; Suggestions, comments and requests for improvements are also welcome.
25 ;;; *************************************************************************
26 ;;;
27
28 (in-package :pcl)
29
30 (eval-when (:compile-toplevel :load-toplevel :execute)
31
32 (defvar *defclass-times* '(load eval)) ;Probably have to change this
33 ;if you use defconstructor.
34 (defvar *defmethod-times* '(load eval))
35 (defvar *defgeneric-times* '(load eval))
36
37 ; defvar is now actually in macros
38 ;(defvar *boot-state* ()) ;NIL
39 ;EARLY
40 ;BRAID
41 ;COMPLETE
42 (defvar *fegf-started-p* nil)
43
44
45 )
46
47 (eval-when (:load-toplevel :execute)
48 (when (eq *boot-state* 'complete)
49 (error "Trying to load (or compile) PCL in an environment in which it~%~
50 has already been loaded. This doesn't work, you will have to~%~
51 get a fresh lisp (reboot) and then load PCL."))
52 (when *boot-state*
53 (cerror "Try loading (or compiling) PCL anyways."
54 "Trying to load (or compile) PCL in an environment in which it~%~
55 has already been partially loaded. This may not work, you may~%~
56 need to get a fresh lisp (reboot) and then load PCL."))
57 )
58
59
60
61 ;;;
62 ;;; If symbol names a function which is traced or advised, return the
63 ;;; unadvised, traced etc. definition. This lets me get at the generic
64 ;;; function object even when it is traced.
65 ;;;
66 (declaim (inline gdefinition))
67 (defun gdefinition (symbol)
68 (fdefinition symbol))
69
70 ;;;
71 ;;; If symbol names a function which is traced or advised, redefine
72 ;;; the `real' definition without affecting the advise.
73 ;;
74 (defun (setf gdefinition) (new-definition name)
75 (c::%%defun name new-definition nil)
76 (c::note-name-defined name :function)
77 new-definition)
78
79 (declaim (special *the-class-t*
80 *the-class-vector* *the-class-symbol*
81 *the-class-string* *the-class-sequence*
82 *the-class-rational* *the-class-ratio*
83 *the-class-number* *the-class-null* *the-class-list*
84 *the-class-integer* *the-class-float* *the-class-cons*
85 *the-class-complex* *the-class-character*
86 *the-class-bit-vector* *the-class-array*
87 *the-class-stream*
88
89 *the-class-slot-object*
90 *the-class-structure-object*
91 *the-class-std-object*
92 *the-class-standard-object*
93 *the-class-funcallable-standard-object*
94 *the-class-class*
95 *the-class-generic-function*
96 *the-class-built-in-class*
97 *the-class-slot-class*
98 *the-class-structure-class*
99 *the-class-std-class*
100 *the-class-standard-class*
101 *the-class-funcallable-standard-class*
102 *the-class-method*
103 *the-class-standard-method*
104 *the-class-standard-reader-method*
105 *the-class-standard-writer-method*
106 *the-class-standard-boundp-method*
107 *the-class-standard-generic-function*
108 *the-class-standard-effective-slot-definition*
109
110 *the-eslotd-standard-class-slots*
111 *the-eslotd-funcallable-standard-class-slots*))
112
113 (declaim (special *the-wrapper-of-t*
114 *the-wrapper-of-vector* *the-wrapper-of-symbol*
115 *the-wrapper-of-string* *the-wrapper-of-sequence*
116 *the-wrapper-of-rational* *the-wrapper-of-ratio*
117 *the-wrapper-of-number* *the-wrapper-of-null*
118 *the-wrapper-of-list* *the-wrapper-of-integer*
119 *the-wrapper-of-float* *the-wrapper-of-cons*
120 *the-wrapper-of-complex* *the-wrapper-of-character*
121 *the-wrapper-of-bit-vector* *the-wrapper-of-array*))
122
123 ;;;; Type specifier hackery:
124
125 ;;; internal to this file.
126 (defun coerce-to-class (class &optional make-forward-referenced-class-p)
127 (if (symbolp class)
128 (or (find-class class (not make-forward-referenced-class-p))
129 (ensure-class class))
130 class))
131
132 ;;; Interface
133 (defun specializer-from-type (type &aux args)
134 (when (consp type)
135 (setq args (cdr type) type (car type)))
136 (cond ((symbolp type)
137 (or (and (null args) (find-class type))
138 (ecase type
139 (class (coerce-to-class (car args)))
140 (prototype (make-instance 'class-prototype-specializer
141 :object (coerce-to-class (car args))))
142 (class-eq (class-eq-specializer (coerce-to-class (car args))))
143 (eql (intern-eql-specializer (car args))))))
144 ((and (null args) (typep type 'lisp:class))
145 (or (kernel:class-pcl-class type)
146 (find-structure-class (lisp:class-name type))))
147 ((specializerp type) type)))
148
149 ;;; interface
150 (defun type-from-specializer (specl)
151 (cond ((eq specl t)
152 t)
153 ((consp specl)
154 (unless (member (car specl) '(class prototype class-eq eql))
155 (error "~S is not a legal specializer type" specl))
156 specl)
157 ((progn
158 (when (symbolp specl)
159 ;;maybe (or (find-class specl nil) (ensure-class specl)) instead?
160 (setq specl (find-class specl)))
161 (or (not (eq *boot-state* 'complete))
162 (specializerp specl)))
163 (specializer-type specl))
164 (t
165 (error "~s is neither a type nor a specializer" specl))))
166
167 (defun type-class (type)
168 (declare (special *the-class-t*))
169 (setq type (type-from-specializer type))
170 (if (atom type)
171 (if (eq type t)
172 *the-class-t*
173 (error "bad argument to type-class"))
174 (case (car type)
175 (eql (class-of (cadr type)))
176 (prototype (class-of (cadr type))) ;?
177 (class-eq (cadr type))
178 (class (cadr type)))))
179
180 (defun class-eq-type (class)
181 (specializer-type (class-eq-specializer class)))
182
183 (defun inform-type-system-about-std-class (name)
184 ;; This should only be called if metaclass is standard-class.
185 ;; Compiler problems have been seen if the metaclass is
186 ;; funcallable-standard-class and this is called from the defclass macro
187 ;; expander. However, bootstrap-meta-braid calls this for funcallable-
188 ;; standard-class metaclasses but *boot-state* is not 'complete then.
189 ;;
190 ;; The only effect of this code is to ensure a lisp:standard-class class
191 ;; exists so as to avoid undefined-function compiler warnings. The
192 ;; skeleton class will be replaced at load-time with the correct object.
193 ;; Earlier revisions (<= 1.17) of this function were essentially NOOPs.
194 (declare (ignorable name))
195 (when (and (eq *boot-state* 'complete)
196 (null (lisp:find-class name nil)))
197 (setf (lisp:find-class name)
198 (lisp::make-standard-class :name name))))
199
200 ;;; Internal to this file.
201 ;;;
202 ;;; These functions are a pale imitiation of their namesake. They accept
203 ;;; class objects or types where they should.
204 ;;;
205 (defun *normalize-type (type)
206 (cond ((consp type)
207 (if (member (car type) '(not and or))
208 `(,(car type) ,@(mapcar #'*normalize-type (cdr type)))
209 (if (null (cdr type))
210 (*normalize-type (car type))
211 type)))
212 ((symbolp type)
213 (let ((class (find-class type nil)))
214 (if class
215 (let ((type (specializer-type class)))
216 (if (listp type) type `(,type)))
217 `(,type))))
218 ((or (not (eq *boot-state* 'complete))
219 (specializerp type))
220 (specializer-type type))
221 (t
222 (error "~s is not a type" type))))
223
224 ;;; internal to this file...
225 (defun convert-to-system-type (type)
226 (case (car type)
227 ((not and or) `(,(car type) ,@(mapcar #'convert-to-system-type
228 (cdr type))))
229 ((class class-eq) ; class-eq is impossible to do right
230 (kernel:layout-class (class-wrapper (cadr type))))
231 (eql type)
232 (t (if (null (cdr type))
233 (car type)
234 type))))
235
236
237 ;;; *SUBTYPEP -- Interface
238 ;;;
239 ;Writing the missing NOT and AND clauses will improve
240 ;the quality of code generated by generate-discrimination-net, but
241 ;calling subtypep in place of just returning (values nil nil) can be
242 ;very slow. *subtypep is used by PCL itself, and must be fast.
243 (defun *subtypep (type1 type2)
244 (if (equal type1 type2)
245 (values t t)
246 (if (eq *boot-state* 'early)
247 (values (eq type1 type2) t)
248 (let ((*in-precompute-effective-methods-p* t))
249 (declare (special *in-precompute-effective-methods-p*))
250 ;; *in-precompute-effective-methods-p* is not a good name.
251 ;; It changes the way class-applicable-using-class-p works.
252 (setq type1 (*normalize-type type1))
253 (setq type2 (*normalize-type type2))
254 (case (car type2)
255 (not
256 (values nil nil)) ; Should improve this.
257 (and
258 (values nil nil)) ; Should improve this.
259 ((eql wrapper-eq class-eq class)
260 (multiple-value-bind (app-p maybe-app-p)
261 (specializer-applicable-using-type-p type2 type1)
262 (values app-p (or app-p (not maybe-app-p)))))
263 (t
264 (subtypep (convert-to-system-type type1)
265 (convert-to-system-type type2))))))))
266
267
268 (defvar *built-in-class-symbols* ())
269 (defvar *built-in-wrapper-symbols* ())
270
271 (defun get-built-in-class-symbol (class-name)
272 (or (cadr (assq class-name *built-in-class-symbols*))
273 (let ((symbol (intern (format nil
274 "*THE-CLASS-~A*"
275 (symbol-name class-name))
276 *the-pcl-package*)))
277 (push (list class-name symbol) *built-in-class-symbols*)
278 symbol)))
279
280 (defun get-built-in-wrapper-symbol (class-name)
281 (or (cadr (assq class-name *built-in-wrapper-symbols*))
282 (let ((symbol (intern (format nil
283 "*THE-WRAPPER-OF-~A*"
284 (symbol-name class-name))
285 *the-pcl-package*)))
286 (push (list class-name symbol) *built-in-wrapper-symbols*)
287 symbol)))
288
289
290
291
292 (pushnew 'class *variable-declarations*)
293 (pushnew 'variable-rebinding *variable-declarations*)
294
295 (defvar *name->class->slotd-table* (make-hash-table))
296
297 (defvar *standard-method-combination*)
298
299
300
301 (defun make-class-predicate-name (name)
302 (intern (format nil "~A::~A class predicate"
303 (package-name (symbol-package name))
304 name)
305 *the-pcl-package*))
306
307 (defun plist-value (object name)
308 (getf (object-plist object) name))
309
310 (defun (setf plist-value) (new-value object name)
311 (if new-value
312 (setf (getf (object-plist object) name) new-value)
313 (progn
314 (remf (object-plist object) name)
315 nil)))
316
317
318
319 (defvar *built-in-classes*
320 ;;
321 ;; name supers subs cdr of cpl
322 ;; prototype
323 '(;(t () (number sequence array character symbol) ())
324 (number (t) (complex float rational) (t))
325 (complex (number) () (number t)
326 #c(1 1))
327 (float (number) () (number t)
328 1.0)
329 (rational (number) (integer ratio) (number t))
330 (integer (rational) () (rational number t)
331 1)
332 (ratio (rational) () (rational number t)
333 1/2)
334
335 (sequence (t) (list vector) (t))
336 (list (sequence) (cons null) (sequence t))
337 (cons (list) () (list sequence t)
338 (nil))
339
340
341 (array (t) (vector) (t)
342 #2A((NIL)))
343 (vector (array
344 sequence) (string bit-vector) (array sequence t)
345 #())
346 (string (vector) () (vector array sequence t)
347 "")
348 (bit-vector (vector) () (vector array sequence t)
349 #*1)
350 (character (t) () (t)
351 #\c)
352
353 (symbol (t) (null) (t)
354 symbol)
355 (null (symbol
356 list) () (symbol list sequence t)
357 nil)))
358
359 (labels ((direct-supers (class)
360 (if (typep class 'lisp:built-in-class)
361 (kernel:built-in-class-direct-superclasses class)
362 (let ((inherits (kernel:layout-inherits
363 (kernel:class-layout class))))
364 (list (svref inherits (1- (length inherits)))))))
365 (direct-subs (class)
366 (ext:collect ((res))
367 (let ((subs (kernel:class-subclasses class)))
368 (when subs
369 (ext:do-hash (sub v subs)
370 (declare (ignore v))
371 (when (member class (direct-supers sub))
372 (res sub)))))
373 (res))))
374 (ext:collect ((res))
375 (dolist (bic kernel::built-in-classes)
376 (let* ((name (car bic))
377 (class (lisp:find-class name)))
378 (unless (member name '(t kernel:instance kernel:funcallable-instance
379 function stream))
380 (res `(,name
381 ,(mapcar #'lisp:class-name (direct-supers class))
382 ,(mapcar #'lisp:class-name (direct-subs class))
383 ,(map 'list (lambda (x)
384 (lisp:class-name (kernel:layout-class x)))
385 (reverse
386 (kernel:layout-inherits
387 (kernel:class-layout class))))
388 ,(let ((found (assoc name *built-in-classes*)))
389 (if found (fifth found) 42)))))))
390 (setq *built-in-classes* (res))))
391
392
393 ;;;
394 ;;; The classes that define the kernel of the metabraid.
395 ;;;
396 (defclass t () ()
397 (:metaclass built-in-class))
398
399 (defclass kernel:instance (t) ()
400 (:metaclass built-in-class))
401
402 (defclass function (t) ()
403 (:metaclass built-in-class))
404
405 (defclass kernel:funcallable-instance (function) ()
406 (:metaclass built-in-class))
407
408 (defclass stream (kernel:instance) ()
409 (:metaclass built-in-class))
410
411 (defclass slot-object (t) ()
412 (:metaclass slot-class))
413
414 (defclass structure-object (slot-object kernel:instance) ()
415 (:metaclass structure-class))
416
417 (defstruct (dead-beef-structure-object
418 (:constructor |STRUCTURE-OBJECT class constructor|)))
419
420
421 (defclass std-object (slot-object) ()
422 (:metaclass std-class))
423
424 (defclass standard-object (std-object kernel:instance) ())
425
426 (defclass funcallable-standard-object (std-object
427 kernel:funcallable-instance)
428 ()
429 (:metaclass funcallable-standard-class))
430
431 (defclass specializer (standard-object)
432 ((type
433 :initform nil
434 :reader specializer-type)))
435
436 (defclass definition-source-mixin (std-object)
437 ((source
438 :initform (load-truename)
439 :reader definition-source
440 :initarg :definition-source))
441 (:metaclass std-class))
442
443 (defclass plist-mixin (std-object)
444 ((plist
445 :initform ()
446 :accessor object-plist))
447 (:metaclass std-class))
448
449 (defclass documentation-mixin (plist-mixin)
450 ()
451 (:metaclass std-class))
452
453 (defclass dependent-update-mixin (plist-mixin)
454 ()
455 (:metaclass std-class))
456
457 ;;;
458 ;;; The class CLASS is a specified basic class. It is the common superclass
459 ;;; of any kind of class. That is any class that can be a metaclass must
460 ;;; have the class CLASS in its class precedence list.
461 ;;;
462 (defclass class (documentation-mixin dependent-update-mixin definition-source-mixin
463 specializer)
464 ((name
465 :initform nil
466 :initarg :name
467 :accessor class-name)
468 (class-eq-specializer
469 :initform nil
470 :reader class-eq-specializer)
471 (direct-superclasses
472 :initform ()
473 :reader class-direct-superclasses)
474 (direct-subclasses
475 :initform ()
476 :reader class-direct-subclasses)
477 (direct-methods
478 :initform (cons nil nil))
479 (predicate-name
480 :initform nil
481 :reader class-predicate-name)))
482
483 ;;;
484 ;;; The class PCL-CLASS is an implementation-specific common superclass of
485 ;;; all specified subclasses of the class CLASS.
486 ;;;
487 (defclass pcl-class (class)
488 ((class-precedence-list
489 :reader class-precedence-list)
490 (can-precede-list
491 :initform ()
492 :reader class-can-precede-list)
493 (incompatible-superclass-list
494 :initform ()
495 :accessor class-incompatible-superclass-list)
496 (wrapper
497 :initform nil
498 :reader class-wrapper)
499 (prototype
500 :initform nil
501 :reader class-prototype)))
502
503 (defclass slot-class (pcl-class)
504 ((direct-slots
505 :initform ()
506 :accessor class-direct-slots)
507 (slots
508 :initform ()
509 :accessor class-slots)
510 (initialize-info
511 :initform nil
512 :accessor class-initialize-info)))
513
514 ;;;
515 ;;; The class STD-CLASS is an implementation-specific common superclass of
516 ;;; the classes STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS.
517 ;;;
518 (defclass std-class (slot-class)
519 ())
520
521 (defclass standard-class (std-class)
522 ())
523
524 (defclass funcallable-standard-class (std-class)
525 ())
526
527 (defclass forward-referenced-class (pcl-class) ())
528
529 (defclass built-in-class (pcl-class) ())
530
531 (defclass structure-class (slot-class)
532 ((defstruct-form
533 :initform ()
534 :accessor class-defstruct-form)
535 (defstruct-constructor
536 :initform nil
537 :accessor class-defstruct-constructor)
538 (from-defclass-p
539 :initform nil
540 :initarg :from-defclass-p)))
541
542
543 (defclass specializer-with-object (specializer) ())
544
545 (defclass exact-class-specializer (specializer) ())
546
547 (defclass class-eq-specializer (exact-class-specializer specializer-with-object)
548 ((object :initarg :class :reader specializer-class :reader specializer-object)))
549
550 (defclass class-prototype-specializer (specializer-with-object)
551 ((object :initarg :class :reader specializer-class :reader specializer-object)))
552
553 (defclass eql-specializer (exact-class-specializer specializer-with-object)
554 ((object :initarg :object :reader specializer-object
555 :reader eql-specializer-object)))
556
557 (defvar *eql-specializer-table* (make-hash-table :test 'eql))
558
559 (defun intern-eql-specializer (object)
560 (or (gethash object *eql-specializer-table*)
561 (setf (gethash object *eql-specializer-table*)
562 (make-instance 'eql-specializer :object object))))
563
564
565 ;;;
566 ;;; Slot definitions.
567 ;;;
568 (defclass slot-definition (standard-object)
569 ((name
570 :initform nil
571 :initarg :name
572 :accessor slot-definition-name)
573 (initform
574 :initform nil
575 :initarg :initform
576 :accessor slot-definition-initform)
577 (initfunction
578 :initform nil
579 :initarg :initfunction
580 :accessor slot-definition-initfunction)
581 (readers
582 :initform nil
583 :initarg :readers
584 :accessor slot-definition-readers)
585 (writers
586 :initform nil
587 :initarg :writers
588 :accessor slot-definition-writers)
589 (initargs
590 :initform nil
591 :initarg :initargs
592 :accessor slot-definition-initargs)
593 (type
594 :initform t
595 :initarg :type
596 :accessor slot-definition-type)
597 (documentation
598 :initform ""
599 :initarg :documentation)
600 (class
601 :initform nil
602 :initarg :class
603 :accessor slot-definition-class)))
604
605 (defclass standard-slot-definition (slot-definition)
606 ((allocation
607 :initform :instance
608 :initarg :allocation
609 :accessor slot-definition-allocation)))
610
611 (defclass structure-slot-definition (slot-definition)
612 ((defstruct-accessor-symbol
613 :initform nil
614 :initarg :defstruct-accessor-symbol
615 :accessor slot-definition-defstruct-accessor-symbol)
616 (internal-reader-function
617 :initform nil
618 :initarg :internal-reader-function
619 :accessor slot-definition-internal-reader-function)
620 (internal-writer-function
621 :initform nil
622 :initarg :internal-writer-function
623 :accessor slot-definition-internal-writer-function)))
624
625 (defclass direct-slot-definition (slot-definition)
626 ())
627
628 (defclass effective-slot-definition (slot-definition)
629 ((reader-function ; (lambda (object) ...)
630 :accessor slot-definition-reader-function)
631 (writer-function ; (lambda (new-value object) ...)
632 :accessor slot-definition-writer-function)
633 (boundp-function ; (lambda (object) ...)
634 :accessor slot-definition-boundp-function)
635 (accessor-flags
636 :initform 0)))
637
638 (defclass standard-direct-slot-definition (standard-slot-definition
639 direct-slot-definition)
640 ())
641
642 (defclass standard-effective-slot-definition (standard-slot-definition
643 effective-slot-definition)
644 ((location ; nil, a fixnum, a cons: (slot-name . value)
645 :initform nil
646 :accessor slot-definition-location)))
647
648 (defclass structure-direct-slot-definition (structure-slot-definition
649 direct-slot-definition)
650 ())
651
652 (defclass structure-effective-slot-definition (structure-slot-definition
653 effective-slot-definition)
654 ())
655
656 (defclass method (standard-object) ())
657
658 (defclass standard-method (definition-source-mixin plist-mixin method)
659 ((generic-function
660 :initform nil
661 :accessor method-generic-function)
662 ; (qualifiers
663 ; :initform ()
664 ; :initarg :qualifiers
665 ; :reader method-qualifiers)
666 (specializers
667 :initform ()
668 :initarg :specializers
669 :reader method-specializers)
670 (lambda-list
671 :initform ()
672 :initarg :lambda-list
673 :reader method-lambda-list)
674 (function
675 :initform nil
676 :initarg :function) ;no writer
677 (fast-function
678 :initform nil
679 :initarg :fast-function ;no writer
680 :reader method-fast-function)
681 ; (documentation
682 ; :initform nil
683 ; :initarg :documentation
684 ; :reader method-documentation)
685 ))
686
687 (defclass standard-accessor-method (standard-method)
688 ((slot-name :initform nil
689 :initarg :slot-name
690 :reader accessor-method-slot-name)
691 (slot-definition :initform nil
692 :initarg :slot-definition
693 :reader accessor-method-slot-definition)))
694
695 (defclass standard-reader-method (standard-accessor-method) ())
696
697 (defclass standard-writer-method (standard-accessor-method) ())
698
699 (defclass standard-boundp-method (standard-accessor-method) ())
700
701 (defclass generic-function (dependent-update-mixin
702 definition-source-mixin
703 documentation-mixin
704 funcallable-standard-object)
705 ()
706 (:metaclass funcallable-standard-class))
707
708 (defclass standard-generic-function (generic-function)
709 ((name
710 :initform nil
711 :initarg :name
712 :accessor generic-function-name)
713 (methods
714 :initform ()
715 :accessor generic-function-methods)
716 (method-class
717 :initarg :method-class
718 :accessor generic-function-method-class)
719 (method-combination
720 :initarg :method-combination
721 :accessor generic-function-method-combination)
722 (arg-info
723 :initform (make-arg-info)
724 :reader gf-arg-info)
725 (dfun-state
726 :initform ()
727 :accessor gf-dfun-state)
728 (pretty-arglist
729 :initform ()
730 :accessor gf-pretty-arglist)
731 )
732 (:metaclass funcallable-standard-class)
733 (:default-initargs :method-class *the-class-standard-method*
734 :method-combination *standard-method-combination*))
735
736 (defclass method-combination (standard-object) ())
737
738 (defclass standard-method-combination
739 (definition-source-mixin method-combination)
740 ((type :reader method-combination-type
741 :initarg :type)
742 (documentation :reader method-combination-documentation
743 :initarg :documentation)
744 (options :reader method-combination-options
745 :initarg :options)))
746
747 (defparameter *early-class-predicates*
748 '((specializer specializerp)
749 (exact-class-specializer exact-class-specializer-p)
750 (class-eq-specializer class-eq-specializer-p)
751 (eql-specializer eql-specializer-p)
752 (class classp)
753 (slot-class slot-class-p)
754 (std-class std-class-p)
755 (standard-class standard-class-p)
756 (funcallable-standard-class funcallable-standard-class-p)
757 (structure-class structure-class-p)
758 (forward-referenced-class forward-referenced-class-p)
759 (method method-p)
760 (standard-method standard-method-p)
761 (standard-accessor-method standard-accessor-method-p)
762 (standard-reader-method standard-reader-method-p)
763 (standard-writer-method standard-writer-method-p)
764 (standard-boundp-method standard-boundp-method-p)
765 (generic-function generic-function-p)
766 (standard-generic-function standard-generic-function-p)
767 (method-combination method-combination-p)))
768

  ViewVC Help
Powered by ViewVC 1.1.5