0.7.9.43:
[sbcl.git] / src / pcl / defs.lisp
index 4df534a..ebf2eff 100644 (file)
 (defun class-eq-type (class)
   (specializer-type (class-eq-specializer class)))
 
-(defun inform-type-system-about-std-class (name)
-  (let ((predicate-name (make-type-predicate-name name)))
-    (setf (gdefinition predicate-name)
-         (make-type-predicate name))))
-
-(defun make-type-predicate (name)
-  (let ((cell (find-class-cell name)))
-    (lambda (x)
-      (funcall (the function (find-class-cell-predicate cell)) x))))
-
-(defun make-type-predicate-name (name &optional kind)
-  (if (symbol-package name)
-      (intern (format nil
-                     "~@[~A ~]TYPE-PREDICATE ~A ~A"
-                     kind
-                     (package-name (symbol-package name))
-                     (symbol-name name))
-             *pcl-package*)
-      (make-symbol (format nil
-                          "~@[~A ~]TYPE-PREDICATE ~A"
-                          kind
-                          (symbol-name name)))))
-
 ;;; internal to this file..
 ;;;
 ;;; These functions are a pale imitation of their namesake. They accept
 
 (defvar *name->class->slotd-table* (make-hash-table))
 
-;;; This is used by combined methods to communicate the next methods
-;;; to the methods they call. This variable is captured by a lexical
-;;; variable of the methods to give it the proper lexical scope.
-(defvar *next-methods* nil)
-
-(defvar *not-an-eql-specializer* '(not-an-eql-specializer))
-
-(defvar *umi-gfs*)
-(defvar *umi-complete-classes*)
-(defvar *umi-reorder*)
-
-(defvar *invalidate-discriminating-function-force-p* ())
-(defvar *invalid-dfuns-on-stack* ())
-
 (defvar *standard-method-combination*)
-
-(defvar *slotd-unsupplied* (list '*slotd-unsupplied*)) ;***
 \f
-(defmacro define-gf-predicate (predicate-name &rest classes)
-  `(progn
-     (defmethod ,predicate-name ((x t)) nil)
-     ,@(mapcar (lambda (c) `(defmethod ,predicate-name ((x ,c)) t))
-              classes)))
-
 (defun make-class-predicate-name (name)
   (intern (format nil "~A::~A class predicate"
                  (package-name (symbol-package name))
 
 (defclass definition-source-mixin (std-object)
   ((source
-    :initform *load-truename*
+    :initform *load-pathname*
     :reader definition-source
     :initarg :definition-source))
   (:metaclass std-class))
   (:metaclass std-class))
 
 ;;; The class CLASS is a specified basic class. It is the common
-;;; superclass of any kind of class. That is any class that can be a
+;;; superclass of any kind of class. That is, any class that can be a
 ;;; metaclass must have the class CLASS in its class precedence list.
 (defclass class (documentation-mixin
                 dependent-update-mixin
    (direct-superclasses
     :initform ()
     :reader class-direct-superclasses)
+   ;; Note: The (CLASS-)DIRECT-SUBCLASSES for STRUCTURE-CLASSes and
+   ;; CONDITION-CLASSes are lazily computed whenever the subclass info
+   ;; becomes available, i.e. when the PCL class is created.
    (direct-subclasses
     :initform ()
     :reader class-direct-subclasses)
    (method-combination
     :initarg :method-combination
     :accessor generic-function-method-combination)
+   (declarations
+    :initarg :declarations
+    :initform ()
+    :accessor generic-function-declarations)
    (arg-info
     :initform (make-arg-info)
     :reader gf-arg-info)