gyn

Win32下的Perl,无用的select,停滞的Tk,结束吧....

Tcl闭包

Tcl 中没有闭包,但是以字符串为基础的构建使得类似功能的实现并不是一件很困难的事情。在平时的 coding 中倒是经常为一些 Tcl 的规则所困扰。比如说,需要一个用过即丢弃的功能,由于 Tcl 并没有匿名函数一说,为此不得不建立一个命名函数,这个随无伤大雅但在代码的结构上看来却有点扎眼,很让人不爽。

我没有对闭包做深入的研究,所以对于类似闭包功能的使用,仅仅实现了以下的几个功能。第一,一个容易读懂的代码段;第二,具备上下文环境的信息;第三,可在运行时接收参数。

这里所谓容易懂的代码是指不用双引号包围的字符串,虽然使用双引号可以很方便地融入上下文环境中,但是由于转义和执行等情况的存在,不仅不易于编写而且更不容易读明白,因此最好还是用花括号来包围。

第二个问题比较麻烦。对于在花括号中定义的字符串,一般可以使用 subst 来做一些替换工作,但事实上 subst 除了提供延时替换以及 nobackslashes nocommand 控制特征之外,与双引号没有本质上的区别,有些时候甚至不如双引号方便。而即使是用双引号包围了的代码段,依然可能在不经意间造成错误。假设有以下一个程序:

set a jack

set code “ set a mike; puts $a “

在全局环境中,定义了一个值为 jack 的变量 a ;接着,又定义了一个名为 code 的字符串,其中也定义了变量 a ,但是由于存在转义,事实上这个 code 变成了:

set a mike; puts jack

也就是说,如果用 code 来实现闭包的功能,那么将无法在定义与全局中同名的变量。这显然不是很方便,当在类闭包中定义了一个变量的时候,它的作用域应该是属于当前的,而与外层的环境无关,只有没有显式定义的参数我们才需要将其置换为上下文环境中定义的值。

到这里就涉及到一个如何引入上下文环境的问题了,一种就像上面所写的,直接进行变量替换,但是这样做存在副作用;另一种办法是,添加参数定义,即搜索类闭包中的参数,之后在类闭包的开始处添加使用上下文环境的值的定义。还是上面那个例子,使用这个办法, code 将变为:

set a jack

set a mike; puts $a

倘若 code 中没有 a 的显式定义,则是:

set a jack

puts $a

由于添加的定义永远先于类闭包中代码段的内容,所以无论是否定义同名参数,都不会影响到实际的执行效果。这是一种本地优先的规则,类闭包中没有定义的变量将使用全局替换,而定义了的变量,即使是上下文环境同名变量,依然会使用类闭包中定义的值。

显然作为后一种方法,是恰好能满足我们需要的,不过也面临一个问题,即找出在类比包中的变量名。我用了一个正则判断来得到所有的变量,之后进行筛选以剔除重复并使用 info 函数来验证的确存在该变量。

set unique_vars {}

foreach w [regexp -all -inline {\$[:\w]+} $code] {

foreach u $unique_vars {

if {$u == $w} { continue }

}

lappend unique_vars $w

}

 

set buf {}

foreach w $unique_vars {

    set w [string trimleft $w \$]

    if [uplevel 1 info exists $w] {

        upvar 1 $w var

        set buf "$buf set $w $var;"   

    }

}

最终得到的 buf 将被放置在 code 之前,实现上下文环境对类比包的作用。

第三问题说明,这个类闭包可以接收传入参数,比如一个类闭包被赋值给名为 lambda 的变量,那么它支持形如 ”yield lambda $var” 形式的调用。至于支持传入几个参数,就像 proc 一样,在定义类闭包的时候需要显式说明。

参数传入的实现,在原理上与第二个问题的解决办法类似,但这里的关键在于在与生成的类闭包对象。事实上,该对象包含了两个部分,分别是传入参数的定义和代码段。当执行类闭包的时候,传入的值将和定义的参数结合,被放置于 code 的前端。

最后为了方便使用,我将创建和运行类闭包的命令 fenbie 定义为“ @ ”和“ ~ ”。以下是一个例子:

 

if 1 {

    set name1 jack

    set name2 mike

   

    set lamb [ @ {{id 1}} {

        if {$id == {}} {

            puts {nothing to puts}

            return

        }

        while {$id > 0} {

            puts "hello, $name1 and $name2"    

            incr id -1

        }

    } ]

   

    ~ $lamb

    puts {}

    foreach id {1 2 3} {

        puts "$id time(s):"

        ~ $lamb $id

        puts {}

    }

}

closure包下载

posted on 2010-03-15 20:26 gyn_tadao 阅读(648) 评论(0)  编辑 收藏 引用 所属分类: TclTk

只有注册用户登录后才能发表评论。
<2010年3月>
28123456
78910111213
14151617181920
21222324252627
28293031123
45678910

导航

统计

常用链接

留言簿(15)

随笔分类(126)

随笔档案(108)

相册

搜索

最新评论

阅读排行榜

评论排行榜