X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftype-class.lisp;h=d1dbb0bada34023f8e72d829365ba3d03d954185;hb=d5aafdd8ab6387e12bac187048ed322bc96fb79a;hp=e4a1b6b9cb6ff0a3098552239620847826abc6d7;hpb=1bdc658b910e7dcc76f606b2c7c9c64012b6ee11;p=sbcl.git

diff --git a/src/code/type-class.lisp b/src/code/type-class.lisp
index e4a1b6b..d1dbb0b 100644
--- a/src/code/type-class.lisp
+++ b/src/code/type-class.lisp
@@ -144,21 +144,18 @@
 ) ; EVAL-WHEN
 
 (defmacro !define-type-method ((class method &rest more-methods)
-			      lambda-list &body forms-and-decls)
+			      lambda-list &body body)
   (let ((name (symbolicate CLASS "-" method "-TYPE-METHOD")))
-    (multiple-value-bind (forms decls) (parse-body forms-and-decls)
-      `(progn
-	 (defun ,name ,lambda-list
-	   ,@decls
-	   (block punt-type-method
-	     ,@forms))
-	 (!cold-init-forms
-	  ,@(mapcar #'(lambda (method)
-			`(setf (,(class-function-slot-or-lose method)
-				(type-class-or-lose ',class))
-			       #',name))
-		    (cons method more-methods)))
-	 ',name))))
+    `(progn
+       (defun ,name ,lambda-list
+	 ,@body)
+       (!cold-init-forms
+	,@(mapcar (lambda (method)
+		    `(setf (,(class-function-slot-or-lose method)
+			    (type-class-or-lose ',class))
+			   #',name))
+		  (cons method more-methods)))
+       ',name)))
 
 (defmacro !define-type-class (name &key inherits)
   `(!cold-init-forms