Rebol Programming/Advanced/Bindology

Author: Ladislav Mecir

Acknowledgments

I would like to thank the men that influenced this article in some way. Those are especially 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 and Romano Paolo Tenca. Any errors are my copyright.

References

The code in this article was tested in Rebol/View 2.7.6.3.1. It is possible that other versions of the interpreter yield different results.

A reader who wants to check all the examples can run this code:

do http://www.rebol.org/download-a-script.r?script-name=contexts.r

, which defines all functions from this article.

Word types

Rebol words like all Rebol values have type. Let's have a look at all available word types:

type? first [rebol] ; == word!
type? first [rebol:] ; == set-word!
type? first [:rebol] ; == get-word!
type? first ['rebol] ; == lit-word!
type? first [/rebol] ; == refinement!

Moreover, all Rebol words have a common pseudo-type 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

Spelling

Every word has got a spelling. The spelling of a word is a string and it is one of the properties the above example words have in common. We can obtain the spelling of a word using the TO-STRING function:

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"

Observation (Unusual spellings): Words normally don't have some spellings like spellings containing spaces, spellings starting with a colon, etc. On the other hand, it is possible to create a word having any spelling as follows:

unusual: make word! ":unusual word:"
type? unusual ; == word!
to-string unusual ; == ":unusual word:"

Observation (Spelling and word equality): Words with strict equal spelling are equal.

Illustration:

equal? first [rebol] first [rebol:] ; == true

The reverse implication does not hold (since Rebol supports aliases). Nevertheless, we can reverse the implication at least in some way.

Observation (SAME? and spelling): If two words are the same according to the SAME? function then they have got strict equal spelling.

Variables

A very important property of words is the ability to serve as variables (refer to Rebol values). To set a variable 'rebolution to refer to a Rebol string "uprising" we can pick one of the following:

rebolution: "uprising"
set 'rebolution "uprising"
set/any 'rebolution "uprising"
set first [rebolution:] "uprising"

etc.

To get the value a variable refers to we can pick one of the following:

:rebolution
get 'rebolution
get/any 'rebolution

etc.

Observation (Variables): The ability of words to serve as variables is closely related to a word property called binding. A word is a variable if and only if it is bound to a context (has a context, is in a context).

Illustration:

; a refinement
get/any /rebol
** Script Error: rebol word has no context
** Near: get/any /rebol

The easiest way how to find out if a word is a variable is to use the properties of the BIND? function, which returns NONE for words that aren't variables:

variable?: func [
    {is the given WORD a variable?}
    word [any-word!]
] [
    found? bind? :word
]

Tests:

variable? 'rebol ; == true
variable? /rebol ; == false

Observation (Context uniqueness): As the BIND? function helps us to find out, for every Rebol word there is at most one context the given word is bound to.

Corollary (Context hierarchy): From the above observation follows that in Rebol there is no context hierarchy, because a context hierarchy would require some word being bound to at least two distinct contexts, one being "smaller" than the other.

Observation (Word sameness): According to the SAME? function two words are the same if and only if they have strict equal spelling and equal binding.

Observation (The result of the BIND? function): When the BIND? function is used to obtain the context of a word in an object, the result of the BIND? function "is not considered identical" with the object.

Illustration:

o: make object! [a: none]
o-context: bind? in o 'a
same? o o-context ; == false

Observation (Equal words need not have equal binding): In fact, the opposite is true. For any word we can create a word having strict equal spelling, equal type and different binding.

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]
]

Let's test, whether the function does what we declared:

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

The test shows that WORD1 and WORD2 have strict equal spelling and equal type. Their bindings are different. They can refer to different values at the same time, so they are distinct variables. Another test:

word1: /a ; == /a
word2: different-binding word1 ; == /a
same? word1 word2 ; == false
equal? bind? word1 bind? word2 ; == false

The BIND function

When we need to get a word having the spelling and type a given WORDS word has and the context a given KNOWN-WORD has, we can use the BIND function.

This is how the BIND function works:

Binding to no context

Observation (Binding to no context): If the KNOWN-WORD has no context, BIND causes an error.

Illustration:

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

Binding when the WORDS argument is a word

