[REBOL] Re: tail-func: for the gurus
From: lmecir:mbox:vol:cz at: 22-Nov-2001 16:39
Hi all,
I changed the implementation of Tail-func to support the THROW attribute:
tail-func: function [
{Creates a tail-recursive function.}
[catch]
spec [block!] body [block!]
] [
ic icb i item locals result does-body
] [
use [new-locals stop] [
stop: false
locals: copy []
icb: copy []
i: 1
parse spec [
any [
set item any-word! (
append locals to word! :item
append icb compose [
error? set/any pick new-locals (i) get/any pick
locals (i)
]
i: i + 1
) | skip
]
]
set [new-locals body] use locals copy/deep reduce [
reduce [locals body]
]
use [finish] [
does-body: has [ret] compose [
finish: [return get/any 'result]
set/any 'ret do (reduce [body])
finish: [get/any 'result]
get/any 'ret
]
append icb compose/deep [
either stop [
stop: false
] [
until [
stop: true
error? set/any 'result (:does-body)
stop
]
stop: false
do finish
]
]
]
ic: func [
{do body with locals in new context}
[throw]
locals
] icb
throw-on-error [
func spec reduce [:ic locals]
]
]
]
