Changeset 15459 for trunk/abcl/src/org/armedbear/lisp/clos.lisp

Timestamp:

10/29/20 16:55:03 (3 years ago)

Author:

Mark Evenson

Message:

Tidy call-next-method flets with macrology

File:

• trunk/abcl/src/org/armedbear/lisp/clos.lisp (modified) (8 diffs)

trunk/abcl/src/org/armedbear/lisp/clos.lisp

@@ -2740 +2740 @@
 (defvar *next-method-p-p*)
 
+;;; FIXME this doesn't work for macroized references
 (defun walk-form (form)
   (cond ((atom form)
@@ -2749 +2750 @@
          (walk-form (%car form))
          (walk-form (%cdr form)))))
+
+(defmacro flet-call-next-method (args next-emfun &body body) 
+  `(flet ((call-next-method (&rest cnm-args)
+            (if (null ,next-emfun)
+                (error "No next method for generic function.")
+                (funcall ,next-emfun (or cnm-args ,args))))
+          (next-method-p ()
+            (not (null ,next-emfun))))
+     (declare (ignorable (function call-next-method)
+                         (function next-method-p)))
+     ,@body))
 
 (defun compute-method-function (lambda-expression)
@@ -2768 +2780 @@
                      (declare (ignorable ,(%car lambda-list)))
                      ,@declarations
-                     (flet ((call-next-method (&rest cnm-args)
-                              (if (null next-emfun)
-                                  (error "No next method for generic function.")
-                                  (funcall next-emfun (or cnm-args args))))
-                            (next-method-p ()
-                              (not (null next-emfun))))
-                       (declare (ignorable (function call-next-method)
-                                           (function next-method-p)))
+                     (flet-call-next-method args next-emfun
                        ,@body))))
-                     
                (2
                 `(lambda (args next-emfun)
@@ -2785 +2789 @@
                                          ,(%cadr lambda-list)))
                      ,@declarations
-                     (flet ((call-next-method (&rest cnm-args)
-                              (if (null next-emfun)
-                                  (error "No next method for generic function.")
-                                  (funcall next-emfun (or cnm-args args))))
-                            (next-method-p ()
-                              (not (null next-emfun))))
-                       (declare (ignorable (function call-next-method)
-                                           (function next-method-p)))
-
+                     (flet-call-next-method args next-emfun 
                        ,@body))))
                (3
@@ -2804 +2800 @@
                                          ,(%caddr lambda-list)))
                      ,@declarations
-                     (flet ((call-next-method (&rest cnm-args)
-                              (if (null next-emfun)
-                                  (error "No next method for generic function.")
-                                  (funcall next-emfun (or cnm-args args))))
-                            (next-method-p ()
-                              (not (null next-emfun))))
-                       (declare (ignorable (function call-next-method)
-                                           (function next-method-p)))
+                     (flet-call-next-method args next-emfun 
                        ,@body))))
                (t
@@ -2817 +2806 @@
                    (apply #'(lambda ,lambda-list
                               ,@declarations
-                              (flet ((call-next-method (&rest cnm-args)
-                                       (if (null next-emfun)
-                                           (error "No next method for generic function.")
-                                           (funcall next-emfun (or cnm-args args))))
-                                     (next-method-p ()
-                                       (not (null next-emfun))))
-                                (declare (ignorable (function call-next-method)
-                                                    (function next-method-p)))
+                              (flet-call-next-method args next-emfun 
                                 ,@body))
                           args))))
@@ -2830 +2812 @@
                 (apply #'(lambda ,lambda-list
                            ,@declarations
-                           (flet ((call-next-method (&rest cnm-args)
-                                    (if (null next-emfun)
-                                        (error "No next method for generic function.")
-                                        (funcall next-emfun (or cnm-args args))))
-                                  (next-method-p ()
-                                    (not (null next-emfun))))
-                             (declare (ignorable (function call-next-method)
-                                                 (function next-method-p)))
-                             
+                           (flet-call-next-method args next-emfun
                              ,@body))
                        args))))))
@@ -2871 +2845 @@
                       (next-method-p () nil))
                  (declare (ignorable (function call-next-method)
-                                    (function next-method-p)))
+                                     (function next-method-p)))
                  ,@body))
             nil))))))