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"
結束。