[Ecls-list] Patch: drop arg markers when propagating types

[Josh Elsasser]

When retrieving a function's proclaimed argument types, the argument
markers such as &optional and &key are included, as well as any
following types.  The following patch stops processing at the first
marker.

I guess I should have done a separate patch for this, but included is
a fix for a missing let binding I found while researching the above.

--- src/cmp/cmpenv.lsp
+++ src/cmp/cmpenv.lsp
@@ -68,10 +68,13 @@
 		     (incf *env*)
 		     (setq *max-env* (max *env* *max-env*))))
 
+(defun arg-type-marker-p (arg)
+  (member arg '(&optional &rest &key &allow-other-keys)))
+
 (defun function-arg-types (arg-types &aux (types nil))
   (do ((al arg-types (cdr al)))
       ((or (endp al)
-           (member (car al) '(&optional &rest &key)))
+           (arg-type-marker-p (car al)))
        (nreverse types))
       (declare (object al))
       (push (type-filter (car al)) types)))
@@ -87,7 +90,7 @@
                 (warn "The function return types ~s is illegal." return-types)
                 t)
                ((or (endp (cdar return-types))
-                    (member (cadar return-types) '(&optional &rest &key)))
+                    (arg-type-marker-p (cadar return-types)))
                 t)
                (t (type-filter (cadar return-types)))))
         (t (type-filter (car return-types)))))
@@ -130,7 +133,7 @@
   (let ((x (assoc fname *function-declarations*)))
     (if x
 	(second x)
-	(get-sysprop fname 'PROCLAIMED-ARG-TYPES))))
+	(function-arg-types (get-sysprop fname 'PROCLAIMED-ARG-TYPES)))))
 
 (defun get-return-type (fname)
   (let ((x (assoc fname *function-declarations*)))
@@ -152,10 +155,10 @@
   (multiple-value-bind (x found)
       (get-sysprop fun 'PROCLAIMED-ARG-TYPES)
     (if found
-      (let ((minarg (length x)))
+      (let ((minarg (length x))
+	    (maxarg call-arguments-limit))
 	(if (eq (first (last x)) '*)
-	  (setf minarg (1- minarg)
-		maxarg call-arguments-limit)
+	  (setf minarg (1- minarg))
 	  (setf maxarg minarg))
 	(values minarg maxarg))
       (values 0 call-arguments-limit))))