具有相同名称的 Common Lisp 本地影子函数
Common Lisp locally shadow function with same name
这个问题我不止一次遇到过。
一般问题
是否可以透明地本地隐藏一个函数 f 和它的同名 f 的包装器？
即，如何在本地将 (f wrapped-args...) 扩展为 (f args...)？
Flet 似乎允许我们这样做，但有局限性，即生成的包装器不可设置。不求助于 flet 是否可以这样做？
理想情况下会有一个宏让我们编写“包装”f 调用并将代码扩展为原始“非包装”f 调用。
起初我认为 macrolet 可能就是这样，因为它在文档中说它首先扩展宏，然后在扩展形式上应用 setf，但我无法使用它（继续阅读下文） .
动机
这在某些参数是隐式的且不应反复重复的上下文中很有用，以获得更多 DRY 代码。
在 中有一个特殊的例子。尝试“自动”分配函数的某些参数 (let-curry)。
flet 的注意事项
我在那里得到了一些很好的答案，但是，我遇到了一些限制。通过求助于 flet 来完成函数名称的这种局部“阴影”到它上面的包装器，这样的包装器是不可设置的，因此，这样的包装器不能像原始函数那样灵活地使用，只能读取值，不能写入.
具体问题
有了上面的link，如何编写宏 flet-curry 并使包装函数可设置？
奖励：该宏能否以 0 运行时开销将包装调用扩展为原始调用？
我尝试在 post 中选择答案并使用 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 ...)
到位，就好像我在源代码中写的是后一种形式而不是前一种形式。如果某些“宏”是这种情况，那么它可以通过设计进行设置。
宏似乎是解决此问题的正确工具，但我不知道如何。
再次感谢:)
P.S.：如果您需要访问完整代码，请访问此处：https://github.com/AlbertoEAF/cl-lox (scanner.lisp)
与 macrolet 的绑定并不简单，因为：
- 一旦在 macrolet 中绑定
f，如果它扩展为 (f ...)，您将拥有无限的宏扩展。
此外，您可以将 macrolet 扩展为 (apply #'f ...)（这很好，因为 APPLY 可以是 SETF 位置 1 )，但是你有错误，因为 #'f 绑定到本地宏，而不是原始函数。但是，如果您首先评估 #'f，将其绑定到一个隐藏变量，然后定义一个应用该变量值的宏，SETF APPLY 会抱怨（至少在 SBCL 中）该函数不能是一个符号（即。动态计算）。
1：例如(let ((x (list 0 1 2))) (prog1 x (setf (apply #'second list ()) 9)))
但是您不需要 macrolet，因为您可以在 FLET 中绑定 SETF 函数；如果你想在本地重新定义一些函数，你可以手动编写以下内容：
(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
以下宏扩展为可内联的 flet 并以特殊方式处理 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 演算中的 β-reduction）。
当编译器识别它时，就好像您将代码定义为 macrolet，无需调用函数。当内联生效时，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
反正和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
虽然我没有详细关注此内容，但请注意 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))) 将 return 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) 都是局部函数，调用它们的全局对应函数。
请注意，使用 define-setf-* 定义的 setf 形式可能会更复杂：如果可以避免的话，我从不使用它们。
这个问题我不止一次遇到过。
一般问题
是否可以透明地本地隐藏一个函数 f 和它的同名 f 的包装器？
即，如何在本地将 (f wrapped-args...) 扩展为 (f args...)？
Flet 似乎允许我们这样做，但有局限性，即生成的包装器不可设置。不求助于 flet 是否可以这样做？
理想情况下会有一个宏让我们编写“包装”f 调用并将代码扩展为原始“非包装”f 调用。
起初我认为 macrolet 可能就是这样，因为它在文档中说它首先扩展宏，然后在扩展形式上应用 setf，但我无法使用它（继续阅读下文） .
动机
这在某些参数是隐式的且不应反复重复的上下文中很有用，以获得更多 DRY 代码。
在
flet 的注意事项
我在那里得到了一些很好的答案，但是，我遇到了一些限制。通过求助于 flet 来完成函数名称的这种局部“阴影”到它上面的包装器，这样的包装器是不可设置的，因此，这样的包装器不能像原始函数那样灵活地使用，只能读取值，不能写入.
具体问题
有了上面的link，如何编写宏 flet-curry 并使包装函数可设置？
奖励：该宏能否以 0 运行时开销将包装调用扩展为原始调用？
我尝试在 post 中选择答案并使用 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 ...)
到位，就好像我在源代码中写的是后一种形式而不是前一种形式。如果某些“宏”是这种情况，那么它可以通过设计进行设置。
宏似乎是解决此问题的正确工具，但我不知道如何。
再次感谢:)
P.S.：如果您需要访问完整代码，请访问此处：https://github.com/AlbertoEAF/cl-lox (scanner.lisp)
与 macrolet 的绑定并不简单，因为：
- 一旦在 macrolet 中绑定
f，如果它扩展为(f ...)，您将拥有无限的宏扩展。 此外，您可以将 macrolet 扩展为
(apply #'f ...)（这很好，因为APPLY可以是 SETF 位置 1 )，但是你有错误，因为#'f绑定到本地宏，而不是原始函数。但是，如果您首先评估#'f，将其绑定到一个隐藏变量，然后定义一个应用该变量值的宏，SETF APPLY 会抱怨（至少在 SBCL 中）该函数不能是一个符号（即。动态计算）。1：例如
(let ((x (list 0 1 2))) (prog1 x (setf (apply #'second list ()) 9)))
但是您不需要 macrolet，因为您可以在 FLET 中绑定 SETF 函数；如果你想在本地重新定义一些函数，你可以手动编写以下内容：
(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
以下宏扩展为可内联的 flet 并以特殊方式处理 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 演算中的 β-reduction）。
当编译器识别它时，就好像您将代码定义为 macrolet，无需调用函数。当内联生效时，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
反正和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
虽然我没有详细关注此内容，但请注意 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))) 将 return 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) 都是局部函数，调用它们的全局对应函数。
请注意，使用 define-setf-* 定义的 setf 形式可能会更复杂：如果可以避免的话，我从不使用它们。