Rebol 编程/高级/绑定学
作者：Ladislav Mecir
我要感谢那些以某种方式影响了这篇文章的人。特别是 Galt Barber、Brian D.、Mark Dickson、Elan Goldman、Brian Hawley、Gregg Irwin、Thomas Jensen、Pierre Johnson、Holger Kruse、Volker Nitsch、Larry Palmiter、Patrick Philipot、Gabriele Santilli、Carl Sassenrath、Frank Sievertsen 和 Romano Paolo Tenca。任何错误都是我的版权。
本文中的代码在 Rebol/View 2.7.6.3.1 中测试过。其他版本的解释器可能产生不同的结果。
想要检查所有示例的读者可以运行这段代码
do http://www.rebol.org/download-a-script.r?script-name=contexts.r
，它定义了本文中的所有函数。
Rebol 词语像所有 Rebol 值一样具有类型。让我们看看所有可用的词语类型
type? first [rebol] ; == word! type? first [rebol:] ; == set-word! type? first [:rebol] ; == get-word! type? first ['rebol] ; == lit-word! type? first [/rebol] ; == refinement!
此外，所有 Rebol 词语都有一个通用的伪类型 ANY-WORD!
any-word? first [rebol] ; == true any-word? first [rebol:] ; == true any-word? first [:rebol] ; == true any-word? first ['rebol] ; == true any-word? first [/rebol] ; == true
每个词语都有一个拼写。词语的拼写是一个字符串，它是上面示例词语共有的属性之一。我们可以使用 TO-STRING 函数获取词语的拼写
to-string first [rebol] ; == "rebol" to-string first [rebol:] ; == "rebol" to-string first [:rebol] ; == "rebol" to-string first ['rebol] ; == "rebol" to-string first [/rebol] ; == "rebol"
观察（不寻常的拼写）：词语通常不会有一些拼写，例如包含空格的拼写、以冒号开头的拼写等。另一方面，可以创建具有任何拼写的词语，如下所示
unusual: make word! ":unusual word:" type? unusual ; == word! to-string unusual ; == ":unusual word:"
观察（拼写和词语相等）：拼写完全相同的词语是相等的。
说明
equal? first [rebol] first [rebol:] ; == true
反向蕴涵不成立（因为 Rebol 支持别名）。然而，我们至少可以以某种方式反转蕴涵。
观察（SAME? 和拼写）：如果两个词语根据 SAME? 函数相同，那么它们具有完全相同的拼写。
词语的一个非常重要的属性是能够充当变量（引用 Rebol 值）。要设置一个变量 'rebolution 来引用 Rebol 字符串 "uprising"，我们可以选择以下之一
rebolution: "uprising" set 'rebolution "uprising" set/any 'rebolution "uprising" set first [rebolution:] "uprising"
等等。
要获取变量引用的值，我们可以选择以下之一
:rebolution get 'rebolution get/any 'rebolution
等等。
观察（变量）：词语充当变量的能力与一个称为绑定的词语属性密切相关。词语是变量当且仅当它被绑定到一个上下文（具有上下文，在上下文之中）。
说明
; a refinement get/any /rebol ** Script Error: rebol word has no context ** Near: get/any /rebol
找出词语是否是变量的最简单方法是使用 BIND? 函数的属性，该函数对于不是变量的词语返回 NONE
variable?: func [
{is the given WORD a variable?}
word [any-word!]
] [
found? bind? :word
]
测试
variable? 'rebol ; == true variable? /rebol ; == false
观察（上下文唯一性）：正如 BIND? 函数帮助我们发现的那样，对于每个 Rebol 词语，最多存在一个该词语被绑定到的上下文。
推论（上下文层次结构）：从上面的观察结果可以得出，在 Rebol 中不存在上下文层次结构，因为上下文层次结构需要某个词语被绑定到至少两个不同的上下文，其中一个比另一个“更小”。
观察（词语相同）：根据 SAME? 函数，两个词语相同当且仅当它们具有完全相同的拼写和相同的绑定。
观察（BIND? 函数的结果）：当使用 BIND? 函数获取对象中词语的上下文时，BIND? 函数的结果“不被认为与”对象相同。
说明
o: make object! [a: none] o-context: bind? in o 'a same? o o-context ; == false
观察（相等的词语不一定具有相同的绑定）：实际上，情况恰恰相反。对于任何词语，我们都可以创建一个具有完全相同的拼写、相同的类型和不同的绑定的词语。
different-binding: func [
{
for a given WORD yield a word having
strict equal spelling, equal type and different binding
}
word [any-word!] {the given word}
] [
bind :word use reduce [to word! :word] reduce [to lit-word! :word]
]
让我们测试一下该函数是否按我们声明的那样工作
word1: 'a ; == a word2: different-binding word1 ; == a strict-equal? to-string word1 to-string word2 ; == true equal? type? word1 type? word2 ; == true equal? bind? word1 bind? word2 ; == false set word1 1 set word2 2 get word1 ; == 1 get word2 ; == 2
测试表明 WORD1 和 WORD2 具有完全相同的拼写和相同的类型。它们的绑定不同。它们可以同时引用不同的值，因此它们是不同的变量。另一个测试
word1: /a ; == /a word2: different-binding word1 ; == /a same? word1 word2 ; == false equal? bind? word1 bind? word2 ; == false
当我们需要获得一个词语，该词语具有给定 WORDS 词语的拼写和类型，以及给定 KNOWN-WORD 的上下文时，我们可以使用 BIND 函数。
BIND 函数的工作原理如下
观察（绑定到无上下文）：如果 KNOWN-WORD 没有上下文，BIND 会引发错误。
说明
a-word: second first context [rebol: 1] ; == rebol bind? a-word ; == none bind 'a a-word ** Script Error: rebol word has no context ** Near: bind 'a a-word
观察（有效绑定）：如果可能，BIND 函数将产生一个词语，该词语具有 WORDS 参数的拼写和类型，以及 KNOWN-WORD 参数的上下文。
说明
words: 'a ; == a known-word: use [a b] ['b] ; == b result: bind words known-word ; == a equal? bind? known-word bind? result ; == true same? words known-word ; == false
我们观察到，结果具有 WORDS 词语的拼写和类型，但它不是 WORDS 词语，因为它被绑定到与 KNOWN-WORD 相同的上下文。
观察（相等的词语和有效绑定）：如果 WORD1 是一个具有上下文 CONTEXT 的变量，而 WORD2 等于 WORD1，那么 WORD2 也可以被绑定到 CONTEXT。
观察（无效绑定）：如果 BIND 函数无法产生一个词语，该词语具有 WORDS 参数的拼写和类型，以及 KNOWN-WORD 参数的绑定，那么 BIND 将返回 WORDS 参数。
words: 'c ; == c known-word: use [a b] ['b] ; == b result: bind words known-word ; == c same? words result ; == true
在这种情况下，BIND 只是返回了 WORDS 词语。
观察（不复制的绑定块）：如果没有使用 /COPY 修饰，BIND 会用绑定结果替换块中的元素。此规则有一个例外：BIND 不会绑定块中包含的修饰。
定义（别名）：我们称拼写不完全相同的等效词为别名。
这是我们翻译成 Rebol 的定义
aliases?: func [
{find out, if WORD1 and WORD2 are aliases}
word1 [any-word!]
word2 [any-word!]
] [
found? all [
equal? :word1 :word2
strict-not-equal? to-string :word1 to-string :word2
]
]
推论（词语相等）：当且仅当以下条件之一成立时，两个词语相等
- 词语的拼写完全相同
- 词语是别名
推论（别名和 SAME？）：当比较两个别名时，SAME？函数返回 FALSE。
证明：参见 (SAME？和拼写) 观察和我们对别名的定义。
观察（自动别名）：由于 Rebol 试图做到不区分大小写，解释器通常（除了不一致的情况）“认为”拼写仅在大小写方面不同的词语是别名。
观察（ALIAS）：可以使用 ALIAS 函数显式定义别名。
; let's create an alias 'revolutionary for the word 'rebol alias 'rebol "revolutionary" ; 'rebol and 'revolutionary will be equal words with different spelling: equal? 'rebol 'revolutionary ; == true strict-equal? to-string 'rebol to-string 'revolutionary ; == false aliases? 'rebol 'mean ; == false aliases? 'rebol 'rebol ; == false aliases? 'rebol 'revolutionary ; == true aliases? 'system 'SYSTEM ; == true
观察（ALIAS 返回值）：ALIAS 函数返回未绑定的词语。
y: alias 'x "xx" ; == xx bind? y ; == none
观察（变量一致性）：当且仅当两个词语相等且它们的绑定也相等时，它们才是一个变量。
same-variable?: func [
{are WORD1 and WORD2 the same variable?}
word1 [any-word!]
word2 [any-word!]
] [
found? all [
equal? :word1 :word2
equal? bind? :word1 bind? :word2
]
]
观察（ALIASES？的备选定义）：根据我们的先前观察，此定义等效于我们最初的定义
aliases?: func [
{find out, if WORD1 and WORD2 are aliases}
word1 [any-word!]
word2 [any-word!]
/local context
] [
found? all [
equal? :word1 :word2
(
if context: any [bind? :word1 bind? :word2] [
word1: in context :word1
word2: in context :word2
]
; WORD1 and WORD2 have equal binding now
not same? :word1 :word2
)
]
]
备选定义看起来更复杂，但由于它不需要操作字符串，因此它更快。
BIND？函数允许我们找到给定词语的上下文。相反的任务是找到所有在给定 CONTEXT 上下文中的词语。它可以按照以下步骤完成
context-words?: func [
{get the words in a given CONTEXT}
context [object!]
] [
bind first context context
]
观察（简化的上下文词语集）：作为 first context 表达式的结果获得的块是简化的上下文词语集。与上述函数的结果相反，它包含未绑定的词语。此外，与上述函数的结果类似，它不包含其词语的别名，并且只包含 WORD！数据类型的词语。
说明
alias 'rebol "rebellious" o: make object! [rebellious: 1] first o ; == [self rebellious] bind? first first o ; == none in o 'rebol ; == rebol
定义（全局上下文）：全局上下文可以定义为
global-context: bind? 'system
注意：这不是唯一的选项，另一个选项是将其定义为 SYSTEM/WORDS 对象。以上定义为我们提供了全局词语的最简单定义。
定义（全局词语/全局变量）：绑定到全局上下文的词语我们称之为全局词语（全局变量）
global?: func [
{find out if a WORD is global}
word [any-word! object!]
] [
same? global-context bind? :word
]
观察（MAKE、TO、LOAD、BIND 和全局上下文）：由 MAKE WORD！、MAKE SET-WORD！、MAKE GET-WORD！、MAKE LIT-WORD！、MAKE REFINEMENT！、TO WORD！、TO SET-WORD！、TO GET-WORD！、TO LIT-WORD！、TO REFINEMENT！、LOAD 和 BIND WORD 'SYSTEM 创建的词语是全局的。
说明
global? make word! first first rebol/words ; == true global? to word! first first rebol/words ; == true
观察（自动增长）：可以使用 MAKE、TO、LOAD 和 BIND 函数扩展全局上下文。另一方面，IN 函数不会扩展全局上下文。
观察（MAKE、TO 和未绑定的词语）：如果 SPEC 参数是字符串，则 MAKE BLOCK！、TO BLOCK！及其子块的结果块中包含的所有词语都是未绑定的。
说明
bind? first make block! "unbound" ; == none bind? first first first make block! "[[unbound-too]]" ; == none
定义（局部词语/局部变量）：我们称既不是未绑定也不是全局的词语为局部词语（局部变量）
local?: func [
{find out, if a WORD is local}
word [any-word!]
] [
not any [
none? bind? :word
global? :word
]
]
定义（局部上下文）：如果一个上下文的词语是局部词语，则称该上下文为局部上下文。
观察（局部上下文类型）：用户定义的对象、函数上下文和 USE 上下文是局部上下文。除了这些，我们还可以使用 BIND？函数将用户定义的对象和端口“转换为”上下文，并使用 DISARM 函数将错误转换为对象。所有结果都是局部上下文。函数和 USE 上下文与所有其他上下文类型之间的主要区别在于，函数和 USE 上下文不需要包含等于词语 'self 的词语。
观察（扩展局部上下文）：局部上下文不可扩展。
观察（DIFFERENT-BINDING 函数的结果）：DIFFERENT-BINDING 函数的结果（如我们上面定义的）始终是局部词语。
让我们观察一下 Rebol 解释器在评估示例代码字符串时的行为
code-string: {'f 'g 'h use [g h] [colorize "USE 1" 'f 'g 'h use [h] [colorize "USE 2" 'f 'g 'h]]}
COLORIZE 函数将代码列表着色如下
- 未绑定的词语将为 棕色
- 全局词语将为 蓝色
- 由第一个 USE 评估绑定的词语将为 红色
- 由第二个 USE 评估绑定的词语将为 洋红色
emit: func [text [char! string! block!]] [
append result either block? text [rejoin text] [text]
]
colorize: func [
{emit a table row containing text and the colorized code block}
text [string!]
/local space?
] [
emit ["^/|-^/| " text "^/| "]
space?: ""
parse code-block rule: [
(
emit [space? #"["]
space?: ""
)
any [
[
set word any-word! (
emit [
space?
{<font color="}
case [
not bind? :word ["brown"]
global? :word ["blue"]
equal? bind? :word bind? code-block/6/4 ["red"]
equal? bind? :word bind? code-block/6/8/5 [
"magenta"
]
]
{">}
mold :word
</font>
]
) | into rule | set word skip (
emit [space? mold :word]
)
]
(space?: " ")
]
]
]
让我们观察代码是如何被解释的
; the result will be a wikitable
result: {^{| class="wikitable" border="1"
|-
! Text
! Code}
; first, the interpreter creates a code block
code-block: make block! code-string
colorize "String to block conversion"
; next, the code block is bound to the global context
bind code-block global-context
colorize "Code block bound to the global context"
; and then the code block is interpreted
do code-block
; now we close the table
emit "^/|}^/"
write clipboard:// result
结果（从剪贴板粘贴到这里）是
| 文本 | 代码 |
|---|---|
| 字符串到块的转换 | ['f 'g 'h use [g h] [colorize "USE 1" 'f 'g 'h use [h] [colorize "USE 2" 'f 'g 'h]]] |
| 绑定到全局上下文的代码块 | ['f 'g 'h use [g h] [colorize "USE 1" 'f 'g 'h use [h] [colorize "USE 2" 'f 'g 'h]]] |
| USE 1 | ['f 'g 'h use [g h] [colorize "USE 1" 'f 'g 'h use [h] [colorize "USE 2" 'f 'g 'h]]] |
| USE 2 | ['f 'g 'h use [g h] [colorize "USE 1" 'f 'g 'h use [h] [colorize "USE 2" 'f 'g 'h]]] |
结果证明
- 在字符串到块转换之后，CODE-BLOCK 中的所有词语都是未绑定的
- 在 CODE-BLOCK 绑定到全局上下文之后，CODE-BLOCK 中的所有词语都是全局的
- 第一个 USE 调用用局部 USE 1 词语替换了其主体块及其子块中的所有 'g 和 'h 词语
- 第二个 USE 调用用局部 USE 2 词语替换了最内层块中的 'h
观察（计算绑定）：在解释过程中，代码中包含的 Rebol 词语的绑定被改变（即词语被替换为具有不同绑定的词语），直到它们被正确绑定并评估。这就是为什么 Rebol 的创建者将这种行为称为“计算绑定”。
看起来我们在执行上面的 Rebol 代码时观察到一个“范围层次结构”。正如我们所演示的那样，这仅仅是计算绑定的副作用。
借助计算绑定，我们可以轻松创建不显示任何“范围”属性的代码示例
; create a block CODE-BLK containing a word 'a code-blk: copy [a] a: 12 ; now append another word 'a to CODE-BLK make object! [append code-blk 'a a: 13] code-blk ; == [a a] ; test if CODE-BLK contains equal words equal? first code-blk second code-blk ; == true ; prove that the CODE-BLK is not a "scope" equal? bind? first code-blk bind? second code-blk ; == false
CODE-BLK 示例表明，对于代码块来说，在 Rebol 中没有“当前上下文”这样的东西，因为在 Rebol 中只有单个词语与上下文相关联。
为了尽可能精确，我们将用 Rebol 编写 USE 函数行为的描述。
以下函数创建一个新上下文，其中所有单词都未设置
make-context-model: func [
{context creation simulation}
words [block!] {context words, needs to be non-empty}
] [
bind? first use words reduce [reduce [first words]]
]
USE 的描述
use-model: function [
{USE simulation, works for non-empty WORDS block}
[throw]
words [block!] "Local word(s) to the block"
body [block!] "Block to evaluate"
] [new-context] [
unless empty? words [
; create a new context
new-context: make-context-model words
; bind the body to the new Context
bind body new-context
]
do body
]
观察 (USE-MODEL 和 BODY): USE-MODEL 在将 BODY 参数绑定到新上下文时会修改它的 BODY 参数。如果我们想让 BODY 参数保持不变，我们应该使用 BIND/COPY 而不是当前的 BIND。
让我们比较 USE-MODEL 的行为和 USE 的行为
body: ['a] body-copy: copy body same? first body first body-copy ; == true use [a] body same? first body first body-copy ; == false
正如我们所确定的，USE-MODEL 和原始 USE 都是一样的。模拟非常准确，它帮助我们发现以下代码中的一个错误
f: func [x] [
use [a] [
either x = 1 [
a: "OK"
f 2
a
] [
a: "BUG!"
"OK"
]
]
]
f 1 ; == "BUG!"
解释/修正
观察到的 USE 属性导致函数 F 的主体在第二次 USE 执行期间被修改。修改之后，它不再包含在第一次调用 F 期间设置为“OK”的单词“a”。相反，它只包含在第二次调用 F 期间设置为“BUG!”值的单词“a”。
如果我们以某种方式保留 F 的主体，我们可以获得正确的行为
f: func [x] [
use [a] copy/deep [
either x = 1 [
a: "OK"
f 2
a
] [
a: "BUG!"
"OK"
]
]
]
f 1 ; == "OK"
另一种修正行为的方法是使用我们自己的 USE 版本，它不会修改它的主体参数
nm-use: func [
{
Defines words local to a block.
Does't modify the BODY argument.
}
[throw]
words [block!] {Local words to the block}
body [block!] {Block to evaluate}
] [
use words copy/deep body
]
我们需要一个函数来评估 SPEC 参数，就像 MAKE OBJECT! 一样，这意味着它必须捕获 RETURN、THROW 和 BREAK
spec-eval: func [
{evaluate the SPEC like MAKE OBJECT! does}
spec [block!]
] [
any-type? catch [loop 1 spec]
]
MAKE OBJECT! 模拟
make-object!-model: function [
{MAKE OBJECT! simulation}
spec [block!]
] [set-words object sw] [
; find all set-words in SPEC
set-words: copy [self]
parse spec [
any [
copy sw set-word! (append set-words sw)
|
skip
]
]
; create a context with the desired local words
object: make-context-model set-words
; set 'self in object to refer to the object
object/self: object
; bind the SPEC to the blank object
bind spec in object 'self
; evaluate it
spec-eval spec
; return the value of 'self as the result
return get/any in object 'self
]
观察 (MAKE-OBJECT!-MODEL 和 SPEC): MAKE-OBJECT!-MODEL 在将 SPEC 参数绑定到新上下文时会修改它的 SPEC 参数。如果我们想让 SPEC 参数保持不变，我们应该使用 BIND/COPY 而不是当前的 BIND。
描述的行为导致了类似于 USE 部分中描述的错误
f: func [x] [
get in make-object!-model [
a: "OK"
if x = 1 [
a: "BUG!"
f 2
a: "OK"
]
] 'a
]
f 1 ; == "BUG!"
解释和修正与 USE 函数类似。在递归调用 F 后位置的 a: “OK” 行中绑定到首先创建的对象 F 的单词 a: 被绑定到递归调用期间创建的对象 F 的单词 a: 替换。因此，表达式 a: “OK” 对首先创建的对象 F 没有影响，因此它保留了 'a 的最后一个值，即“BUG!”。如果我们保留 F 的主体，我们可以获得正确的行为
f: func [x] [
get in make object! copy/deep [
a: "OK"
if x = 1 [
a: "BUG!"
f 2
a: "OK"
]
] 'a
]
f 1 ; == "OK"
如您所见，上面的代码在将 BODY 块绑定到上下文之前深度复制了它。当 FUNC 函数创建 Rebol 函数时，如果未使用深度复制，就会发现类似的错误。
这是 MAKE 函数获取要创建的对象的原型的场景的模拟。首先，我们需要一个特殊的 BIND 类函数
specbind: function [
{bind only known-words}
block [block!]
known-words [block!]
] [p w bind-one kw] [
bind-one: [
p:
[
copy w any-word! (
if kw: find known-words first w [
change p bind w first kw
]
) | copy w [path! | set-path! | lit-path!] (
if kw: find known-words first first w [
change p bind w first kw
]
) | into [any bind-one] | skip
]
]
parse block [any bind-one]
block
]
以下是模拟
make-proto: function [
{MAKE PROTO simulation}
proto [object!]
spec [block!]
] [set-words object sw word value spc body pwords] [
; get local words from proto
set-words: copy first proto
; append all set-words from SPEC
parse spec [
any [
copy sw set-word! (append set-words sw) |
skip
]
]
; create a blank object with the desired local words
object: make-context-model set-words
object/self: object
; copy the contents of the proto
pwords: bind first proto object
repeat i (length? first proto) - 1 [
word: pick next first proto i
any-type? set/any 'value pick next second proto i
any [
all [string? get/any 'value set in object word copy value]
all [
block? get/any 'value
value: specbind copy/deep value pwords
set in object word value
]
all [
function? get/any 'value
spc: load mold third :value
body: specbind copy/deep second :value pwords
set in object word func spc body
]
any-type? set/any in object word get/any 'value
]
]
bind spec object
spec-eval spec
return get/any in object 'self
]
在我们尝试模拟函数评估之前，我们可以问一下我们是否可以使用与 CONTEXT 函数相同的方法来处理局部单词。
答案是肯定的，能够做到这一点的函数定义如下。
首先是一个函数，可以从函数的 SPEC 中提取所有局部单词
locals?: func [
{Get all locals from a spec block.}
spec [block!]
/args {get only arguments}
/local locals item item-rule
] [
locals: make block! 16
item-rule: either args [[
refinement! to end (item-rule: [end skip]) |
set item any-word! (insert tail locals to word! :item) | skip
]] [[
set item any-word! (insert tail locals to word! :item) | skip
]]
parse spec [any item-rule]
locals
]
set-words: func [
{Get all set-words from a block}
block [block!]
/deep {also search in subblocks/parens}
/local elem words rule here
] [
words: make block! length? block
rule: either deep [[
any [
set elem set-word! (
insert tail words to word! :elem
) | here: [block! | paren!] :here into rule | skip
]
]] [[
any [
set elem set-word! (
insert tail words to word! :elem
) | skip
]
]]
parse block rule
words
]
funcs: func [
{Define a function with auto local and static variables.}
[throw]
spec [block!] {Help string (opt) followed by arg words with opt type and string}
init [block!] {Set-words become static variables, shallow scan}
body [block!] {Set-words become local variables, deep scan}
/local svars lvars
] [
; Preserve the original Spec, Init and Body
spec: copy spec
init: copy/deep init
body: copy/deep body
; Collect static and local variables
svars: set-words init
lvars: set-words/deep body
unless empty? svars [
; create the static context and bind Init and Body to it
use svars reduce [reduce [init body]]
]
unless empty? lvars: exclude exclude lvars locals? spec svars [
; declare local variables
insert any [find spec /local insert tail spec /local] lvars
]
do init
make function! spec body
]
我们的 Rebol 函数模型将是一个 Rebol 对象 FUNCTION!-MODEL，它具有适当的属性。Rebol 函数的完全必要属性是 SPEC 和 BODY。
为了准确地模拟 Rebol 函数的当前行为，我们的 FUNCTION!-MODEL 需要 CONTEXT、CONTEXT-WORDS 和 RECURSION-LEVEL 属性来模拟 Rebol 函数在递归调用期间的行为
function!-model: make object! [
spec: none
body: none
context: none
context-words: none
recursion-level: none
]
该函数获取 SPEC 和 BODY 属性，创建一个新的 FUNCTION!-MODEL 并初始化它。
func-model: function [
{create a function!-model}
spec [block!]
body [block!]
] [result aw] [
result: make function!-model []
; SPEC and BODY are deep copied
result/spec: copy/deep spec
result/body: copy/deep body
result
]
解释器启动时调用栈为空。
call-stack-model: make block! []
我们的模拟从收集函数参数的值并检查它们的类型开始。
评估函数获取一个 FUNCTION!-MODEL 以及它应该存储到其局部上下文单词（即其所有参数、可选参数、细化和局部单词的值）的值块。
我们只模拟没有 THROW/CATCH 属性的函数最常见的情况。
我们模型的第一部分执行主体
exec: func [body] [do body]
模拟
evaluate-model: function [
{evaluate a function!-model}
f-model {the evaluated function!-model}
values [block!] {the supplied values}
] [old-values result] [
; detect recursive call
if (f-model/recursion-level: f-model/recursion-level + 1) > 1 [
; push the old values of context words to the stack
insert/only tail call-stack-model second f-model/context
]
set/any f-model/context-words values
; execute the function body
error? set/any 'result exec f-model/body
; restore the former values from the stack, if needed
if (f-model/recursion-level: f-model/recursion-level - 1) > 0 [
; pop the old values of the context words from the stack
set/any f-model/context-words last call-stack-model
remove back tail call-stack-model
]
return get/any 'result
]
我们的模型只使用一个上下文来处理 FUNCTION!-MODEL 的整个生命周期，无需更改其 BODY 的绑定。我将这种行为称为动态递归补丁。
一些测试
probeblk: func [] [
prin mold blk
prin ": "
print mold reduce blk
]
recfun: func-model [x] [
append blk 'x
either x = 2 [
probeblk
] [
evaluate-model recfun [2]
]
]
blk: copy []
evaluate-model recfun [1] ; [x x]: [2 2]
probeblk ; [x x]: [1 1]
如果我们将模拟的行为与真实的 Rebol 函数进行比较，我们会得到
recfun: func [x] [
append blk 'x
either x = 2 [
probeblk
] [
recfun 2
]
]
blk: copy []
recfun 1 ; [x x]: [2 2]
probeblk ; [x x]: [1 1]
这表明模拟非常准确，并且 Rebol 函数也使用动态递归补丁。
虽然动态递归补丁可以在某些情况下加速评估，但它也有其缺点
f-returning-x: func [x] [
func [] [x]
]
f-returning-ok: f-returning-x "OK"
f-returning-ok ; == "OK"
f-returning-bug: f-returning-x "BUG!"
; so far so good, but now:
f-returning-ok ; == "BUG!"
正如我们上面所看到的，计算绑定有其优点，而动态递归补丁并不理想。结果促使我实现计算绑定函数，并将它们的行为与动态递归补丁函数的行为进行比较。
计算绑定函数将在每次被调用时创建一个新上下文，并相应地绑定它们的主体。我们甚至可以使用上述模拟的一部分来实现它们。
closure: func [
[catch]
spec [block!] {Help string (opt) followed by arg words (and opt type and string)}
body [block!] {The body block of the closure}
/local spc item result
] [
spc: make block! 1 + (2 * length? spec)
insert/only spc [throw]
result: make block! 5 + length? spec
insert result reduce [:do :make :function! spc body]
parse spec [
any [
set item any-word! (
insert tail result to word! :item
insert tail spc to get-word! :item
insert/only tail spc [any-type!]
) | skip
]
]
throw-on-error [make function! spec result]
]
第一次测试
recfun: closure [x] [
append blk 'x
either x = 2 [
probeblk
] [
recfun 2
]
]
blk: copy []
recfun 1 ; [x x]: [1 2]
probeblk ; [x x]: [1 2]
这肯定比以前好多了。第二次测试
f-returning-x: closure [x] [
func [] [x]
]
f-returning-ok: f-returning-x "OK"
f-returning-ok ; == "OK"
f-returning-bug: f-returning-x "BUG!"
; so far so good, but now:
f-returning-ok ; == "OK"
结束。