X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fdefs.lisp;h=322563d2e83cf011bfe311891452251305dcb751;hb=98f3f617894ce24a40764aa98606ce68c5482cf0;hp=4df534afd8f8c243e8d519fbf10f6e465d7a2170;hpb=106e6fe2df729b6027718f6f056721a95c047c17;p=sbcl.git

diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index 4df534a..322563d 100644
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -187,29 +187,6 @@
 (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
@@ -306,36 +283,11 @@
 
 (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*))	;***
 
-(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))
-		  name)
-	  *pcl-package*))
-
+  (list 'class-predicate name))
+  
 (defun plist-value (object name)
   (getf (object-plist object) name))
 
@@ -517,7 +469,7 @@
 
 (defclass definition-source-mixin (std-object)
   ((source
-    :initform *load-truename*
+    :initform *load-pathname*
     :reader definition-source
     :initarg :definition-source))
   (:metaclass std-class))
@@ -537,7 +489,7 @@
   (: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
@@ -553,6 +505,9 @@
    (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)
@@ -687,7 +642,11 @@
   ((allocation
     :initform :instance
     :initarg :allocation
-    :accessor slot-definition-allocation)))
+    :accessor slot-definition-allocation)
+   (allocation-class
+    :initform nil
+    :initarg :allocation-class
+    :accessor slot-definition-allocation-class)))
 
 (defclass structure-slot-definition (slot-definition)
   ((defstruct-accessor-symbol
@@ -814,6 +773,10 @@
    (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)
@@ -838,6 +801,14 @@
     :reader method-combination-options
     :initarg :options)))
 
+(defclass long-method-combination (standard-method-combination)
+  ((function
+    :initarg :function
+    :reader long-method-combination-function)
+   (args-lambda-list
+    :initarg :args-lambda-list
+    :reader long-method-combination-args-lambda-list)))
+
 (defparameter *early-class-predicates*
   '((specializer specializerp)
     (exact-class-specializer exact-class-specializer-p)
@@ -858,5 +829,6 @@
     (standard-boundp-method standard-boundp-method-p)
     (generic-function generic-function-p)
     (standard-generic-function standard-generic-function-p)
-    (method-combination method-combination-p)))
+    (method-combination method-combination-p)
+    (long-method-combination long-method-combination-p)))