tcl：包装一个同名的proc

Posted 2023-02-23

【中文标题】tcl：包装一个同名的proc

【英文标题】：tcl: wrap a proc of the same name

【发布时间】：2011-09-01 03:59:57

【问题描述】：

我想将“proc N”的定义替换为具有相同名称和调用约定的 proc，但需要添加一些额外的错误检测代码。

在 python 中，我可以像下面那样做我想做的事，但我不了解命名空间和函数句柄在 tcl 中是如何工作的。

__orig_N = N
def N(arg1, arg2):
    if arg1 != 'GOOD VALUE':
        exit('arg1 is bad')
    return __orig_N(arg1, arg2)

【参考方案1】：

您可以使用rename 命令重命名现有的proc：

rename N __orig_N
proc N arg1 arg2 
    if  $arg1 != "GOOD_VALUE"  
        puts stderr "arg1 is bad"
        exit 1
    
    return [uplevel 1 __orig_N $arg1 $arg2]

这实际上比 python 原版更复杂一点，因为使用uplevel 有效地从调用堆栈中完全删除了包装器——诚然，在你的情况下这可能不是必需的，但很高兴能够做到。

【讨论】：

+1: error "arg1 is bad" 可能是更直接的翻译，而不是单独的puts 和exit 命令。

@glenn：也许，虽然 [error] 可以被捕获，而 Python 退出命令 afaik 无条件退出解释器，所以语义有点不同。

+1：一些注意事项：8.6 有tailcall，它允许您将最后一行重写为tailcall __orig_N $arg1 $arg2，以便从调用堆栈中获得更完整的省略，这非常重要 不跨命名空间边界重命名过程或解析范围更改。 （男孩，我是否讨厌那个特别的错误！）

@Eric：python exit() 引发了 SystemExit 异常，可以被捕获。

@Donal：我无法想象“跨命名空间边界重命名过程”意味着什么。你能扩展一下吗？

【参考方案2】：

Tcl 对程序有很好的内省。这使您可以重写一个过程以添加更多代码：

# Assume there are no defaults; defaults make this more complicated...
proc N [info args N] [concat 
    # Use 'ne' for string comparison, '!=' for numeric comparison
    if $arg1 ne "GOOD VALUE" 
        error "arg1 is bad"
        # The semicolon is _important_ because of the odd semantics of [concat]
    ;
 [info body N]]

好的，这不是唯一的方法 - Eric 的答案更接近于我通常如何包装命令，并且它还具有使用非过程命令的优势 - 但这种解决方案的优势在于将代码绑定得很好，很紧密，这样以后就不会出错了。它也不会在任何错误跟踪中引入额外的堆栈帧，这有助于保持调试简单。

【讨论】：

Eric 的回答中关于 Tcl 的 error 与 Python 的 exit 的注释也适用于此，但应该注意的是，在 Tcl 中使用 error（或 return -code error）是惯用的而让代码吹走这个过程并不是因为不是非常友好。

在您的第二个“它具有优势”中，不清楚您是在谈论 Eric 的答案还是您自己的答案。

您的方法的一个缺点是它会使您暴露在新注入代码的原始过程中的“污染”中。例如，如果“包装器”中的内容创建了新变量，那么这些变量将对原始代码可见，这可能导致意外行为和非常棘手的错误。我的方法可以保护您免受这种风险。

@Eric：对于一个直接的论据检查——提问者所要求的——污染不太可能成为问题。对于更实质性的处理，情况会有所不同。也有几种方法可以处理它（例如，apply 命令可以限制临时对象的范围），每种方法都有自己的特定权衡。当然，这样的问题也出现在其他语言中，例如，AspectJ 有可能使 Java 变得非常惊人晦涩难懂。

@bukzor：澄清，并解释了这个版本的另一个优点。