1.0.5.45: metatypes-related refactor

	Many of the dlisp functions took (metatypes applyp) arguments,
	when in fact all they were using was the length of the metatypes
	argument and the applyp boolean.  Make this explicit, to assist
	in understanding when the identity of metatypes actually
	matters.

diff --git a/src/pcl/combin.lisp b/src/pcl/combin.lisp
index c65f390..b6a0fc1 100644 (file)
--- a/src/pcl/combin.lisp
+++ b/src/pcl/combin.lisp
@@ -216,10 +216,9 @@
 
 (defun expand-effective-method-function (gf effective-method &optional env)
   (declare (ignore env))
-  (multiple-value-bind (nreq applyp metatypes nkeys arg-info)
+  (multiple-value-bind (nreq applyp)
       (get-generic-fun-info gf)
-    (declare (ignore nreq nkeys arg-info))
-    (let ((ll (make-fast-method-call-lambda-list metatypes applyp))
+    (let ((ll (make-fast-method-call-lambda-list nreq applyp))
           (check-applicable-keywords
            (when (and applyp (gf-requires-emf-keyword-checks gf))
              '((check-applicable-keywords))))
@@ -243,7 +242,7 @@
              (declare (ignorable #'%no-primary-method #'%invalid-qualifiers))
              ,effective-method)))
         (mc-args-p
-         (let* ((required (make-dfun-required-args metatypes))
+         (let* ((required (make-dfun-required-args nreq))
                 (gf-args (if applyp
                              `(list* ,@required
                                      (sb-c::%listify-rest-args
@@ -310,7 +309,7 @@
     (call-method
      (let ((gensym (get-effective-method-gensym)))
        (values (make-emf-call
-                metatypes applyp gensym
+                (length metatypes) applyp gensym
                 (make-effective-method-fun-type
                  generic-function form method-alist-p wrappers-p))
                (list gensym))))
@@ -319,7 +318,7 @@
            (type (make-effective-method-list-fun-type
                   generic-function form method-alist-p wrappers-p)))
        (values `(dolist (emf ,gensym nil)
-                 ,(make-emf-call metatypes applyp 'emf type))
+                 ,(make-emf-call (length metatypes) applyp 'emf type))
                (list gensym))))
     (check-applicable-keywords
      (values `(check-applicable-keywords .keyargs-start.

diff --git a/src/pcl/dlisp.lisp b/src/pcl/dlisp.lisp
index d461014..a3d841c 100644 (file)
--- a/src/pcl/dlisp.lisp
+++ b/src/pcl/dlisp.lisp
@@ -43,17 +43,14 @@
       (format-symbol *pcl-package* ".SLOTS~A." arg-number)))
 
 (declaim (inline make-dfun-required-args))
-(defun make-dfun-required-args (metatypes)
-  ;; Micro-optimizations 'R Us
-  (labels ((rec (types i)
-             (declare (fixnum i))
-             (when types
-               (cons (dfun-arg-symbol i)
-                     (rec (cdr types) (1+ i))))))
-    (rec metatypes 0)))
-
-(defun make-dfun-lambda-list (metatypes applyp)
-  (let ((required (make-dfun-required-args metatypes)))
+(defun make-dfun-required-args (count)
+  (declare (type index count))
+  (let (result)
+    (dotimes (i count (nreverse result))
+      (push (dfun-arg-symbol i) result))))
+
+(defun make-dfun-lambda-list (nargs applyp)
+  (let ((required (make-dfun-required-args nargs)))
     (if applyp
         (nconc required
                ;; Use &MORE arguments to avoid consing up an &REST list
@@ -61,10 +58,10 @@
                ;; INVOKE-EFFECTIVE-METHOD-FUNCTION for the other
                ;; pieces.
                '(&more .dfun-more-context. .dfun-more-count.))
-      required)))
+        required)))
 
-(defun make-dlap-lambda-list (metatypes applyp)
-  (let* ((required (make-dfun-required-args metatypes))
+(defun make-dlap-lambda-list (nargs applyp)
+  (let* ((required (make-dfun-required-args nargs))
          (lambda-list (if applyp
                           (append required '(&more .more-context. .more-count.))
                           required)))
@@ -81,8 +78,8 @@
             (when applyp
               '(.more-context. .more-count.)))))
 
-(defun make-emf-call (metatypes applyp fn-variable &optional emf-type)
-  (let ((required (make-dfun-required-args metatypes)))
+(defun make-emf-call (nargs applyp fn-variable &optional emf-type)
+  (let ((required (make-dfun-required-args nargs)))
     `(,(if (eq emf-type 'fast-method-call)
            'invoke-effective-method-function-fast
            'invoke-effective-method-function)
@@ -102,9 +99,8 @@
        :more-arg ,(when applyp
                     '(.dfun-more-context. .dfun-more-count.)))))
 
-(defun make-fast-method-call-lambda-list (metatypes applyp)
-  (list* '.pv-cell. '.next-method-call.
-         (make-dfun-lambda-list metatypes applyp)))
+(defun make-fast-method-call-lambda-list (nargs applyp)
+  (list* '.pv-cell. '.next-method-call. (make-dfun-lambda-list nargs applyp)))
 \f
 ;;; Emitting various accessors.
 
@@ -184,7 +180,7 @@
       (return-from emit-default-only
         (emit-default-only-function metatypes applyp))))
   (multiple-value-bind (lambda-list args rest-arg more-arg)
-      (make-dlap-lambda-list metatypes applyp)
+      (make-dlap-lambda-list (length metatypes) applyp)
     (generating-lisp '(emf)
                      lambda-list
                      `(invoke-effective-method-function emf
@@ -264,7 +260,7 @@
                        (return-from access value)))))
                 (:boundp
                  `((let ((value ,read-form))
-                      (return-from access (not (eq value +slot-unbound+))))))
+                     (return-from access (not (eq value +slot-unbound+))))))
                 (:writer
                  `((return-from access (setf ,read-form ,(car arglist)))))))
           (funcall miss-fn ,@arglist))))))
@@ -345,7 +341,7 @@
         (emit-checking-or-caching-function
          cached-emf-p return-value-p metatypes applyp))))
   (multiple-value-bind (lambda-list args rest-arg more-arg)
-      (make-dlap-lambda-list metatypes applyp)
+      (make-dlap-lambda-list (length metatypes) applyp)
     (generating-lisp
      `(cache ,@(unless cached-emf-p '(emf)) miss-fn)
      lambda-list

diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index 849e499..d3186a0 100644 (file)
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -1337,11 +1337,12 @@
     (let* ((name (generic-function-name generic-function))
            (arg-info (gf-arg-info generic-function))
            (metatypes (arg-info-metatypes arg-info))
+           (nargs (length metatypes))
            (applyp (arg-info-applyp arg-info))
-           (fmc-arg-info (cons (length metatypes) applyp))
+           (fmc-arg-info (cons nargs applyp))
            (arglist (if function-p
-                        (make-dfun-lambda-list metatypes applyp)
-                        (make-fast-method-call-lambda-list metatypes applyp))))
+                        (make-dfun-lambda-list nargs applyp)
+                        (make-fast-method-call-lambda-list nargs applyp))))
       (multiple-value-bind (cfunction constants)
           (get-fun1 `(lambda
                       ,arglist
@@ -1349,7 +1350,7 @@
                           `((declare (ignore .pv-cell. .next-method-call.))))
                       (locally (declare #.*optimize-speed*)
                                (let ((emf ,net))
-                                 ,(make-emf-call metatypes applyp 'emf))))
+                                 ,(make-emf-call nargs applyp 'emf))))
                     #'net-test-converter
                     #'net-code-converter
                     (lambda (form)

diff --git a/version.lisp-expr b/version.lisp-expr
index 0fb61c6..06b09cc 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.5.44"
+"1.0.5.45"