Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv29438/src/pcl

Modified Files:
	generic-functions.lisp methods.lisp 
Log Message:
1.0.18.19: Fix FUNCTION-KEYWORDS, re-add FUNCTION-KEYWORD-PARAMETERS.

* Recently-renamed FUNCTION-KEYWORD-PARAMETERS did something different
  than what FUNCTION-KEYWORDS is supposed to do.  Fix
  FUNCTION-KEYWORDS, and re-add a distinct FUNCTION-KEYWORD-PARAMETERS
  (used indirectly by DESCRIBE, something in sb-introspect, maybe
  elsewhere).


Index: generic-functions.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/generic-functions.lisp,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -d -r1.39 -r1.40
--- generic-functions.lisp	30 Jun 2008 10:04:48 -0000	1.39
+++ generic-functions.lisp	16 Jul 2008 17:30:01 -0000	1.40
@@ -259,6 +259,8 @@
 
 (defgeneric function-keywords (method))
 
+(defgeneric function-keyword-parameters (method))
+
 (defgeneric generic-function-argument-precedence-order (gf))
 
 (defgeneric generic-function-lambda-list (gf))

Index: methods.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/methods.lisp,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -d -r1.83 -r1.84
--- methods.lisp	30 Jun 2008 10:04:48 -0000	1.83
+++ methods.lisp	16 Jul 2008 17:30:01 -0000	1.84
@@ -1624,6 +1624,15 @@
                                (early-method-lambda-list method)
                                (method-lambda-list method)))
     (declare (ignore nreq nopt keysp restp keywords))
+    (values keywords allow-other-keys-p)))
+
+(defmethod function-keyword-parameters ((method standard-method))
+  (multiple-value-bind (nreq nopt keysp restp allow-other-keys-p
+                        keywords keyword-parameters)
+      (analyze-lambda-list (if (consp method)
+                               (early-method-lambda-list method)
+                               (method-lambda-list method)))
+    (declare (ignore nreq nopt keysp restp keywords))
     (values keyword-parameters allow-other-keys-p)))
 
 (defun method-ll->generic-function-ll (ll)
@@ -1658,7 +1667,7 @@
           (let ((methods.keys nil) (methods.allowp nil))
             (dolist (m methods)
               (multiple-value-bind (m.keyparams m.allow-other-keys)
-                  (function-keywords m)
+                  (function-keyword-parameters m)
                 (setq methods.keys (union methods.keys m.keyparams :key #'maybe-car))
                 (setq methods.allowp (or methods.allowp m.allow-other-keys))))
             (let ((arglist '()))