Alb*_*rto 2 macros common-lisp lisp-macros
我以前不止一次有过这个问题。
是否可以使用具有相同名称的包装器在本地ff透明地隐藏函数？
即，如何在本地将 (f 包裹的参数...) 扩展为 (f args...)？
Flet 似乎允许我们这样做，但有局限性，即生成的包装器不可设置。是否有可能在不诉诸舰队的情况下这样做？
理想情况下，会有一个宏让我们编写“包装”f调用，并将代码扩展为原始的“非包装”f调用。
起初我相信macrolet可能是这样，因为它在文档中说它首先扩展宏然后在扩展形式上应用setf，但我无法使用它（继续阅读下面）。
这在某些参数是隐式的并且不应一遍又一遍地重复以获取更多 DRY 代码的上下文中很有用。
在我之前的问题 (let-curry) 中有一个特定的例子。试图“自动”分配函数的一些参数（let-curry）。
我在那里得到了一些很好的答案，但是，我遇到了一些限制。通过使用 flet 来完成函数名称的这种局部“阴影”到其上的包装器，此类包装器不可设置，因此，此类包装器不能像原始函数一样灵活使用，只能读取值，而不是写入.
通过上面的链接，如何编写宏 flet-curry 并使包装函数可设置？
奖励：该宏能否以 0 运行时开销将包装的调用扩展到原始调用？
我尝试在该帖子中选择答案并使用 macrolet 而不是 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转换该块中柯里化函数的任何调用
(f arg1 arg2 ...)
到(f scanner arg1 arg2 ...)就位，好像我在源代码中编写了后一种形式而不是前者。如果某些“宏”是这种情况，那么它可以通过设计设置。
似乎宏将是正确的工具，但我不知道如何。
再次感谢 ：）
PS：如果您需要访问完整代码，请访问：https : //github.com/AlbertoEAF/cl-lox (scanner.lisp)
绑定 withmacrolet并非易事，因为：
f了一个宏，如果它扩展为(f ...)，你将拥有无限的宏扩展。此外，您可以将 macrolet 扩展为(apply #'f ...)（这很好，因为APPLY可以是 SETF place 1），但是您会遇到错误，因为#'f它绑定到本地宏，而不是原始函数。但是，如果您首先评估#'f，将其绑定到一个隐藏变量，然后定义一个应用该变量值的宏，SETF APPLY 会抱怨（至少在 SBCL 中）该函数不能是一个符号（即动态计算）。
1：例如(let ((x (list 0 1 2))) (prog1 x (setf (apply #'second list ()) 9)))
但是你不需要macrolet，因为你可以绑定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))))))
以下宏扩展为可内联 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))))
内联声明是一个请求（编译器可能会忽略它）用函数体替换对函数的每个调用（参数被函数调用参数替换；它看起来像lambda 演算中的?-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
反正和inlinecase的反汇编输出有很大的不同：
(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