用通用Lisp宏捕获-22的情况

Question

通常，当我试图编写宏时，会遇到以下困难:在生成宏展开时被调用的助手函数处理之前，需要将一个传递给宏的表单进行计算。在下面的示例中，我们只对如何编写宏以发出我们想要的代码感兴趣，而不关心宏本身的无用性：

想象一下(请接受我的)一个版本的Common的lambda宏，其中只有参数的数量是重要的，而参数的名称和顺序并不重要。我们叫它jlambda吧。它的使用方式如下：

(jlambda 2
  ...body)

其中2是返回的函数的一致性。换句话说，这会产生一个二进制运算符。

现在假设，在这种情况下，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宏作为一个计算为非负整数(而不是直接接收一个非负整数)的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的一个版本，当数据直接作为数字提供时，而不是将其作为要计算的表单传递时，该版本可以工作：

(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的展开为它建立适当的上下文之前计算函数体代码；然而，它也必须是一个函数，因为在将其传递给生成宏展开的助手函数之前，我需要计算第一个表单(在本例中是“关系形式”)。如何克服这种Catch-22的情况？

编辑

在回答@Sylwester的问题时，以下是对上下文的解释：

我正在编写类似于“esoteric programming language”的东西，在通用Lisp中实现为DSL。这个想法(虽然很愚蠢，但也可能很有趣)是尽可能强迫程序员(我还不知道还有多远！)，完全用point-free style编写。为了做到这一点，我将做几件事：

• 使用curry-compose-reader-macros提供在CL中以无点样式编写所需的大部分功能。
• 强制函数的广泛性-即覆盖CL的默认行为，允许函数是可变的
• 与其使用类型系统来确定某个函数何时被“完全应用”(如在Haskell中)，只需在定义函数时手动指定它的重要性。

因此，我需要一个自定义版本的lambda来用这种愚蠢的语言定义一个函数，而且--如果我搞不懂--一个定制版本的funcall和/或apply来调用这些函数。理想情况下，它们只是普通CL版本的皮肤，后者稍微改变了功能。

在这种语言中，函数将以某种方式跟踪它的特性。但是，为了简单起见，我希望这个过程本身仍然是一个功能良好的CL对象，但是我真的希望避免使用MetaObject协议，因为它比宏更让我困惑。

一个潜在的简单解决方案是使用闭包。每个函数都可以简单地关闭存储其重要性的变量的绑定。当被调用时，重要性值将决定函数应用程序的确切性质(即全部或部分应用程序)。如果有必要，闭包可能是“通俗的”，以便提供外部访问，以获得一致性值；这可以使用plambda和来自Let Over Lambda的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的一致性等于a – n，这就是jlambda的问题所在:需要像这样创建g：

(jlambda (- a n)
  ...body)

这意味着访问词汇环境是必要的。

Answer 1

这是一个特别棘手的情况，因为没有明显的方法在运行时创建特定数量的参数的函数。如果没有办法做到这一点，那么编写一个函数，该函数接受一个一致性函数和另一个函数，并将该函数封装在一个新函数中，需要提供特定数量的参数，这可能是最简单的：

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

它的行为与您希望的大致一致，包括让在编译时不为人所知的特性。

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中有效，但我不清楚它是否确实能够工作。我们使用强制编译一个函数，其中包含一个文字函数对象。我不确定那是不是便携的。

Answer 2

NB:在您的代码中使用了奇怪的引号，这样(print “hello”)就不会实际打印hello，而是输出变量“hello”计算到的变量，而(print "hello")则会执行预期的操作。

我的第一个问题是为什么？通常，您知道需要花费多少参数来编译，或者至少您只是使其具有多重性。如果使用错误的参数作为附加功能，使用n和朋友的缺点，只会产生错误的passwd。

由于您将运行时与宏展开时间混合在一起，因此不能将其作为宏解决。想象一下这种用法：

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

编辑

现在我知道你要干什么了，我给你一个答复。您的初始函数不需要依赖于运行时，因此所有函数都具有固定的特性，所以我们需要做的是运行或部分应用程序。

;; 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"

Answer 3

如果您想要的只是可以部分或完全应用的lambda函数，我认为您不需要显式地传递参数的数量。您可以这样做(使用Alexandria)：

(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}>

编辑：，这里也有一个版本，可以让您指定这个特性。坦白说，我看不出这有什么用。如果用户不能引用参数，并且不会自动对它们做任何操作，那么，对它们就什么也不做了。它们也可能不存在。

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

Edit2:，如果我正确理解，您可能需要这样的(?)：

(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 #'*