X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fmethods.lisp;h=e9365a886e5665ae9b05d6595ca4bab673fd6f3f;hb=12836ca105af62252aa0974c3f6992e60ce0ebf4;hp=2d63c9b108d39adc6ba5855c69f598439879a369;hpb=1799852c47cd0c29be71c259f1ab9df7ffb643c2;p=sbcl.git diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index 2d63c9b..e9365a8 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -616,11 +616,11 @@ ;; 7.6.4 point 5 probably entails that if any method says ;; &allow-other-keys then the gf should be construed to ;; accept any key. - (let ((allowp (or gf.allowp - (find '&allow-other-keys methods - :test #'find - :key #'method-lambda-list)))) - (setf (info :function :type name) + (let* ((allowp (or gf.allowp + (find '&allow-other-keys methods + :test #'find + :key #'method-lambda-list))) + (ftype (specifier-type `(function (,@(mapcar tfun gf.required) @@ -644,10 +644,11 @@ `(&key)) ,@(when allowp `(&allow-other-keys))) - *)) + *)))) + (setf (info :function :type name) ftype (info :function :where-from name) :defined-method - (gf-info-needs-update gf) nil)))))) - (values))) + (gf-info-needs-update gf) nil) + ftype))))))) (defun compute-applicable-methods-function (generic-function arguments) (values (compute-applicable-methods-using-types