通常，当我尝试编写宏时，我会遇到以下困难：我需要将一个传递给宏的表单进行评估，然后再由在生成宏扩展时调用的帮助程序函数进行处理。在下面的示例中，我们只对如何编写宏来发出我们想要的代码感兴趣，而不是对宏本身的无用感兴趣：
想象一下(请耐心等待(Common Lisp 的lambda宏版本，其中只有参数的数量很重要，参数的名称和顺序并不重要。我们称之为jlambda.它将像这样使用：
(jlambda 2
...body)
其中2是返回的函数的 arity。换句话说，这将生成一个二元运算符。
现在想象一下，给定 arity，jlambda 生成一个虚拟的 lambda 列表，它传递给实际的 lambda 宏，如下所示：
(defun build-lambda-list (arity)
(assert (alexandria:non-negative-integer-p arity))
(loop for x below arity collect (gensym)))
(build-lambda-list 2)
==> (#:G15 #:G16)
上述调用对jlambda的扩展将如下所示：
(lambda (#:G15 #:16)
(declare (ignore #:G15 #:16))
…body))
假设我们需要 jlambda 宏能够接收 arity 值作为 Lisp 形式，该形式计算为非负整数(而不是直接接收非负整数(，例如：
(jlambda (+ 1 1)
...body)
需要评估表单(+ 1 1)，然后将结果传递给build-lambda-list并且需要对其进行评估，并将结果插入到宏扩展中。
(+ 1 1)
=> 2
(build-lambda-list 2)
=> (#:G17 #:18)
(jlambda (+ 1 1) ...body)
=> (lambda (#:G19 #:20)
(declare (ignore #:G19 #:20))
…body))
因此，这里有一个版本的 jlambda，当 arity 直接作为数字提供时有效，但当它作为要评估的形式传递时则不工作：
(defun jlambda-helper (arity)
(let ((dummy-args (build-lambda-list arity)))
`(lambda ,dummy-args
(declare (ignore ,@dummy-args))
body)))
(defmacro jlambda (arity &body body)
(subst (car body) 'body (jlambda-helper arity)))
(jlambda 2 (print “hello”)) ==> #<anonymous-function>
(funcall *
'ignored-but-required-argument-a
'ignored-but-required-argument-b)
==> “hello”
“hello”
(jlambda (+ 1 1) (print “hello”)) ==> failed assertion in build-lambda-list, since it receives (+ 1 1) not 2
我可以使用尖点读取宏评估(+ 1 1)，如下所示：
(jlambda #.(+ 1 1) (print “hello”)) ==> #<anonymous-function>
但是，表单不能包含对词法变量的引用，因为它们在读取时求值时不可用：
(let ((x 1))
;; Do other stuff with x, then:
(jlambda #.(+ x 1) (print “hello”))) ==> failure – variable x not bound
我可以引用我传递给jlambda的所有主体代码，将其定义为函数，然后eval它返回的代码：
(defun jlambda (arity &rest body)
(let ((dummy-args (build-lambda-list arity)))
`(lambda ,dummy-args
(declare (ignore ,@dummy-args))
,@body)))
(eval (jlambda (+ 1 1) `(print “hello”))) ==> #<anonymous-function>
但我不能使用eval，因为就像尖点一样，它会抛弃词汇环境，这是不好的。
所以jlambda必须是一个宏，因为我不希望函数体代码在通过jlambda的扩展建立适当的上下文之前进行评估;但是它也必须是一个函数，因为我希望在将第一个形式(在本例中为 arity 形式(传递给生成宏扩展的辅助函数之前对其进行计算。我如何克服这种 Catch-22 情况？
编辑
针对@Sylwester的问题，以下是上下文的解释：
我正在编写类似于"深奥的编程语言"的东西，在Common Lisp中实现为DSL。这个想法(诚然很愚蠢，但可能很有趣(是迫使程序员尽可能(我不确定还有多远！(完全以无点风格编写。为此，我将做几件事：
- 使用咖喱-撰写-阅读器-宏提供在 CL 中以无点样式编写所需的大部分功能
- 强制函数的arity——即覆盖CL的默认行为，允许函数是可变参数 的
- 与其使用类型系统来确定函数何时被"完全应用"(如在 Haskell 中(，只需在定义函数时手动指定函数的 arity。
因此，我需要自定义版本的lambda来用这种愚蠢的语言定义函数，并且 - 如果我无法弄清楚 - funcall和/或apply的自定义版本来调用这些函数。理想情况下，它们只是普通CL版本的皮肤，略微改变功能。
这种语言中的函数必须以某种方式跟踪其arity。但是，为了简单起见，我希望过程本身仍然是一个可调用的 CL 对象，但真的很想避免使用 MetaObject 协议，因为它对我来说比宏更令人困惑。
一个可能简单的解决方案是使用闭包。每个函数都可以简单地关闭存储其arity的变量的绑定。调用时，arity 值将确定函数应用程序的确切性质(即完全或部分应用程序(。如有必要，闭包可以是"潘多里克式的"，以便提供对 arity 值的外部访问;这可以使用 Let Over Lambda 的 plambda 和 with-pandoric来实现。
一般来说，我的语言中的函数会像这样运行(可能是有缺陷的伪代码，纯粹是说明性的(：
Let n be the number of arguments provided upon invocation of the function f of arity a.
If a = 0 and n != a, throw a “too many arguments” error;
Else if a != 0 and 0 < n < a, partially apply f to create a function g, whose arity is equal to a – n;
Else if n > a, throw a “too many arguments” error;
Else if n = a, fully apply the function to the arguments (or lack thereof).
g的arity等于a – n这一事实是jlambda问题出现的地方：g需要像这样创建：
(jlambda (- a n)
...body)
这意味着访问词汇环境是必要的。
这是一个特别棘手的情况，因为在运行时没有明显的方法来创建特定数量的参数的函数。 如果没有办法做到这一点，那么最简单的方法是编写一个函数，该函数接受一个arity和另一个函数，并将该函数包装在一个新函数中，该函数需要提供特定数量的参数：
(defun %jlambda (n function)
"Returns a function that accepts only N argument that calls the
provided FUNCTION with 0 arguments."
(lambda (&rest args)
(unless (eql n (length args))
(error "Wrong number of arguments."))
(funcall function)))
一旦你有了它，就很容易围绕它编写你希望能够的宏：
(defmacro jlambda (n &body body)
"Produces a function that takes exactly N arguments and and evalutes
the BODY."
`(%jlambda ,n (lambda () ,@body)))
它的行为大致符合您的期望，包括让 arity 成为编译时未知的东西。
CL-USER> (let ((a 10) (n 7))
(funcall (jlambda (- a n)
(print 'hello))
1 2 3))
HELLO
HELLO
CL-USER> (let ((a 10) (n 7))
(funcall (jlambda (- a n)
(print 'hello))
1 2))
; Evaluation aborted on #<SIMPLE-ERROR "Wrong number of arguments." {1004B95E63}>.
现在，您可能能够使用强制在运行时调用编译器，可能间接调用编译器，但这不会让函数的主体能够引用原始词法范围内的变量，尽管您会得到实现的错误参数数异常：
(defun %jlambda (n function)
(let ((arglist (loop for i below n collect (make-symbol (format nil "$~a" i)))))
(coerce `(lambda ,arglist
(declare (ignore ,@arglist))
(funcall ,function))
'function)))
(defmacro jlambda (n &body body)
`(%jlambda ,n (lambda () ,@body)))
这在 SBCL 中有效：
CL-USER> (let ((a 10) (n 7))
(funcall (jlambda (- a n)
(print 'hello))
1 2 3))
HELLO
CL-USER> (let ((a 10) (n 7))
(funcall (jlambda (- a n)
(print 'hello))
1 2))
; Evaluation aborted on #<SB-INT:SIMPLE-PROGRAM-ERROR "invalid number of arguments: ~S" {1005259923}>.
虽然这在 SBCL 中有效，但我不清楚它是否真的保证有效。 我们使用强制来编译一个包含文字函数对象的函数。 我不确定这是否是便携式的。
注意：
在你的代码中，你使用奇怪的引号，这样(print “hello”)实际上不会打印hello，而是打印变量“hello”计算的任何内容，而(print "hello")会按照人们的期望去做。
我的第一个问题是为什么？通常你知道你花了多少个参数来编译，或者至少你只是让它多 arity。制作一个n的arity函数只会在将错误数量的参数作为附加功能时出错，缺点是使用eval和朋友。
它不能作为宏解决，因为您将运行时与宏扩展时间混合在一起。想象一下这种用法：
(defun test (last-index)
(let ((x (1+ last-index)))
(jlambda x (print "hello"))))
在计算此表单时，宏将展开，并在将函数分配给 test 之前替换内容。此时x没有任何值，果然宏函数只获取符号，因此结果需要使用此值。 lambda是一种特殊形式，因此它在扩展jlambda之后再次扩展，也是在函数的任何使用之前。
没有任何词汇发生，因为这发生在程序运行之前。它可能在使用compile-file加载文件之前发生，然后如果您加载它将加载所有表单，其中包含事先已经展开的宏。
使用compile，您可以从数据中生成函数。它可能和eval一样邪恶，所以你不应该把它用于常见的任务，但它们的存在是有原因的：
;; Macro just to prevent evaluation of the body
(defmacro jlambda (nexpr &rest body)
`(let ((dummy-args (build-lambda-list ,nexpr)))
(compile nil (list* 'lambda dummy-args ',body))))
所以第一个示例的扩展变成了这样：
(defun test (last-index)
(let ((x (1+ last-index)))
(let ((dummy-args (build-lambda-list x)))
(compile nil (list* 'lambda dummy-args '((print "hello")))))))
这看起来可以工作。让我们测试一下：
(defparameter *test* (test 10))
(disassemble *test*)
;Disassembly of function nil
;(CONST 0) = "hello"
;11 required arguments <!-- this looks right
;0 optional arguments
;No rest parameter
;No keyword parameters
;4 byte-code instructions:
;0 (const&push 0) ; "hello"
;1 (push-unbound 1)
;3 (calls1 142) ; print
;5 (skip&ret 12)
;nil
可能的变体
我制作了一个宏，它接受文字数字并从a生成绑定变量......可以在函数中使用。
如果您不使用参数，为什么不创建一个执行此操作的宏：
(defmacro jlambda2 (&rest body)
`(lambda (&rest #:rest) ,@body))
结果需要任意数量的参数，只是忽略它：
(defparameter *test* (jlambda2 (print "hello")))
(disassemble *test*)
;Disassembly of function :lambda
;(CONST 0) = "hello"
;0 required arguments
;0 optional arguments
;Rest parameter <!-- takes any numer of arguments
;No keyword parameters
;4 byte-code instructions:
;0 (const&push 0) ; "hello"
;1 (push-unbound 1)
;3 (calls1 142) ; print
;5 (skip&ret 2)
;nil
(funcall *test* 1 2 3 4 5 6 7)
; ==> "hello" (prints "hello" as side effect)
编辑
现在我知道你在做什么，我有一个答案给你。您的初始函数不需要依赖于运行时，因此所有函数确实具有固定的arity，因此我们需要做的是currying或部分应用程序。
;; currying
(defmacro fixlam ((&rest args) &body body)
(let ((args (reverse args)))
(loop :for arg :in args
:for r := `(lambda (,arg) ,@body)
:then `(lambda (,arg) ,r)
:finally (return r))))
(fixlam (a b c) (+ a b c))
; ==> #<function :lambda (a) (lambda (b) (lambda (c) (+ a b c)))>
;; can apply multiple and returns partially applied when not enough
(defmacro fixlam ((&rest args) &body body)
`(let ((lam (lambda ,args ,@body)))
(labels ((chk (args)
(cond ((> (length args) ,(length args)) (error "too many args"))
((= (length args) ,(length args)) (apply lam args))
(t (lambda (&rest extra-args)
(chk (append args extra-args)))))))
(lambda (&rest args)
(chk args)))))
(fixlam () "hello") ; ==> #<function :lambda (&rest args) (chk args)>
;;Same but the zero argument functions are applied right away:
(defmacro fixlam ((&rest args) &body body)
`(let ((lam (lambda ,args ,@body)))
(labels ((chk (args)
(cond ((> (length args) ,(length args)) (error "too many args"))
((= (length args) ,(length args)) (apply lam args))
(t (lambda (&rest extra-args)
(chk (append args extra-args)))))))
(chk '()))))
(fixlam () "hello") ; ==> "hello"
如果您想要的只是可以部分或完全应用的 lambda 函数，我认为您不需要显式传递参数的数量。你可以做这样的事情(使用亚历山大(：
(defmacro jlambda (arglist &body body)
(with-gensyms (rest %jlambda)
`(named-lambda ,%jlambda (&rest ,rest)
(cond ((= (length ,rest) ,(length arglist))
(apply (lambda ,arglist ,@body) ,rest))
((> (length ,rest) ,(length arglist))
(error "Too many arguments"))
(t (apply #'curry #',%jlambda ,rest))))))
CL-USER> (jlambda (x y) (format t "X: ~s, Y: ~s~%" x y))
#<FUNCTION (LABELS #:%JLAMBDA1046) {1003839D6B}>
CL-USER> (funcall * 10) ; Apply partially
#<CLOSURE (LAMBDA (&REST ALEXANDRIA.0.DEV::MORE) :IN CURRY) {10038732DB}>
CL-USER> (funcall * 20) ; Apply fully
X: 10, Y: 20
NIL
CL-USER> (funcall ** 100) ; Apply fully again
X: 10, Y: 100
NIL
CL-USER> (funcall *** 100 200) ; Try giving a total of 3 args
; Debugger entered on #<SIMPLE-ERROR "Too many arguments" {100392D7E3}>
编辑：这里还有一个版本，可让您指定arity。坦率地说，我不明白这怎么可能有用。如果用户无法引用参数，并且没有自动对它们执行任何操作，那么，好吧，不会对它们执行任何操作。它们也可能不存在。
(defmacro jlambda (arity &body body)
(with-gensyms (rest %jlambda n)
`(let ((,n ,arity))
(named-lambda ,%jlambda (&rest ,rest)
(cond ((= (length ,rest) ,n)
,@body)
((> (length ,rest) ,n)
(error "Too many arguments"))
(t (apply #'curry #',%jlambda ,rest)))))))
CL-USER> (jlambda (+ 1 1) (print "hello"))
#<CLOSURE (LABELS #:%JLAMBDA1085) {1003B7913B}>
CL-USER> (funcall * 2)
#<CLOSURE (LAMBDA (&REST ALEXANDRIA.0.DEV::MORE) :IN CURRY) {1003B7F7FB}>
CL-USER> (funcall * 5)
"hello"
"hello"
编辑2：如果我理解正确，你可能会寻找这样的东西(？
(defvar *stack* (list))
(defun jlambda (arity function)
(lambda ()
(push (apply function (loop repeat arity collect (pop *stack*)))
*stack*)))
CL-USER> (push 1 *stack*)
(1)
CL-USER> (push 2 *stack*)
(2 1)
CL-USER> (push 3 *stack*)
(3 2 1)
CL-USER> (push 4 *stack*)
(4 3 2 1)
CL-USER> (funcall (jlambda 4 #'+)) ; take 4 arguments from the stack
(10) ; and apply #'+ to them
CL-USER> (push 10 *stack*)
(10 10)
CL-USER> (push 20 *stack*)
(20 10 10)
CL-USER> (push 30 *stack*)
(30 20 10 10)
CL-USER> (funcall (jlambda 3 [{reduce #'*} #'list])) ; pop 3 args from
(6000 10) ; stack, make a list
; of them and reduce
; it with #'*