2

我以前不止一次有过这个问题。

一般问题

是否可以使用同名的包装器透明地在本地隐藏一个函数ff？

即，如何在本地将 (f Wrapped-args...) 扩展为 (f args...)？

Flet 似乎让我们这样做，但有局限性，即生成的包装器不是可设置的。是否有可能在不诉诸弗莱特的情况下做到这一点？

理想情况下，会有一个宏让我们编写“包装”f调用，并将代码扩展为原始“非包装”f调用。

起初我认为macrolet 可能是这样，因为它在文档中说它首先扩展宏，然后在扩展的表单上应用 setf，但我无法使用它（请继续阅读下文）。

动机

这在某些参数是隐式的并且不应该一遍又一遍地重复的上下文中很有用，以获得更多的 DRY 代码。

在我之前的问题（let-curry）中有一个特殊的例子。尝试“自动”分配函数的一些参数（let-curry）。

弗莱特的注意事项

我在那里得到了一些很好的答案，但是，我遇到了一些限制。通过使用 flet 来完成函数名到其上的包装器的这种局部“阴影”，这种包装器是不可设置的，因此，这种包装器不能像原始函数那样灵活地使用，只能读取值，而不是写入.

具体问题

通过上面的链接，如何编写宏 flet-curry 并使包装函数可以设置？

奖励：该宏能否以 0 运行时开销将包装调用扩展为原始调用？

我尝试在那篇文章中选择答案并使用宏而不是 flet 无济于事。

谢谢！

更新

我被要求为这个通用问题举一个具体的例子。

代码中的愿望注释：

(locally (declare (optimize safety))
  (defclass scanner ()
    ((source
      :initarg :source
      :accessor source
      :type string)
     (tokens
      :initform nil
      :accessor tokens
      :type list)
     (start
      :initform 0
      :accessor start
      :type integer)
     (current
      :initform 0
      :accessor current
      :type integer)
     (line
      :initform 1
      :accessor line
      :type integer))
    (:metaclass checked-class)))

