Common Lisp宏的{Catch-22情况

时间:2016-09-10 14:11:00

标签: macros common-lisp eval

通常当我尝试编写一个宏时,我遇到了以下困难:我需要一个传递给宏的表单,然后在生成宏时调用的辅助函数处理之前进行评估。扩张。在下面的例子中,我们只关心如何编写一个宏来发出我们想要的代码,而不是宏本身的无用:

想象一下(忍受我)一个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的问题时,以下是对上下文的解释:

我正在写一些类似于“esoteric programming language”的东西,在Common Lisp中作为DSL实现。这个想法(虽然很愚蠢,但可能很有趣)是强迫程序员尽可能地(我不知道还有多远!),专门写在point-free style。要做到这一点,我会做几件事:

  • 使用curry-compose-reader-macros提供在CL
  • 中以无点样式书写所需的大部分功能
  • 执行功能&#39; arity - 即覆盖CL的默认行为,允许函数为variadic
  • 不是使用类型系统来确定函数何时“完全应用”(如在Haskell中),而是在定义函数时手动指定函数。

所以我需要lambda的自定义版本来定义这种愚蠢语言中的函数,并且 - 如果我无法解决这个问题 - funcall的自定义版本和/或apply用于调用这些函数。理想情况下,它们只是略微改变功能的普通CL版本。

这种语言的功能必须以某种方式跟踪它的arity。但是,为了简单起见,我希望程序本身仍然是一个可操作的CL对象,但是我真的想避免使用MetaObject协议,因为它对我来说比宏更容易让人困惑。

一个可能简单的解决方案是使用闭包。每个函数都可以简单地关闭存储其arity的变量的绑定。调用时,arity值将确定函数应用程序的确切性质(即完整或部分应用程序)。如果有必要,关闭可以是“pandoric”,以便提供对arity值的外部访问;可以使用Let Over Lambda中的plambdawith-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)

这意味着必须访问词汇环境。

3 个答案:

答案 0 :(得分:6)

这是一个特别棘手的情况,因为没有明显的方法可以在运行时创建特定数量的参数的函数。如果没有办法做到这一点,那么编写一个带有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中使用,但我不清楚它是否真的有效。我们使用 coerce 来编译一个包含文字函数对象的函数。我不确定这是否便携。

答案 1 :(得分:4)

NB: 在您的代码中,您使用了奇怪的引号,因此(print “hello”)实际上并不打印hello,而是变量“hello”评估为,而(print "hello")执行人们期望的事情。

我的第一个问题是为什么?通常你知道你在编译时需要多少个参数,或者至少你只需要多个参数。制作n arity函数只会在使用错误数量的参数作为passwd添加错误时使用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"

答案 2 :(得分:1)

如果您想要的是可以部分或全部应用的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 #'*