SBCL中nlet宏展开失败问题咨询

问题描述 #

参考《Let over Lambda》第三章的named let及Emacs Lisp的named-let实现，编写了如下nlet宏：

(defmacro nlet (name bindings &rest body)
  "Looping construct taken from Scheme.
Like `let', bind variables in BINDINGS and then evaluate BODY,
but with the twist that BODY can evaluate itself recursively by
calling NAME, where the arguments passed to NAME are used
as the new values of the bound variables in the recursive invocation.

Implementation after D. Hoyte from \"Let over lambda\"."
  (let ((fargs (mapcar (lambda (b) (if (consp b) (car b) b)) bindings))
        (aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings)))
    `(labels ((,name ,fargs ,@body))
       (,name ,aargs))))

在SBCL中执行macroexpand-all时触发错误，预期展开结果为：

(macroexpand-all
 '(nlet fact ((n n))
        (if (zerop n)
            1
          (* n (fact (- n 1))))))

=> (labels ((fact (n) (if (zerop n) 1 (* n (fact (- n 1)))))) (fact (n)))

实际错误信息：

Illegal function call in method body:
  ((N N))
   [Condition of type SIMPLE-ERROR]

Restarts:
 0: [RETRY] Retry SLY mREPL evaluation request.
 1: [ABORT] Return to sly-db level 1.
 2: [RETRY] Retry SLY mREPL evaluation request.
 3: [*ABORT] Return to SLY's top level.
 4: [ABORT] abort thread (#<THREAD tid=15104 "sly-channel-1-mrepl-remote-1" RUNNING {1100BC0003}>)

Backtrace:
 0: (SB-WALKER::GET-WALKER-TEMPLATE (N N) ((N N)))
 1: ((LAMBDA NIL :IN SB-WALKER::WALK-FORM-INTERNAL))

疑问：SBCL代码分析器为何不认可该模板？似乎在宏展开阶段尝试执行label表达式的绑定？

问题原因与修复 #

错误根源 #

宏展开后生成了非法代码：(fact (n))。这里的(n)被解析为试图调用函数n，但n是变量而非函数，SBCL的代码分析器（walker）在宏展开阶段检测到这个非法函数调用，触发了SIMPLE-ERROR。

问题出在宏的最后一行：(,name ,aargs)。aargs是绑定的初始值列表（比如对于((n n))，aargs为(n)），使用,aargs会将整个列表作为单个参数传递给name函数，导致生成(fact (n))，而不是预期的(fact n)。

修复方案 #

将宏中的(,name ,aargs)改为(,name ,@aargs)，使用反引号的@符号将aargs列表展开为多个参数：

(defmacro nlet (name bindings &rest body)
  "Looping construct taken from Scheme.
Like `let', bind variables in BINDINGS and then evaluate BODY,
but with the twist that BODY can evaluate itself recursively by
calling NAME, where the arguments passed to NAME are used
as the new values of the bound variables in the recursive invocation.

Implementation after D. Hoyte from \"Let over lambda\"."
  (let ((fargs (mapcar (lambda (b) (if (consp b) (car b) b)) bindings))
        (aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings)))
    `(labels ((,name ,fargs ,@body))
       (,name ,@aargs))))

验证 #

修复后执行macroexpand-all，将得到正确的展开结果：

(macroexpand-all
 '(nlet fact ((n n))
        (if (zerop n)
            1
          (* n (fact (- n 1))))))

=> (labels ((fact (n) (if (zerop n) 1 (* n (fact (- n 1)))))) (fact n))

此时SBCL不会再触发错误，代码可正常执行。

内容的提问来源于stack exchange，提问作者myname