首页 文章

使用Common Lisp宏捕获-22情况

提问于
浏览
7

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

想象一下(忍受我)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 宏能够以一个Lisp形式接收arity值,该形式计算为非负整数(而不是直接接收非负整数),例如:

(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 必须是一个宏,因为我不希望评估函数体代码,直到_687003的扩展已经确定了它的正确上下文;但它也必须是一个函数,因为我希望在将它传递给生成宏扩展的辅助函数之前评估第一个表单(在此示例中为arity表单) . 我如何克服这种Catch-22情况?

EDIT

在回答@Sylwester的问题时,这里是对上下文的解释:

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

  • 使用curry-compose-reader-macros提供在CL中以无点样式书写所需的大部分功能

  • 强制函数' arity – i.e. override CL' s允许函数为可变参数的默认行为

  • 而不是使用类型系统来确定函数何时“完全应用”(如在Haskell中),只需在定义函数时手动指定函数的arity .

因此,我需要一个自定义版本的 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 回答

  • 6

    这是一个特别棘手的情况,因为在运行时没有明显的方法来创建特定数量的参数的函数 . 如果's no way to do that, then it'可能最容易编写一个带有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}>.
    

    现在,你可能能够在运行时使用 coerce 来间接调用编译器,但这不会让函数体可以引用原始词法范围中的变量,尽管你会得到实现错误的参数数量异常:

    (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 来编译一个包含文字函数对象的函数 . 我'm not sure whether that'便携式或不携带 .

  • 4

    NB: 在你的代码中,你使用奇怪的引号,以便 (print “hello”) 实际上不打印 hello 但是 “hello” 评估的变量是什么,而 (print "hello") 做了人们所期望的 .

    我的第一个问题是为什么?通常你知道你在编译时需要多少个参数,或者至少你只需要多个参数 . 制作一个 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)
    

    EDIT

    现在我知道你在做什么,我有一个答案 . 您的初始函数不需要依赖于运行时因此所有函数确实具有固定的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"
    
  • 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}>
    

    Edit: 这里's also a version that lets you specify the arity. Frankly, I don'看看这怎么可能有用呢 . 如果用户不能引用参数,并且没有自动对它们进行任何操作,那么,它们没有任何用处 . 他们可能也不存在 .

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

相关问题