Observation (Effective bind): If it is possible, the BIND function yields a word having the spelling and type of the WORDS argument and the context of the KNOWN-WORD argument.

Illustration:

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

We observe that the result has got the spelling and the type of the WORDS word, but it isn't the WORDS word because it is bound to the same context as the KNOWN-WORD is.

Observation (Equal words and effective bind): If WORD1 is a variable having a context CONTEXT and WORD2 is equal to WORD1 then WORD2 can be bound to CONTEXT too.

Observation (Ineffective bind): In case the BIND function cannot yield a word having the spelling and type of the WORDS argument and the binding of the KNOWN-WORD argument, BIND returns the WORDS argument.

words: 'c ; == c
known-word: use [a b] ['b] ; == b
result: bind words known-word ; == c
same? words result ; == true

In this case BIND simply returned the WORDS word.

Binding when the WORDS argument is a block

Observation (Binding block without copying): If the /COPY refinement isn't used, BIND replaces the elements of the block by results of their binding. There is one exception to this rule: BIND doesn't bind refinements contained in the block.

Aliases

Definition (Aliases): Equal words that do not have strict equal spelling we call aliases.

This is our definition translated to 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
    ]
]

Corollary (Word equality): Two words are equal if and only if one of the following conditions holds:

1. the words have strict equal spelling
2. the words are aliases

Corollary (Aliases and SAME?): The SAME? function yields FALSE when comparing two aliases.

Proof: See the (SAME? and spelling) observation and our definition of aliases.

Observation (Automatic aliases): Since Rebol tries to be case-insensitive, the interpreter usually (except for inconsistencies) "considers" words with spellings differing only in case to be aliases.

Observation (ALIAS): Aliases can be defined explicitly using the ALIAS function.

; 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

Observation (ALIAS return value): The ALIAS function returns unbound words.

y: alias 'x "xx" ; == xx
bind? y ; == none

Observation (Variable sameness): Two words are one variable if and only if they are equal and their bindings are equal too.

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
    ]
]

Observation (Alternative definition of ALIASES?): According to our previous observations this definition is equivalent to our original definition:

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
        )
    ]
]

The alternative definition looks more complicated, but it is faster due to the fact that it does not need to manipulate strings.

Context words

The BIND? function allows us to find the context of a given word. The reverse task is a task to find all words that are in a given CONTEXT context. It can be done as follows:

context-words?: func [
    {get the words in a given CONTEXT}
    context [object!]
] [
    bind first context context
]

Observation (Simplified set of context words): The block obtained as the result of the first context expression is a simplified set of context words. As opposed to the result of the above function it contains unbound words. Moreover, similarly as the result of the above function it doesn't contain aliases of its words and it contains only words of the WORD! datatype.

Illustration:

alias 'rebol "rebellious"
o: make object! [rebellious: 1]
first o ; == [self rebellious]
bind? first first o ; == none
in o 'rebol ; == rebol

The global context

Definition (Global context): The global context can be defined e.g. as follows:

global-context: bind? 'system

Note: This is not the only option, another one is to define it as the SYSTEM/WORDS object. The above definition gives us the simplest possible definition of global words.

Definition (Global words/global variables): The words that are bound to the global context we call global words (global variables):

global?: func [
    {find out if a WORD is global}
    word [any-word! object!]
] [
    same? global-context bind? :word
]

Observation (MAKE, TO, LOAD, BIND and the global context): The words created by 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 and BIND WORD 'SYSTEM are global.

Illustration:

global? make word! first first rebol/words ; == true
global? to word! first first rebol/words ; == true

Observation (Automatic growth): The global context can be enlarged using the MAKE, TO, LOAD and BIND functions. On the other hand, the IN function doesn't enlarge the global context.

Observation (MAKE, TO and unbound words): All words contained in a result block of MAKE BLOCK!, TO BLOCK! and in its subblocks are unbound if the SPEC argument is a string.

Illustration:

bind? first make block! "unbound" ; == none
bind? first first first make block! "[[unbound-too]]" ; == none

Local contexts

Definition (Local words/local variables): The words that are neither unbound nor global we call local words (local variables):

