LISP:如何跟踪宏

LISP: how to trace macros

这可能是一个愚蠢的问题,但我正在浏览 PG lisp 书,我想逐句浏览他提供的一些具有实际值的示例宏,例如:

(defmacro our-let (binds &body body) 
    `(
        (lambda ,(
                mapcar #'(lambda (x) (if (consp x) (car x) x)) binds
            )
                ,@body
        )
        ,@(mapcar #'(lambda (x) (if (consp x) (cadr x) nil)) binds)
    )
)

我天真地尝试 运行 (trace our-let) 然后 (our-let ((x 1) (y 2)) (+ x y)) 但我收到了一个错误,can't use encapsulation to trace anonymous function #<FUNCTION (MACRO-FUNCTION OUR-LET) {22675BBB}>。也不确定如何最好地将 print 语句放入 lambda 中。调试此 macro/output 它如何处理输入的最佳方法是什么?

EDIT(1):我的 macroexpand 格式不正确,但有效。

你如何调试它:

(macroexpand-1 '(our-let ((x 1) (y 2)) (+ x y)))
; ==> ((lambda (X Y) (+ X Y)) 1 2) 
; ==> t

顺便说一句,你的格式不好。它的外观如下:

(defmacro our-let (binds &body body) 
  `((lambda ,(mapcar #'(lambda (x) (if (consp x) (car x) x)) binds)
      ,@body)
    ,@(mapcar #'(lambda (x) (if (consp x) (cadr x) nil)) binds)))

或者我更喜欢:

(defmacro our-let ((&rest bindings) &body body) 
  (let ((names (mapcar #'(lambda (x) (if (consp x) (car x) x)) bindings))
        (exprs (mapcar #'(lambda (x) (if (consp x) (cadr x) nil)) bindings)))
    `((lambda ,names ,@body) ,@exprs)))

实际上,能够跟踪宏在 Common Lisp 实现中并不常见。编译器通常会在编译期间扩展宏形式。

虽然有一些实现支持它——当它们还支持运行实际源代码的 Lisp 解释器时,这就有意义了。其中包括 LispWorks 和 CLISP。

这里使用 CLISP 中 Sylwester 的代码:

  i i i i i i i       ooooo    o        ooooooo   ooooo   ooooo
  I I I I I I I      8     8   8           8     8     o  8    8
  I  \ `+' /  I      8         8           8     8        8    8
   \  `-+-'  /       8         8           8      ooooo   8oooo
    `-__|__-'        8         8           8           8  8
        |            8     o   8           8     o     8  8
  ------+------       ooooo    8oooooo  ooo8ooo   ooooo   8

Welcome to GNU CLISP 2.49.93+ (2018-02-18) <http://clisp.org/>

Copyright (c) Bruno Haible, Michael Stoll 1992-1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2018

Type :h and hit Enter for context help.

[1]> (defmacro our-let ((&rest bindings) &body body) 
       (let ((names (mapcar #'(lambda (x) (if (consp x) (car x) x)) bindings))
             (exprs (mapcar #'(lambda (x) (if (consp x) (cadr x) nil)) bindings)))
          `((lambda ,names ,@body) ,@exprs)))
OUR-LET
[2]> (trace our-let)
;; Tracing macro OUR-LET.
(OUR-LET)
[3]> (dotimes (i 3)
       (our-let ((x (* i 10)))
         (+ x 3)))
1. Trace: (OUR-LET ((X (* I 10))) (+ X 3))
1. Trace: OUR-LET ==> ((LAMBDA (X) (+ X 3)) (* I 10))
1. Trace: (OUR-LET ((X (* I 10))) (+ X 3))
1. Trace: OUR-LET ==> ((LAMBDA (X) (+ X 3)) (* I 10))
1. Trace: (OUR-LET ((X (* I 10))) (+ X 3))
1. Trace: OUR-LET ==> ((LAMBDA (X) (+ X 3)) (* I 10))
NIL
[4]> 

CL 的一个优点是它的设计者对某些事情考虑得很周到。特别是,由于 *macroexpand-hook*,事实证明您可以在 CL 中可移植地跟踪宏展开。该答案末尾的代码使用它来跟踪宏扩展它尝试与可能与 *macroexpand-hook* 对话的任何其他内容合作,并避免递归跟踪,但它没有经过很好的测试。有控制应该打印多少的控件,默认值为 'much less than everything'.

这是 LispWorks 中的一个示例:

> (macroexpand-traced-p)
nil

> (trace-macroexpand)
t

> (defun foo (x) x)
(defun foo (x) ...)
 -> (dspec:def (defun foo) (dspec:install-defun 'foo # ...))
(dspec:def (defun foo) (dspec:install-defun 'foo # ...))
 -> (compiler-let (#) (compiler::top-level-form-name # #))
(compiler::top-level-form-name (defun foo)
  (dspec:install-defun 'foo # ...))
 -> (compiler::tlf-name-binding (compiler-let #)
      (dspec:install-defun 'foo # ...))
(compiler::tlf-name-binding (compiler-let #)
  (dspec:install-defun 'foo # ...))
 -> (compiler-let (# #) (dspec:install-defun 'foo # ...))
(dspec:location)
 -> ':listener
foo

如您所见,您获得了很多可能并不有趣的内部扩展。为了解决这个问题,支持过滤输出,这样您就不会看到您可能不感兴趣的宏展开,其中有很多。

这是一个过滤器函数,它试图只显示展开的内容在当前包中可见的地方:

(defun trace-macroexpand-trace-this-package-p (macro-function macro-form
                                                              environment)
  (declare (ignore macro-function environment))
  (and (consp macro-form)
       (symbolp (first macro-form))
       (let ((name (first macro-form)))
         (eq (find-symbol (symbol-name name) *package*) name))))

这是一些输出结果:

 > (setf *trace-macroexpand-trace-p* #'trace-macroexpand-trace-this-package-p)
(setf *trace-macroexpand-trace-p*
      #'trace-macroexpand-trace-this-package-p)
 -> (let* (#) (setq *trace-macroexpand-trace-p* #:|Store-Var-1102|))
#<Function trace-macroexpand-trace-this-package-p 4060000844>

> (defun foo (x) x)
(defun foo (x) ...)
 -> (dspec:def (defun foo) (dspec:install-defun 'foo # ...))
foo

如您所见,您现在只能得到 'interesting' 宏展开。当然,可以定义更智能的过滤器。

代码如下:

(eval-when (:load-toplevel :compile-toplevel :execute)
  ;; macroexpansion tracing really wants to be off when compiling this
  ;; code as exciting things may happen during the evaluation of
  ;; DEFVAR &c otherwise.
  (when (fboundp 'trace-macroexpand)
    (ignore-errors                      ;don't barf
      (trace-macroexpand nil))))

(defvar *trace-macroexpand-print-length* 3
  "The value of *PRINT-LENGTH* used when tracing macroexpansions")

(defvar *trace-macroexpand-print-level* 2
  "The value of *PRINT-LEVEL* used when tracing macroexpansions")

(defvar *trace-macroexpand-trace-p* (constantly t)
  "Should we trace a given macroexpansion?

If this is bound to a function that function will be called with the
same three arguments that *MACROEXPAND-HOOK* takes, and should return
true if the expansion is to be printed.  Otherwise it should be true
if expansion is to be printed, false otherwise.")

(defvar *traced-macroexpand-hook*
  ;; the old value of *MACROEXPAND-HOOK*, used to restore it and to
  ;; know if we should trace.  Not user-adjustable.
  nil)

(defun trace-macroexpand (&optional (tracep t))
  "Trace or untrace macroexpansion.

If called with no argument, or an argument which is true, ensure that
macroexpansion is on.  If it was already on return NIL, otherwise
return T.

If called with an argument which is NIL then ensure macroexpansion is
not traced.  If it was traced return T else return NIL."
  (if tracep
      (if *traced-macroexpand-hook*
          nil
        (let ((hook *macroexpand-hook*))
          (flet ((macroexpand-hook (macro-function macro-form environment)
                   (if (if (functionp *trace-macroexpand-trace-p*)
                           (funcall *trace-macroexpand-trace-p*
                                    macro-function macro-form environment)
                         *trace-macroexpand-trace-p*)
                       (let ((expanded-form (funcall hook macro-function 
                                                     macro-form environment))
                             (*print-length* *trace-macroexpand-print-length*)
                             (*print-level* *trace-macroexpand-print-level*)
                             (*print-pretty* t))
                         (format *debug-io* "~&~S~% -> ~S~%" macro-form expanded-form)
                         expanded-form)
                     (funcall hook macro-function macro-form environment))))
            (setf *traced-macroexpand-hook* hook
                  *macroexpand-hook* #'macroexpand-hook)
            t)))
    (if *traced-macroexpand-hook*
      (progn 
        (setf *macroexpand-hook* *traced-macroexpand-hook*
              *traced-macroexpand-hook* nil)
        t)
    nil)))

(defun macroexpand-traced-p ()
  "Is macroexpansion currently traced?"
  (if *traced-macroexpand-hook* t nil))

这是一种跟踪宏的方法,它应该在任何 Common Lisp 中工作:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun our-let-expander (binds body)
    `((lambda ,(mapcar #'(lambda (x) (if (consp x) (car x) x)) binds)
        ,@body)
      ,@(mapcar #'(lambda (x) (if (consp x) (cadr x) nil)) binds))))

(defmacro our-let (binds &body body)
  (our-let-expander binds body))

现在我们 (trace our-let-expander).

根据我的经验,出于各种原因,复杂的宏通常最终会通过这样的扩展辅助函数来处理。

(一个重要的原因是:一旦您有两个或多个指向相同扩展逻辑的句法接口,您就不想将该逻辑复制并粘贴到多个 defmacro 形式中,而是它在一个函数中。)

P.S。注意反引号形式的重新格式化。左括号和后面的不要分开,右括号单独占一行。