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

Question

有时我们需要修改一个地方,但这里没有符合我们需求的内置功能.

例如,这里是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 place和可选环境

⇒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宏需要环境变量并将其传递给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的 On Lisp,第 12.4 节"更复杂的实用程序".

Answer 2

使用define-modify-macro(加一点)

Mark的答案提供了从头开始执行此操作的全面方法,但实际上可以使用define-modify-macro近似,并使用define-modify-macro加上另一个宏:

(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")