local?: func [
    {find out, if a WORD is local}
    word [any-word!]
] [
    not any [
        none? bind? :word
        global? :word
    ]
]

Definition (Local context): A context is called local context if its words are local words.

Observation (Local context types): User defined objects, function contexts and USE contexts are local contexts. In addition to these we can use the BIND? function to "convert" user defined objects and ports to contexts and using the DISARM function we can convert errors to objects. All the results are local contexts. The main distinction between the function- and USE- contexts and all other context types lies in the fact that the function- and USE- contexts don't need to contain a word equal to the word 'self.

Observation (Enlarging local contexts): Local contexts aren't enlargeable.

Observation (The result of the DIFFERENT-BINDING function): The result of the DIFFERENT-BINDING function as we defined it above is always a local word.

Computed binding

Let's observe the behaviour of the Rebol interpreter when evaluating an example code string:

code-string: {'f 'g 'h use [g h] [colorize "USE 1" 'f 'g 'h use [h] [colorize "USE 2" 'f 'g 'h]]}

The COLORIZE function will colorize the code listing as follows:

• the unbound words will be brown
• the global words will be blue
• the words bound by the first USE evaluation will be red
• the words bound by the second USE evaluation will be magenta

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?: " ")
        ]
    ]
]

Let's watch how the code is being interpreted:

; 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

The result (pasted here from the clipboard) is:

Text	Code
String to block conversion	['f 'g 'h use [g h] [colorize "USE 1" 'f 'g 'h use [h] [colorize "USE 2" 'f 'g 'h]]]
Code block bound to the global context	['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]]]

The result proves that:

• After the string to block conversion all words in the CODE-BLOCK were unbound
• After the CODE-BLOCK was bound to the global context all words in the CODE-BLOCK were global
• The first USE call replaced all words 'g and 'h from its body block and its subblock with local USE 1 words
• The second USE call replaced the 'h in the innermost block with the local USE 2 word

Observation (Computed binding): During the interpretation the binding of Rebol words contained in the code is changed (i.e. the words are being replaced by words with different binding) until they are bound correctly and evaluated. That is why the creator of Rebol calls this behaviour "Computed binding".

Scope

It looks like we observed a "scope hierarchy" during the execution of the above Rebol code. As we have demonstrated, it was only a side effect of the computed binding.

With a help of the computed binding we can easily create code samples, which do not exhibit any "scope" property:

; 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

The CODE-BLK example demonstrates that for a code block there is no such thing as its "current context" in Rebol because in Rebol only individual words are associated with context.

The USE function

To be as precise as possible we will write the description of the USE function behaviour in Rebol.

The following function creates a new context, in which all words are unset:

make-context-model: func [
    {context creation simulation}
    words [block!] {context words, needs to be non-empty}
] [
    bind? first use words reduce [reduce [first words]]
]

The description of 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
]

Observation (USE-MODEL and BODY): USE-MODEL modifies its BODY argument when it binds it to the new context. If we wanted to leave the BODY argument unmodified, we should have used BIND/COPY instead of the present BIND.

Let's compare USE-MODEL's behaviour and the behaviour of USE:

body: ['a]
body-copy: copy body
same? first body first body-copy ; == true
use [a] body
same? first body first body-copy ; == false

As we made sure, the same is true for both USE-MODEL and the original USE. The simulation is so accurate that it helped us to reveal a bug in the following code:

f: func [x] [
    use [a] [
        either x = 1 [
            a: "OK"
            f 2
            a
        ] [
            a: "BUG!"
            "OK"
        ]
    ]
]
f 1 ; == "BUG!"

Explanation/correction:

The observed USE property caused that the body of the function F got modified during the second USE execution. After that modification it no longer contained the word 'a that was set to "OK" during the first invocation of F. Instead it contained only the word 'a set to the "BUG!" value during the second invocation of F.

If we preserve the body of the F somehow, we can get the correct behaviour:

f: func [x] [
    use [a] copy/deep [
        either x = 1 [
            a: "OK"
            f 2
            a
        ] [
            a: "BUG!"
            "OK"
        ]
    ]
]
f 1 ; == "OK"

Another way how to correct the behaviour is to use our own version of USE that will not modify its body argument:

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
]

MAKE OBJECT!

We need a function that evaluates the SPEC argument like MAKE OBJECT! does, which means that it has to catch RETURN, THROW and BREAK:

spec-eval: func [
    {evaluate the SPEC like MAKE OBJECT! does}
    spec [block!]
] [
    any-type? catch [loop 1 spec]
]

The MAKE OBJECT! simulation:

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
]

Observation (MAKE-OBJECT!-MODEL and SPEC): MAKE-OBJECT!-MODEL modifies its SPEC argument when it binds it to the new context. If we wanted to leave the SPEC argument unmodified, we should have used BIND/COPY instead of the present BIND.

The described behaviour leads to a bug similar to the bug described in the USE section:

f: func [x] [
    get in make-object!-model [
        a: "OK"
        if x = 1 [
            a: "BUG!"
            f 2
            a: "OK"
        ]
    ] 'a
]
f 1 ; == "BUG!"

The explanation and the correction are similar as for the USE function. The word a: in the a: "OK" line positioned after the recursive call to F and bound to the object F created first was replaced by a word a: bound to the object F created during the recursive call. Consequently, the expression a: "OK" had no effect on the object F created first and therefore it retained the last value of 'a, which was "BUG!". If we preserve the body of F, we can get the correct behaviour:

f: func [x] [
    get in make object! copy/deep [
        a: "OK"
        if x = 1 [
            a: "BUG!"
            f 2
            a: "OK"
        ]
    ] 'a
]
f 1 ; == "OK"

As you might have seen, the above code deep copies the BODY block before binding it to the context. Analogical bugs were discovered when the deep copying was not used when the FUNC function created Rebol functions.

MAKE PROTO

This is a simulation of the situation when the MAKE function obtains a prototype of the object it has to create. First of all, we need a special BIND-like function:

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
]

