From dbdd5a80e79d449fcfc1401ef9cc1c77bfc64b6a Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Mon, 1 Sep 2008 19:09:28 +0000
Subject: [PATCH] C::GET-PROCLAIMED-NARG understands complex function types
 with &optional, &rest and the like.

---
 src/cmp/cmpenv.lsp | 38 +++++++++++++++++++++++---------------
 1 file changed, 23 insertions(+), 15 deletions(-)

diff --git a/src/cmp/cmpenv.lsp b/src/cmp/cmpenv.lsp
index efe7dfe71..2de5eeb2a 100644
--- a/src/cmp/cmpenv.lsp
+++ b/src/cmp/cmpenv.lsp
@@ -129,36 +129,44 @@
 (defun get-arg-types (fname)
   (let ((x (assoc fname *function-declarations*)))
     (if x
-	(second x)
+	(values (second x) t)
 	(get-sysprop fname 'PROCLAIMED-ARG-TYPES))))
 
 (defun get-return-type (fname)
   (let ((x (assoc fname *function-declarations*)))
     (if x
-	(third x)
+	(values (third x) t)
 	(get-sysprop fname 'PROCLAIMED-RETURN-TYPE))))
 
 (defun get-local-arg-types (fun &aux x)
   (if (setq x (assoc fun *function-declarations*))
-      (second x)
-      nil))
+      (values (second x) t)
+      (values nil nil)))
 
 (defun get-local-return-type (fun &aux x)
   (if (setq x (assoc fun *function-declarations*))
-      (caddr x)
-      nil))
+      (values (caddr x) t)
+      (values nil nil)))
 
 (defun get-proclaimed-narg (fun)
-  (multiple-value-bind (x found)
-      (get-sysprop fun 'PROCLAIMED-ARG-TYPES)
+  (multiple-value-bind (arg-list found)
+      (get-arg-types fun)
     (if found
-      (let* ((minarg (length x))
-	     (maxarg call-arguments-limit))
-	(if (eq (first (last x)) '*)
-	  (setf minarg (1- minarg))
-	  (setf maxarg minarg))
-	(values minarg maxarg))
-      (values 0 call-arguments-limit))))
+	(loop for type in arg-list
+	   with minarg = 0
+	   and maxarg = 0
+	   and in-optionals = nil
+	   do (cond ((member type '(* &rest &key &allow-other-keys))
+		     (return (values minarg call-arguments-limit)))
+		    ((eq type '&optional)
+		     (setf in-optionals t maxarg minarg))
+		    (in-optionals
+		     (incf maxarg))
+		    (t
+		     (incf minarg)
+		     (incf maxarg)))
+	   finally (return (values minarg maxarg)))
+	(values 0 call-arguments-limit))))
 
 ;;; Proclamation and declaration handling.