From 3f58cf17d46b7c0f3a0531b799a7c01193962d10 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Thu, 22 Oct 1998 00:32:30 +0000 Subject: [PATCH] Fix for the :method option in expand-defgeneric, removing a broken check; spotted by Liam Healy. --- pcl/boot.lisp | 22 +++++----------------- 1 file changed, 5 insertions(+), 17 deletions(-) diff --git a/pcl/boot.lisp b/pcl/boot.lisp index 8a0440e9c..41686b1c1 100644 --- a/pcl/boot.lisp +++ b/pcl/boot.lisp @@ -26,7 +26,7 @@ ;;; #+cmu (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.16 1998/07/17 00:36:10 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.17 1998/10/22 00:32:30 dtc Exp $") (in-package :pcl) @@ -174,18 +174,7 @@ work during bootstrapping. (flet ((duplicate-option (name) (error 'kernel:simple-program-error :format-control "The option ~S appears more than once." - :format-arguments (list name))) - (define-method(gf-name q-a-b) - (let* ((arg-pos (position-if #'listp q-a-b)) - (arglist (elt q-a-b arg-pos)) - (qualifiers (subseq q-a-b 0 arg-pos)) - (body (nthcdr (1+ arg-pos) q-a-b))) - (when (not (equal (cadr (getf initargs :method-combination)) - qualifiers)) - (error "Bad method specification in defgeneric ~a~%~ - -- qualifier mismatch for lamda list ~a" - gf-name arglist)) - `(defmethod ,gf-name ,@qualifiers ,arglist ,@body)))) + :format-arguments (list name)))) ;; ;; INITARG takes this screwy new argument to get around a bad ;; interaction between lexical macros and setf in the Lucid @@ -221,7 +210,8 @@ work during bootstrapping. (duplicate-option :method-class) (initarg :method-class `',(cadr option)))) (:method - (push (cdr option) methods)) + (push `(defmethod ,function-specifier ,@(cdr option)) + methods)) (t ;unsuported things must get a 'program-error (error 'kernel:simple-program-error :format-control "Unsupported option ~S." @@ -235,9 +225,7 @@ work during bootstrapping. `(defgeneric ,function-specifier) *defgeneric-times* `(load-defgeneric ',function-specifier ',lambda-list ,@initargs)) - ,@(mapcar #'(lambda(m)(define-method `,function-specifier m)) - `,methods) - + ,@methods `,(function ,function-specifier))))) (defun load-defgeneric (function-specifier lambda-list &rest initargs) -- GitLab