0.7.8.22:

	Delete some more unused code from PCL (from Gerd Moellmann via Pierre
		Mai; see the entomotomy CLiki under misc-unused-code-in-pcl)
	... only two or three of the patches turned out to be applicable

diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index 2ec1da6..76d5b8d 100644 (file)
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -283,30 +283,8 @@
 
 (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))

diff --git a/src/pcl/dlisp2.lisp b/src/pcl/dlisp2.lisp
index 45e6212..7186fc3 100644 (file)
--- a/src/pcl/dlisp2.lisp
+++ b/src/pcl/dlisp2.lisp
@@ -62,22 +62,10 @@
                      (emit-one-or-n-index-reader/writer-macro :writer nil nil)))))
    nil))
 
-;;; Note this list is set up in dlisp3.lisp when all the necessary
-;;; macros have been loaded.
-(defvar *checking-or-caching-function-list* nil)
-
-(defmacro emit-checking-or-caching-function-precompiled ()
-  `(cdr (assoc (list cached-emf-p return-value-p metatypes applyp)
-              *checking-or-caching-function-list*
-              :test #'equal)))
-
 (defun emit-checking-or-caching-function (cached-emf-p return-value-p metatypes applyp)
-  (let ((fn (emit-checking-or-caching-function-precompiled)))
-    (if fn
-       (values fn nil)
-       (values (emit-checking-or-caching-function-preliminary
-                cached-emf-p return-value-p metatypes applyp)
-               t))))
+  (values (emit-checking-or-caching-function-preliminary
+          cached-emf-p return-value-p metatypes applyp)
+         t))
 
 (defvar *not-in-cache* (make-symbol "not in cache"))
 

diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp
index cce5b7f..47b8988 100644 (file)
--- a/src/pcl/init.lisp
+++ b/src/pcl/init.lisp
@@ -48,34 +48,11 @@
     (apply #'initialize-instance instance initargs)
     instance))
 
-(defvar *default-initargs-flag* (list nil))
-
 (defmethod default-initargs ((class slot-class) supplied-initargs)
   (call-initialize-function
    (initialize-info-default-initargs-function
     (initialize-info class supplied-initargs))
-   nil supplied-initargs)
-  #||
-  ;; This implementation of default initargs is critically dependent
-  ;; on all-default-initargs not having any duplicate initargs in it.
-  (let ((all-default (class-default-initargs class))
-       (miss *default-initargs-flag*))
-    (flet ((getf* (plist key)
-            (do ()
-                ((null plist) miss)
-              (if (eq (car plist) key)
-                  (return (cadr plist))
-                  (setq plist (cddr plist))))))
-      (labels ((default-1 (tail)
-                (if (null tail)
-                    nil
-                    (if (eq (getf* supplied-initargs (caar tail)) miss)
-                        (list* (caar tail)
-                               (funcall (cadar tail))
-                               (default-1 (cdr tail)))
-                        (default-1 (cdr tail))))))
-       (append supplied-initargs (default-1 all-default)))))
-  ||#)
+   nil supplied-initargs))
 
 (defmethod initialize-instance ((instance slot-object) &rest initargs)
   (apply #'shared-initialize instance t initargs))

diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp
index 7135e5f..dd2295d 100644 (file)
--- a/src/pcl/low.lisp
+++ b/src/pcl/low.lisp
@@ -97,31 +97,16 @@
 
 (import 'sb-kernel:funcallable-instance-p)
 
-;;; This "works" on non-PCL FINs, which allows us to weaken
-;;; FUNCALLABLE-INSTANCE-P to return true for all FINs. This is also
-;;; necessary for bootstrapping to work, since the layouts for early
-;;; GFs are not initially initialized.
-(defmacro funcallable-instance-data-1 (fin slot)
-  (ecase (eval slot)
-    (wrapper `(sb-kernel:%funcallable-instance-layout ,fin))
-    (slots `(sb-kernel:%funcallable-instance-info ,fin 0))))
-
-;;; FIXME: Now that we no longer try to make our CLOS implementation
-;;; portable to other implementations of Common Lisp, all the
-;;; funcallable instance wrapper logic here can go away in favor
-;;; of direct calls to native SBCL funcallable instance operations.
 (defun set-funcallable-instance-fun (fin new-value)
   (declare (type function new-value))
   (aver (funcallable-instance-p fin))
   (setf (sb-kernel:funcallable-instance-fun fin) new-value))
 (defmacro fsc-instance-p (fin)
   `(funcallable-instance-p ,fin))
-(defmacro fsc-instance-class (fin)
-  `(wrapper-class (funcallable-instance-data-1 ,fin 'wrapper)))
 (defmacro fsc-instance-wrapper (fin)
-  `(funcallable-instance-data-1 ,fin 'wrapper))
+  `(sb-kernel:%funcallable-instance-layout ,fin))
 (defmacro fsc-instance-slots (fin)
-  `(funcallable-instance-data-1 ,fin 'slots))
+  `(sb-kernel:%funcallable-instance-info ,fin 0))
 \f
 (declaim (inline clos-slots-ref (setf clos-slots-ref)))
 (declaim (ftype (function (simple-vector index) t) clos-slots-ref))

diff --git a/version.lisp-expr b/version.lisp-expr
index 868255d..5e50aa0 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; internal versions off the main CVS branch, it gets hairier, e.g.
 ;;; "0.pre7.14.flaky4.13".)
 
-"0.7.8.21"
+"0.7.8.22"