From a0a9232dac87a6f3f707bfa4256b7b427ff38262 Mon Sep 17 00:00:00 2001 From: phg <phg> Date: Tue, 12 Jan 1993 18:28:29 +0000 Subject: [PATCH] September-16-92-PCL-e has been incorporated into the CMUCL sources thanks to Rick Harris. --- pcl/boot.lisp | 76 ++- pcl/braid.lisp | 4 +- pcl/cache.lisp | 2 +- pcl/cmu-low.lisp | 7 +- pcl/combin.lisp | 2 +- pcl/defclass.lisp | 2 +- pcl/defcombin.lisp | 2 +- pcl/defsys.lisp | 74 ++- pcl/dfun.lisp | 7 +- pcl/dlisp.lisp | 8 +- pcl/env.lisp | 14 +- pcl/fast-init.lisp | 651 +++++++++---------- pcl/fin.lisp | 2 +- pcl/generic-functions.lisp | 6 +- pcl/init.lisp | 2 +- pcl/low.lisp | 3 +- pcl/macros.lisp | 71 +- pcl/methods.lisp | 41 +- pcl/slots-boot.lisp | 57 +- pcl/slots.lisp | 8 +- pcl/sys-proclaim.lisp | 1262 +++++++++++++++--------------------- pcl/vector.lisp | 88 ++- 22 files changed, 1139 insertions(+), 1250 deletions(-) diff --git a/pcl/boot.lisp b/pcl/boot.lisp index 80572e3d2..aeb7ba960 100644 --- a/pcl/boot.lisp +++ b/pcl/boot.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* ;;; -(in-package 'pcl) +(in-package :pcl) #| @@ -99,9 +99,10 @@ work during bootstrapping. (eval-when (load eval) (defun redirect-early-function-internal (real early) - (setf (symbol-function real) + (setf (gdefinition real) (set-function-name - #'(lambda (&rest args) (apply (symbol-function early) args)) + #'(lambda (&rest args) + (apply (the function (symbol-function early)) args)) real))) (dolist (fns *early-functions*) @@ -278,10 +279,16 @@ work during bootstrapping. (find-class 'standard-method))))))) +(defvar *optimize-asv-funcall-p* nil) +(defvar *asv-readers*) +(defvar *asv-writers*) +(defvar *asv-boundps*) (defun expand-defmethod (name proto-gf proto-method qualifiers lambda-list body env) (when (listp name) (do-standard-defsetf-1 (cadr name))) - (let ((*make-instance-function-keys* nil)) + (let ((*make-instance-function-keys* nil) + (*optimize-asv-funcall-p* t) + (*asv-readers* nil) (*asv-writers* nil) (*asv-boundps* nil)) (declare (special *make-instance-function-keys*)) (multiple-value-bind (method-lambda unspecialized-lambda-list specializers) (add-method-declarations name qualifiers lambda-list body env) @@ -294,6 +301,9 @@ work during bootstrapping. (proclaim-defgeneric ',name ',lambda-list) ,@(when *make-instance-function-keys* `((get-make-instance-functions ',*make-instance-function-keys*))) + ,@(when (or *asv-readers* *asv-writers* *asv-boundps*) + `((initialize-internal-slot-gfs* + ',*asv-readers* ',*asv-writers* ',*asv-boundps*))) ,(make-defmethod-form name qualifiers specializers unspecialized-lambda-list (if proto-method @@ -411,7 +421,7 @@ work during bootstrapping. (make-method-initargs-form-internal method-lambda initargs env)) (unless (fboundp 'make-method-initargs-form) - (setf (symbol-function 'make-method-initargs-form) + (setf (gdefinition 'make-method-initargs-form) (symbol-function 'real-make-method-initargs-form))) (defun real-make-method-lambda (proto-gf proto-method method-lambda env) @@ -527,7 +537,7 @@ work during bootstrapping. `(:documentation ,documentation))))))))))) (unless (fboundp 'make-method-lambda) - (setf (symbol-function 'make-method-lambda) + (setf (gdefinition 'make-method-lambda) (symbol-function 'real-make-method-lambda))) (defmacro simple-lexical-method-functions ((lambda-list method-args next-methods @@ -605,7 +615,7 @@ work during bootstrapping. (index 0 :type fixnum)) (eval-when (compile load eval) -(defvar *allow-emf-call-tracing-p* t) +(defvar *allow-emf-call-tracing-p* nil) (defvar *enable-emf-call-tracing-p* #-testing nil #+testing t) ) @@ -656,24 +666,28 @@ work during bootstrapping. (invoke-fast-method-call ,emf ,@required-args+rest-arg)) ,@(when (and (null restp) (= 1 (length required-args+rest-arg))) `(((typep ,emf 'fixnum) - (let* ((.slots. (get-slots-or-nil ,(car required-args+rest-arg))) + (let* ((.slots. (get-slots-or-nil + ,(car required-args+rest-arg))) (value (when .slots. (%instance-ref .slots. ,emf)))) (if (eq value ',*slot-unbound*) - (slot-unbound-internal ,(car required-args+rest-arg) ,emf) + (slot-unbound-internal ,(car required-args+rest-arg) + ,emf) value))))) ,@(when (and (null restp) (= 2 (length required-args+rest-arg))) `(((typep ,emf 'fixnum) (let ((.new-value. ,(car required-args+rest-arg)) - (.slots. (get-slots-or-nil ,(car required-args+rest-arg)))) + (.slots. (get-slots-or-nil + ,(car required-args+rest-arg)))) (when .slots. ; just to avoid compiler wranings (setf (%instance-ref .slots. ,emf) .new-value.)))))) #|| ,@(when (and (null restp) (= 1 (length required-args+rest-arg))) `(((typep ,emf 'fast-instance-boundp) - (let ((.slots. (get-slots-or-nil ,(car required-args+rest-arg)))) + (let ((.slots. (get-slots-or-nil + ,(car required-args+rest-arg)))) (and .slots. - (not (eq (%instance-ref .slots. - (fast-instance-boundp-index ,emf)) + (not (eq (%instance-ref + .slots. (fast-instance-boundp-index ,emf)) ',*slot-unbound*))))))) ||# (t @@ -747,6 +761,7 @@ work during bootstrapping. (nreq (arg-info-number-required arg-info)) (restp (arg-info-applyp arg-info))) #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) (trace-emf-call emf t args) (apply (fast-method-call-function emf) (fast-method-call-pv-cell emf) @@ -757,10 +772,11 @@ work during bootstrapping. (nconc req-args rest-args)) args))))) (method-call #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) (trace-emf-call emf t args) (apply (method-call-function emf) - args - (method-call-call-method-args emf)))) + args + (method-call-call-method-args emf)))) (function emf))) (defmacro bind-fast-lexical-method-macros ((args rest-arg next-method-call) @@ -814,6 +830,7 @@ work during bootstrapping. '((call-next-method (&rest cnm-args) #+Genera (declare (dbg:invisible-frame :clos-internal)) + #+copy-&rest-arg (setq args (copy-list args)) (call-next-method-body cnm-args)))) ,@(and next-method-p-p '((next-method-p () @@ -945,6 +962,13 @@ work during bootstrapping. (generic-function-name-p (car form))) (optimize-generic-function-call form required-parameters env slots calls)) + ((and (eq (car form) 'asv-funcall) + *optimize-asv-funcall-p*) + (case (fourth form) + (reader (push (third form) *asv-readers*)) + (writer (push (third form) *asv-writers*)) + (boundp (push (third form) *asv-boundps*))) + `(,(second form) ,@(cddddr form))) (t form)))) (let ((walked-lambda (walk-form method-lambda env #'walk-function))) @@ -952,7 +976,13 @@ work during bootstrapping. call-next-method-p closurep next-method-p-p))))) (defun generic-function-name-p (name) - (and (gboundp name) + (and (or (symbolp name) + (and (consp name) + (eq (car name) 'setf) + (consp (cdr name)) + (symbolp (cadr name)) + (null (cddr name)))) + (gboundp name) (if (eq *boot-state* 'complete) (standard-generic-function-p (gdefinition name)) (funcallable-instance-p (gdefinition name))))) @@ -1208,6 +1238,7 @@ work during bootstrapping. &key environment &allow-other-keys) (declare (ignore environment)) + #+copy-&rest-arg (setq all-keys (copy-list all-keys)) (let ((existing (and (gboundp function-specifier) (gdefinition function-specifier)))) (if (and existing @@ -1336,7 +1367,6 @@ work during bootstrapping. (and first-p (eq (arg-info-lambda-list arg-info) ':no-lambda-list))) (multiple-value-bind (nreq nopt keysp restp allow-other-keys-p keywords) (analyze-lambda-list lambda-list) - (declare (ignore allow-other-keys-p)) (when (and methods (not first-p)) (let ((gf-nreq (arg-info-number-required arg-info)) (gf-nopt (arg-info-number-optional arg-info)) @@ -1349,9 +1379,11 @@ work during bootstrapping. lambda-list gf)))) (when lambda-list-p (setf (arg-info-lambda-list arg-info) lambda-list)) + (when (or lambda-list-p argument-precedence-order + (null (arg-info-precedence arg-info))) + (setf (arg-info-precedence arg-info) + (compute-precedence lambda-list nreq argument-precedence-order))) (setf (arg-info-metatypes arg-info) (make-list nreq)) - (setf (arg-info-precedence arg-info) - (compute-precedence lambda-list nreq argument-precedence-order)) (setf (arg-info-number-optional arg-info) nopt) (setf (arg-info-key/rest-p arg-info) (not (null (or keysp restp)))) (setf (arg-info-keywords arg-info) @@ -1593,6 +1625,7 @@ work during bootstrapping. &key environment (lambda-list nil lambda-list-p) (generic-function-class 'standard-generic-function gf-class-p) &allow-other-keys) + #+copy-&rest-arg (setq all-keys (copy-list all-keys)) (real-ensure-gf-internal generic-function-class all-keys environment) (unless (or (null gf-class-p) (eq (class-of existing) generic-function-class)) @@ -1610,6 +1643,7 @@ work during bootstrapping. (generic-function-class 'standard-generic-function) &allow-other-keys) (declare (ignore existing)) + #+copy-&rest-arg (setq all-keys (copy-list all-keys)) (real-ensure-gf-internal generic-function-class all-keys environment) (prog1 (setf (gdefinition function-specifier) @@ -1738,6 +1772,7 @@ work during bootstrapping. specializers arglist &rest initargs) + #+copy-&rest-arg (setq initargs (copy-list initargs)) (let* ((gf (ensure-generic-function generic-function-name)) (existing (dolist (m (early-gf-methods gf)) @@ -1848,7 +1883,7 @@ work during bootstrapping. (set-methods gf methods))) (dolist (fns *early-functions*) - (setf (symbol-function (car fns)) (symbol-function (caddr fns)))) + (setf (gdefinition (car fns)) (symbol-function (caddr fns)))) (dolist (fixup *generic-function-fixups*) (let* ((fspec (car fixup)) @@ -1866,6 +1901,7 @@ work during bootstrapping. (declare (ignore next-methods)) (apply fn args)) `(call ,fn-name))))) + (declare (type function fn)) (make-a-method 'standard-method () lambda-list diff --git a/pcl/braid.lisp b/pcl/braid.lisp index f6d2ce9be..b05bd2db4 100644 --- a/pcl/braid.lisp +++ b/pcl/braid.lisp @@ -34,7 +34,7 @@ ;;; ;;; -(in-package 'pcl) +(in-package :pcl) (defun allocate-standard-instance (wrapper &optional (slots-init nil slots-init-p)) #-new-kcl-wrapper (declare (special *slot-unbound*)) @@ -127,7 +127,7 @@ (defun bootstrap-meta-braid () (let* ((name 'class) (predicate-name (make-type-predicate-name name))) - (setf (symbol-function predicate-name) + (setf (gdefinition predicate-name) #'(lambda (x) (declare (ignore x)) t)) (do-satisfies-deftype name predicate-name)) (let* ((*create-classes-from-internal-structure-definitions-p* nil) diff --git a/pcl/cache.lisp b/pcl/cache.lisp index ac3b00434..268d8bbbd 100644 --- a/pcl/cache.lisp +++ b/pcl/cache.lisp @@ -27,7 +27,7 @@ ;;; The basics of the PCL wrapper cache mechanism. ;;; -(in-package 'pcl) +(in-package :pcl) ;;; ;;; The caching algorithm implemented: ;;; diff --git a/pcl/cmu-low.lisp b/pcl/cmu-low.lisp index ab684398e..87bceaa3a 100644 --- a/pcl/cmu-low.lisp +++ b/pcl/cmu-low.lisp @@ -27,7 +27,7 @@ ;;; This is the CMU Lisp version of the file low. ;;; -(in-package 'pcl) +(in-package :pcl) (defmacro dotimes ((var count &optional (result nil)) &body body) `(lisp:dotimes (,var (the fixnum ,count) ,result) @@ -87,8 +87,11 @@ fcn) (t (let ((header (kernel:%closure-function fcn))) + #+cmu17 + (setf (c::%function-name header) new-name) + #-cmu17 (system:%primitive c::set-function-name header new-name)) - fcn))) + fcn))) (in-package "C") diff --git a/pcl/combin.lisp b/pcl/combin.lisp index 430905251..d6bdd87b5 100644 --- a/pcl/combin.lisp +++ b/pcl/combin.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* ;;; -(in-package 'pcl) +(in-package :pcl) (defun get-method-function (method &optional method-alist wrappers) (let ((fn (cadr (assoc method method-alist)))) diff --git a/pcl/defclass.lisp b/pcl/defclass.lisp index e5ded1bda..747be0110 100644 --- a/pcl/defclass.lisp +++ b/pcl/defclass.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* ;;; -(in-package 'pcl) +(in-package :pcl) ;;; ;;; MAKE-TOP-LEVEL-FORM is used by all PCL macros that appear `at top-level'. diff --git a/pcl/defcombin.lisp b/pcl/defcombin.lisp index 7d1434526..61222ad44 100644 --- a/pcl/defcombin.lisp +++ b/pcl/defcombin.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* ;;; -(in-package 'pcl) +(in-package :pcl) ;;; ;;; DEFINE-METHOD-COMBINATION diff --git a/pcl/defsys.lisp b/pcl/defsys.lisp index 4a758c239..210c613e2 100644 --- a/pcl/defsys.lisp +++ b/pcl/defsys.lisp @@ -218,7 +218,7 @@ ;;; (defvar *the-pcl-package* (find-package :pcl)) -(defvar *pcl-system-date* "September 16 PCL") +(defvar *pcl-system-date* "September 16 92 PCL (e)") #+cmu (setf (getf ext:*herald-items* :pcl) @@ -239,6 +239,7 @@ (pushnew :genera-release-6 *features*)) ((7) (pushnew :genera-release-7 *features*) + (pushnew :copy-&rest-arg *features*) (ecase minor ((0 1) (pushnew :genera-release-7-1 *features*)) ((2) (pushnew :genera-release-7-2 *features*)) @@ -300,6 +301,22 @@ (eval-when (eval compile load) (pushnew :excl-sun4 *features*)) +#+cmu +(eval-when (compile load eval) + (let ((vs (lisp-implementation-version))) + (cond ((and (<= 2 (length vs)) + (eql #\1 (aref vs 0)) + (let ((d (digit-char-p (aref vs 1)))) + (and d (<= 6 d)))) + (pushnew :cmu16 *features*)) + ((string= "20-Dec-1992" vs) + (pushnew :cmu16 *features*) + (pushnew :cmu17 *features*) + (when (fboundp 'pcl::original-defstruct) + (setf (macro-function 'defstruct) + (macro-function 'pcl::original-defstruct)))) + (t + (error "what version of cmucl is this?"))))) ;;; Yet Another Sort Of General System Facility and friends. ;;; @@ -514,6 +531,7 @@ and load your system with: (defun make-transformations (modules filter make-transform) + (declare (type function filter make-transform)) (let ((transforms (list nil))) (dolist (m modules) (when (funcall filter m transforms) (funcall make-transform m transforms))) @@ -567,7 +585,7 @@ and load your system with: (defun operation-transformations (name mode &optional arg) (let ((system (get-system name))) (unless system (error "Can't find system with name ~S." name)) - (let ((*system-directory* (funcall (car system))) + (let ((*system-directory* (funcall (the function (car system)))) (modules (cadr system))) (ecase mode (:compile @@ -637,7 +655,7 @@ and load your system with: (defun operate-on-system (name mode &optional arg print-only) (let ((system (get-system name))) (unless system (error "Can't find system with name ~S." name)) - (let* ((*system-directory* (funcall (car system))) + (let* ((*system-directory* (funcall (the function (car system)))) (transformations (operation-transformations name mode arg))) (labels ((load-binary (name pathname) (format t "~&Loading binary of ~A...~%" name) @@ -702,7 +720,7 @@ and load your system with: (defun system-source-files (name) (let ((system (get-system name))) (unless system (error "Can't find system with name ~S." name)) - (let ((*system-directory* (funcall (car system))) + (let ((*system-directory* (funcall (the function (car system)))) (modules (cadr system))) (mapcar #'(lambda (module) (make-source-pathname (module-name module))) @@ -711,7 +729,7 @@ and load your system with: (defun system-binary-files (name) (let ((system (get-system name))) (unless system (error "Can't find system with name ~S." name)) - (let ((*system-directory* (funcall (car system))) + (let ((*system-directory* (funcall (the function (car system)))) (modules (cadr system))) (mapcar #'(lambda (module) (make-binary-pathname (module-name module))) @@ -752,16 +770,17 @@ and load your system with: ;; #+LUCID (or lucid::*source-pathname* (bad-time)) #+akcl si:*load-pathname* - #-(or Lispm excl Xerox (and dec vax common) LUCID akcl) nil)) + #+cmu17 *load-truename* + #-(or Lispm excl Xerox (and dec vax common) LUCID akcl cmu17) nil)) -#-(or cmu Symbolics) +#-(or (and cmu (not cmu17)) Symbolics) (defvar *pcl-directory* (or (load-truename t) (error "Because load-truename is not implemented in this port~%~ of PCL, you must manually edit the definition of the~%~ variable *pcl-directory* in the file defsys.lisp."))) -#+cmu +#+(and cmu (not cmu17)) (defvar *pcl-directory* (pathname "pcl:")) #+Genera @@ -1002,19 +1021,7 @@ and load your system with: (names (mapcar #'symbol-name vars)) (values (mapcar #'symbol-value vars))) (declare (special *redefined-functions*)) - (let ((pkg (find-package "PCL"))) - (do-symbols (sym pkg) - (when (eq pkg (symbol-package sym)) - (if (or (constantp sym) - (eq sym 'wrapper) - (eq sym 'arg-info)) - (unintern sym pkg) - (progn - (makunbound sym) - (unless (eq sym 'reset-pcl-package) - (fmakunbound sym)) - #+cmu (fmakunbound `(setf ,sym)) - (setf (symbol-plist sym) nil)))))) + (reset-package "PCL") (let ((pkg (find-package "SLOT-ACCESSOR-NAME"))) (when pkg (do-symbols (sym pkg) @@ -1031,5 +1038,26 @@ and load your system with: (setf (symbol-function sym) (get sym ':definition-before-pcl))) nil)) - - +(defun reset-package (&optional (package-name "PCL")) + (let ((pkg (find-package package-name))) + (do-symbols (sym pkg) + (when (eq pkg (symbol-package sym)) + (if (or (constantp sym) + #-cmu (member sym '(wrapper cache arg-info pv-table)) + #+cmu + (or (c::info setf inverse sym) + (c::info setf expander sym) + (c::info type kind sym) + (c::info type structure-info sym) + (c::info type defined-structure-info sym) + (c::info function macro-function sym) + (c::info function compiler-macro-function sym))) + (unintern sym pkg) + (progn + (makunbound sym) + (unless (or (eq sym 'reset-pcl-package) + (eq sym 'reset-package)) + (fmakunbound sym) + #+cmu + (fmakunbound `(setf ,sym))) + (setf (symbol-plist sym) nil))))))) diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp index 0972ec87a..ef35e338c 100644 --- a/pcl/dfun.lisp +++ b/pcl/dfun.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* ;;; -(in-package 'pcl) +(in-package :pcl) #| @@ -419,6 +419,7 @@ And so, we are saved. function #'(lambda (&rest args) (declare (pcl-fast-call)) + #+copy-&rest-arg (setq args (copy-list args)) (checking-miss generic-function args dfun-info))) cache dfun-info))))) @@ -428,6 +429,7 @@ And so, we are saved. (let ((metatypes (arg-info-metatypes (gf-arg-info generic-function)))) (if (every #'(lambda (mt) (eq mt 't)) metatypes) (values #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) (invoke-emf function args)) nil (default-method-only-dfun-info)) (let ((cache (make-final-ordinary-dfun-internal @@ -474,6 +476,7 @@ And so, we are saved. cache #'(lambda (&rest args) (declare (pcl-fast-call)) + #+copy-&rest-arg (setq args (copy-list args)) (caching-miss generic-function args dfun-info))) cache dfun-info)))) @@ -535,6 +538,7 @@ And so, we are saved. cache #'(lambda (&rest args) (declare (pcl-fast-call)) + #+copy-&rest-arg (setq args (copy-list args)) (constant-value-miss generic-function args dfun-info))) cache dfun-info)))) @@ -644,6 +648,7 @@ And so, we are saved. (defun make-initial-dfun (gf) (let ((initial-dfun #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) (initial-dfun gf args)))) (multiple-value-bind (dfun cache info) (if (and (eq *boot-state* 'complete) diff --git a/pcl/dlisp.lisp b/pcl/dlisp.lisp index da9c8a261..f8538ad5f 100644 --- a/pcl/dlisp.lisp +++ b/pcl/dlisp.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* ;;; -(in-package 'pcl) +(in-package :pcl) ;;; This file is (almost) functionally equivalent to dlap.lisp, ;;; but easier to read. @@ -105,6 +105,10 @@ ,@(when (member 'miss-fn closure-variables) `((declare (type function miss-fn)))) #'(lambda ,args + #+copy-&rest-arg + ,@(when rest + `((setq .lap-rest-arg. + (copy-list .lap-rest-arg.)))) (let () (declare #.*optimize-speed*) ,form))))) @@ -116,7 +120,7 @@ (defun emit-reader/writer (reader/writer 1-or-2-class class-slot-p) (when (and (null *precompiling-lap*) *emit-function-p*) (return-from emit-reader/writer - (emit-reader/writer-function reader/writer 1-or-2-class class-slot-p))) + (emit-reader/writer-function reader/writer 1-or-2-class class-slot-p))) (let ((instance nil) (arglist ()) (closure-variables ()) diff --git a/pcl/env.lisp b/pcl/env.lisp index 524055f73..000ee3e78 100644 --- a/pcl/env.lisp +++ b/pcl/env.lisp @@ -27,7 +27,7 @@ ;;; Basic environmental stuff. ;;; -(in-package 'pcl) +(in-package :pcl) #+Lucid (progn @@ -209,9 +209,14 @@ #+cmu (defmethod describe-object ((object hash-table) stream) - (format stream "~&~S is an ~a hash table." object (lisp::hash-table-kind object)) - (format stream "~&Its size is ~d buckets." (lisp::hash-table-size object)) - (format stream "~&Its rehash-size is ~d." (lisp::hash-table-rehash-size object)) + (format stream "~&~S is an ~a hash table." + object + #-cmu17 (lisp::hash-table-kind object) + #+cmu17 (lisp::hash-table-test object)) + (format stream "~&Its size is ~d buckets." + (lisp::hash-table-size object)) + (format stream "~&Its rehash-size is ~d." + (lisp::hash-table-rehash-size object)) (format stream "~&Its rehash-threshold is ~d." (lisp::hash-table-rehash-threshold object)) (format stream "~&It currently holds ~d entries." @@ -262,6 +267,7 @@ (defvar *traced-methods* ()) (defun trace-method (spec &rest options) + #+copy-&rest-arg (setq options (copy-list options)) (multiple-value-bind (gf omethod name) (parse-method-or-spec spec) (let* ((tfunction (trace-method-internal (method-function omethod) diff --git a/pcl/fast-init.lisp b/pcl/fast-init.lisp index a083f5c25..31224265c 100644 --- a/pcl/fast-init.lisp +++ b/pcl/fast-init.lisp @@ -28,58 +28,25 @@ ;;; This file defines the optimized make-instance functions. ;;; -(in-package 'pcl) +(in-package :pcl) -;make-instance-functions take up more space when compiled. -(defvar *inhibit-compile-make-instance-functions-p* nil) +(defvar *compile-make-instance-functions-p* nil) -(defvar *compile-make-instance-functions-p* nil) ; this gets bound to t below - -(defvar *make-instance-function-table* (make-hash-table :test 'equal)) - -(defvar gmif-class nil) - -(defun update-make-instance-function-table (&optional (gmif-class *the-class-t*)) - (when (symbolp gmif-class) (setq gmif-class (find-class gmif-class))) - (let ((class gmif-class)) +(defun update-make-instance-function-table (&optional (class *the-class-t*)) + (when (symbolp class) (setq class (find-class class))) (when (eq class *the-class-t*) (setq class *the-class-slot-object*)) (when (memq *the-class-slot-object* (class-precedence-list class)) (map-all-classes #'reset-class-initialize-info class))) - (maphash #'get-make-instance-function *make-instance-function-table*)) - -(defun get-make-instance-function-key (class initargs) - (let ((keys nil)(allow-other-keys-p nil) key value) - (when initargs - (let ((initargs-tail initargs)) - (setq key (pop initargs-tail) value (pop initargs-tail)) - (when (eq key ':allow-other-keys) - (setq allow-other-keys-p value)) - (setq keys (cons key nil)) - (when initargs-tail - (let ((keys-tail keys)) - (loop (setq key (pop initargs-tail) value (pop initargs-tail)) - (when (eq key ':allow-other-keys) - (setq allow-other-keys-p value)) - (if keys-tail - (setf (cdr keys-tail) (cons key nil) - keys-tail (cdr keys-tail)) - (setf keys-tail (setf keys (cons key nil)))) - (when (null initargs-tail) (return nil))))))) - (list class keys allow-other-keys-p))) - -(defmacro %get-make-instance-function (class initargs) - `(let ((key (get-make-instance-function-key ,class ,initargs))) - (or (car (gethash key *make-instance-function-table*)) - (get-make-instance-function key)))) (defun constant-symbol-p (form) - (and (constantp form) (symbolp (eval form)))) + (and (constantp form) + (let ((object (eval form))) + (and (symbolp object) + (symbol-package object))))) (defvar *make-instance-function-keys* nil) -(defvar *skip-boundp-check* nil) -(defun expand-make-instance-form (form &optional - (skip-boundp-check *skip-boundp-check*)) +(defun expand-make-instance-form (form) (let ((class (cadr form)) (initargs (cddr form)) (keys nil)(allow-other-keys-p nil) key value) (when (and (constant-symbol-p class) @@ -97,18 +64,11 @@ (key (list class keys allow-other-keys-p)) (sym (make-instance-function-symbol key))) (push key *make-instance-function-keys*) - (if (and sym skip-boundp-check) - `(,sym ',class (list ,@initargs)) - `(funcall ,(if sym - `(if (#-akcl fboundp #+akcl %fboundp ',sym) - (#-akcl symbol-function #+akcl %symbol-function ',sym) - (get-make-instance-function ',key)) - `(get-make-instance-function ',key)) - ',class (list ,@initargs))))))) + (when sym + `(,sym ',class (list ,@initargs))))))) (defmacro expanding-make-instance-top-level (&rest forms &environment env) (let* ((*make-instance-function-keys* nil) - (*skip-boundp-check* t) (form (macroexpand `(expanding-make-instance ,@forms) env))) `(progn ,@(when *make-instance-function-keys* @@ -134,62 +94,257 @@ (defun ,name ,lambda-list (make-instance ',class ,@initialization-arguments)))) -(defun get-make-instance-functions (key-list &optional compile-p) - (let ((*compile-make-instance-functions-p* compile-p)) - (dolist (key key-list) - (if compile-p - (get-make-instance-function key) - (set-make-instance-function (make-instance-function-symbol key) - key - (make-lazy-get-make-instance-function key) - nil))))) +(defun get-make-instance-functions (key-list) + (dolist (key key-list) + (let* ((cell (find-class-cell (car key))) + (make-instance-function-keys + (find-class-cell-make-instance-function-keys cell)) + (mif-key (cons (cadr key) (caddr key)))) + (unless (find mif-key make-instance-function-keys + :test #'equal) + (push mif-key (find-class-cell-make-instance-function-keys cell)) + (let ((class (find-class-cell-class cell))) + (when (and class (not (forward-referenced-class-p class))) + (update-initialize-info-internal + (initialize-info class (car mif-key) nil (cdr mif-key)) + 'make-instance-function))))))) (defun make-instance-function-symbol (key) - (let ((class (car key))) - (when (or (symbolp class) (classp class)) + (let* ((class (car key)) + (symbolp (symbolp class))) + (when (or symbolp (classp class)) (let* ((class-name (if (symbolp class) class (class-name class))) (keys (cadr key)) (allow-other-keys-p (caddr key))) - (let ((*package* *the-pcl-package*) - (*print-length* nil) (*print-level* nil) - (*print-circle* nil) (*print-case* :upcase) - (*print-pretty* nil)) - (intern (format nil "MAKE-INSTANCE ~S ~S ~S" - class-name keys allow-other-keys-p))))))) - -(defun make-lazy-get-make-instance-function (key) - #'(lambda (class initargs) - (if (eq *boot-state* 'complete) - (funcall (get-make-instance-function key) class initargs) - (apply #'make-instance class initargs)))) - -(defun get-make-instance-function (key &optional (value (list nil nil))) - (let* ((class (car key)) + (when (and (or symbolp + (and (symbolp class-name) + (eq class (find-class class-name nil)))) + (symbol-package class-name)) + (let ((*package* *the-pcl-package*) + (*print-length* nil) (*print-level* nil) + (*print-circle* nil) (*print-case* :upcase) + (*print-pretty* nil)) + (intern (format nil "MAKE-INSTANCE ~S ~S ~S" + class-name keys allow-other-keys-p)))))))) + +(defun make-instance-1 (class initargs) + (apply #'make-instance class initargs)) + +(defmacro define-cached-reader (type name trap) + (let ((reader-name (intern (format nil "~A-~A" type name))) + (cached-name (intern (format nil "~A-CACHED-~A" type name)))) + `(defmacro ,reader-name (info) + `(let ((value (,',cached-name ,info))) + (if (eq value ':unknown) + (progn + (,',trap ,info ',',name) + (,',cached-name ,info)) + value))))) + +(eval-when (compile load eval) +(defparameter initialize-info-cached-slots + '(valid-p ; t or (:invalid key) + ri-valid-p + initargs-form-list + new-keys + default-initargs-function + shared-initialize-t-function + shared-initialize-nil-function + constants + combined-initialize-function ; allocate-instance + shared-initialize + make-instance-function ; nil means use gf + make-instance-function-symbol))) + +(defmacro define-initialize-info () + (let ((cached-slot-names + (mapcar #'(lambda (name) + (intern (format nil "CACHED-~A" name))) + initialize-info-cached-slots)) + (cached-names + (mapcar #'(lambda (name) + (intern (format nil "~A-CACHED-~A" + 'initialize-info name))) + initialize-info-cached-slots))) + `(progn + (defstruct initialize-info + key wrapper + ,@(mapcar #'(lambda (name) + `(,name :unknown)) + cached-slot-names)) + (defmacro reset-initialize-info-internal (info) + `(progn + ,@(mapcar #'(lambda (cname) + `(setf (,cname ,info) ':unknown)) + ',cached-names))) + (defun initialize-info-bound-slots (info) + (let ((slots nil)) + ,@(mapcar #'(lambda (name cached-name) + `(unless (eq ':unknown (,cached-name info)) + (push ',name slots))) + initialize-info-cached-slots cached-names) + slots)) + ,@(mapcar #'(lambda (name) + `(define-cached-reader initialize-info ,name + update-initialize-info-internal)) + initialize-info-cached-slots)))) + +(define-initialize-info) + +(defvar *initialize-info-cache-class* nil) +(defvar *initialize-info-cache-initargs* nil) +(defvar *initialize-info-cache-info* nil) + +(defvar *revert-initialize-info-p* nil) + +(defun reset-initialize-info (info) + (setf (initialize-info-wrapper info) + (class-wrapper (car (initialize-info-key info)))) + (let ((slots-to-revert (if *revert-initialize-info-p* + (initialize-info-bound-slots info) + '(make-instance-function)))) + (reset-initialize-info-internal info) + (dolist (slot slots-to-revert) + (update-initialize-info-internal info slot)) + info)) + +(defun reset-class-initialize-info (class) + (reset-class-initialize-info-1 (class-initialize-info class))) + +(defun reset-class-initialize-info-1 (cell) + (when (consp cell) + (when (car cell) + (reset-initialize-info (car cell))) + (let ((alist (cdr cell))) + (dolist (a alist) + (reset-class-initialize-info-1 (cdr a)))))) + +(defun initialize-info (class initargs &optional (plist-p t) allow-other-keys-arg) + (let ((info nil)) + (if (and (eq *initialize-info-cache-class* class) + (eq *initialize-info-cache-initargs* initargs)) + (setq info *initialize-info-cache-info*) + (let ((initargs-tail initargs) + (cell (or (class-initialize-info class) + (setf (class-initialize-info class) (cons nil nil))))) + (loop (when (null initargs-tail) (return nil)) + (let ((keyword (pop initargs-tail)) + (alist-cell cell)) + (when plist-p + (if (eq keyword :allow-other-keys) + (setq allow-other-keys-arg (pop initargs-tail)) + (pop initargs-tail))) + (loop (let ((alist (cdr alist-cell))) + (when (null alist) + (setq cell (cons nil nil)) + (setf (cdr alist-cell) (list (cons keyword cell))) + (return nil)) + (when (eql keyword (caar alist)) + (setq cell (cdar alist)) + (return nil)) + (setq alist-cell alist))))) + (setq info (or (car cell) + (setf (car cell) (make-initialize-info)))))) + (let ((wrapper (initialize-info-wrapper info))) + (unless (eq wrapper (class-wrapper class)) + (unless wrapper + (let* ((initargs-tail initargs) + (klist-cell (list nil)) + (klist-tail klist-cell)) + (loop (when (null initargs-tail) (return nil)) + (let ((key (pop initargs-tail))) + (setf (cdr klist-tail) (list key))) + (setf klist-tail (cdr klist-tail)) + (when plist-p (pop initargs-tail))) + (setf (initialize-info-key info) + (list class (cdr klist-cell) allow-other-keys-arg)))) + (reset-initialize-info info))) + (setq *initialize-info-cache-class* class) + (setq *initialize-info-cache-initargs* initargs) + (setq *initialize-info-cache-info* info) + info)) + +(defun update-initialize-info-internal (info name) + (let* ((key (initialize-info-key info)) + (class (car key)) (keys (cadr key)) - (gmif-class-1 gmif-class) (gmif-class nil) - name) - (flet ((return-function (function) - (return-from get-make-instance-function - (set-make-instance-function name key function nil)))) - (unless (eq *boot-state* 'complete) - (return-function (make-lazy-get-make-instance-function key))) - (when (symbolp class) - (let ((real-class (find-class class nil))) - (unless real-class - (if gmif-class-1 - (return-function (make-lazy-get-make-instance-function key)) - (error "class ~S not found" class))) - (setq class real-class))) - (when (classp class) - (unless (class-finalized-p class) (finalize-inheritance class)) - (when (and gmif-class-1 - (not (member gmif-class-1 (class-precedence-list class)))) - (return-from get-make-instance-function nil)) - (setq name (make-instance-function-symbol key)) - (when (and gmif-class-1 (not *compile-make-instance-functions-p*)) - (return-function - #'(lambda (class initargs) - (funcall (get-make-instance-function key) class initargs))))) + (allow-other-keys-arg (caddr key))) + (ecase name + ((initargs-form-list new-keys) + (multiple-value-bind (initargs-form-list new-keys) + (make-default-initargs-form-list class keys) + (setf (initialize-info-cached-initargs-form-list info) initargs-form-list) + (setf (initialize-info-cached-new-keys info) new-keys))) + ((default-initargs-function) + (let ((initargs-form-list (initialize-info-initargs-form-list info))) + (setf (initialize-info-cached-default-initargs-function info) + (initialize-instance-simple-function + 'default-initargs-function info + class initargs-form-list)))) + ((valid-p ri-valid-p) + (flet ((compute-valid-p (methods) + (or (not (null allow-other-keys-arg)) + (multiple-value-bind (legal allow-other-keys) + (check-initargs-values class methods) + (or (not (null allow-other-keys)) + (dolist (key keys t) + (unless (member key legal) + (return (cons :invalid key))))))))) + (let ((proto (class-prototype class))) + (setf (initialize-info-cached-valid-p info) + (compute-valid-p + (list (list* 'allocate-instance class nil) + (list* 'initialize-instance proto nil) + (list* 'shared-initialize proto t nil)))) + (setf (initialize-info-cached-ri-valid-p info) + (compute-valid-p + (list (list* 'reinitialize-instance proto nil) + (list* 'shared-initialize proto nil nil))))))) + ((shared-initialize-t-function) + (multiple-value-bind (initialize-form-list ignore) + (make-shared-initialize-form-list class keys t nil) + (declare (ignore ignore)) + (setf (initialize-info-cached-shared-initialize-t-function info) + (initialize-instance-simple-function + 'shared-initialize-t-function info + class initialize-form-list)))) + ((shared-initialize-nil-function) + (multiple-value-bind (initialize-form-list ignore) + (make-shared-initialize-form-list class keys nil nil) + (declare (ignore ignore)) + (setf (initialize-info-cached-shared-initialize-nil-function info) + (initialize-instance-simple-function + 'shared-initialize-nil-function info + class initialize-form-list)))) + ((constants combined-initialize-function) + (let ((initargs-form-list (initialize-info-initargs-form-list info)) + (new-keys (initialize-info-new-keys info))) + (multiple-value-bind (initialize-form-list constants) + (make-shared-initialize-form-list class new-keys t t) + (setf (initialize-info-cached-constants info) constants) + (setf (initialize-info-cached-combined-initialize-function info) + (initialize-instance-simple-function + 'combined-initialize-function info + class (append initargs-form-list initialize-form-list)))))) + ((make-instance-function-symbol) + (setf (initialize-info-cached-make-instance-function-symbol info) + (make-instance-function-symbol key))) + ((make-instance-function) + (let* ((function (get-make-instance-function key)) + (symbol (initialize-info-make-instance-function-symbol info))) + (setf (initialize-info-cached-make-instance-function info) function) + (when symbol (setf (gdefinition symbol) + (or function #'make-instance-1))))))) + info) + +(defun get-make-instance-function (key) + (let* ((class (car key)) + (keys (cadr key))) + (unless (eq *boot-state* 'complete) + (return-from get-make-instance-function nil)) + (when (symbolp class) + (setq class (find-class class))) + (when (classp class) + (unless (class-finalized-p class) (finalize-inheritance class))) (let* ((initargs (mapcan #'(lambda (key) (list key nil)) keys)) (class-and-initargs (list* class initargs)) (make-instance (gdefinition 'make-instance)) @@ -199,7 +354,7 @@ (class+initargs (list class initargs)) (default-initargs (gdefinition 'default-initargs)) (default-initargs-methods - (compute-applicable-methods default-initargs class+initargs)) + (compute-applicable-methods default-initargs class+initargs)) (proto (and (classp class) (class-prototype class))) (initialize-instance-methods (when proto @@ -210,9 +365,9 @@ (compute-applicable-methods (gdefinition 'shared-initialize) (list* proto t initargs))))) (when (null make-instance-methods) - (return-function - #'(lambda (class initargs) - (apply #'no-applicable-method make-instance class initargs)))) + (return-from get-make-instance-function + #'(lambda (class initargs) + (apply #'no-applicable-method make-instance class initargs)))) (unless (and (null (cdr make-instance-methods)) (eq (car make-instance-methods) std-mi-meth) (null (cdr default-initargs-methods)) @@ -228,24 +383,15 @@ (eq (car quals) ':after))))))) (and (every #'check-meth initialize-instance-methods) (every #'check-meth shared-initialize-methods)))) - (return-function - #'(lambda (class initargs) - (apply #'make-instance class initargs)))) + (return-from get-make-instance-function nil)) (get-make-instance-function-internal class key (default-initargs class initargs) - initialize-instance-methods shared-initialize-methods - name - (or (cadr value) - (and *compile-make-instance-functions-p* - (not *inhibit-compile-make-instance-functions-p*)))))))) + initialize-instance-methods shared-initialize-methods)))) (defun get-make-instance-function-internal (class key initargs initialize-instance-methods - shared-initialize-methods - &optional (name nil name-p) - compile-p) - (let* ((*compile-make-instance-functions-p* compile-p) - (keys (cadr key)) + shared-initialize-methods) + (let* ((keys (cadr key)) (allow-other-keys-p (caddr key)) (allocate-instance-methods (compute-applicable-methods (gdefinition 'allocate-instance) @@ -257,28 +403,18 @@ initialize-instance-methods shared-initialize-methods) t nil) - (return-from get-make-instance-function-internal - (make-lazy-get-make-instance-function key)))) - (let ((function (if (or (cdr allocate-instance-methods) - (some #'complicated-instance-creation-method - initialize-instance-methods) - (some #'complicated-instance-creation-method - shared-initialize-methods)) - (make-instance-function-complex - key class keys - initialize-instance-methods shared-initialize-methods) - (make-instance-function-simple - key class keys - initialize-instance-methods shared-initialize-methods)))) - (when name-p (set-make-instance-function name key function compile-p)) - function))) - -(defun set-make-instance-function (name key function compile-p) - #-cmu (set-function-name function name) - (when name (setf (symbol-function name) function)) - (setf (gethash key *make-instance-function-table*) - (list function compile-p)) - function) + (return-from get-make-instance-function-internal nil))) + (if (or (cdr allocate-instance-methods) + (some #'complicated-instance-creation-method + initialize-instance-methods) + (some #'complicated-instance-creation-method + shared-initialize-methods)) + (make-instance-function-complex + key class keys + initialize-instance-methods shared-initialize-methods) + (make-instance-function-simple + key class keys + initialize-instance-methods shared-initialize-methods)))) (defun complicated-instance-creation-method (m) (let ((qual (method-qualifiers m))) @@ -304,9 +440,9 @@ (eq (car .function.) 'call-initialize-instance-simple)) (initialize-instance-simple (cadr .function.) (caddr .function.) ,instance ,initargs) - (funcall .function. ,instance ,initargs)))) + (funcall (the function .function.) ,instance ,initargs)))) -(defun make-instance-function-simple (key class keys +(defun make-instance-function-simple (key class keys initialize-instance-methods shared-initialize-methods) (multiple-value-bind (initialize-function constants) @@ -342,9 +478,11 @@ (remove std-ii-meth initialize-instance-methods))))) #'(lambda (class1 initargs) - (declare (ignore class1)) (if (not (eq wrapper (class-wrapper class))) - (funcall (get-make-instance-function key) class initargs) + (let* ((info (initialize-info class1 initargs)) + (fn (initialize-info-make-instance-function info))) + (declare (type function fn)) + (funcall fn class1 initargs)) (let* ((instance (funcall allocate-function wrapper constants)) (initargs (call-initialize-function initialize-function instance initargs))) @@ -367,6 +505,7 @@ `((,(find-standard-ii-method shared-initialize-methods 'slot-object) ,#'(lambda (instance init-type &rest initargs) (declare (ignore init-type)) + #+copy-&rest-arg (setq initargs (copy-list initargs)) (call-initialize-function initialize-function instance initargs) instance))) @@ -377,13 +516,16 @@ `((class-eq ,class) t) `((,(find-standard-ii-method initialize-instance-methods 'slot-object) ,#'(lambda (instance &rest initargs) + #+copy-&rest-arg (setq initargs (copy-list initargs)) (invoke-effective-method-function shared-initialize t instance t initargs)))) (list wrapper *the-wrapper-of-t*)))) #'(lambda (class1 initargs) - (declare (ignore class1)) (if (not (eq wrapper (class-wrapper class))) - (funcall (get-make-instance-function key) class initargs) + (let* ((info (initialize-info class1 initargs)) + (fn (initialize-info-make-instance-function info))) + (declare (type function fn)) + (funcall fn class1 initargs)) (let* ((initargs (call-initialize-function initargs-function nil initargs)) (instance (apply #'allocate-instance class initargs))) @@ -391,172 +533,6 @@ initialize-instance t instance initargs) instance)))))) -(defmacro define-cached-reader (type name trap) - (let ((reader-name (intern (format nil "~A-~A" type name))) - (cached-name (intern (format nil "~A-CACHED-~A" type name)))) - `(defmacro ,reader-name (info) - `(let ((value (,',cached-name ,info))) - (if (eq value ':unknown) - (progn - (,',trap ,info ',',name) - (,',cached-name ,info)) - value))))) - -(eval-when (compile load eval) -(defparameter initialize-info-cached-slots - '(valid-p ; t or (:invalid key) - ri-valid-p - initargs-form-list - new-keys - default-initargs-function - shared-initialize-t-function - shared-initialize-nil-function - constants - combined-initialize-function))) - -(defmacro define-initialize-info () - (flet ((cached-slot-name (name) - (intern (format nil "CACHED-~A" name))) - (cached-name (name) - (intern (format nil "~A-CACHED-~A" 'initialize-info name)))) - `(progn - (defstruct initialize-info - key wrapper - ,@(mapcar #'cached-slot-name initialize-info-cached-slots)) - (defun reset-initialize-info (info) - ,@(mapcar #'(lambda (name) - `(setf (,(cached-name name) info) ':unknown)) - initialize-info-cached-slots) - info) - ,@(mapcar #'(lambda (name) - `(define-cached-reader initialize-info ,name - update-initialize-info-internal)) - initialize-info-cached-slots)))) - -(define-initialize-info) - -(defvar *initialize-info-cache-class* nil) -(defvar *initialize-info-cache-initargs* nil) -(defvar *initialize-info-cache-info* nil) - -(defun reset-class-initialize-info (class) - (reset-class-initialize-info-1 (class-initialize-info class))) - -(defun reset-class-initialize-info-1 (cell) - (when (consp cell) - (when (car cell) - (setf (initialize-info-wrapper (car cell)) nil)) - (let ((alist (cdr cell))) - (dolist (a alist) - (reset-class-initialize-info-1 (cdr a)))))) - -(defun initialize-info (class initargs &optional (plist-p t) allow-other-keys-arg) - (let ((info nil)) - (if (and (eq *initialize-info-cache-class* class) - (eq *initialize-info-cache-initargs* initargs)) - (setq info *initialize-info-cache-info*) - (let ((initargs-tail initargs) - (cell (or (class-initialize-info class) - (setf (class-initialize-info class) (cons nil nil))))) - (loop (when (null initargs-tail) (return nil)) - (let ((keyword (pop initargs-tail)) - (alist-cell cell)) - (when plist-p - (if (eq keyword :allow-other-keys) - (setq allow-other-keys-arg (pop initargs-tail)) - (pop initargs-tail))) - (loop (let ((alist (cdr alist-cell))) - (when (null alist) - (setq cell (cons nil nil)) - (setf (cdr alist-cell) (list (cons keyword cell))) - (return nil)) - (when (eql keyword (caar alist)) - (setq cell (cdar alist)) - (return nil)) - (setq alist-cell alist))))) - (setq info (or (car cell) - (setf (car cell) (make-initialize-info)))))) - (let ((wrapper (initialize-info-wrapper info))) - (unless (eq wrapper (class-wrapper class)) - (unless wrapper - (let* ((initargs-tail initargs) - (klist-cell (list nil)) - (klist-tail klist-cell)) - (loop (when (null initargs-tail) (return nil)) - (let ((key (pop initargs-tail))) - (setf (cdr klist-tail) (list key))) - (setf klist-tail (cdr klist-tail)) - (when plist-p (pop initargs-tail))) - (setf (initialize-info-key info) - (list class (cdr klist-cell) allow-other-keys-arg)))) - (update-initialize-info info))) - (setq *initialize-info-cache-class* class) - (setq *initialize-info-cache-initargs* initargs) - (setq *initialize-info-cache-info* info) - info)) - -(defun update-initialize-info (info) - (let* ((key (initialize-info-key info)) - (class (car key))) - (setf (initialize-info-wrapper info) (class-wrapper class)) - (reset-initialize-info info) - info)) - -(defun update-initialize-info-internal (info name) - (let* ((key (initialize-info-key info)) - (class (car key)) - (keys (cadr key)) - (allow-other-keys-arg (caddr key))) - (ecase name - ((initargs-form-list new-keys) - (multiple-value-bind (initargs-form-list new-keys) - (make-default-initargs-form-list class keys) - (setf (initialize-info-cached-initargs-form-list info) initargs-form-list) - (setf (initialize-info-cached-new-keys info) new-keys))) - ((default-initargs-function) - (let ((initargs-form-list (initialize-info-initargs-form-list info))) - (setf (initialize-info-cached-default-initargs-function info) - (initialize-instance-simple-function class initargs-form-list)))) - ((valid-p ri-valid-p) - (flet ((compute-valid-p (methods) - (or (not (null allow-other-keys-arg)) - (multiple-value-bind (legal allow-other-keys) - (check-initargs-values class methods) - (or (not (null allow-other-keys)) - (dolist (key keys t) - (unless (member key legal) - (return (cons :invalid key))))))))) - (let ((proto (class-prototype class))) - (setf (initialize-info-cached-valid-p info) - (compute-valid-p (list (list* 'allocate-instance class nil) - (list* 'initialize-instance proto nil) - (list* 'shared-initialize proto t nil)))) - (setf (initialize-info-cached-ri-valid-p info) - (compute-valid-p (list (list* 'reinitialize-instance proto nil) - (list* 'shared-initialize proto nil nil))))))) - ((shared-initialize-t-function) - (multiple-value-bind (initialize-form-list ignore) - (make-shared-initialize-form-list class keys t nil) - (declare (ignore ignore)) - (setf (initialize-info-cached-shared-initialize-t-function info) - (initialize-instance-simple-function class initialize-form-list)))) - ((shared-initialize-nil-function) - (multiple-value-bind (initialize-form-list ignore) - (make-shared-initialize-form-list class keys nil nil) - (declare (ignore ignore)) - (setf (initialize-info-cached-shared-initialize-nil-function info) - (initialize-instance-simple-function class initialize-form-list)))) - ((constants combined-initialize-function) - (let ((initargs-form-list (initialize-info-initargs-form-list info)) - (new-keys (initialize-info-new-keys info))) - (multiple-value-bind (initialize-form-list constants) - (make-shared-initialize-form-list class new-keys t t) - (setf (initialize-info-cached-constants info) constants) - (setf (initialize-info-cached-combined-initialize-function info) - (initialize-instance-simple-function - class (append initargs-form-list initialize-form-list)))))))) - info) - (defun get-simple-initialization-function (class keys &optional allow-other-keys-arg) (let ((info (initialize-info class keys nil allow-other-keys-arg))) (values (initialize-info-combined-initialize-function info) @@ -682,23 +658,34 @@ (defvar *initialize-instance-simple-alist* nil) (defvar *note-iis-entry-p* nil) -(defun initialize-instance-simple-function (class form-list) - (let ((pv-cell (get-pv-cell-for-class class))) - (if (and *compile-make-instance-functions-p* - (not *inhibit-compile-make-instance-functions-p*)) +(defvar *compiled-initialize-instance-simple-functions* + (make-hash-table :test #'equal)) + +(defun initialize-instance-simple-function (use info class form-list) + (let* ((pv-cell (get-pv-cell-for-class class)) + (key (initialize-info-key info)) + (sf-key (list* use (class-name (car key)) (cdr key)))) + (if (or *compile-make-instance-functions-p* + (gethash sf-key *compiled-initialize-instance-simple-functions*)) (multiple-value-bind (form args) (form-list-to-lisp pv-cell form-list) (let ((entry (assoc form *initialize-instance-simple-alist* :test #'equal))) - (unless entry - (setq entry (list form - (unless *note-iis-entry-p* (compile-lambda form)) - nil)) - (setq *initialize-instance-simple-alist* - (nconc *initialize-instance-simple-alist* - (list entry)))) + (setf (gethash sf-key + *compiled-initialize-instance-simple-functions*) + t) + (if entry + (setf (cdddr entry) (union (list sf-key) (cdddr entry) + :test #'equal)) + (progn + (setq entry (list* form nil nil (list sf-key))) + (setq *initialize-instance-simple-alist* + (nconc *initialize-instance-simple-alist* + (list entry))))) + (unless (or *note-iis-entry-p* (cadr entry)) + (setf (cadr entry) (compile-lambda (car entry)))) (if (cadr entry) - (apply (cadr entry) args) + (apply (the function (cadr entry)) args) `(call-initialize-instance-simple ,pv-cell ,form-list)))) #|| #'(lambda (instance initargs) @@ -706,16 +693,20 @@ ||# `(call-initialize-instance-simple ,pv-cell ,form-list)))) -(defun load-precompiled-iis-entry (form function system) +(defun load-precompiled-iis-entry (form function system uses) (let ((entry (assoc form *initialize-instance-simple-alist* :test #'equal))) (unless entry - (setq entry (list form nil nil)) + (setq entry (list* form nil nil nil)) (setq *initialize-instance-simple-alist* (nconc *initialize-instance-simple-alist* (list entry)))) (setf (cadr entry) function) - (setf (caddr entry) system))) + (setf (caddr entry) system) + (dolist (use uses) + (setf (gethash use *compiled-initialize-instance-simple-functions*) t)) + (setf (cdddr entry) (union uses (cdddr entry) + :test #'equal)))) (defmacro precompile-iis-functions (&optional system) (let ((index -1)) @@ -732,10 +723,12 @@ `(load-precompiled-iis-entry ',(car iis-entry) #',(car iis-entry) - ',system))))))))) + ',system + ',(cdddr iis-entry)))))))))) (defun compile-iis-functions (after-p) (let ((*compile-make-instance-functions-p* t) + (*revert-initialize-info-p* t) (*note-iis-entry-p* (not after-p))) (declare (special *compile-make-instance-functions-p*)) (when (eq *boot-state* 'complete) @@ -764,7 +757,7 @@ (const (setq value (cadr form))) (funcall - (setq value (funcall (cadr form)))) + (setq value (funcall (the function (cadr form))))) (pop-initargs (setq initargs-tail (nthcdr (1- (cadr form)) initargs-tail)) (setq value (pop initargs-tail))) diff --git a/pcl/fin.lisp b/pcl/fin.lisp index 05539d32e..5328c4880 100644 --- a/pcl/fin.lisp +++ b/pcl/fin.lisp @@ -66,7 +66,7 @@ explicitly marked saying who wrote it. |# -(in-package 'pcl) +(in-package :pcl) ;;; ;;; The first part of the file contains the implementation dependent code to diff --git a/pcl/generic-functions.lisp b/pcl/generic-functions.lisp index 8b02e13b1..00d71d767 100644 --- a/pcl/generic-functions.lisp +++ b/pcl/generic-functions.lisp @@ -564,8 +564,8 @@ (defgeneric map-dependents (metaobject function)) ; (dependent-update-mixin t) -(defgeneric maybe-update-constructors (generic-function method)) -; (generic-function method) +;(defgeneric maybe-update-constructors (generic-function method)) +; (generic-function method) (defgeneric print-object (mc stream)) ; (t t) @@ -765,6 +765,8 @@ ; :after (standard-accessor-method t) ; :before (standard-generic-function t) +(defgeneric update-dependent (metaobject dependent &rest initargs)) + (defgeneric update-instance-for-different-class (previous current &rest initargs)) ; (standard-object standard-object) diff --git a/pcl/init.lisp b/pcl/init.lisp index 9518c1286..ea607bc93 100644 --- a/pcl/init.lisp +++ b/pcl/init.lisp @@ -28,7 +28,7 @@ ;;; This file defines the initialization and related protocols. ;;; -(in-package 'pcl) +(in-package :pcl) (defmethod make-instance ((class symbol) &rest initargs) (apply #'make-instance (find-class class) initargs)) diff --git a/pcl/low.lisp b/pcl/low.lisp index 324e45858..2f8937f66 100644 --- a/pcl/low.lisp +++ b/pcl/low.lisp @@ -62,7 +62,7 @@ ;;; Thanks. ;;; -(in-package 'pcl) +(in-package :pcl) (eval-when (compile load eval) (defvar *optimize-speed* '(optimize (speed 3) (safety 0))) @@ -328,6 +328,7 @@ (defun compile-lambda-deferred (uncompiled) (let ((function (coerce uncompiled 'function)) (compiled nil)) + (declare (type (or function null) compiled)) #'(lambda (&rest args) (if compiled (apply compiled args) diff --git a/pcl/macros.lisp b/pcl/macros.lisp index 5ae83f4d6..117f448e7 100644 --- a/pcl/macros.lisp +++ b/pcl/macros.lisp @@ -31,7 +31,7 @@ ;;; loaded before it can be compiled. ;;; -(in-package 'pcl) +(in-package :pcl) (proclaim '(declaration #-Genera values ;I use this so that Zwei can remind @@ -376,8 +376,10 @@ (defmacro define-compiler-macro (name arglist &body body) #+(or lucid kcl) `(#+lucid lcl:def-compiler-macro #+kcl si::define-compiler-macro - ,name ,arglist - ,@body) + ,name ,arglist + ,@body) + #-(or kcl lucid) + (declare (ignore name arglist body)) #-(or kcl lucid) nil) @@ -406,11 +408,14 @@ `(car ,cell)) (defmacro find-class-cell-predicate (cell) - `(cdr ,cell)) + `(cadr ,cell)) + +(defmacro find-class-cell-make-instance-function-keys (cell) + `(cddr ,cell)) (defmacro make-find-class-cell (class-name) (declare (ignore class-name)) - '(cons nil #'function-returning-nil)) + '(list* nil #'function-returning-nil nil)) (defun find-class-cell (symbol &optional dont-create-p) (or (gethash symbol *find-class*) @@ -443,11 +448,13 @@ (defun find-class (symbol &optional (errorp t) environment) (declare (ignore environment)) - (find-class-from-cell symbol (find-class-cell symbol errorp) errorp)) + (find-class-from-cell + symbol (find-class-cell symbol errorp) errorp)) (defun find-class-predicate (symbol &optional (errorp t) environment) (declare (ignore environment)) - (find-class-predicate-from-cell symbol (find-class-cell symbol errorp) errorp)) + (find-class-predicate-from-cell + symbol (find-class-cell symbol errorp) errorp)) #-setf (defsetf find-class (symbol &optional (errorp t) environment) (new-value) @@ -455,8 +462,19 @@ `(SETF\ PCL\ FIND-CLASS ,new-value ,symbol)) (defun #-setf SETF\ PCL\ FIND-CLASS #+setf (setf find-class) (new-value symbol) + (declare (special *boot-state*)) (if (legal-class-name-p symbol) - (setf (find-class-cell-class (find-class-cell symbol)) new-value) + (let ((cell (find-class-cell symbol))) + (setf (find-class-cell-class cell) new-value) + (when (or (eq *boot-state* 'complete) + (eq *boot-state* 'braid)) + (setf (find-class-cell-predicate cell) + (symbol-function (class-predicate-name new-value))) + (when (and new-value (not (forward-referenced-class-p new-value))) + (dolist (keys+aok (find-class-cell-make-instance-function-keys cell)) + (update-initialize-info-internal + (initialize-info new-value (car keys+aok) nil (cdr keys+aok)) + 'make-instance-function))))) (error "~S is not a legal class name." symbol))) #-setf @@ -723,40 +741,3 @@ (setf (symbol-function name) (symbol-function new))) -(defun reset-pcl-package () ; Try to do this safely - (let* ((vars '(*pcl-directory* - *default-pathname-extensions* - *pathname-extensions* - *redefined-functions*)) - (names (mapcar #'symbol-name vars)) - (values (mapcar #'symbol-value vars))) - (declare (special *redefined-functions*)) - (let ((pkg (find-package "PCL"))) - (do-symbols (sym pkg) - (when (eq pkg (symbol-package sym)) - (if (or (constantp sym) - (eq sym 'wrapper) - (eq sym 'arg-info)) - (unintern sym pkg) - (progn - (makunbound sym) - (unless (eq sym 'reset-pcl-package) - (fmakunbound sym)) - #+cmu (fmakunbound `(setf ,sym)) - (setf (symbol-plist sym) nil)))))) - (let ((pkg (find-package "SLOT-ACCESSOR-NAME"))) - (when pkg - (do-symbols (sym pkg) - (makunbound sym) - (fmakunbound sym) - (setf (symbol-plist sym) nil)))) - (let ((pcl (find-package "PCL"))) - (mapcar #'(lambda (name value) - (let ((var (intern name pcl))) - (proclaim `(special ,var)) - (set var value))) - names values)) - (dolist (sym *redefined-functions*) - (setf (symbol-function sym) (get sym ':definition-before-pcl))) - nil)) - diff --git a/pcl/methods.lisp b/pcl/methods.lisp index 89cc24de5..625b5bd4a 100644 --- a/pcl/methods.lisp +++ b/pcl/methods.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* ;;; -(in-package 'pcl) +(in-package :pcl) (defmethod print-object (instance stream) (printing-random-thing (instance stream) @@ -388,13 +388,12 @@ specializers lambda-list &rest other-initargs) + #+copy-&rest-arg (setq other-initargs (copy-list other-initargs)) ;; What about changing the class of the generic-function if there is ;; one. Whose job is that anyways. Do we need something kind of ;; like class-for-redefinition? (let* ((generic-function - (ensure-generic-function generic-function-name - :lambda-list (method-ll->generic-function-ll - lambda-list))) + (ensure-generic-function generic-function-name)) (specs (parse-specializers specializers)) ; (existing (get-method generic-function qualifiers specs nil)) (proto (method-prototype-for-gf generic-function-name)) @@ -434,7 +433,7 @@ (if (memq arg lambda-list-keywords) (return) (incf nrequireds))) - (setf (symbol-function function-name) generic-function) + (setf (gdefinition function-name) generic-function) (set-function-name generic-function function-name) (when arglistp (setf (gf-pretty-arglist generic-function) arglist)) @@ -563,13 +562,17 @@ (defmethod reinitialize-instance :after ((gf standard-generic-function) &rest args &key (lambda-list nil lambda-list-p) - argument-precedence-order) + (argument-precedence-order + nil argument-precedence-order-p)) (with-slots (arg-info) gf (if lambda-list-p - (set-arg-info gf - :lambda-list lambda-list - :argument-precedence-order argument-precedence-order) + (if argument-precedence-order-p + (set-arg-info gf + :lambda-list lambda-list + :argument-precedence-order argument-precedence-order) + (set-arg-info gf + :lambda-list lambda-list)) (set-arg-info gf)) (when (and (arg-info-valid-p arg-info) args @@ -616,8 +619,7 @@ '(make-instance default-initargs allocate-instance shared-initialize initialize-instance)) (update-make-instance-function-table (type-class (car specializers)))) - (update-dfun generic-function) - (maybe-update-constructors generic-function method)) + (update-dfun generic-function)) method))) (defun real-remove-method (generic-function method) @@ -639,7 +641,6 @@ allocate-instance shared-initialize initialize-instance)) (update-make-instance-function-table (type-class (car specializers)))) (update-dfun generic-function) - (maybe-update-constructors generic-function method) generic-function))) @@ -723,7 +724,7 @@ (class-of (slot-value specializer 'object))) (defvar *in-gf-arg-info-p* nil) -(setf (symbol-function 'arg-info-reader) +(setf (gdefinition 'arg-info-reader) (let ((mf (initialize-method-function (make-internal-reader-method-function 'standard-generic-function 'arg-info) @@ -775,6 +776,7 @@ (defun default-secondary-dispatch-function (generic-function) #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) (let ((methods (compute-applicable-methods generic-function args))) (if methods (let ((emf (get-effective-method-function generic-function methods))) @@ -1363,7 +1365,8 @@ (setf (gethash (car k+m) table) (cdr k+m))) table))))))) -(defun compute-secondary-dispatch-function1 (generic-function net &optional function-p) +(defun compute-secondary-dispatch-function1 (generic-function net + &optional function-p) (if (eq (car net) 'methods) (get-effective-method-function1 generic-function (cadr net)) (let* ((name (generic-function-name generic-function)) @@ -1376,8 +1379,13 @@ (make-fast-method-call-lambda-list metatypes applyp)))) (multiple-value-bind (cfunction constants) (get-function1 `(lambda ,arglist - ,(unless function-p - `(declare (ignore .pv-cell. .next-method-call.))) + ,@(unless function-p + `((declare (ignore .pv-cell. + .next-method-call.)))) + #+copy-&rest-arg + ,@(when (and applyp function-p) + `((setq .dfun-rest-arg. + (copy-list .dfun-rest-arg.)))) (let ((emf ,net)) ,(make-emf-call metatypes applyp 'emf))) #'net-test-converter @@ -1413,6 +1421,7 @@ (format t "~&make-unordered-methods-emf ~s~%" (generic-function-name generic-function))) #'(lambda (&rest args) + #+copy-&rest-arg (setq args (copy-list args)) (let* ((types (types-from-arguments generic-function args 'eql)) (smethods (sort-applicable-methods generic-function methods types)) (emf (get-effective-method-function generic-function smethods))) diff --git a/pcl/slots-boot.lisp b/pcl/slots-boot.lisp index da7b525b1..56a897169 100644 --- a/pcl/slots-boot.lisp +++ b/pcl/slots-boot.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* ;;; -(in-package 'pcl) +(in-package :pcl) (defmacro slot-symbol (slot-name type) `(if (and (symbolp ,slot-name) (symbol-package ,slot-name)) @@ -53,11 +53,11 @@ (defun slot-boundp-symbol (slot-name) (slot-symbol slot-name boundp)) -(defmacro asv-funcall (sym slot-name &rest args) - `(function-funcall (if (#-akcl fboundp #+akcl %fboundp ,sym) - (#-akcl symbol-function #+akcl %symbol-function ,sym) - (no-slot ,sym ,slot-name)) - ,@args)) +(defmacro asv-funcall (sym slot-name type &rest args) + (declare (ignore type)) + `(if (#-akcl fboundp #+akcl %fboundp ',sym) + (,sym ,@args) + (no-slot ',sym ',slot-name))) (defun no-slot (slot-name sym) (error "No class has a slot named ~S (~s has no function binding) @@ -71,7 +71,7 @@ 'accessor-slot-value)) (let* ((slot-name (eval slot-name)) (sym (slot-reader-symbol slot-name))) - `(asv-funcall ',sym ',slot-name ,object))) + `(asv-funcall ,sym ,slot-name reader ,object))) (defmacro accessor-set-slot-value (object slot-name new-value &environment env) (unless (constantp slot-name) @@ -85,7 +85,7 @@ (prog1 `((,object-var ,object)) (setq object object-var))))) (sym (slot-writer-symbol slot-name)) - (form `(asv-funcall ',sym ',slot-name ,new-value ,object))) + (form `(asv-funcall ,sym ,slot-name writer ,new-value ,object))) (if bindings `(let ,bindings ,form) form))) @@ -100,7 +100,7 @@ (sym (slot-boundp-symbol slot-name))) (if (not *optimize-slot-boundp*) `(slot-boundp-normal ,object ',slot-name) - `(asv-funcall ',sym ',slot-name ,object)))) + `(asv-funcall ,sym ,slot-name boundp ,object)))) (defun structure-slot-boundp (object) @@ -111,6 +111,7 @@ (let* ((reader (slot-definition-internal-reader-function slotd)) (fun #'(lambda (object) (not (eq (funcall reader object) *slot-unbound*))))) + (declare (type function reader)) #+(and kcl turbo-closure) (si:turbo-closure fun) fun)) @@ -126,10 +127,11 @@ (slot-name (slot-definition-name slotd)) (index (slot-definition-location slotd)) (function (ecase name - (reader 'make-optimized-std-reader-method-function) - (writer 'make-optimized-std-writer-method-function) - (boundp 'make-optimized-std-boundp-method-function))) + (reader #'make-optimized-std-reader-method-function) + (writer #'make-optimized-std-writer-method-function) + (boundp #'make-optimized-std-boundp-method-function))) (value (funcall function fsc-p slot-name index))) + (declare (type function function)) (values value index)))) (defun make-optimized-std-reader-method-function (fsc-p slot-name index) @@ -379,18 +381,29 @@ (list* ':method-spec `(boundp-method ,class-name ,slot-name) initargs))) -(defun initialize-internal-slot-gfs (slot-name) - (let* ((name (slot-reader-symbol slot-name)) - (gf (ensure-generic-function name))) - (unless (generic-function-methods gf) - (add-reader-method *the-class-slot-object* gf slot-name))) - (let* ((name (slot-writer-symbol slot-name)) - (gf (ensure-generic-function name))) - (unless (generic-function-methods gf) - (add-writer-method *the-class-slot-object* gf slot-name))) - (when *optimize-slot-boundp* +(defun initialize-internal-slot-gfs (slot-name &optional type) + (when (or (null type) (eq type 'reader)) + (let* ((name (slot-reader-symbol slot-name)) + (gf (ensure-generic-function name))) + (unless (generic-function-methods gf) + (add-reader-method *the-class-slot-object* gf slot-name)))) + (when (or (null type) (eq type 'writer)) + (let* ((name (slot-writer-symbol slot-name)) + (gf (ensure-generic-function name))) + (unless (generic-function-methods gf) + (add-writer-method *the-class-slot-object* gf slot-name)))) + (when (and *optimize-slot-boundp* + (or (null type) (eq type 'boundp))) (let* ((name (slot-boundp-symbol slot-name)) (gf (ensure-generic-function name))) (unless (generic-function-methods gf) (add-boundp-method *the-class-slot-object* gf slot-name)))) nil) + +(defun initialize-internal-slot-gfs* (readers writers boundps) + (dolist (reader readers) + (initialize-internal-slot-gfs reader 'reader)) + (dolist (writer writers) + (initialize-internal-slot-gfs writer 'writer)) + (dolist (boundp boundps) + (initialize-internal-slot-gfs boundp 'boundp))) diff --git a/pcl/slots.lisp b/pcl/slots.lisp index 2bbcab0b6..6cb3c866e 100644 --- a/pcl/slots.lisp +++ b/pcl/slots.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* ;;; -(in-package 'pcl) +(in-package :pcl) (defmethod wrapper-fetcher ((class standard-class)) 'std-instance-wrapper) @@ -134,7 +134,7 @@ (slot-missing class object slot-name 'slot-value) (slot-value-using-class class object slot-definition)))) -(setf (symbol-function 'slot-value-normal) #'slot-value) +(setf (gdefinition 'slot-value-normal) #'slot-value) (define-compiler-macro slot-value (object-form slot-name-form) (if (and (constantp slot-name-form) @@ -151,7 +151,7 @@ (setf (slot-value-using-class class object slot-definition) new-value)))) -(setf (symbol-function 'set-slot-value-normal) #'set-slot-value) +(setf (gdefinition 'set-slot-value-normal) #'set-slot-value) (define-compiler-macro set-slot-value (object-form slot-name-form new-value-form) (if (and (constantp slot-name-form) @@ -169,7 +169,7 @@ (slot-missing class object slot-name 'slot-boundp) (slot-boundp-using-class class object slot-definition)))) -(setf (symbol-function 'slot-boundp-normal) #'slot-boundp) +(setf (gdefinition 'slot-boundp-normal) #'slot-boundp) (define-compiler-macro slot-boundp (object-form slot-name-form) (if (and (constantp slot-name-form) diff --git a/pcl/sys-proclaim.lisp b/pcl/sys-proclaim.lisp index 97d2f9f0c..c1d1f92f6 100644 --- a/pcl/sys-proclaim.lisp +++ b/pcl/sys-proclaim.lisp @@ -4,20 +4,20 @@ (PROCLAIM '(FTYPE (FUNCTION (T FIXNUM *) FIXNUM) PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) +(PROCLAIM + '(FTYPE (FUNCTION (T) FIXNUM) PCL::FAST-INSTANCE-BOUNDP-INDEX + PCL::ONE-INDEX-LIMIT-FN PCL::N-N-ACCESSORS-LIMIT-FN + PCL::CHECKING-LIMIT-FN PCL::PV-CACHE-LIMIT-FN + PCL::CACHE-NLINES PCL::CACHE-MAX-LOCATION PCL::CACHE-SIZE + PCL::CACHE-MASK PCL::ARG-INFO-NUMBER-REQUIRED + PCL::DEFAULT-LIMIT-FN PCL::CACHE-COUNT + PCL::CACHING-LIMIT-FN PCL::PV-TABLE-PV-SIZE + PCL::EARLY-CLASS-SIZE)) +(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) PCL::POWER-OF-TWO-CEILING)) (PROCLAIM '(FTYPE (FUNCTION (T) FUNCTION) PCL::CACHE-LIMIT-FN PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION)) -(PROCLAIM - '(FTYPE (FUNCTION (T) FIXNUM) PCL::DEFAULT-LIMIT-FN - PCL::PV-CACHE-LIMIT-FN PCL::CACHE-COUNT - PCL::ARG-INFO-NUMBER-REQUIRED PCL::ONE-INDEX-LIMIT-FN - PCL::N-N-ACCESSORS-LIMIT-FN PCL::CHECKING-LIMIT-FN - PCL::CACHING-LIMIT-FN PCL::CACHE-NLINES - PCL::CACHE-MAX-LOCATION PCL::CACHE-SIZE PCL::CACHE-MASK - PCL::PV-TABLE-PV-SIZE PCL::FAST-INSTANCE-BOUNDP-INDEX - PCL::EARLY-CLASS-SIZE)) (PROCLAIM '(FTYPE (FUNCTION (T) PCL::FIELD-TYPE) PCL::CACHE-FIELD)) -(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) PCL::POWER-OF-TWO-CEILING)) (PROCLAIM '(FTYPE (FUNCTION (T) LIST) PCL::CACHE-OVERFLOW PCL::PV-TABLE-SLOT-NAME-LISTS PCL::PV-TABLE-CALL-LIST)) @@ -35,810 +35,618 @@ (PROCLAIM '(FTYPE (FUNCTION (T) (OR PCL::CACHE NULL)) PCL::PV-TABLE-CACHE)) (PROCLAIM - '(FTYPE (FUNCTION (T T T) *) PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P - PCL::ACCESSOR-VALUES1 WALKER::WALK-LET-IF - PCL::EMIT-READER/WRITER - PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER PCL::GENERATING-LISP - PCL::SET-SLOT-VALUE PCL::EMIT-READER/WRITER-FUNCTION - PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION - PCL::ACCESSOR-VALUES-INTERNAL PCL::CONVERT-METHODS - PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO - (STANDARD-GENERIC-FUNCTION))| PCL::SLOT-VALUE-USING-CLASS-DFUN - PCL::SLOT-BOUNDP-USING-CLASS-DFUN PCL::LOAD-LONG-DEFCOMBIN + '(FTYPE (FUNCTION (T T T T T T) *) PCL::MEMF-CODE-CONVERTER + PCL::REAL-LOAD-DEFCLASS PCL::CACHE-MISS-VALUES-INTERNAL + PCL::GENERATE-DISCRIMINATION-NET-INTERNAL + PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION + PCL::DO-SHORT-METHOD-COMBINATION + WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T) *) + PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + ITERATE::WALK-GATHERING-BODY PCL::CACHE-MISS-VALUES - PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| - PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION - (STANDARD-GENERIC-FUNCTION))| - PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| - PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| - PCL::GET-CLASS-SLOT-VALUE-1 ITERATE::EXPAND-INTO-LET - WALKER::WALK-FORM-INTERNAL ITERATE::RENAME-VARIABLES - PCL::ACCESSOR-VALUES ITERATE::WALK-GATHERING-BODY PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION + PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P PCL::ACCESSOR-VALUES1 + PCL::EMIT-READER/WRITER + PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER + WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::GENERATING-LISP + PCL::EMIT-READER/WRITER-FUNCTION + PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION + WALKER::WALK-LET-IF PCL::SET-SLOT-VALUE + PCL::CONVERT-METHODS PCL::SLOT-VALUE-USING-CLASS-DFUN + PCL::SLOT-BOUNDP-USING-CLASS-DFUN + PCL::CHECK-METHOD-ARG-INFO PCL::LOAD-LONG-DEFCOMBIN + PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN + PCL::MAKE-FINAL-CACHING-DFUN + PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN + PCL::GET-CLASS-SLOT-VALUE-1 PCL::ACCESSOR-VALUES-INTERNAL PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION + ITERATE::EXPAND-INTO-LET WALKER::WALK-FORM-INTERNAL + ITERATE::RENAME-VARIABLES PCL::CONSTANT-VALUE-MISS PCL::CACHING-MISS PCL::CHECKING-MISS - PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION - PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION - PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| - PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| - PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| - PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| - PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| - PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| - PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN - PCL::MAKE-FINAL-CACHING-DFUN - PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN - PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))|)) + PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T) *) + PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL + PCL::ADD-METHOD-DECLARATIONS PCL::WALK-METHOD-LAMBDA + PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN + WALKER::WALK-TEMPLATE-HANDLE-REPEAT)) (PROCLAIM - '(FTYPE (FUNCTION (T T T T) *) PCL::REAL-MAKE-METHOD-LAMBDA - PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| + '(FTYPE (FUNCTION (T T T T) *) + PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION + PCL::BOOTSTRAP-ACCESSOR-DEFINITION PCL::GET-ACCESSOR-METHOD-FUNCTION PCL::EMIT-CHECKING-OR-CACHING - PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| - PCL::BOOTSTRAP-ACCESSOR-DEFINITION PCL::EMIT-CHECKING-OR-CACHING-FUNCTION - PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| - PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| - PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| - PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| - PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN PCL::LOAD-SHORT-DEFCOMBIN - PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES - (GENERIC-FUNCTION T))| PCL::SET-CLASS-SLOT-VALUE-1 + PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION PCL::MAKE-SHARED-INITIALIZE-FORM-LIST - PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| - PCL::GENERATE-DISCRIMINATION-NET PCL::ORDER-SPECIALIZERS - PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN PCL::ACCESSOR-MISS - PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| - PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION - PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| - PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| - PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| - PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| - PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| - PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| - PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| - PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| - PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| - PCL::|(FAST-METHOD MAYBE-UPDATE-CONSTRUCTORS (GENERIC-FUNCTION METHOD))| + PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN - PCL::MAKE-FINAL-CHECKING-DFUN)) + PCL::MAKE-FINAL-CHECKING-DFUN PCL::ACCESSOR-VALUES + PCL::SET-CLASS-SLOT-VALUE-1 + PCL::GENERATE-DISCRIMINATION-NET + PCL::REAL-MAKE-METHOD-LAMBDA + PCL::ORDER-SPECIALIZERS WALKER::WALK-TEMPLATE + PCL::ACCESSOR-MISS)) (PROCLAIM - '(FTYPE (FUNCTION (T T T T T) *) - PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| - PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| - PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| - PCL::ADD-METHOD-DECLARATIONS PCL::WALK-METHOD-LAMBDA - PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) - (T EFFECTIVE-SLOT-DEFINITION T))| - PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| - PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| - PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| - PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL - PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| - PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| - PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS - (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| - PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN - PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS - (STRUCTURE-CLASS STRUCTURE-OBJECT - STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| - PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD - (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| - PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| - PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| - PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| - PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| - PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS - (STANDARD-OBJECT STANDARD-OBJECT))| - PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|)) + '(FTYPE (FUNCTION (T T T T T T T) *) + ITERATE::ITERATE-TRANSFORM-BODY)) (PROCLAIM - '(FTYPE (FUNCTION (T T *) *) PCL::TYPES-FROM-ARGUMENTS - PCL::MAKE-ACCESSOR-TABLE - PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION + '(FTYPE (FUNCTION (T T *) *) PCL::SLOT-VALUE-OR-DEFAULT + PCL::MAKE-EFFECTIVE-METHOD-FUNCTION + PCL::GET-EFFECTIVE-METHOD-FUNCTION + PCL::MAKE-N-N-ACCESSOR-DFUN WALKER:NESTED-WALK-FORM + PCL::MAKE-CHECKING-DFUN PCL::LOAD-DEFGENERIC + PCL::TYPES-FROM-ARGUMENTS + PCL::MAKE-DEFAULT-INITARGS-FORM-LIST + PCL::MAKE-FINAL-ACCESSOR-DFUN PCL::MAKE-ACCESSOR-TABLE PCL::GET-SIMPLE-INITIALIZATION-FUNCTION PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS - PCL::MAKE-CHECKING-DFUN - PCL::MAKE-DEFAULT-INITARGS-FORM-LIST - PCL::SLOT-VALUE-OR-DEFAULT PCL::MAKE-N-N-ACCESSOR-DFUN - PCL::GET-EFFECTIVE-METHOD-FUNCTION PCL::LOAD-DEFGENERIC - PCL::MAKE-EFFECTIVE-METHOD-FUNCTION - WALKER:NESTED-WALK-FORM)) -(PROCLAIM - '(FTYPE (FUNCTION (T T T T T T T) *) - ITERATE::ITERATE-TRANSFORM-BODY - PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS - (STANDARD-OBJECT T T T))|)) -(PROCLAIM - '(FTYPE (FUNCTION (T T T T T T *) *) PCL::REAL-MAKE-A-METHOD)) -(PROCLAIM - '(FTYPE (FUNCTION (T T T T T T) *) PCL::REAL-LOAD-DEFCLASS - PCL::CACHE-MISS-VALUES-INTERNAL - PCL::GENERATE-DISCRIMINATION-NET-INTERNAL - PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) - (T STRUCTURE-CLASS STRUCTURE-OBJECT - STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| - PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION - PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER)) + PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION)) (PROCLAIM - '(FTYPE (FUNCTION (T T T T *) *) ITERATE::RENAME-LET-BINDINGS - PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1)) + '(FTYPE (FUNCTION (T T T T *) *) + PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1 + ITERATE::RENAME-LET-BINDINGS)) (PROCLAIM - '(FTYPE (FUNCTION (T T T *) *) WALKER::WALK-DECLARATIONS - PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN + '(FTYPE (FUNCTION (T T T *) *) PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN + WALKER::WALK-DECLARATIONS PCL::GET-SECONDARY-DISPATCH-FUNCTION)) -(PROCLAIM '(FTYPE (FUNCTION (T STREAM T) T) PCL::PRINT-DFUN-INFO)) (PROCLAIM - '(FTYPE (FUNCTION (T T *) T) PCL::CPL-ERROR - PCL::METHOD-FUNCTION-GET - PCL:ENSURE-GENERIC-FUNCTION-USING-CLASS - PCL::GET-CACHE-FROM-CACHE PCL::EMIT-MISS - PCL::GET-METHOD-FUNCTION-PV-CELL - PCL::NAMED-OBJECT-PRINT-FUNCTION PCL::RECORD-DEFINITION - WALKER::CONVERT-MACRO-TO-LAMBDA - PCL::PRECOMPUTE-EFFECTIVE-METHODS - PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 PCL::PROBE-CACHE - PCL::MAP-CACHE PCL::INITIALIZE-INFO - PCL::GET-EFFECTIVE-METHOD-FUNCTION1 - PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE - PCL::MAKE-EMF-FROM-METHOD - PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION - PCL::FIND-CLASS-FROM-CELL PCL::REAL-ADD-METHOD - PCL::FIND-CLASS-PREDICATE-FROM-CELL PCL::GET-DECLARATION - PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION - PCL::REAL-ENSURE-GF-USING-CLASS--NULL)) + '(FTYPE (FUNCTION (T T T T T T *) *) PCL::REAL-MAKE-A-METHOD)) +(PROCLAIM '(FTYPE (FUNCTION (T STREAM T) T) PCL::PRINT-DFUN-INFO)) (PROCLAIM - '(FTYPE (FUNCTION (T T T) T) PCL::GET-NEW-FUNCTION-GENERATOR - PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| - PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| - WALKER::WALK-TAGBODY-1 PCL::NOTE-PV-TABLE-REFERENCE - WALKER::WALK-LAMBDA - PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| - PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS - (SPECIALIZER-WITH-OBJECT))| WALKER::WALK-COMPILER-LET - PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| - WALKER::WALK-UNEXPECTED-DECLARE WALKER::WALK-FLET - PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| - WALKER::WALK-IF WALKER::WALK-LABELS WALKER::WALK-LET - PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| - PCL::FLUSH-CACHE-TRAP WALKER::WALK-LET* - PCL::OBSOLETE-INSTANCE-TRAP WALKER::WALK-MACROLET - WALKER::WALK-MULTIPLE-VALUE-SETQ - PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| - WALKER::WALK-MULTIPLE-VALUE-BIND WALKER::WALK-SETQ - WALKER::WALK-SYMBOL-MACROLET WALKER::WALK-TAGBODY - WALKER::WALK-DO WALKER::WALK-DO* WALKER::WALK-PROG - WALKER::WALK-PROG* WALKER::WALK-NAMED-LAMBDA - PCL::OPTIMIZE-GF-CALL-INTERNAL PCL::SKIP-FAST-SLOT-ACCESS-P - PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P - PCL::EXPAND-DEFGENERIC - PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| - PCL::EMIT-SLOT-READ-FORM PCL::EMIT-BOUNDP-CHECK - PCL::FIX-SLOT-ACCESSORS - PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL - PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| - PCL::EMIT-GREATER-THAN-1-DLAP - PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| - PCL::EMIT-1-T-DLAP - PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| - PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| - PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| - PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| - PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| - PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| - PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| - PCL::MAKE-METHOD-SPEC - PCL::NEW-ARG-INFO-FROM-GENERIC-FUNCTION PCL::PRINT-CACHE - PCL::SET-FUNCTION-NAME-1 - PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| - PCL::|SETF PCL METHOD-FUNCTION-GET| PCL::INVALIDATE-WRAPPER - PCL::PRINT-STD-INSTANCE PCL::|SETF PCL PLIST-VALUE| + '(FTYPE (FUNCTION (T T T) T) ITERATE::SIMPLE-EXPAND-GATHERING-FORM + ITERATE::RENAME-AND-CAPTURE-VARIABLES + ITERATE::VARIABLE-SAME-P + PCL::GET-FUNCTION-GENERATOR + WALKER:VARIABLE-DECLARATION PCL::GET-NEW-FUNCTION-GENERATOR PCL::TRACE-METHOD-INTERNAL PCL::ONE-INDEX-DFUN-INFO - PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| - PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| - PCL::CONVERT-TABLE - PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| - PCL::DECLARE-STRUCTURE PCL::LOAD-PRECOMPILED-IIS-ENTRY - PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| - WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL PCL::ONE-CLASS-DFUN-INFO - PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| - PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| - PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST - (STANDARD-GENERIC-FUNCTION))| ITERATE::OPTIMIZE-ITERATE-FORM - PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| + PCL::MAP-ALL-ORDERS SYSTEM::APPLY-DISPLAY-FUN + PCL::NOTE-PV-TABLE-REFERENCE + WALKER::RELIST-INTERNAL PCL::MAKE-DFUN-CALL - PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| - PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| - PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| - PCL::COMPUTE-PRECEDENCE PCL::FIRST-FORM-TO-LISP - ITERATE::OPTIMIZE-GATHERING-FORM WALKER::RECONS - ITERATE::SIMPLE-EXPAND-GATHERING-FORM - ITERATE::RENAME-AND-CAPTURE-VARIABLES - PCL::MAKE-TOP-LEVEL-FORM WALKER::RELIST-INTERNAL - ITERATE::VARIABLE-SAME-P PCL::ENTRY-IN-CACHE-P + WALKER::WALK-TAGBODY-1 WALKER::WALK-LAMBDA + PCL::OPTIMIZE-GF-CALL-INTERNAL + PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P + WALKER::WALK-COMPILER-LET PCL::SKIP-FAST-SLOT-ACCESS-P + WALKER::WALK-UNEXPECTED-DECLARE WALKER::WALK-FLET + WALKER::WALK-IF + WALKER::WALK-LABELS WALKER::WALK-LET WALKER::WALK-LET* + WALKER::WALK-LOCALLY + WALKER::WALK-MACROLET + PCL::FIX-SLOT-ACCESSORS WALKER::WALK-MULTIPLE-VALUE-BIND + PCL:COMPUTE-EFFECTIVE-METHOD WALKER::WALK-SETQ + WALKER::WALK-SYMBOL-MACROLET PCL::EMIT-SLOT-READ-FORM + WALKER::WALK-TAGBODY PCL::EMIT-BOUNDP-CHECK WALKER::WALK-DO + WALKER::WALK-DO* WALKER::WALK-PROG + WALKER::WALK-NAMED-LAMBDA WALKER::WALK-PROG* + PCL::EXPAND-DEFGENERIC PCL::EMIT-GREATER-THAN-1-DLAP + PCL::EMIT-1-T-DLAP + PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL + PCL::ENTRY-IN-CACHE-P PCL::CONVERT-TABLE + PCL::MAKE-METHOD-SPEC PCL::TRACE-EMF-CALL-INTERNAL + PCL::FLUSH-CACHE-TRAP PCL::SET-FUNCTION-NAME-1 + PCL::OBSOLETE-INSTANCE-TRAP + PCL::COMPUTE-PRECEDENCE PCL::PRINT-STD-INSTANCE + PCL::|SETF PCL METHOD-FUNCTION-GET| + PCL::|SETF PCL PLIST-VALUE| + WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL + PCL::CAN-OPTIMIZE-ACCESS PCL::OPTIMIZE-SLOT-VALUE + PCL::OPTIMIZE-SET-SLOT-VALUE PCL::DECLARE-STRUCTURE + PCL::OPTIMIZE-SLOT-BOUNDP + PCL::PRINT-CACHE PCL::COMPUTE-STD-CPL-PHASE-3 + PCL::FIRST-FORM-TO-LISP + ITERATE::OPTIMIZE-ITERATE-FORM + PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS + PCL::MAKE-TOP-LEVEL-FORM PCL::INVALIDATE-WRAPPER + PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION - PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS - (EFFECTIVE-SLOT-DEFINITION))| - PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS - PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| - PCL::MAP-ALL-ORDERS - PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| - PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| - PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| - PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| - PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| - PCL::CAN-OPTIMIZE-ACCESS PCL::OPTIMIZE-SLOT-VALUE - PCL::OPTIMIZE-SET-SLOT-VALUE PCL::OPTIMIZE-SLOT-BOUNDP - SYSTEM::APPLY-DISPLAY-FUN - PCL::|(FAST-METHOD UPDATE-CONSTRUCTORS (SLOT-CLASS))| - PCL::|(FAST-METHOD UPDATE-CONSTRUCTORS (CLASS))| - PCL::TRACE-EMF-CALL-INTERNAL - PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| - PCL::GET-FUNCTION-GENERATOR - PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| - WALKER:VARIABLE-DECLARATION PCL::COMPUTE-STD-CPL-PHASE-3 - PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))|)) + WALKER::RECONS ITERATE::OPTIMIZE-GATHERING-FORM)) (PROCLAIM - '(FTYPE (FUNCTION (T T T T) T) WALKER::WALK-LET/LET* - WALKER::WALK-PROG/PROG* - PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| - WALKER::WALK-DO/DO* WALKER::WALK-BINDINGS-2 - PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| - PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| - PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| - PCL::OPTIMIZE-READER PCL::OPTIMIZE-WRITER - PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| - PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| - PCL::FILL-CACHE-P - PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| - PCL::ADJUST-CACHE PCL::EXPAND-CACHE - PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| - PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| - PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| - PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| - PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| - PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| - PCL::|(FAST-METHOD VALIDATE-SUPERCLASS - (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| - PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| - PCL::INITIALIZE-INSTANCE-SIMPLE - PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| - PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| - PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| - PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| - PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| - PCL::MAYBE-EXPAND-ACCESSOR-FORM - PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| - PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| - PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION - (FUNCALLABLE-STANDARD-CLASS T))| - PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR PCL::GET-CACHE - PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION - (FUNCALLABLE-STANDARD-CLASS T))| - PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| - PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| - PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| - PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| - PCL::GET-WRAPPERS-FROM-CLASSES - PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| - PCL::|(FAST-METHOD SAME-SPECIALIZER-P - (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| - PCL::|(FAST-METHOD PRINT-OBJECT (T T))| - PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| - PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| - PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| - PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| - PCL::TWO-CLASS-DFUN-INFO PCL::SET-MAKE-INSTANCE-FUNCTION - PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| - PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| - PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| - PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| - WALKER::WALK-TEMPLATE PCL::EXPAND-DEFCLASS - PCL::BOOTSTRAP-SET-SLOT - PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| - PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| - PCL::|(FAST-METHOD DOCUMENTATION (T))| - PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| - PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| - PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| - PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| - PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND - (STRUCTURE-CLASS T))| PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 + '(FTYPE (FUNCTION (T T T T) T) PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE - PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| - PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| - PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY PCL::MEMF-TEST-CONVERTER - PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| - PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| - PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| - PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| - PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))| - PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| + PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR + PCL::TWO-CLASS-DFUN-INFO + WALKER::WALK-LET/LET* WALKER::WALK-PROG/PROG* + WALKER::WALK-DO/DO* + WALKER::WALK-BINDINGS-2 PCL::OPTIMIZE-READER + PCL::OPTIMIZE-WRITER + PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY + PCL::MAYBE-EXPAND-ACCESSOR-FORM + PCL::INITIALIZE-INSTANCE-SIMPLE + PCL::GET-WRAPPERS-FROM-CLASSES + PCL::LOAD-PRECOMPILED-IIS-ENTRY + PCL::FILL-CACHE-P + PCL::ADJUST-CACHE + PCL::EXPAND-CACHE PCL::EXPAND-SYMBOL-MACROLET-INTERNAL - PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| - PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| - PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| - PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| - PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| - PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| - PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))|)) + PCL::BOOTSTRAP-SET-SLOT PCL::EXPAND-DEFCLASS PCL::GET-CACHE + )) (PROCLAIM - '(FTYPE (FUNCTION (T T T T T) T) - PCL::REAL-MAKE-METHOD-INITARGS-FORM PCL::MAKE-FGEN + '(FTYPE (FUNCTION (T T T T T) T) PCL::LOAD-FUNCTION-GENERATOR + PCL::EXPAND-EMF-CALL-METHOD PCL::MAKE-FGEN + PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS + PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 + PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL PCL::COMPUTE-PV-SLOT WALKER::WALK-BINDINGS-1 - PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| - PCL::COMPUTE-PV-SLOT - PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| - PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| PCL::OPTIMIZE-INSTANCE-ACCESS - PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS PCL::OPTIMIZE-ACCESSOR-CALL - PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS - PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| - PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| - PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD - (GENERIC-FUNCTION STANDARD-METHOD-COMBINATION T))| - PCL::MAKE-PARAMETER-REFERENCES PCL::UPDATE-SLOTS-IN-PV - PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| - PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| - PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| - PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| - PCL::MAKE-EMF-CACHE PCL::MAKE-INSTANCE-FUNCTION-COMPLEX + PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 + PCL::UPDATE-SLOTS-IN-PV + PCL::MAKE-PARAMETER-REFERENCES + PCL::MAKE-EMF-CACHE + PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL + PCL::MAKE-INSTANCE-FUNCTION-COMPLEX PCL::MAKE-INSTANCE-FUNCTION-SIMPLE - WALKER::WALK-TEMPLATE-HANDLE-REPEAT - PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS - (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| - PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS - (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| - PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS - (STRUCTURE-CLASS STRUCTURE-OBJECT - STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| - PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS - (STRUCTURE-CLASS STRUCTURE-OBJECT - STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| - PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| - PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) - (T EFFECTIVE-SLOT-DEFINITION T))| - PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO - (EFFECTIVE-SLOT-DEFINITION T T))| - PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| - PCL::|(FAST-METHOD FIND-METHOD-COMBINATION - (GENERIC-FUNCTION (EQL STANDARD) T))| - PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| - PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD - (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| - PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| - PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| - PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| - PCL::EXPAND-EMF-CALL-METHOD PCL::OPTIMIZE-GENERIC-FUNCTION-CALL - PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL - PCL::LOAD-FUNCTION-GENERATOR)) + PCL::REAL-MAKE-METHOD-INITARGS-FORM + )) (PROCLAIM - '(FTYPE (FUNCTION (T T T T T T *) T) PCL::MAKE-DEFMETHOD-FORM - PCL::MAKE-DEFMETHOD-FORM-INTERNAL PCL::LOAD-DEFMETHOD - PCL::EARLY-MAKE-A-METHOD PCL::SET-ARG-INFO)) -(PROCLAIM - '(FTYPE (FUNCTION (T T T T *) T) PCL::FILL-DFUN-CACHE - PCL::EARLY-ADD-NAMED-METHOD PCL::REAL-ADD-NAMED-METHOD)) -(PROCLAIM - '(FTYPE (FUNCTION (T T T *) T) WALKER::WALK-ARGLIST - PCL::CAN-OPTIMIZE-ACCESS1 PCL::EMIT-FETCH-WRAPPER - PCL::CHECK-INITARGS-1 PCL::MAKE-EMF-CALL PCL::FILL-CACHE - PCL::CHECK-INITARGS-2-PLIST PCL::REAL-GET-METHOD - PCL::CHECK-INITARGS-2-LIST PCL::GET-METHOD)) + '(FTYPE (FUNCTION (T T *) T) + PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE + PCL::MAKE-EMF-FROM-METHOD + PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION + PCL::NAMED-OBJECT-PRINT-FUNCTION PCL::FIND-CLASS-FROM-CELL + PCL::FIND-CLASS-PREDICATE-FROM-CELL PCL::INITIALIZE-INFO + PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::GET-DECLARATION + PCL::GET-METHOD-FUNCTION-PV-CELL + PCL:ENSURE-GENERIC-FUNCTION-USING-CLASS PCL::EMIT-MISS + PCL::METHOD-FUNCTION-GET PCL::PROBE-CACHE PCL::MAP-CACHE + PCL::GET-CACHE-FROM-CACHE PCL::PRECOMPUTE-EFFECTIVE-METHODS + PCL::RECORD-DEFINITION WALKER::CONVERT-MACRO-TO-LAMBDA + PCL::CPL-ERROR PCL::REAL-ADD-METHOD + PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION + PCL::REAL-ENSURE-GF-USING-CLASS--NULL + PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1)) (PROCLAIM - '(FTYPE (FUNCTION (T T T T T T T) T) PCL::EXPAND-DEFMETHOD - PCL::LOAD-DEFMETHOD-INTERNAL - PCL::|(FAST-METHOD SLOT-MISSING (T T T T))|)) + '(FTYPE (FUNCTION (T T T T T T T T) T) + PCL::GET-SECONDARY-DISPATCH-FUNCTION2)) (PROCLAIM '(FTYPE (FUNCTION (T T T T T T) T) PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION PCL::EMIT-SLOT-ACCESS - PCL::OPTIMIZE-GF-CALL PCL::LOAD-DEFCLASS - WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 - PCL::MAKE-EARLY-CLASS-DEFINITION - PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) - (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|)) + PCL::OPTIMIZE-GF-CALL PCL::SET-ARG-INFO1 PCL::LOAD-DEFCLASS + PCL::MAKE-EARLY-CLASS-DEFINITION)) (PROCLAIM - '(FTYPE (FUNCTION (T T T T T T T T) T) - PCL::GET-SECONDARY-DISPATCH-FUNCTION2)) + '(FTYPE (FUNCTION (T T T T *) T) PCL::FILL-DFUN-CACHE + PCL::EARLY-ADD-NAMED-METHOD PCL::REAL-ADD-NAMED-METHOD)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T *) T) PCL::LOAD-DEFMETHOD + PCL::MAKE-DEFMETHOD-FORM PCL::MAKE-DEFMETHOD-FORM-INTERNAL + PCL::EARLY-MAKE-A-METHOD)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T *) T) PCL::CHECK-INITARGS-2-PLIST + PCL::CHECK-INITARGS-2-LIST WALKER::WALK-ARGLIST + PCL::MAKE-EMF-CALL PCL::CAN-OPTIMIZE-ACCESS1 + PCL::EMIT-FETCH-WRAPPER PCL::FILL-CACHE + PCL::REAL-GET-METHOD PCL::CHECK-INITARGS-1 PCL::GET-METHOD)) (PROCLAIM '(FTYPE (FUNCTION (T T T T T *) T) PCL::EMIT-DLAP - PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) (PROCLAIM '(FTYPE (FUNCTION (T T T FIXNUM) T) PCL::FILL-CACHE-FROM-CACHE-P)) +(PROCLAIM + '(FTYPE (FUNCTION (T T T T T T T) T) PCL::EXPAND-DEFMETHOD + PCL::LOAD-DEFMETHOD-INTERNAL + )) (PROCLAIM '(FTYPE (FUNCTION (T T T T T T T T T *) T) PCL::BOOTSTRAP-INITIALIZE-CLASS)) (PROCLAIM - '(FTYPE (FUNCTION NIL *) PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-READERS - PCL::EMIT-N-N-WRITERS PCL::RENEW-SYS-FILES)) + '(FTYPE (FUNCTION NIL *) PCL::COUNT-ALL-DFUNS PCL::RENEW-SYS-FILES + PCL::EMIT-N-N-READERS PCL::EMIT-N-N-WRITERS)) (PROCLAIM - '(FTYPE (FUNCTION NIL T) + '(FTYPE (FUNCTION NIL T) PCL::GET-EFFECTIVE-METHOD-GENSYM + PCL::SHOW-EMF-CALL-TRACE PCL::BOOTSTRAP-META-BRAID + PCL::BOOTSTRAP-BUILT-IN-CLASSES PCL::LIST-ALL-DFUNS + PCL::DEFAULT-METHOD-ONLY-DFUN-INFO PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST - PCL::SHOW-EMF-CALL-TRACE PCL::MAKE-CACHE PCL::MAKE-CPD - PCL::BOOTSTRAP-META-BRAID PCL::EARLY-INITIALIZE-SLOT-GFS - PCL::EARLY-INITIALIZE-CLASS-PREDICATES - PCL::BOOTSTRAP-BUILT-IN-CLASSES PCL::UPDATE-DISPATCH-DFUNS - PCL::SHOW-FREE-CACHE-VECTORS PCL::NO-METHODS-DFUN-INFO + PCL::CACHES-TO-ALLOCATE PCL::UPDATE-DISPATCH-DFUNS + PCL::MAKE-CACHE PCL::RESET-PCL-PACKAGE PCL::IN-THE-COMPILER-P PCL::STRUCTURE-FUNCTIONS-EXIST-P - PCL::%%ALLOCATE-INSTANCE--CLASS PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2 + PCL::%%ALLOCATE-INSTANCE--CLASS PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 - PCL::DEFAULT-METHOD-ONLY-DFUN-INFO - PCL::INITIAL-DISPATCH-DFUN-INFO PCL::INITIAL-DFUN-INFO - PCL::MAKE-ARG-INFO PCL::DISPATCH-DFUN-INFO - PCL::SHOW-DFUN-CONSTRUCTORS PCL::CACHES-TO-ALLOCATE - PCL::RESET-PCL-PACKAGE PCL::GET-EFFECTIVE-METHOD-GENSYM - PCL::LIST-ALL-DFUNS)) + PCL::DISPATCH-DFUN-INFO PCL::INITIAL-DISPATCH-DFUN-INFO + PCL::INITIAL-DFUN-INFO PCL::NO-METHODS-DFUN-INFO + PCL::SHOW-FREE-CACHE-VECTORS PCL::MAKE-CPD + PCL::MAKE-ARG-INFO PCL::SHOW-DFUN-CONSTRUCTORS)) (PROCLAIM - '(FTYPE (FUNCTION (*) *) PCL::LIST-LARGE-CACHES + '(FTYPE (FUNCTION (*) *) PCL::UNTRACE-METHOD PCL:INVALID-METHOD-ERROR PCL:METHOD-COMBINATION-ERROR - PCL::UNTRACE-METHOD)) + PCL::LIST-LARGE-CACHES + PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE)) (PROCLAIM '(FTYPE (FUNCTION (FIXNUM T *) *) PCL::FIND-FREE-CACHE-LINE)) (PROCLAIM '(FTYPE (FUNCTION (FIXNUM T T) *) PCL::COMPUTE-CACHE-PARAMETERS)) (PROCLAIM - '(FTYPE (FUNCTION (*) T) PCL::MAKE-METHOD-CALL - PCL::MAKE-FAST-METHOD-CALL PCL::MAKE-FAST-INSTANCE-BOUNDP + '(FTYPE (FUNCTION (*) T) PCL::|__si::MAKE-DFUN-INFO| + PCL::|__si::MAKE-NO-METHODS| PCL::|__si::MAKE-INITIAL| + PCL::|__si::MAKE-INITIAL-DISPATCH| + PCL::|__si::MAKE-DISPATCH| + PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| + PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| + PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| + PCL::MAKE-FAST-METHOD-CALL PCL::|__si::MAKE-N-N| + PCL::MAKE-FAST-INSTANCE-BOUNDP PCL::|__si::MAKE-ONE-CLASS| + PCL::|__si::MAKE-TWO-CLASS| PCL::|__si::MAKE-ONE-INDEX| + PCL::|__si::MAKE-CHECKING| PCL::|__si::MAKE-ARG-INFO| + PCL::FIX-EARLY-GENERIC-FUNCTIONS PCL::STRING-APPEND + PCL::|__si::MAKE-CACHING| PCL::|__si::MAKE-CONSTANT-VALUE| + PCL::FALSE PCL::|STRUCTURE-OBJECT class constructor| PCL::PV-WRAPPERS-FROM-PV-ARGS PCL::MAKE-PV-TABLE - PCL::|__si::MAKE-ARG-INFO| PCL::|__si::MAKE-PV-TABLE| - PCL::FIX-EARLY-GENERIC-FUNCTIONS PCL::|__si::MAKE-CACHE| - PCL::|__si::MAKE-NO-METHODS| PCL::|__si::MAKE-STD-INSTANCE| + PCL::|__si::MAKE-PV-TABLE| PCL::INTERN-PV-TABLE PCL::CALLED-FIN-WITHOUT-FUNCTION - WALKER::UNBOUND-LEXICAL-FUNCTION PCL::MAKE-INITIALIZE-INFO - PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE - PCL::|__si::MAKE-DFUN-INFO| - PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| - PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| PCL::MAKE-PROGN - PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| PCL::|__si::MAKE-N-N| + PCL::|__si::MAKE-STD-INSTANCE| PCL::TRUE + PCL::MAKE-INITIALIZE-INFO PCL::|__si::MAKE-CACHE| + PCL::MAKE-PROGN WALKER::UNBOUND-LEXICAL-FUNCTION PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| - PCL::|__si::MAKE-ONE-CLASS| PCL::|__si::MAKE-TWO-CLASS| - PCL::|__si::MAKE-ONE-INDEX| PCL::|__si::MAKE-CHECKING| - PCL::|__si::MAKE-CACHING| PCL::|__si::MAKE-CONSTANT-VALUE| - PCL::INTERN-PV-TABLE PCL::TRUE PCL::|__si::MAKE-DISPATCH| - PCL::STRING-APPEND PCL::|__si::MAKE-INITIAL| PCL::FALSE - PCL::|__si::MAKE-INITIAL-DISPATCH| - PCL::|STRUCTURE-OBJECT class constructor|)) + PCL::MAKE-METHOD-CALL)) (PROCLAIM - '(FTYPE (FUNCTION (T) *) PCL::METHOD-PROTOTYPE-FOR-GF - PCL::FIND-WRAPPER PCL::PARSE-DEFMETHOD - PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA - PCL::FORCE-CACHE-FLUSHES PCL::STRUCTURE-WRAPPER - PCL::EMIT-ONE-CLASS-READER PCL::EMIT-ONE-CLASS-WRITER - PCL::EMIT-TWO-CLASS-READER PCL::EMIT-TWO-CLASS-WRITER - PCL::EMIT-ONE-INDEX-READERS PCL::EMIT-ONE-INDEX-WRITERS - PCL::EARLY-METHOD-FUNCTION PCL::EMIT-IN-CHECKING-CACHE-P - PCL::EMIT-CONSTANT-VALUE - PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::NET-CODE-CONVERTER - PCL::STRUCTURE-SLOTD-INIT-FORM PCL::MAKE-DISPATCH-DFUN - PCL::INSURE-CACHING-DFUN PCL::%FBOUNDP PCL::CCLOSUREP - PCL::EARLY-COLLECT-INHERITANCE PCL::TYPE-FROM-SPECIALIZER + '(FTYPE (FUNCTION (T) *) PCL::TYPE-FROM-SPECIALIZER PCL::*NORMALIZE-TYPE PCL::UNPARSE-TYPE - PCL::CONVERT-TO-SYSTEM-TYPE PCL::PCL-DESCRIBE - PCL::PARSE-METHOD-GROUP-SPECIFIER PCL::ANALYZE-LAMBDA-LIST - COMPILER::CAN-USE-PRINT-CIRCLE-P PCL::GF-LAMBDA-LIST + PCL::DEFAULT-CODE-CONVERTER PCL::CONVERT-TO-SYSTEM-TYPE + PCL::EMIT-CONSTANT-VALUE PCL::SFUN-P PCL::PCL-DESCRIBE + PCL::GET-GENERIC-FUNCTION-INFO PCL::EARLY-METHOD-FUNCTION + PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME PCL::SPECIALIZER-FROM-TYPE PCL::CLASS-EQ-TYPE - PCL::FIND-STRUCTURE-CLASS PCL::GENERIC-FUNCTION-NAME-P - PCL::GET-DISPATCH-FUNCTION PCL::DEFAULT-CODE-CONVERTER - PCL::MAKE-FINAL-DISPATCH-DFUN)) -(PROCLAIM - '(FTYPE (FUNCTION (T) T) PCL::FGEN-GENERATOR PCL::FGEN-SYSTEM - PCL::STORE-FGEN PCL::MAKE-PV-TYPE-DECLARATION - PCL::MAKE-CALLS-TYPE-DECLARATION PCL::CHECK-CACHE - PCL::FGEN-GENSYMS PCL::MAKE-CONSTANT-FUNCTION - PCL::FGEN-GENERATOR-LAMBDA PCL::FUNCTION-RETURNING-T - PCL::METHOD-CALL-P PCL::FIND-CYCLE-REASONS - PCL::MAP-ALL-GENERIC-FUNCTIONS PCL::MAKE-PERMUTATION-VECTOR - PCL::FAST-METHOD-CALL-P PCL::ALLOCATE-CACHE-VECTOR - PCL::FLUSH-CACHE-VECTOR-INTERNAL PCL::FORMAT-CYCLE-REASONS - PCL::FAST-INSTANCE-BOUNDP-P PCL::METHOD-FUNCTION-PV-TABLE - PCL::METHOD-FUNCTION-METHOD - PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS - PCL::GET-CACHE-VECTOR + COMPILER::CAN-USE-PRINT-CIRCLE-P PCL::STRUCTURE-WRAPPER + PCL::FIND-STRUCTURE-CLASS PCL::MAKE-DISPATCH-DFUN + PCL::FIND-WRAPPER PCL::PARSE-DEFMETHOD + PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA + PCL::FORCE-CACHE-FLUSHES PCL::EMIT-ONE-CLASS-READER + PCL::EMIT-ONE-CLASS-WRITER PCL::EMIT-TWO-CLASS-READER + PCL::EMIT-TWO-CLASS-WRITER PCL::EMIT-ONE-INDEX-READERS + PCL::EMIT-ONE-INDEX-WRITERS PCL::NET-CODE-CONVERTER + PCL::EMIT-IN-CHECKING-CACHE-P PCL::COMPILE-IIS-FUNCTIONS + PCL::ANALYZE-LAMBDA-LIST + PCL::COMPUTE-APPLICABLE-METHODS-EMF + PCL::GET-DISPATCH-FUNCTION PCL::INSURE-CACHING-DFUN + PCL::%FBOUNDP PCL::CCLOSUREP PCL::GENERIC-FUNCTION-NAME-P + PCL::MAKE-FINAL-DISPATCH-DFUN + PCL::STRUCTURE-SLOTD-INIT-FORM + PCL::PARSE-METHOD-GROUP-SPECIFIER + PCL::METHOD-PROTOTYPE-FOR-GF + PCL::EARLY-COLLECT-INHERITANCE)) +(PROCLAIM + '(FTYPE (FUNCTION (T) T) PCL::UNENCAPSULATED-FDEFINITION + PCL::DFUN-INFO-P PCL::NO-METHODS-P + PCL::MAKE-TYPE-PREDICATE + PCL::DEFAULT-TEST-CONVERTER PCL::INITIAL-P + PCL::UNPARSE-TYPE-LIST PCL::MAKE-CALL-METHODS + PCL::DEFAULT-CONSTANT-CONVERTER PCL::INITIAL-DISPATCH-P + PCL::DISPATCH-P PCL::GBOUNDP PCL::GMAKUNBOUND + PCL::DEFAULT-CONSTANTP PCL::DEFAULT-METHOD-ONLY-P + PCL::FGEN-TEST PCL::LOOKUP-FGEN PCL::ACCESSOR-DFUN-INFO-P + PCL::FGEN-GENERATOR PCL::FGEN-SYSTEM + PCL::ONE-INDEX-DFUN-INFO-P PCL::FAST-METHOD-CALL-P + PCL::N-N-P PCL::FAST-INSTANCE-BOUNDP-P + PCL::METHOD-FUNCTION-PV-TABLE PCL::METHOD-FUNCTION-METHOD + PCL::STORE-FGEN PCL::ONE-CLASS-P PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P - PCL::WRAPPER-FIELD PCL::FREE-CACHE-VECTOR - PCL::METHOD-FUNCTION-PLIST PCL::SORT-SLOTS - PCL::MAP-SPECIALIZERS - PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST - PCL::ONE-INDEX-DFUN-INFO-CACHE PCL::SORT-CALLS - PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::DFUN-ARG-SYMBOL - PCL::N-N-CACHE PCL::GF-DFUN-CACHE PCL::N-N-ACCESSOR-TYPE - PCL::GDEFINITION PCL::GF-DFUN-INFO PCL::ONE-CLASS-CACHE - PCL::EVAL-FORM PCL::EARLY-GF-NAME - PCL::ONE-CLASS-ACCESSOR-TYPE - PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD - PCL::ONE-CLASS-INDEX - PCL:EXTRACT-LAMBDA-LIST PCL::SYMBOL-PKG-NAME - PCL::TWO-CLASS-CACHE PCL:EXTRACT-SPECIALIZER-NAMES - PCL::ARG-INFO-PRECEDENCE PCL::TWO-CLASS-ACCESSOR-TYPE - PCL::ARG-INFO-METATYPES PCL::TWO-CLASS-INDEX - PCL::INITIALIZE-INFO-KEY PCL::INTERNED-SYMBOL-P - PCL::ARG-INFO-NUMBER-OPTIONAL PCL::TWO-CLASS-WRAPPER0 - PCL::INITIALIZE-INFO-WRAPPER PCL::FREE-CACHE + PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST PCL::FGEN-GENSYMS + PCL::TWO-CLASS-P PCL::ARG-INFO-LAMBDA-LIST + PCL::ARG-INFO-PRECEDENCE PCL::ARG-INFO-METATYPES + PCL::FGEN-GENERATOR-LAMBDA SYSTEM:%STRUCTURE-NAME + PCL::ARG-INFO-NUMBER-OPTIONAL + SYSTEM:%COMPILED-FUNCTION-NAME PCL::ARG-INFO-KEY/REST-P + PCL::ONE-INDEX-P PCL::ARG-INFO-KEYWORDS + PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE + PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P + PCL::GF-INFO-STATIC-C-A-M-EMF PCL::CHECKING-P + PCL::GF-INFO-C-A-M-EMF-STD-P PCL::GF-INFO-FAST-MF-P + PCL::UNDEFMETHOD-1 PCL::ARG-INFO-P + PCL::FAST-METHOD-CALL-ARG-INFO PCL::ARG-INFO-NKEYS + PCL::GF-DFUN-CACHE PCL:CLASS-OF PCL::GF-DFUN-INFO + PCL::FUNCTION-RETURNING-NIL + PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE PCL::EVAL-FORM + PCL::ONE-INDEX-DFUN-INFO-INDEX + PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::TYPE-CLASS + PCL::ONE-CLASS-WRAPPER0 PCL::EXTRACT-PARAMETERS + PCL::CLASS-PREDICATE PCL::EXTRACT-REQUIRED-PARAMETERS + PCL::MAKE-CLASS-EQ-PREDICATE PCL::TWO-CLASS-WRAPPER1 + PCL::MAKE-EQL-PREDICATE PCL::CHECKING-FUNCTION + PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS + PCL::INITIALIZE-INFO-KEY PCL::BOOTSTRAP-CLASS-PREDICATES + PCL::GET-BUILT-IN-CLASS-SYMBOL PCL::INITIALIZE-INFO-WRAPPER + PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::DO-STANDARD-DEFSETF-1 + PCL::CACHING-P PCL::GFS-OF-TYPE PCL::LEGAL-CLASS-NAME-P + PCL::STRUCTURE-TYPE-P PCL::CONSTANT-VALUE-P + PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P + SYSTEM::NEXT-STACK-FRAME PCL::WRAPPER-FIELD + PCL::NEXT-WRAPPER-FIELD PCL::SETFBOUNDP + PCL::GET-SETF-FUNCTION-NAME PCL::USE-CACHING-DFUN-P + PCL::MAKE-PV-TYPE-DECLARATION + PCL::MAKE-CALLS-TYPE-DECLARATION PCL::MAP-SPECIALIZERS + WALKER:VARIABLE-GLOBALLY-SPECIAL-P PCL::SLOT-VECTOR-SYMBOL + PCL::MAKE-PERMUTATION-VECTOR PCL::STRUCTURE-OBJECT-P + PCL::EXPAND-MAKE-INSTANCE-FORM PCL::MAKE-CONSTANT-FUNCTION + PCL::FUNCTION-RETURNING-T PCL::SORT-SLOTS PCL::SORT-CALLS + PCL::SYMBOL-PKG-NAME PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P - PCL::ARG-INFO-KEY/REST-P PCL::ONE-INDEX-CACHE - PCL::ARG-INFO-KEYWORDS PCL::ONE-INDEX-ACCESSOR-TYPE - PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::ONE-INDEX-INDEX - PCL::UPDATE-GFS-OF-CLASS PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P - PCL::CHECKING-CACHE PCL::GF-INFO-STATIC-C-A-M-EMF - PCL::CACHING-CACHE PCL::GF-INFO-C-A-M-EMF-STD-P - PCL::CONSTANT-VALUE-CACHE PCL::UPDATE-CLASS-CAN-PRECEDE-P - PCL::GF-INFO-FAST-MF-P PCL::COMPUTE-CLASS-SLOTS - PCL::ARG-INFO-LAMBDA-LIST PCL:INTERN-EQL-SPECIALIZER - PCL::ARG-INFO-P PCL::ARG-INFO-VALID-P PCL::ARG-INFO-NKEYS - PCL::COMPILE-IIS-FUNCTIONS PCL::ARG-INFO-APPLYP - PCL::WRAPPER-FOR-STRUCTURE PCL::PV-TABLEP - PCL::UPDATE-GF-INFO PCL::MAKE-PV-TABLE-TYPE-DECLARATION - PCL::BUILT-IN-WRAPPER-OF PCL::CACHE-P - PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 - PCL::RESET-INITIALIZE-INFO PCL::UPDATE-PV-TABLE-CACHE-INFO - PCL::UPDATE-C-A-M-GF-INFO - PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE - PCL::INITIALIZE-INFO-CACHED-VALID-P PCL::EARLY-CLASS-NAME - PCL::NO-METHODS-P PCL::STANDARD-SVUC-METHOD - PCL::INTERN-FUNCTION-NAME + PCL::INITIALIZE-INFO-BOUND-SLOTS + PCL::INITIALIZE-INFO-CACHED-VALID-P + PCL::GET-MAKE-INSTANCE-FUNCTIONS PCL::INITIALIZE-INFO-CACHED-RI-VALID-P - PCL::STRUCTURE-SVUC-METHOD PCL::COMPILE-LAMBDA-UNCOMPILED PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST - PCL::COMPILE-LAMBDA-DEFERRED PCL::INITIALIZE-INFO-CACHED-NEW-KEYS + PCL::UPDATE-C-A-M-GF-INFO PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION - PCL::UNDEFMETHOD-1 + PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE + PCL::UPDATE-GFS-OF-CLASS PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION - PCL::METHOD-LL->GENERIC-FUNCTION-LL - PCL::COMPUTE-MCASE-PARAMETERS + PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS + PCL::STANDARD-SVUC-METHOD PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION - PCL::INITIALIZE-INFO-CACHED-CONSTANTS PCL::COPY-CACHE - PCL::NET-TEST-CONVERTER + PCL:EXTRACT-LAMBDA-LIST PCL::%CCLOSURE-ENV + PCL::STRUCTURE-SVUC-METHOD + PCL::INITIALIZE-INFO-CACHED-CONSTANTS + PCL:EXTRACT-SPECIALIZER-NAMES PCL::METHOD-FUNCTION-PLIST PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION - PCL::COMPUTE-LINE-SIZE - PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE + PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION + PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL + PCL::INTERNED-SYMBOL-P PCL::GDEFINITION + PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::%STD-INSTANCE-WRAPPER + PCL::%STD-INSTANCE-SLOTS PCL::PV-TABLEP PCL::STD-INSTANCE-P + PCL::COMPUTE-MCASE-PARAMETERS PCL::COMPUTE-CLASS-SLOTS + PCL::MAKE-PV-TABLE-TYPE-DECLARATION PCL::NET-TEST-CONVERTER + PCL:INTERN-EQL-SPECIALIZER + PCL::MAKE-INSTANCE-FUNCTION-SYMBOL PCL::UPDATE-ALL-C-A-M-GF-INFO - PCL::ONE-INDEX-DFUN-INFO-INDEX PCL::ONE-CLASS-WRAPPER0 - PCL::EXTRACT-PARAMETERS PCL::TWO-CLASS-WRAPPER1 - PCL::EXTRACT-REQUIRED-PARAMETERS - PCL::FUNCTION-PRETTY-ARGLIST PCL::CHECKING-FUNCTION - PCL::CLASS-FROM-TYPE PCL::DNET-METHODS-P - PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES - PCL::FUNCALLABLE-INSTANCE-P PCL::DEFAULT-STRUCTUREP - PCL::DEFAULT-STRUCTURE-INSTANCE-P PCL::GFS-OF-TYPE + PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::DFUN-INFO-CACHE + PCL::NO-METHODS-CACHE PCL::ARG-INFO-APPLYP + PCL::INITIAL-CACHE PCL::INITIAL-DISPATCH-CACHE + PCL::CHECK-CACHE PCL::DISPATCH-CACHE PCL::CLASS-FROM-TYPE + PCL::DEFAULT-METHOD-ONLY-CACHE PCL::DNET-METHODS-P + PCL::ACCESSOR-DFUN-INFO-CACHE + PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION + PCL::ONE-INDEX-DFUN-INFO-CACHE + PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE + PCL::METHOD-CALL-CALL-METHOD-ARGS PCL::KEYWORD-SPEC-NAME + PCL::N-N-CACHE PCL::GENERIC-CLOBBERS-FUNCTION + PCL::N-N-ACCESSOR-TYPE PCL::FAST-METHOD-CALL-PV-CELL + PCL::WRAPPER-FOR-STRUCTURE PCL::ONE-CLASS-CACHE + PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL + PCL::ONE-CLASS-ACCESSOR-TYPE PCL::ONE-CLASS-INDEX + PCL::BUILT-IN-WRAPPER-OF PCL::TWO-CLASS-CACHE + PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 + PCL::TWO-CLASS-ACCESSOR-TYPE PCL::TWO-CLASS-INDEX + PCL::ALLOCATE-CACHE-VECTOR PCL::TWO-CLASS-WRAPPER0 + PCL::FLUSH-CACHE-VECTOR-INTERNAL PCL::ONE-INDEX-CACHE + PCL::EARLY-CLASS-NAME PCL::ONE-INDEX-ACCESSOR-TYPE + PCL::ONE-INDEX-INDEX PCL::INTERN-FUNCTION-NAME + PCL::CHECKING-CACHE PCL::COMPILE-LAMBDA-UNCOMPILED + PCL::GF-LAMBDA-LIST PCL::CACHING-CACHE + PCL::CONSTANT-VALUE-CACHE PCL::COMPILE-LAMBDA-DEFERRED + PCL::FUNCALLABLE-INSTANCE-P + PCL::RESET-CLASS-INITIALIZE-INFO PCL::GET-CACHE-VECTOR + PCL::CONSTANT-SYMBOL-P PCL::FREE-CACHE-VECTOR + PCL::EARLY-METHOD-LAMBDA-LIST PCL::ARG-INFO-VALID-P + PCL::DFUN-ARG-SYMBOL PCL::EARLY-METHOD-CLASS + PCL::EARLY-GF-P PCL::EARLY-GF-NAME PCL::CACHING-DFUN-INFO + PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P + PCL::CONSTANT-VALUE-DFUN-INFO + PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::FREE-CACHE + PCL::PARSE-SPECIALIZERS PCL::RESET-INITIALIZE-INFO + PCL::EARLY-METHOD-QUALIFIERS + PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::WRAPPER-OF + PCL::EARLY-METHOD-STANDARD-ACCESSOR-P + PCL::FUNCTION-PRETTY-ARGLIST + PCL::GET-MAKE-INSTANCE-FUNCTION PCL::CHECK-WRAPPER-VALIDITY + PCL::UNPARSE-SPECIALIZERS PCL::%SYMBOL-FUNCTION + PCL::FINAL-ACCESSOR-DFUN-TYPE + PCL::COMPLICATED-INSTANCE-CREATION-METHOD + PCL::DEFAULT-STRUCTUREP PCL::UPDATE-GF-INFO + PCL::CACHE-OWNER PCL::DEFAULT-STRUCTURE-INSTANCE-P PCL::DEFAULT-STRUCTURE-TYPE PCL::STRUCTURE-TYPE + PCL::COMPUTE-STD-CPL-PHASE-2 PCL::GET-PV-CELL-FOR-CLASS PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME - PCL::RESET-CLASS-INITIALIZE-INFO - PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST - PCL::CONSTANT-SYMBOL-P PCL::STRUCTURE-SLOTD-NAME - PCL::MAKE-INSTANCE-FUNCTION-SYMBOL + PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST PCL::CACHE-P + PCL::STRUCTURE-SLOTD-NAME PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL - PCL::MAKE-LAZY-GET-MAKE-INSTANCE-FUNCTION - PCL::%STD-INSTANCE-WRAPPER + PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION PCL::STRUCTURE-SLOTD-WRITER-FUNCTION - PCL::%STD-INSTANCE-SLOTS PCL::STRUCTURE-SLOTD-TYPE - PCL::STD-INSTANCE-P PCL::CONSTANT-VALUE-P - PCL::USE-CACHING-DFUN-P - PCL::COMPLICATED-INSTANCE-CREATION-METHOD - PCL::MAKE-FUNCTION-INLINE - PCL::SLOT-VECTOR-SYMBOL PCL::CACHING-DFUN-INFO - PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P - PCL::CONSTANT-VALUE-DFUN-INFO - PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS WALKER::ENV-LOCK - PCL::CPD-CLASS WALKER::ENV-LEXICAL-VARIABLES - PCL::RESET-CLASS-INITIALIZE-INFO-1 WALKER::ENV-DECLARATIONS - ITERATE::VARIABLES-FROM-LET - WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE - PCL::UPDATE-INITIALIZE-INFO PCL::CPD-SUPERS - WALKER::ENV-WALK-FORM WALKER::ENV-WALK-FUNCTION - PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION PCL::CPD-AFTER - PCL::EARLY-CLASS-DEFINITION WALKER::GET-WALKER-TEMPLATE - PCL::GET-PV-CELL-FOR-CLASS ITERATE::SEQUENCE-ACCESSOR - PCL::CPD-COUNT PCL::%SYMBOL-FUNCTION PCL::%CCLOSURE-ENV + PCL::FIND-CYCLE-REASONS PCL::EARLY-CLASS-DEFINITION + PCL::ECD-SOURCE PCL::STRUCTURE-SLOTD-TYPE + PCL::FORMAT-CYCLE-REASONS PCL::ECD-METACLASS PCL::CPD-CLASS PCL::EARLY-CLASS-PRECEDENCE-LIST + PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P PCL::CPD-SUPERS + PCL::EXPAND-LONG-DEFCOMBIN PCL::EARLY-CLASS-NAME-OF + PCL::CPD-AFTER PCL::EXPAND-SHORT-DEFCOMBIN + PCL::EARLY-CLASS-SLOTDS PCL::CPD-COUNT + PCL::EARLY-SLOT-DEFINITION-NAME PCL::SLOT-READER-SYMBOL + PCL::EARLY-SLOT-DEFINITION-LOCATION WALKER::ENV-LOCK + PCL::MAKE-INITIAL-DFUN PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME + PCL::SLOT-WRITER-SYMBOL WALKER::ENV-DECLARATIONS + WALKER::ENV-LEXICAL-VARIABLES PCL::LIST-DFUN + PCL::SLOT-BOUNDP-SYMBOL PCL::MAP-ALL-GENERIC-FUNCTIONS + PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION + PCL::EARLY-CLASS-DIRECT-SUBCLASSES + PCL::MAKE-FUNCTION-INLINE PCL::LIST-LARGE-CACHE + PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS - PCL::MAKE-INITFUNCTION PCL::DFUN-INFO-P PCL::ECD-CLASS-NAME - PCL::DISPATCH-P PCL::CANONICAL-SLOT-NAME - PCL::EARLY-CLASS-SLOTS PCL::EARLY-COLLECT-CPL - PCL::EARLY-COLLECT-SLOTS PCL::DEFAULT-METHOD-ONLY-P - PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P - PCL::EARLY-COLLECT-DEFAULT-INITARGS - PCL::ECD-SUPERCLASS-NAMES PCL::ECD-CANONICAL-SLOTS - PCL::UNENCAPSULATED-FDEFINITION PCL::ECD-OTHER-INITARGS - PCL::FAST-METHOD-CALL-ARG-INFO PCL::MAKE-INITIAL-DFUN - PCL::ACCESSOR-DFUN-INFO-P PCL::ECD-SOURCE - PCL::ECD-METACLASS PCL::MAKE-TYPE-PREDICATE - PCL::ONE-INDEX-DFUN-INFO-P PCL::EARLY-CLASS-NAME-OF - PCL::UNPARSE-TYPE-LIST PCL::EARLY-CLASS-DIRECT-SUBCLASSES - PCL::N-N-P PCL::SLOT-READER-SYMBOL PCL::SLOT-WRITER-SYMBOL - PCL::SLOT-BOUNDP-SYMBOL - PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION PCL::ONE-CLASS-P + PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION - PCL::GBOUNDP + WALKER::ENV-WALK-FUNCTION + WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE + PCL::COUNT-DFUN PCL::MAKE-INITFUNCTION PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION - PCL::GMAKUNBOUND + ITERATE::VARIABLES-FROM-LET WALKER::ENV-WALK-FORM PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION - PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::TWO-CLASS-P - PCL::EXPAND-LONG-DEFCOMBIN PCL::STRUCTURE-SLOT-BOUNDP - PCL::ONE-INDEX-P PCL::CHECKING-P - PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION - SYSTEM:%STRUCTURE-NAME PCL::INITIALIZE-INTERNAL-SLOT-GFS - SYSTEM:%COMPILED-FUNCTION-NAME PCL::CACHING-P - PCL::EXPAND-SHORT-DEFCOMBIN - PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P - PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION - PCL::KEYWORD-SPEC-NAME PCL:CLASS-OF - PCL::GENERIC-CLOBBERS-FUNCTION PCL::FUNCTION-RETURNING-NIL - PCL::EARLY-METHOD-LAMBDA-LIST PCL::DO-STANDARD-DEFSETF-1 - PCL::EARLY-GF-P PCL::PARSE-SPECIALIZERS PCL::TYPE-CLASS - PCL::MAKE-CALL-METHODS PCL::EARLY-METHOD-QUALIFIERS - PCL::CLASS-PREDICATE PCL::LEGAL-CLASS-NAME-P - PCL::MAKE-CLASS-EQ-PREDICATE PCL::STRUCTURE-TYPE-P - PCL::MAKE-EQL-PREDICATE - PCL::EARLY-METHOD-STANDARD-ACCESSOR-P - PCL::NEXT-WRAPPER-FIELD PCL::GET-BUILT-IN-CLASS-SYMBOL - PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::UNPARSE-SPECIALIZERS - PCL::SETFBOUNDP PCL::GET-SETF-FUNCTION-NAME - PCL::METHOD-CALL-CALL-METHOD-ARGS SYSTEM::NEXT-STACK-FRAME - PCL::INITIALIZE-INFO-P PCL::WRAPPER-OF - PCL::FAST-METHOD-CALL-PV-CELL PCL::CHECK-WRAPPER-VALIDITY - PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL PCL::INITIAL-P - PCL::DEFAULT-TEST-CONVERTER PCL::COMPUTE-STD-CPL-PHASE-2 - PCL::DFUN-INFO-CACHE PCL::DEFAULT-CONSTANT-CONVERTER - WALKER:VARIABLE-GLOBALLY-SPECIAL-P PCL::NO-METHODS-CACHE - PCL::INITIAL-CACHE PCL::LIST-DFUN - PCL::INITIAL-DISPATCH-CACHE PCL::STRUCTURE-OBJECT-P - PCL::LIST-LARGE-CACHE PCL::DEFAULT-CONSTANTP - PCL::INITIAL-DISPATCH-P PCL::DISPATCH-CACHE PCL::COUNT-DFUN - PCL::FGEN-TEST PCL::DEFAULT-METHOD-ONLY-CACHE - PCL::LOOKUP-FGEN PCL::ACCESSOR-DFUN-INFO-CACHE)) -(PROCLAIM - '(FTYPE (FUNCTION (T *) *) PCL::GET-FUNCTION PCL::GET-FUNCTION1 - PCL:ENSURE-CLASS PCL::MAKE-METHOD-FUNCTION-INTERNAL + PCL::INITIALIZE-INFO-P PCL::ECD-CLASS-NAME PCL::COPY-CACHE + PCL::COMPUTE-LINE-SIZE PCL::CANONICAL-SLOT-NAME + WALKER::GET-WALKER-TEMPLATE PCL::EARLY-CLASS-SLOTS + PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::EARLY-COLLECT-CPL + PCL::EARLY-COLLECT-SLOTS + PCL::METHOD-LL->GENERIC-FUNCTION-LL + PCL::EARLY-COLLECT-DEFAULT-INITARGS + PCL::ECD-SUPERCLASS-NAMES PCL::METHOD-CALL-P + PCL::STRUCTURE-SLOT-BOUNDP ITERATE::SEQUENCE-ACCESSOR + PCL::ECD-CANONICAL-SLOTS PCL::ECD-OTHER-INITARGS)) +(PROCLAIM + '(FTYPE (FUNCTION (T *) *) PCL::COERCE-TO-CLASS + PCL::GET-METHOD-FUNCTION WALKER:MACROEXPAND-ALL + PCL::GET-FUNCTION PCL::GET-FUNCTION1 + PCL:ENSURE-GENERIC-FUNCTION PCL::PARSE-METHOD-OR-SPEC + PCL::EXTRACT-DECLARATIONS PCL::GET-DFUN-CONSTRUCTOR + PCL::MAP-ALL-CLASSES PCL::MAKE-CACHING-DFUN + WALKER:WALK-FORM PCL:ENSURE-CLASS + PCL::MAKE-METHOD-FUNCTION-INTERNAL PCL::PARSE-SPECIALIZED-LAMBDA-LIST PCL::MAKE-METHOD-LAMBDA-INTERNAL - PCL::GET-MAKE-INSTANCE-FUNCTION - PCL::GET-GENERIC-FUNCTION-INFO PCL::PARSE-METHOD-OR-SPEC - PCL::COMPILE-LAMBDA PCL::GET-DFUN-CONSTRUCTOR - PCL::MAKE-CACHING-DFUN PCL::MAKE-CONSTANT-VALUE-DFUN - PCL::MAKE-FINAL-DFUN-INTERNAL PCL::COERCE-TO-CLASS - PCL::MAP-ALL-CLASSES PCL:ENSURE-GENERIC-FUNCTION - PCL::GET-METHOD-FUNCTION PCL::EXTRACT-DECLARATIONS - WALKER:WALK-FORM WALKER:MACROEXPAND-ALL)) + PCL::MAKE-CONSTANT-VALUE-DFUN PCL::MAKE-FINAL-DFUN-INTERNAL + PCL::COMPILE-LAMBDA)) (PROCLAIM '(FTYPE (FUNCTION (T T *) (VALUES T T)) PCL::SYMBOL-APPEND)) (PROCLAIM '(FTYPE (FUNCTION (T *) STRING) PCL::CAPITALIZE-WORDS)) (PROCLAIM - '(FTYPE (FUNCTION (T T) *) PCL::COMPUTE-TEST - PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL PCL::COMPUTE-CODE - PCL::FIND-SUPERCLASS-CHAIN + '(FTYPE (FUNCTION (T T) *) PCL::SAUT-CLASS + PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P PCL::*TYPEP + PCL::COMPUTE-TEST PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL + PCL::COMPUTE-CODE PCL::CLASS-APPLICABLE-USING-CLASS-P + PCL::SAUT-AND PCL::SAUT-NOT PCL::SAUT-PROTOTYPE + COMPILER::CAN-USE-PRINT-CIRCLE-P1 PCL:SLOT-BOUNDP + PCL::DESTRUCTURE PCL:SLOT-MAKUNBOUND PCL:SLOT-VALUE + PCL::ENSURE-CLASS-VALUES PCL::MAKE-DIRECT-SLOTD PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P - PCL::MUTATE-SLOTS-AND-CALLS PCL::ENSURE-CLASS-VALUES - PCL::MAKE-DIRECT-SLOTD PCL::EMIT-DEFAULT-ONLY-FUNCTION - PCL::EMIT-DEFAULT-ONLY PCL::SPLIT-DECLARATIONS + PCL::MUTATE-SLOTS-AND-CALLS PCL::INVOKE-EMF + PCL::EMIT-DEFAULT-ONLY-FUNCTION PCL::SPLIT-DECLARATIONS + PCL::EMIT-DEFAULT-ONLY COMPILER::C2LAMBDA-EXPR-WITH-KEY PCL::SLOT-NAME-LISTS-FROM-SLOTS PCL::EMIT-CHECKING - PCL::EMIT-CACHING PCL::UPDATE-SLOT-VALUE-GF-INFO - PCL::SET-FUNCTION-NAME PCL::SDFUN-FOR-CACHING - ITERATE::PARSE-DECLARATIONS + PCL::UPDATE-SLOT-VALUE-GF-INFO PCL::EMIT-CACHING + PCL::SDFUN-FOR-CACHING PCL::SLOT-UNBOUND-INTERNAL + PCL::MAKE-INSTANCE-1 PCL::SET-FUNCTION-NAME + PCL::COMPUTE-STD-CPL-PHASE-1 PCL::FORM-LIST-TO-LISP + PCL::FIND-SUPERCLASS-CHAIN PCL::SAUT-CLASS-EQ PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES - PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION - PCL::FORM-LIST-TO-LISP PCL::CHECK-INITARGS-VALUES - PCL::*SUBTYPEP PCL::CLASS-APPLICABLE-USING-CLASS-P - PCL::SAUT-AND PCL::SAUT-NOT PCL::SAUT-CLASS - PCL::SAUT-PROTOTYPE PCL::SAUT-CLASS-EQ PCL::SAUT-EQL - PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P PCL::*TYPEP - COMPILER::CAN-USE-PRINT-CIRCLE-P1 PCL::DESTRUCTURE - PCL::INVOKE-EMF PCL:SLOT-BOUNDP PCL:SLOT-EXISTS-P - PCL:SLOT-MAKUNBOUND PCL:SLOT-VALUE - PCL::COMPUTE-STD-CPL-PHASE-1 PCL::SLOT-UNBOUND-INTERNAL)) + PCL::CHECK-INITARGS-VALUES PCL::SAUT-EQL PCL::*SUBTYPEP + ITERATE::PARSE-DECLARATIONS PCL::INITIAL-DFUN)) (PROCLAIM - '(FTYPE (FUNCTION (T *) T) PCL::PV-TABLE-LOOKUP-PV-ARGS + '(FTYPE (FUNCTION (T *) T) PCL::MAKE-TYPE-PREDICATE-NAME + PCL::SET-DFUN PCL:FIND-CLASS PCL::TRACE-METHOD + PCL::FIND-CLASS-CELL PCL::MAKE-FINAL-DFUN + PCL::PV-TABLE-LOOKUP-PV-ARGS PCL::USE-DISPATCH-DFUN-P WALKER::RELIST* WALKER::RELIST PCL::FIND-CLASS-PREDICATE - PCL::EXPAND-MAKE-INSTANCE-FORM PCL::SET-DFUN - PCL::MAKE-WRAPPER PCL::MAKE-SPECIALIZABLE - PCL::MAKE-FINAL-DFUN WALKER::WALKER-ENVIRONMENT-BIND-1 - PCL::USE-DISPATCH-DFUN-P PCL::ALLOCATE-STRUCTURE-INSTANCE - PCL::ALLOCATE-STANDARD-INSTANCE ITERATE::FUNCTION-LAMBDA-P - ITERATE::MAYBE-WARN PCL::REAL-USE-DISPATCH-DFUN-P - PCL::MAKE-TYPE-PREDICATE-NAME PCL::USE-CONSTANT-VALUE-DFUN-P - PCL::ALLOCATE-FUNCALLABLE-INSTANCE - PCL::GET-MAKE-INSTANCE-FUNCTIONS PCL:FIND-CLASS PCL::EARLY-METHOD-SPECIALIZERS - PCL::INITIALIZE-METHOD-FUNCTION PCL::TRACE-METHOD - PCL::UPDATE-DFUN PCL::FIND-CLASS-CELL)) + PCL::USE-CONSTANT-VALUE-DFUN-P PCL::MAKE-EARLY-GF + PCL::ALLOCATE-FUNCALLABLE-INSTANCE PCL::SET-ARG-INFO + PCL::INITIALIZE-METHOD-FUNCTION PCL::UPDATE-DFUN + PCL::MAKE-SPECIALIZABLE PCL::ALLOCATE-STRUCTURE-INSTANCE + PCL::ALLOCATE-STANDARD-INSTANCE + WALKER::WALKER-ENVIRONMENT-BIND-1 + ITERATE::FUNCTION-LAMBDA-P ITERATE::MAYBE-WARN + PCL::MAKE-WRAPPER)) (PROCLAIM '(FTYPE (FUNCTION (T T T) (*)) PCL::SORT-APPLICABLE-METHODS PCL::SORT-METHODS)) (PROCLAIM - '(FTYPE (FUNCTION (T T) T) PCL::CPL-INCONSISTENT-ERROR - WALKER::NOTE-DECLARATION WALKER::NOTE-LEXICAL-BINDING + '(FTYPE (FUNCTION (T T) T) PCL::FDEFINE-CAREFULLY + PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION + PCL::MAKE-STD-READER-METHOD-FUNCTION + PCL::MAKE-STD-WRITER-METHOD-FUNCTION + ITERATE::SIMPLE-EXPAND-ITERATE-FORM + PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION + PCL::DO-SATISFIES-DEFTYPE PCL::MEMF-CONSTANT-CONVERTER + PCL::COMPUTE-CONSTANTS PCL::CLASS-CAN-PRECEDE-P + PCL::SAUT-NOT-CLASS PCL::SAUT-NOT-CLASS-EQ + PCL::SAUT-NOT-PROTOTYPE PCL::GF-MAKE-FUNCTION-FROM-EMF + PCL::SAUT-NOT-EQL PCL::SUPERCLASSES-COMPATIBLE-P + PCL::CLASSES-HAVE-COMMON-SUBCLASS-P + SYSTEM:%SET-COMPILED-FUNCTION-NAME PCL:ADD-METHOD + SYSTEM::DISPLAY-ENV PCL::DESCRIBE-PACKAGE + SYSTEM::DISPLAY-COMPILED-ENV + PCL::PRINTING-RANDOM-THING-INTERNAL + PCL::MAKE-CLASS-PREDICATE + PCL::METHOD-FUNCTION-RETURNING-NIL + PCL::METHOD-FUNCTION-RETURNING-T PCL::VARIABLE-CLASS + PCL::MAKE-PLIST PCL::REMTAIL PCL:REMOVE-METHOD + PCL:SLOT-EXISTS-P PCL::DESTRUCTURE-INTERNAL + PCL::ACCESSOR-MISS-FUNCTION + PCL::UPDATE-INITIALIZE-INFO-INTERNAL PCL::N-N-DFUN-INFO + PCL::MAKE-CAXR PCL::MAKE-CDXR WALKER:VARIABLE-LEXICAL-P + WALKER:VARIABLE-SPECIAL-P PCL::CHECKING-DFUN-INFO PCL::MAKE-PV-TABLE-INTERNAL PCL::FIND-SLOT-DEFINITION - WALKER::ENVIRONMENT-FUNCTION PCL::|SETF PCL FIND-CLASS| + WALKER::WALK-REPEAT-EVAL WALKER::NOTE-DECLARATION + PCL::MAKE-DFUN-LAMBDA-LIST WALKER::NOTE-LEXICAL-BINDING + PCL::MAKE-DLAP-LAMBDA-LIST PCL::ADD-DIRECT-SUBCLASSES + PCL::COMPUTE-PV PCL::MAKE-DFUN-ARG-LIST PCL::COMPUTE-CALLS + PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST + PCL::UPDATE-ALL-PV-TABLE-CACHES PCL::UPDATE-CLASS + PCL::MAP-PV-TABLE-REFERENCES-OF PCL::ADD-SLOT-ACCESSORS + WALKER::ENVIRONMENT-FUNCTION PCL::REMOVE-DIRECT-SUBCLASSES + PCL::REMOVE-SLOT-ACCESSORS PCL::SYMBOL-LESSP + PCL::SYMBOL-OR-CONS-LESSP PCL::|SETF PCL FIND-CLASS| PCL::|SETF PCL FIND-CLASS-PREDICATE| - PCL::COMPUTE-EMF-FROM-WRAPPERS PCL::COMPUTE-PV - PCL::COMPUTE-CALLS PCL::UPDATE-ALL-PV-TABLE-CACHES - PCL::MAP-PV-TABLE-REFERENCES-OF - PCL::GF-MAKE-FUNCTION-FROM-EMF PCL::PLIST-VALUE - PCL::ADD-DIRECT-SUBCLASSES PCL::UPDATE-CLASS - PCL::MAKE-CLASS-PREDICATE PCL::ADD-SLOT-ACCESSORS - PCL::SYMBOL-LESSP PCL::REDEFINE-FUNCTION - PCL::METHOD-FUNCTION-RETURNING-NIL - PCL::REMOVE-DIRECT-SUBCLASSES - PCL::METHOD-FUNCTION-RETURNING-T PCL::SYMBOL-OR-CONS-LESSP - PCL::REMOVE-SLOT-ACCESSORS - PCL:FUNCALLABLE-STANDARD-INSTANCE-ACCESS - PCL::PV-TABLE-LOOKUP PCL::UPDATE-CPL - PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::UPDATE-SLOTS - PCL::UPDATE-INITS PCL::EMIT-1-NIL-DLAP + PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::PV-TABLE-LOOKUP + PCL::PROCLAIM-DEFGENERIC PCL::UPDATE-CPL PCL::LIST-EQ + PCL::UPDATE-SLOTS PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION + PCL::COMPUTE-EMF-FROM-WRAPPERS PCL::UPDATE-INITS + PCL::UPDATE-STD-OR-STR-METHODS + PCL::SET-STANDARD-SVUC-METHOD PCL::EMIT-1-NIL-DLAP + PCL::PLIST-VALUE PCL::SET-STRUCTURE-SVUC-METHOD PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION - PCL::COMPUTE-LAYOUT + PCL:FUNCALLABLE-STANDARD-INSTANCE-ACCESS + PCL::MEC-ALL-CLASSES-INTERNAL PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION - PCL::GET-MAKE-INSTANCE-FUNCTION-KEY - PCL::CHANGE-CLASS-INTERNAL PCL::NEW-ARG-INFO-FROM-METHOD - PCL::ADD-ARG-INFO PCL::REMOVE-ARG-INFO - PCL:SET-FUNCALLABLE-INSTANCE-FUNCTION PCL::LIST-EQ - PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION - PCL::UPDATE-INITIALIZE-INFO-INTERNAL + PCL::MEC-ALL-CLASSES PCL::%SET-CCLOSURE-ENV + PCL::MEC-ALL-CLASS-LISTS PCL::REDEFINE-FUNCTION + PCL::METHODS-CONVERTER PCL::COMPUTE-LAYOUT PCL::NO-SLOT PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS - PCL::UPDATE-STD-OR-STR-METHODS - PCL::SET-STANDARD-SVUC-METHOD - PCL::SET-STRUCTURE-SVUC-METHOD - PCL::|SETF PCL METHOD-FUNCTION-PLIST| - PCL::MEC-ALL-CLASSES-INTERNAL PCL::MEC-ALL-CLASSES - PCL::MEC-ALL-CLASS-LISTS PCL:STANDARD-INSTANCE-ACCESS - PCL::DESCRIBE-PACKAGE PCL::METHODS-CONVERTER - PCL::RAISE-METATYPE - PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST - PCL::|SETF PCL GDEFINITION| PCL::NET-CONSTANT-CONVERTER - PCL::AUGMENT-TYPE PCL::SET-FUNCTION-PRETTY-ARGLIST - PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER PCL::VALUE-FOR-CACHING - PCL::ACCESSOR-MISS-FUNCTION PCL::MAKE-UNORDERED-METHODS-EMF - PCL::FIND-STANDARD-II-METHOD PCL::N-N-DFUN-INFO - PCL::CHECKING-DFUN-INFO + PCL::NET-CONSTANT-CONVERTER PCL::AUGMENT-TYPE + PCL::CHANGE-CLASS-INTERNAL + PCL:SET-FUNCALLABLE-INSTANCE-FUNCTION + PCL::VALUE-FOR-CACHING PCL:STANDARD-INSTANCE-ACCESS + PCL::|SETF PCL METHOD-FUNCTION-PLIST| PCL::GET-KEY-ARG + PCL::GET-KEY-ARG1 PCL::SET-METHODS + PCL::SET-FUNCTION-PRETTY-ARGLIST + PCL::FIND-STANDARD-II-METHOD PCL::MAKE-EARLY-ACCESSOR + PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER PCL::COMPUTE-STD-CPL + PCL::|SETF PCL GDEFINITION| + PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST PCL::ADD-FORMS + PCL::CPL-INCONSISTENT-ERROR + PCL::REDIRECT-EARLY-FUNCTION-INTERNAL PCL::ADD-TO-CVECTOR + PCL::BOOTSTRAP-SLOT-INDEX PCL::QUALIFIER-CHECK-RUNTIME PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR - PCL::MAKE-DFUN-LAMBDA-LIST PCL::MAKE-DLAP-LAMBDA-LIST - WALKER::ENVIRONMENT-MACRO PCL::MAKE-DFUN-ARG-LIST - PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST ITERATE::MV-SETQ - ITERATE::EXTRACT-SPECIAL-BINDINGS - WALKER::VARIABLE-SYMBOL-MACRO-P PCL::ADD-FORMS - PCL::SET-WRAPPER PCL::BOOTSTRAP-SLOT-INDEX - PCL::CLASS-CAN-PRECEDE-P PCL::SWAP-WRAPPERS-AND-SLOTS - PCL::ADD-TO-CVECTOR PCL::SAUT-NOT-CLASS - PCL::CANONICALIZE-SLOT-SPECIFICATION PCL::SAUT-NOT-CLASS-EQ - PCL::CANONICALIZE-DEFCLASS-OPTION PCL::SAUT-NOT-PROTOTYPE - WALKER::WALK-REPEAT-EVAL PCL::%SET-CCLOSURE-ENV - PCL::SAUT-NOT-EQL PCL::SUPERCLASSES-COMPATIBLE-P - ITERATE::SIMPLE-EXPAND-ITERATE-FORM - PCL::CLASSES-HAVE-COMMON-SUBCLASS-P PCL::FDEFINE-CAREFULLY - PCL::CLASS-MIGHT-PRECEDE-P PCL::NO-SLOT - PCL::DO-SATISFIES-DEFTYPE PCL::QUALIFIER-CHECK-RUNTIME + PCL::REAL-REMOVE-METHOD WALKER::ENVIRONMENT-MACRO + PCL::CANONICALIZE-SLOT-SPECIFICATION + PCL::CANONICALIZE-DEFCLASS-OPTION PCL::SET-WRAPPER PCL::DEAL-WITH-ARGUMENTS-OPTION - PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION - PCL::PARSE-QUALIFIER-PATTERN - PCL::MAKE-STD-READER-METHOD-FUNCTION - PCL::MAKE-STD-WRITER-METHOD-FUNCTION - PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION - SYSTEM:%SET-COMPILED-FUNCTION-NAME PCL:ADD-METHOD - SYSTEM::DISPLAY-ENV PCL::PRINTING-RANDOM-THING-INTERNAL - SYSTEM::DISPLAY-COMPILED-ENV PCL::PROCLAIM-DEFGENERIC - PCL::COMPUTE-STD-CPL PCL::MAKE-PLIST PCL::REMTAIL - PCL::MEMF-CONSTANT-CONVERTER PCL::DESTRUCTURE-INTERNAL - PCL:REMOVE-METHOD PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD - PCL::SET-METHODS PCL::VARIABLE-CLASS PCL::MAKE-CAXR - PCL::MAKE-CDXR PCL::REDIRECT-EARLY-FUNCTION-INTERNAL - WALKER:VARIABLE-LEXICAL-P WALKER:VARIABLE-SPECIAL-P - PCL::REAL-REMOVE-METHOD PCL::COMPUTE-CONSTANTS)) + PCL::PARSE-QUALIFIER-PATTERN PCL::SWAP-WRAPPERS-AND-SLOTS + ITERATE::MV-SETQ PCL::MAKE-UNORDERED-METHODS-EMF + PCL::CLASS-MIGHT-PRECEDE-P + ITERATE::EXTRACT-SPECIAL-BINDINGS + WALKER::VARIABLE-SYMBOL-MACRO-P PCL::RAISE-METATYPE)) (PROCLAIM '(FTYPE (FUNCTION NIL FIXNUM) PCL::GET-WRAPPER-CACHE-NUMBER)) -(IN-PACKAGE "PCL") - (DOLIST (PCL::V '(PCL::ADD-READER-METHOD PCL::SHORT-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT - PCL::|DEFINITION-SOURCE-MIXIN class predicate| PCL::REMOVE-READER-METHOD PCL::EQL-SPECIALIZER-P PCL::OBJECT-PLIST PCL::SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL @@ -846,51 +654,30 @@ PCL::CLASS-DEFSTRUCT-CONSTRUCTOR PCL::METHOD-FAST-FUNCTION PCL::SPECIALIZERP PCL::EXACT-CLASS-SPECIALIZER-P - PCL::|STANDARD-OBJECT class predicate| PCL::COMPATIBLE-META-CLASS-CHANGE-P - PCL::|STANDARD-METHOD-COMBINATION class predicate| - PCL::UPDATE-GF-DFUN - PCL::|STANDARD-EFFECTIVE-SLOT-DEFINITION class predicate| - PCL::SPECIALIZER-OBJECT + PCL::UPDATE-GF-DFUN PCL::SPECIALIZER-OBJECT PCL::ACCESSOR-METHOD-SLOT-NAME - PCL::|STANDARD-DIRECT-SLOT-DEFINITION class predicate| PCL::SPECIALIZER-CLASS PCL::CLASS-EQ-SPECIALIZER-P PCL::SLOTS-FETCHER PCL::REMOVE-WRITER-METHOD - PCL::|STANDARD-SLOT-DEFINITION class predicate| PCL::STRUCTURE-CLASS-P PCL::UPDATE-CONSTRUCTORS - PCL::DOCUMENTATION - PCL::|SLOT-OBJECT class predicate| - PCL::METHOD-PRETTY-ARGLIST - PCL::|RATIONAL class predicate| + PCL::DOCUMENTATION PCL::METHOD-PRETTY-ARGLIST PCL::CLASS-EQ-SPECIALIZER PCL::INFORM-TYPE-SYSTEM-ABOUT-CLASS - PCL::|PCL-CLASS class predicate| PCL::ACCESSOR-METHOD-CLASS PCL::GENERIC-FUNCTION-PRETTY-ARGLIST PCL::MAKE-BOUNDP-METHOD-FUNCTION - PCL::|SLOT-DEFINITION class predicate| - PCL::|METAOBJECT class predicate| - PCL::CLASS-PREDICATE-NAME - PCL::|SEQUENCE class predicate| PCL::CLASSP - PCL::|CHARACTER class predicate| - PCL::|COMPLEX class predicate| - PCL::|STD-CLASS class predicate| + PCL::CLASS-PREDICATE-NAME PCL::CLASSP PCL::LEGAL-QUALIFIERS-P PCL::ADD-BOUNDP-METHOD PCL::LEGAL-LAMBDA-LIST-P PCL::|SETF PCL GENERIC-FUNCTION-NAME| - PCL::|DEPENDENT-UPDATE-MIXIN class predicate| - PCL::DESCRIBE-OBJECT + PCL::DESCRIBE-OBJECT PCL::CLASS-INITIALIZE-INFO PCL::MAKE-WRITER-METHOD-FUNCTION PCL::|SETF PCL GF-DFUN-STATE| - PCL::|LONG-METHOD-COMBINATION class predicate| - PCL::|VECTOR class predicate| PCL::|SETF PCL SLOT-DEFINITION-NAME| PCL::|SETF PCL CLASS-NAME| PCL::INITIALIZE-INTERNAL-SLOT-FUNCTIONS PCL::|SETF PCL SLOT-DEFINITION-TYPE| PCL::METHOD-COMBINATION-P - PCL::|STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| - PCL::|STRUCTURE-EFFECTIVE-SLOT-DEFINITION class predicate| PCL::|SETF PCL GENERIC-FUNCTION-METHODS| PCL::|SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION| PCL::|SETF PCL METHOD-GENERIC-FUNCTION| @@ -913,7 +700,6 @@ PCL::|SETF PCL SLOT-DEFINITION-INITFUNCTION| PCL::METHOD-COMBINATION-OPTIONS PCL::|SETF PCL SLOT-DEFINITION-READERS| - PCL::|STRUCTURE-OBJECT class predicate| PCL::|SETF PCL DOCUMENTATION| PCL::FUNCALLABLE-STANDARD-CLASS-P PCL::|SETF PCL SLOT-DEFINITION-CLASS| @@ -924,13 +710,9 @@ PCL::SLOT-ACCESSOR-FUNCTION PCL::|SETF PCL CLASS-INCOMPATIBLE-SUPERCLASS-LIST| PCL::|SETF PCL SLOT-DEFINITION-WRITERS| - PCL::|STRUCTURE-SLOT-DEFINITION class predicate| PCL::SLOT-CLASS-P PCL::MAKE-READER-METHOD-FUNCTION - PCL::|STRING class predicate| - PCL::LEGAL-METHOD-FUNCTION-P - PCL::|NUMBER class predicate| PCL::GET-METHOD + PCL::LEGAL-METHOD-FUNCTION-P PCL::GET-METHOD PCL::SHORT-METHOD-COMBINATION-P PCL::GF-ARG-INFO - PCL::|SYMBOL class predicate| PCL::SPECIALIZER-METHOD-TABLE PCL::MAKE-METHOD-INITARGS-FORM PCL::CLASS-DEFSTRUCT-FORM PCL::GF-PRETTY-ARGLIST @@ -942,54 +724,40 @@ PCL::SLOT-DEFINITION-INTERNAL-READER-FUNCTION PCL::SLOT-DEFINITION-CLASS PCL::EQL-SPECIALIZER-OBJECT - PCL::|RATIO class predicate| PCL::CLASS-CONSTRUCTORS PCL::SLOTS-TO-INSPECT PCL::SPECIALIZER-DIRECT-GENERIC-FUNCTIONS PCL::ADD-WRITER-METHOD - PCL::MAYBE-UPDATE-CONSTRUCTORS - PCL::|EFFECTIVE-SLOT-DEFINITION class predicate| - PCL::|LIST class predicate| PCL::LONG-METHOD-COMBINATION-FUNCTION - PCL::|BUILT-IN-CLASS class predicate| - PCL::GENERIC-FUNCTION-P PCL::|T class predicate| - PCL::|FLOAT class predicate| - PCL::|CONS class predicate| PCL::LEGAL-SLOT-NAME-P - PCL::CLASS-WRAPPER PCL::|ARRAY class predicate| - PCL::DEFINITION-SOURCE PCL::DEFAULT-INITARGS - PCL::|NULL class predicate| PCL::CLASS-SLOT-VALUE + PCL::GENERIC-FUNCTION-P PCL::LEGAL-SLOT-NAME-P + PCL::CLASS-WRAPPER PCL::DEFINITION-SOURCE + PCL::DEFAULT-INITARGS PCL::CLASS-SLOT-VALUE PCL::FORWARD-REFERENCED-CLASS-P PCL::GF-FAST-METHOD-FUNCTION-P - PCL::|SPECIALIZER-WITH-OBJECT class predicate| PCL::LEGAL-QUALIFIER-P PCL::METHOD-P - PCL::|PLIST-MIXIN class predicate| PCL::CLASS-SLOT-CELLS PCL::STANDARD-ACCESSOR-METHOD-P PCL::STANDARD-GENERIC-FUNCTION-P PCL::STANDARD-READER-METHOD-P PCL::STANDARD-METHOD-P - PCL::|TRACED-METHOD class predicate| PCL::COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS PCL::COMPUTE-DEFAULT-INITARGS PCL::|SETF PCL CLASS-SLOT-VALUE| PCL::METHOD-COMBINATION-TYPE PCL::STANDARD-CLASS-P PCL::LEGAL-SPECIALIZER-P PCL::COMPUTE-SLOT-ACCESSOR-INFO - PCL::|DIRECT-SLOT-DEFINITION class predicate| PCL::STANDARD-BOUNDP-METHOD-P PCL::RAW-INSTANCE-ALLOCATOR PCL::|SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| + PCL::|SETF PCL CLASS-INITIALIZE-INFO| PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO PCL::STANDARD-WRITER-METHOD-P PCL::CLASS-INCOMPATIBLE-SUPERCLASS-LIST PCL::WRAPPER-FETCHER - PCL::|INTEGER class predicate| PCL::METHOD-COMBINATION-DOCUMENTATION PCL::|SETF PCL SLOT-DEFINITION-INITARGS| PCL::REMOVE-BOUNDP-METHOD PCL::|SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| - PCL::|DOCUMENTATION-MIXIN class predicate| PCL::SHORT-COMBINATION-OPERATOR - PCL::|BIT-VECTOR class predicate| PCL::REMOVE-NAMED-METHOD PCL::LEGAL-DOCUMENTATION-P PCL:CLASS-DIRECT-SUPERCLASSES diff --git a/pcl/vector.lisp b/pcl/vector.lisp index b1a4161c5..c85aecff4 100644 --- a/pcl/vector.lisp +++ b/pcl/vector.lisp @@ -27,7 +27,7 @@ ;;; Permutation vectors. ;;; -(in-package 'pcl) +(in-package :pcl) (defmacro instance-slot-index (wrapper slot-name) `(let ((pos 0)) @@ -183,11 +183,16 @@ (make-permutation-vector (cons nil elements))))))) (defun compute-calls (call-list wrappers) + (declare (ignore call-list wrappers)) + #|| (map 'vector #'(lambda (call) (compute-emf-from-wrappers call wrappers)) - call-list)) + call-list) + ||# + '#()) +#|| ; Need to finish this, then write the maintenance functions. (defun compute-emf-from-wrappers (call wrappers) (when call (destructuring-bind (gf-name nreq restp arg-info) call @@ -204,7 +209,9 @@ wrappers classes types 'caching))) (update-all-pv-tables call wrappers emf) + #+copy-&rest-arg (setq args (copy-list args)) (invoke-emf emf args)))))))) +||# (defun make-permutation-vector (indexes) (make-array (length indexes) :initial-contents indexes)) @@ -340,7 +347,7 @@ (defun maybe-expand-accessor-form (form required-parameters slots env) (let* ((fname (car form)) - (len (length form)) + #||(len (length form))||# (gf (if (symbolp fname) (unencapsulated-fdefinition fname) (gdefinition fname)))) @@ -390,7 +397,7 @@ (defun optimize-generic-function-call (form required-parameters env slots calls) (declare (ignore required-parameters env slots calls)) (or (and (eq (car form) 'make-instance) - (expand-make-instance-form form t)) + (expand-make-instance-form form)) #|| (maybe-expand-accessor-form form required-parameters slots env) (let* ((fname (car form)) @@ -856,9 +863,25 @@ ,pv ,calls ,@forms)) +(defvar *non-variable-declarations* + '(method-name method-lambda-list + optimize ftype inline notinline)) + +(defvar *variable-declarations-with-argument* + '(class + type)) + +(defvar *variable-declarations-without-argument* + '(ignore special dynamic-extent + array atom base-char bignum bit bit-vector character common compiled-function + complex cons double-float extended-char fixnum float function hash-table integer + keyword list long-float nil null number package pathname random-state ratio + rational readtable sequence short-float signed-byte simple-array + simple-bit-vector simple-string simple-vector single-float standard-char + stream string-char symbol t unsigned-byte vector)) + (defun split-declarations (body args) - (let* ((must-rebind-args-p nil) - (inner-decls nil) (outer-decls nil) decl) + (let ((inner-decls nil) (outer-decls nil) decl) (loop (when (null body) (return nil)) (setq decl (car body)) (unless (and (consp decl) @@ -866,24 +889,40 @@ (return nil)) (dolist (form (cdr decl)) (when (consp form) - (case (car form) - ((optimize method-name method-lambda-list) - (push `(declare ,form) outer-decls)) - ((ignore type class) - (let ((dname (list (pop form))) (inners nil) (outers nil)) - (when (member (car dname) '(type class)) - (setq dname (append dname (list (pop form))))) - (dolist (var form) - (if (member var args) - (push var outers) - (push var inners))) - (when outers - (push `(declare (,@dname ,@outers)) outer-decls)) - (when inners - (push `(declare (,@dname ,@inners)) inner-decls)))) - (t (setq must-rebind-args-p t))))) + (let ((declaration-name (car form))) + (if (member declaration-name *non-variable-declarations*) + (push `(declare ,form) outer-decls) + (let ((arg-p + (member declaration-name + *variable-declarations-with-argument*)) + (non-arg-p + (member declaration-name + *variable-declarations-without-argument*)) + (dname (list (pop form))) + (inners nil) (outers nil)) + (unless (or arg-p non-arg-p) + (warn "The declaration ~S is not understood by ~S.~@ + Please put ~S on one of the lists ~S,~%~S, or~%~S.~@ + (Assuming it is a variable declarations without argument)." + declaration-name 'split-declarations + declaration-name + '*non-variable-declarations* + '*variable-declarations-with-argument* + '*variable-declarations-without-argument*) + (push declaration-name + *variable-declarations-without-argument*)) + (when arg-p + (setq dname (append dname (list (pop form))))) + (dolist (var form) + (if (member var args) + (push var outers) + (push var inners))) + (when outers + (push `(declare (,@dname ,@outers)) outer-decls)) + (when inners + (push `(declare (,@dname ,@inners)) inner-decls))))))) (setq body (cdr body))) - (values outer-decls inner-decls must-rebind-args-p body))) + (values outer-decls inner-decls body))) (defun make-method-initargs-form-internal (method-lambda initargs env) (declare (ignore env)) @@ -910,7 +949,7 @@ (defun make-method-initargs-form-internal1 (initargs body req-args lmf-params restp) - (multiple-value-bind (outer-decls inner-decls must-rebind-args-p body) + (multiple-value-bind (outer-decls inner-decls body) (split-declarations body req-args) (let* ((rest-arg (when restp '.rest-arg.)) (args+rest-arg (if restp (append req-args (list rest-arg)) req-args))) @@ -939,6 +978,7 @@ ;will get called only when the user explicitly funcalls a result of method-function. ;BUT, this is needed to make early methods work. (defun method-function-from-fast-function (fmf) + (declare (type function fmf)) (let* ((method-function nil) (pv-table nil) (arg-info (method-function-get fmf ':arg-info)) (nreq (car arg-info)) -- GitLab