(defun lox-string (scanner)
  "Parse string into a token and add it to tokens"
  ;; Any function / defmethod / accessor can be passed to let-curry

  ;; 1. I'd like to add the accessor `line` to this list of curried methods:
  (let-curry scanner (peek at-end-p advance source start current)
    (loop while (and (char/= #\" (peek))
                     (not (at-end-p)))
          do
             ;; 2. but cannot due to the incf call which calls setf:
             (if (char= #\Newline (peek)) (incf (line scanner))
                 (advance)))
    (when (at-end-p)
      (lox.error::lox-error (line scanner) "Unterminated string.")
      (return-from lox-string nil))
    (advance) ;; consume closing \"
    (add-token scanner 'STRING (subseq (source)
                                       (1+ (start))
                                       (1- (current))))))

这意味着我想let-curry将该块中的咖喱函数的任何调用从

  1. (f arg1 arg2 ...) 到
  2. (f scanner arg1 arg2 ...)

就好像我在源代码中写了后一种形式而不是前者一样。如果某些“宏”是这种情况，那么它可以通过设计来设置。

似乎宏将是正确的工具，但我不知道如何。

再次感谢 ：）

PS：如果您需要访问完整代码，请访问：https ://github.com/AlbertoEAF/cl-lox (scanner.lisp)

4

2 回答 2

8

绑定 withmacrolet并非易事，因为：

  • 一旦你绑定f到一个宏，如果它扩展为(f ...)，你将有无限的宏扩展。

  • 此外，您可以将宏扩展为(apply #'f ...)（这很好，因为APPLY可以是 SETF 位置1），但是由于#'f绑定到本地宏，而不是原始函数，因此您会遇到错误。但是，如果您首先评估#'f，将其绑定到隐藏变量，然后定义一个应用变量值的宏，则 SETF APPLY 抱怨（至少在 SBCL 中）该函数不能是符号（即动态计算）。

    1：例如(let ((x (list 0 1 2))) (prog1 x (setf (apply #'second list ()) 9)))

但是你不需要宏，因为你可以在;中绑定SETF函数。FLET如果您想在本地重新定义某些功能，您可以手动编写以下内容：

(defun lox-string (scanner)
  (flet 
    ((peek        ()  (peek scanner))
     (at-end-p    ()  (at-end-p scanner))
     (advance     ()  (advance scanner))
     (line        ()  (line scanner))
     ((setf line) (n) (setf (line scanner) n))
     (source      ()  (source scanner))
     (start       ()  (start scanner))
     (current     ()  (current scanner)))
    (loop 
       while (and (char/= #\" (peek))
                  (not (at-end-p)))
       do
         (if (char= #\Newline (peek)) 
         (incf (line))
             (advance)))
    (when (at-end-p)
      (error "Unterminated string at line ~a" (line)))
    (advance)
    (add-token scanner 'STRING (subseq (source)
                                       (1+ (start))
                                       (1- (current))))))

扩展为 FLET

以下宏扩展为可内联的 flets 并SETF以特殊方式处理函数，因为第一个参数始终是设置的值：

(defmacro with-curry ((&rest fn-specs) prefix &body body)
  (loop 
     with args = (gensym)
     and n = (gensym)
     and prefix = (alexandria:ensure-list prefix)
     for f in fn-specs
     collect (if (and (consp f) (eq 'setf (first f)))
                 `(,f (,n &rest ,args) (apply #',f ,n ,@prefix ,args))
                 `(,f (&rest ,args) (apply #',f ,@prefix ,args))) 
     into flets
     finally (return
               `(flet ,flets
                  (declare (inline ,@fn-specs))
                  ,@body))))

例如：

(let ((scanner (make-instance 'scanner)))
  (with-curry (start (setf start)) scanner
    (setf (start) (+ (start) 10))))

这个宏展开为：

(LET ((SCANNER (MAKE-INSTANCE 'SCANNER)))
  (FLET ((START (&REST #:G849)
           (APPLY #'START SCANNER #:G849))
         ((SETF START) (#:G850 &REST #:G849)
           (APPLY #'(SETF START) #:G850 SCANNER #:G849)))
    (DECLARE (INLINE START (SETF START)))
    (LET* ((#:NEW1 (+ (START) 10)))
      (FUNCALL #'(SETF START) #:NEW1))))

内联 FLET

内联声明是一个请求（编译器可能会忽略它）用它的主体替换对函数的每个调用（参数被函数调用参数替换；它看起来像lambda-calculus 中的β-reduction）。

当编译器识别它时，就好像您将代码定义为宏，无需调用函数。当内联生效时，apply将在编译期间看到要调用的函数对象和所有参数，因此编译器可以发出代码，就像您直接编写所有参数一样。

让我们用 SBCL 测试一下，首先用一个notinline声明来明确地防止内联：

(disassemble
 (lambda ()
   (declare (optimize (debug 0) (safety 0)))
   (flet ((p (&rest args) (apply #'print args)))
     (declare (notinline p))
     (p 0) (p 1))))

反汇编程序的输出有点长，我不会声称我完全理解发生了什么；有一个显然分配内存的第一段（对于本地函数？）：

; disassembly for (LAMBDA ())
; Size: 187 bytes. Origin: #x53F0A5B6 (segment 1 of 2)        ; (LAMBDA ())
; 5B6:       49896D28         MOV [R13+40], RBP               ; thread.pseudo-atomic-bits
; 5BA:       4D8B5D68         MOV R11, [R13+104]              ; thread.alloc-region
; 5BE:       498D4B10         LEA RCX, [R11+16]
; 5C2:       493B4D70         CMP RCX, [R13+112]
; 5C6:       0F878C000000     JNBE L8
; 5CC:       49894D68         MOV [R13+104], RCX              ; thread.alloc-region
; 5D0: L0:   498D4B07         LEA RCX, [R11+7]
; 5D4:       49316D28         XOR [R13+40], RBP               ; thread.pseudo-atomic-bits
; 5D8:       7402             JEQ L1
; 5DA:       CC09             INT3 9                          ; pending interrupt trap
; 5DC: L1:   C7410117001050   MOV DWORD PTR [RCX+1], #x50100017  ; NIL
; 5E3:       488BDD           MOV RBX, RBP
; 5E6:       488D5424F0       LEA RDX, [RSP-16]
; 5EB:       4883EC10         SUB RSP, 16
; 5EF:       48891A           MOV [RDX], RBX
; 5F2:       488BEA           MOV RBP, RDX
; 5F5:       E82F000000       CALL L4
; 5FA:       49896D28         MOV [R13+40], RBP               ; thread.pseudo-atomic-bits
; 5FE:       4D8B5D68         MOV R11, [R13+104]              ; thread.alloc-region
; 602:       498D4B10         LEA RCX, [R11+16]
; 606:       493B4D70         CMP RCX, [R13+112]
; 60A:       775A             JNBE L9
; 60C:       49894D68         MOV [R13+104], RCX              ; thread.alloc-region
; 610: L2:   498D4B07         LEA RCX, [R11+7]
; 614:       49316D28         XOR [R13+40], RBP               ; thread.pseudo-atomic-bits
; 618:       7402             JEQ L3
; 61A:       CC09             INT3 9                          ; pending interrupt trap
; 61C: L3:   C641F902         MOV BYTE PTR [RCX-7], 2
; 620:       C7410117001050   MOV DWORD PTR [RCX+1], #x50100017  ; NIL
; 627:       EB03             JMP L5
; 629: L4:   8F4508           POP QWORD PTR [RBP+8]

...后面是第二段，看起来它实际上定义并调用了本地函数（？）：

; Origin #x53F0A62C (segment 2 of 2)                          ; (FLET P)
; 62C: L5:   488BF4           MOV RSI, RSP
; 62F: L6:   4881F917001050   CMP RCX, #x50100017             ; NIL
; 636:       7412             JEQ L7
; 638:       FF71F9           PUSH QWORD PTR [RCX-7]
; 63B:       488B4901         MOV RCX, [RCX+1]
; 63F:       8D41F9           LEA EAX, [RCX-7]
; 642:       A80F             TEST AL, 15
; 644:       74E9             JEQ L6
; 646:       CC0A             INT3 10                         ; cerror trap
; 648:       06               BYTE #X06                       ; BOGUS-ARG-TO-VALUES-LIST-ERROR
; 649:       04               BYTE #X04                       ; RCX
; 64A: L7:   488B053FFFFFFF   MOV RAX, [RIP-193]              ; #<FUNCTION PRINT>
; 651:       FF2425A8000052   JMP QWORD PTR [#x520000A8]      ; TAIL-CALL-VARIABLE
; 658: L8:   6A11             PUSH 17
; 65A:       FF142550000052   CALL QWORD PTR [#x52000050]     ; CONS->R11
; 661:       E96AFFFFFF       JMP L0
; 666: L9:   6A11             PUSH 17
; 668:       FF142550000052   CALL QWORD PTR [#x52000050]     ; CONS->R11
; 66F:       EB9F             JMP L2

反正和case的反汇编输出有很大区别inline：

(disassemble
 (lambda ()
   (declare (optimize (debug 0) (safety 0)))
   (flet ((p (&rest args) (apply #'print args)))
     (declare (inline p))
     (p 0) (p 1))))

这打印：

; disassembly for (LAMBDA ())
; Size: 45 bytes. Origin: #x540D3CF6                          ; (LAMBDA ())
; CF6:       4883EC10         SUB RSP, 16
; CFA:       31D2             XOR EDX, EDX
; CFC:       B902000000       MOV ECX, 2
; D01:       48892C24         MOV [RSP], RBP
; D05:       488BEC           MOV RBP, RSP
; D08:       B8C2283950       MOV EAX, #x503928C2             ; #<FDEFN PRINT>
; D0D:       FFD0             CALL RAX
; D0F:       BA02000000       MOV EDX, 2
; D14:       B902000000       MOV ECX, 2
; D19:       FF7508           PUSH QWORD PTR [RBP+8]
; D1C:       B8C2283950       MOV EAX, #x503928C2             ; #<FDEFN PRINT>
; D21:       FFE0             JMP RAX

上面的比较短，直接调用print。相当于手动内联的反汇编：

(disassemble (lambda ()
               (declare (optimize (debug 0) (safety 0)))
               (print 0) (print 1)))

; disassembly for (LAMBDA ())
; Size: 45 bytes. Origin: #x540D4066                          ; (LAMBDA ())
; 66:       4883EC10         SUB RSP, 16
; 6A:       31D2             XOR EDX, EDX
; 6C:       B902000000       MOV ECX, 2
; 71:       48892C24         MOV [RSP], RBP
; 75:       488BEC           MOV RBP, RSP
; 78:       B8C2283950       MOV EAX, #x503928C2              ; #<FDEFN PRINT>
; 7D:       FFD0             CALL RAX
; 7F:       BA02000000       MOV EDX, 2
; 84:       B902000000       MOV ECX, 2
; 89:       FF7508           PUSH QWORD PTR [RBP+8]
; 8C:       B8C2283950       MOV EAX, #x503928C2              ; #<FDEFN PRINT>
; 91:       FFE0             JMP RAX
于 2020-05-24T22:42:32.933 回答
0

虽然我没有详细关注这一点，但请注意，这setf不一定是问题。

考虑一下：

(defclass grunga-object ()
  ;; grunga objects have grungas, but they may be unbound
  ((grunga :accessor object-grunga :initarg :grunga)))

(defgeneric object-has-valid-grunga-p (o)
  ;; Does some object have a valid grunga?
  (:method (o)
   nil))

(defmethod object-has-valid-grunga-p ((o grunga-object))
  ;; grunga object's grungas are valid if they are bound
  (slot-boundp o 'grunga))


(defun grunga (object &optional (default 'grunga))
  ;; get the grunga of a thing
  (if (object-has-valid-grunga-p object)
      (object-grunga object)
    default))

(defun (setf grunga) (new object)
  ;; set the grunga of a thing
  (setf (object-grunga object) new))

现在这将正常工作：

(defun foo (o)
  (flet ((grunga (object)
           (grunga object 3)))
    (setf (grunga o) (grunga o))
    o))

并将(grunga (foo (make-instance 'grunga-object)))返回3。在这种情况下，本地grunga函数调用全局函数，而(setf grunga)直接调用不同的函数。

如果您想覆盖该(setf grunga)功能，您也可以这样做：

(defun bar (o &optional (exploded-value 'exploded))
  (flet ((grunga (object)
           (grunga object 3))
         ((setf grunga) (new object &optional (exploding t))
           (setf (grunga object) (if exploding (cons exploded-value new) new))))
    (setf (grunga o t) (grunga o))
    o))

而现在(grunga (bar (make-instance 'grunga-object) 'crunched))是(cruched . 3)。在这种情况下，两者grunga都是(setf grunga)局部函数，它们调用它们的全局函数。

请注意，对于setf由 定义的表单，这可能会更复杂define-setf-*：如果可以避免的话，我从不使用它们。

于 2020-05-26T09:28:53.987 回答