And here is the simulation:

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
]

Functions with MAKE OBJECT!-like handling of local words

Before we try to model the function evaluation, we can ask whether we can use the same method of the local words handling as the CONTEXT function uses.

The answer is positive and the function able to do this is defined below.

First of all a function that can extract all local words of a function from its 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
]

Model of Rebol functions

Our model of Rebol functions will be a Rebol object FUNCTION!-MODEL having the appropriate attributes. The totally necessary attributes of Rebol functions are SPEC and BODY.

To model the current behaviour of Rebol functions accurately our FUNCTION!-MODEL needs CONTEXT, CONTEXT-WORDS and RECURSION-LEVEL attributes to model the behaviour of Rebol functions during recursive calls:

function!-model: make object! [
    spec: none
    body: none
    context: none
    context-words: none
    recursion-level: none
]

Model of the FUNC function

This function gets the SPEC and BODY attributes, creates a new FUNCTION!-MODEL and initializes it.

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
]

Model of the function call stack

The call stack is empty when the interpreter starts.

call-stack-model: make block! []

Model of function evaluation

Our simulation begins when the values of the function arguments are collected and their types checked.

The evaluation function obtains a FUNCTION!-MODEL together with a block of values it shall store to its local context words (i.e. all values of its arguments, optional arguments, refinements and local words).

We model only the morst frequent case of a function without the THROW/CATCH attributes.

The first part of our model executes the body:

exec: func [body] [do body]

The simulation:

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
]

Our model uses just one context for the whole lifetime of the FUNCTION!-MODEL without need to change the binding of its BODY. I call this behaviour a Dynamic Recursion Patch.

Some tests:

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]

If we compare the simulated behaviour with the real Rebol functions, we get:

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]

This shows that the simulation is really accurate and that Rebol functions use the Dynamic Recursion Patch too.

Although the Dynamic Recursion Patch can speed up the evaluation under some circumstances it has got its drawbacks:

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!"

Computed binding functions (Closures)

As we have seen above Computed binding has got its merits while the Dynamic recursion patch isn't ideal. The results inspired me to implement the Computed binding functions and compare their behaviour with the behaviour of the Dynamic recursion patch functions.

The Computed binding functions shall create a new context every time they are called and bind their bodies accordingly. We can even use a part of the above simulation to implement them.

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]
]

The first test:

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]

This surely looks better than before. The second test:

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"

The end.