common-lisp - 如何编写一个用参数调用函数的函数？

Question

我正在尝试编写包装另一个函数的函数，但我不确定如何在维护合理的 lambda 列表的同时正确传递参数。

例如如果我有一个函数

(defun f (x &key y z) ...)

我想写这样的东西

(defun g (x &key y z)
  (h (f x :y y :z z)))

这并不令人满意，因为我想从 g 调用 f 并使用调用 g 时使用的确切参数，而这不是发生(例如，我不想向 f 提供调用者未提供给 g 的关键字参数)。

我最初写的是这样的:

(defun g (&rest f-args)
  (apply #'f f-args))

这就是我想要的效果，但是 g 的 lambda 列表现在非常神秘，我不得不一直导航到 f 以查看参数应该是什么。

我确实想出了一个解决方案(它最令人满意，所以我将其作为答案发布)，但我需要明确每个关键参数，并使用大型 lambda 列表(例如，如果我想包装 drakma:http-request )，会很痛苦。我希望也许有更好的方法。

Answer 1

您可以编写一个宏，通过从另一个函数复制 lambda 列表来定义一个函数。问题是没有获取 lambda 列表的标准方法，但对于 SBCL，您可以使用 SB-INTROSPECT:FUNCTION-LAMBDA-LIST(尽管这不适用于 (声明(优化(调试 0))))。您可以尝试阅读 Swank 源代码，了解它如何获取各种实现的 lambda 列表。

(defmacro define-wrapper (name lambda-source &body body)
  `(defun ,name ,(sb-introspect:function-lambda-list lambda-source)
     ,@body))

(defun f (x &key (y 3) (z 4))
  (+ x y z))

(define-wrapper g f
  (* 2 (f x :y y :z z)))

(f 2) ;=> 9
(g 2) ;=> 18

这有点难看，因为代码没有显示变量定义。更复杂的解决方案可能是做类似的事情

;; Requires Alexandria.
(defmacro define-wrapper (name lambda-source &body body)
  (let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
    (multiple-value-bind (required optional rest keywords)
        (alexandria:parse-ordinary-lambda-list lambda-list)
      (declare (ignore rest))
      `(defun ,name ,lambda-list
         ,@(sublis `((_ . (,lambda-source ,@(loop for r in required collect r)
                                          ,@(loop for (name init suppliedp)
                                                  in optional collect name)
                                          ,@(loop for ((k-name name) init suppliedp)
                                                  in keywords
                                                append (list k-name name)))))
                   body)))))

(defun f (x &key (y 3) (z 4))
  (+ x y z))

(define-wrapper g f
  (* 2 _))

包装器中的 _ 替换为使用给定参数调用函数 F。您仍然需要记住参数变量存在并且可能与您自己定义的变量冲突。

这会将所有参数传递给函数，而不管它们是否已给定。这可能会搞乱一个根据是否提供参数而表现不同的函数。您可以通过使用 APPLY 来避免这种情况，但它有点复杂。

(defmacro define-wrapper (name lambda-source &body body)
  (let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
    (alexandria:with-gensyms (deparsed-arglist-sym
                              key-sym val-sym suppliedp-sym)
      (multiple-value-bind (required optional rest keywords)
          (alexandria:parse-ordinary-lambda-list lambda-list)
        (declare (ignore rest))
        (multiple-value-bind (body declarations docstring)
            (alexandria:parse-body body :documentation t)
          `(defun ,name ,lambda-list
             ,@(when docstring (list docstring))
             ,@declarations
             (let ((,deparsed-arglist-sym
                     (nconc (loop for ,val-sym in (list ,@required) collect ,val-sym)
                            (loop for (,val-sym . ,suppliedp-sym)
                                    in (list ,@(loop for (name init suppliedp)
                                                       in optional
                                                     collect (list 'cons name
                                                                   (or suppliedp t))))
                                  when ,suppliedp-sym collect ,val-sym)
                            (loop for (,key-sym ,val-sym ,suppliedp-sym)
                                    in (list ,@(loop for ((kname name) init suppliedp) 
                                                       in keywords
                                                     collect (list 'list kname name
                                                                   (or suppliedp t))))
                                  when ,suppliedp-sym append (list ,key-sym ,val-sym)))))
               ,@(sublis `((_ . (apply #',lambda-source ,deparsed-arglist-sym)))
                         body))))))))

(define-wrapper bar drakma:http-request
  "Return the length of a response to http-request."
  ;; HTTP-REQUEST has some &aux variables.
  (declare (ignore drakma::unparsed-uri
                   drakma::args))
  (length _))

(bar "http://www.google.com") ;=> 11400 (14 bits, #x2C88)