From: Christophe R. <cr...@us...> - 2004-10-01 12:35:36
|
Update of /cvsroot/sbcl/sbcl/src/pcl In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26838/src/pcl Modified Files: boot.lisp Log Message: 0.8.15.4: Fix for method redefinition WARNING (Zach Beane sbcl-devel 2004-09-24) ... slight tweak to get &optional (stream *standard-output*) right. Index: boot.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/boot.lisp,v retrieving revision 1.83 retrieving revision 1.84 diff -u -d -r1.83 -r1.84 --- boot.lisp 1 Sep 2004 19:59:11 -0000 1.83 +++ boot.lisp 1 Oct 2004 12:35:27 -0000 1.84 @@ -1644,6 +1644,12 @@ (unless (equal ,pos ,valsym) (setf ,pos ,valsym))))) +(defun create-gf-lambda-list (lambda-list) + ;;; Create a gf lambda list from a method lambda list + (loop for x in lambda-list + collect (if (consp x) (list (car x)) x) + if (eq x '&key) do (loop-finish))) + (defun set-arg-info (gf &key new-method (lambda-list nil lambda-list-p) argument-precedence-order) (let* ((arg-info (if (eq *boot-state* 'complete) @@ -1671,8 +1677,10 @@ (error "The lambda-list ~S is incompatible with ~ existing methods of ~S." lambda-list gf)))) - (when lambda-list-p - (esetf (arg-info-lambda-list arg-info) lambda-list)) + (esetf (arg-info-lambda-list arg-info) + (if lambda-list-p + lambda-list + (create-gf-lambda-list lambda-list))) (when (or lambda-list-p argument-precedence-order (null (arg-info-precedence arg-info))) (esetf (arg-info-precedence arg-info) @@ -1920,11 +1928,8 @@ (let* ((method (car (last methods))) (ll (if (consp method) (early-method-lambda-list method) - (method-lambda-list method))) - (k (member '&key ll))) - (if k - (ldiff ll (cdr k)) - ll)))) + (method-lambda-list method)))) + (create-gf-lambda-list ll)))) (arg-info-lambda-list arg-info)))) (defmacro real-ensure-gf-internal (gf-class all-keys env) |