如何修改具有任意功能的地方

Question

有时我们需要修改place，但这里没有符合我们需求的内置函数。

例如，这里有incf和decf加法和减法：

CL-USER> (defvar *x* 5)
*X*
CL-USER> (incf *x* 3)
8
CL-USER> *x*
8
CL-USER> (decf *x* 10)
-2
CL-USER> *x*
-2

但乘法和除法怎么样？如果我们希望修改具有任意功能的地方，如下所示：

(xf (lambda (x) ...) *x*)

xf实用程序非常有用，特别是当我们必须处理深层嵌套结构时：

(my-accessor (aref (cdr *my-data*) n))

Answer 1

使用define-modify-macro

定义新宏

为我们的需求定义新的便捷宏的一种简单方法是define-modify-macro。这是一个方便的宏，可以为我们创建其他宏。

  

<强>语法：

     

define-modify-macro name lambda-list function [documentation]

     

⇒姓名

我们应该提供新宏的名称，参数列表（不包括那里）以及将用于处理的功能符号。

使用示例：

(define-modify-macro togglef () not
  "togglef modifies place, changing nil value to t and non-nil value to nil")

(define-modify-macro mulf (&rest args) *
  "mulf modifies place, assigning product to it")

(define-modify-macro divf (&rest args) /
  "divf modifies place, assigning result of division to it")

但是，define-modify-macro不能用于任意处理。在这里，我们要看看其他可能性。

功能get-setf-expansion

函数get-setf-expansion不会创建任何宏，但提供了我们可以用来编写自己的宏。

  

<强>语法：

     

get-setf-expansion 地点和可选环境

     

⇒vars，vals，store-vars，writer-form，reader-form

正如您所看到的，它会返回一堆值，因此乍一看可能会令人困惑。让我们试试吧：

CL-USER> (defvar *array* #(1 2 3 4 5))
*ARRAY*
CL-USER> (get-setf-expansion '(aref *array* 1))
; get-setf-expansion is a function, so we have to quote its argument
(#:G6029 #:G6030)        ; list of variables needed to modify place
(*ARRAY* 1)              ; values for these variables
(#:G6031)                ; variable to store result of calculation
(SYSTEM::STORE #:G6029   ; writer-form: we should run it to modify place
               #:G6030   ; ^
               #:G6031)  ; ^  
(AREF #:G6029 #:G6030)   ; reader-form: hm.. looks like our expression

编写xf宏

现在我们已经获得了编写xf宏的所有信息：

(defmacro xf (fn place &rest args &environment env)
  (multiple-value-bind (vars forms var set access)
      (get-setf-expansion place env)
    (let ((g (gensym)))
      `(let* ((,g ,fn)   ; assign supplied function to generated symbol
              ,@(mapcar #'list vars forms) ; generate pairs (variable value)
              (,(car var) (funcall ,g ,access ,@args))) ; call supplied function
              ; and save the result, we use reader-form here to get intial value
         ,set)))) ; just put writer-from here as provided

注意，xf宏需要evironment variable并将其传递给get-setf-expansion。需要此变量来确保考虑编译环境中建立的任何词法绑定或定义。

让我们试一试：

CL-USER> (defvar *var* '(("foo" . "bar") ("baz" . "qux")))
*VAR*
CL-USER> (xf #'reverse (cdr (second *var*)))
"xuq"
CL-USER> *var*
(("foo" . "bar") ("baz" . "xuq"))

扩展：

(LET* ((#:G6033 #'REVERSE)
       (#:TEMP-6032 (SECOND *VAR*))
       (#:NEW-6031 (FUNCALL #:G6033
                            (CDR #:TEMP-6032))))
  (SYSTEM::%RPLACD #:TEMP-6032 #:NEW-6031))

我希望这些信息有用。

此答案基于 Paul Graham's On Lisp，部分 12.4更复杂的实用程序。

Answer 2

使用define-modify-macro（加一点）

Mark's answer提供了从头开始执行此操作的全面方法，但实际上可以使用 define-modify-macro 进行近似，并使用 define-modify-macro < / strong>加上另一个宏：

(define-modify-macro xxf (function)  ; like XF, but the place comes first, then the function
  (lambda (value function)
    (funcall function value)))

(let ((l (copy-tree '(("foo" . "bar") ("baz" . "qux")))))
  (xxf (cdr (second l)) #'reverse)
  l)
;=> (("foo" . "bar") ("baz" . "xuq"))

要颠倒顺序，可以轻松定义扩展为 xxf 调用的宏 xf ：

(defmacro xf (function place)
  `(xxf ,place ,function))

(let ((l (copy-tree '(("foo" . "bar") ("baz" . "qux")))))
  (xf #'reverse (cdr (second l)))
  l)
;=> (("foo" . "bar") ("baz" . "xuq"))

让它变得更好

当前版本仅接受单个函数作为参数。但是，许多函数采用其他参数（例如，其他必需参数，关键字参数和可选参数）。我们仍然可以使用 define-modify-macro 来处理这些：

(define-modify-macro xxf (function &rest args)
  (lambda (value function &rest args)
    (apply function value args)))

(defmacro xf (function place &rest args)
  `(xxf ,place ,function ,@args))

(let ((l (copy-tree '("HeLlo WoRlD" "HeLlo WoRlD"))))
  (xf #'remove-duplicates (first l) :test #'char=)
  (xf #'remove-duplicates (second l) :test #'char-equal)
  l)
;=> ("HeL WoRlD" "He WoRlD")