From 4cf9c8955fc99aa5718eb4b265360578d0de29e0 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 9 Oct 2002 17:03:32 +0000 Subject: [PATCH] 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 --- src/pcl/defs.lisp | 22 ---------------------- src/pcl/dlisp2.lisp | 18 +++--------------- src/pcl/init.lisp | 25 +------------------------ src/pcl/low.lisp | 19 ++----------------- version.lisp-expr | 2 +- 5 files changed, 7 insertions(+), 79 deletions(-) diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp index 2ec1da6..76d5b8d 100644 --- 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*)) ;*** -(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 --- 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 --- 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 --- 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)) (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 --- 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" -- 1.7.10.4