tail-func: for the gurus
[1/11] from: koopmans:itr:ing:nl at: 14-Nov-2001 15:48
Hey all,
See below a tail-func function: it allows you to define a tail-recursive
function *with refinements*.
Refinement transferral is correct even if refinements change in a recursive
call.
You can also use it as a drop-in replacement for normal funcs, provided that
they don't do an almost tail-recursive thing as in:
f: tail-func [x] [ 1+ f x]
OTOH, this works:
f: tail-func [x /y z]
[
x: x + 1
either [ y ]
[ print [ "x: " x "z: " z] f x
[ print [ "x: " x ] f/y x x ]
]
and so do all other func definitions.
The trick is that I use an extended use context as a kinda stack frame to
implement goto like behaviour.
Also posted to the reb in the script libs as tailfunc.r
Enjoy,
Maarten
REBOL []
tail-func: func
[
{Returns a function that handles tail-recursion transparently.}
args [block!] body [block!]
/local meta-func meta-spec meta-body p1 p2
]
[
meta-spec: append/only copy [] args
meta-body: append/only copy [] body
;matches refinements and copies refinements to our command
p1: [ set r refinement!
(either get bind to-word r 'comm
[
append comm mold r
ref-mode: on
]
[ ref-mode: off ]
)
]
;matches words and copies their values to the statement if ref-mode = on
p2: [ set w word! (if ref-mode [ append/only statement get bind to-word w
'comm])]
meta-func: copy
[
;The use context is accessible from the wrapper function that
;eliminates tail recursion. It plays the role of a stack frame
;ti implement a goto like behaviour in case of tail recursion
use [ _*loop-detected _*myself _*innerfunc _*loops _*myspec _*myspec2
_*mycall]
[
;some static initialization of the use context varaiables
_*loops: 0
_*loop-detected: false
_*mycall: copy []
_*innerfunc: func (meta-spec) (meta-body)
_*myspec: copy first :_*innerfunc
_*myspec2: append copy _*myspec [/local ref-mode p1 p2 r w comm statement
ret]
insert/only _*myspec2 [catch]
;The function that is returned from the use context
_*myself: func _*myspec2
[
;How deep in a loop am I?
_*loops: _*loops + 1
;These parse rules extract how I am called
;(which refinements and so)
p1: [(p1)]
p2: [(p2)]
ref-mode: on
;Ourt initial call
comm: copy {_*innerfunc}
;Our initial statement
statement: copy []
;Generate our statement and call
parse _*myspec [ any [ p1 | p2 ]]
insert statement to-path comm
;Copy it in the use context so it survives
;a loop (_*mycall is the 'goto args)
_*mycall: copy statement
if _*loops = 2
[
_*loops: 1
_*loop-detected: true
return
]
;Until we are no longer in loop-detection mode
until
[
_*loop-detected: false
set/any 'ret do bind _*mycall '_*loops
not _*loop-detected
]
;set/any 'ret pick ret 1
;Use context cleanup
_*loops: 0
_*loop-detected: false
_*mycall: copy []
;return our value
return get/any 'ret
];_*myself: func ...
];use context
];meta-func
;return our function....
do compose/deep meta-func
]
[2/11] from: lmecir:mbox:vol:cz at: 17-Nov-2001 17:47
Hi Maarten,
interesting. There are some other "tricks" that can be applied in this case.
1) your implementation uses "keywords": [ref-mode p1 p2 r w comm statement
ret either get bind to-word append mold on off refinement! word! copy parse
_*loops _*myspec insert to-path _*mycall if _*loop-detected true return
until false set do not]. The need to have keywords can be eliminated.
2) Why did you use the CATCH function attribute?
3) Refinements can be passed more transparently.
4) Other simplifications/generalizations were possible. I have "stolen" some
ideas from my
CFUNC implementation:
exec: func [body] [do body]
tail-func: function [
{Transparently creates a tail-recursive function.}
[catch]
spec [block!] body [block!]
] [
ic icb i item
] [
use [new-locals loop] [
loop: 0
locals: copy []
icb: copy []
i: 1
parse spec [
any [
set-word! | 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]
]
append icb compose/deep [
either loop > 0 [
loop: 2
] [
until [
loop: 1
error? set/any 'result exec (reduce [body])
loop = 1
]
loop: 0
return get/any 'result
]
]
ic: func [
{do body with locals in new context}
[throw]
locals
] icb
throw-on-error [
func spec reduce [:ic locals]
]
]
]
fib: tail-func [first second n] [
print [first second n]
either n = 2 [second] [
fib second first + second n - 1
]
]
Cheers
Ladislav
[3/11] from: koopmans:itr:ing:nl at: 19-Nov-2001 9:33
Hi Ladislav,
See below....
> 1) your implementation uses "keywords": [ref-mode p1 p2 r w comm statement
> ret either get bind to-word append mold on off refinement! word! copy parse
> _*loops _*myspec insert to-path _*mycall if _*loop-detected true return
> until false set do not]. The need to have keywords can be eliminated.
>
I agree. But the idea is to have some kind of stack frame. I found it handy
to use keywords there. Along the same road a class hierarchy can be
implemented.
> 2) Why did you use the CATCH function attribute?
>
A local code convention in our project.
> 3) Refinements can be passed more transparently.
>
I see. But... I use this technique also in Rugby, where this is the only way
because you are in a distributed environment. Stolen from myself ;-)
> 4) Other simplifications/generalizations were possible. I have "stolen"
> some ideas from my
Cool! I hope others are reading this thread because it is very insightful to
(have) demonstrate(d) the true power of Rebol: if it isn't there, you can
built it in no time. Rebol really transforms into what *you* want it to be.
Human-centered software engineering for the programmers....
--Maarten
[4/11] from: lmecir:mbox:vol:cz at: 19-Nov-2001 12:51
Hi
> 1) your implementation uses "keywords": [ref-mode p1 p2 r w comm statement
> ret either get bind to-word append mold on off refinement! word! copy
parse
> _*loops _*myspec insert to-path _*mycall if _*loop-detected true return
> until false set do not]. The need to have keywords can be eliminated.
>
<<Maarten:>>
I agree. But the idea is to have some kind of stack frame. I found it handy
to use keywords there. Along the same road a class hierarchy can be
implemented.
<</Maarten>>
I am not sure we understood each other. What I wanted to tell was, that your
implementation wouldn't correctly handle functions with arguments/locals
from the "Keywords" block. (Actually, it looks to me, that another "keyword"
I didn't mention was 'local, which might really mean a serious limitation).
> 2) Why did you use the CATCH function attribute?
<<Maarten:>>
A local code convention in our project.
<</Maarten>>
That might not be as useful as it may look at a first glance. I suggest you
to look at http://www.rebol.cz/cffr.html . See the reasons why I wrote
TRANSP-FUNC, especially WRT the CATCH attribute.
> 3) Refinements can be passed more transparently.
<<Maarten:>>
I see. But... I use this technique also in Rugby, where this is the only way
because you are in a distributed environment. Stolen from myself ;-)
<</Maarten>>
It might be interesting to compare the speed of these two, although there
are other possible alternatives ...
> 4) Other simplifications/generalizations were possible. I have "stolen"
> some ideas from my
<<Maarten:>>
Cool! I hope others are reading this thread because it is very insightful to
(have) demonstrate(d) the true power of Rebol: if it isn't there, you can
built it in no time. Rebol really transforms into what *you* want it to be.
Human-centered software engineering for the programmers....
--Maarten
<</Maarten>>
Well said.
[5/11] from: koopmans:itr:ing:nl at: 19-Nov-2001 13:29
nevermind, I get it. I'll fix it. Just took some re-reading....
--Maarten
[6/11] from: koopmans:itr:ing:nl at: 19-Nov-2001 13:29
Can you give me a sample function that doesn't work?
--Maarten
[7/11] from: koopmans:itr:ing:nl at: 19-Nov-2001 13:53
OK, rethought it some more, and despite that you are right I thought it would
be enough (most of the time) to prefix all local variables with _* for now....
--Maarten
[8/11] from: lmecir:mbox:vol:cz at: 19-Nov-2001 16:31
Here is an example (using your TAIL-FUNC):
>> f: tail-func [x y /local z] [
[ either x = 1 [y] [
[ f 1 1 - y
[ ]
[ ]
** Script Error: Duplicate function value: local
** Where: throw-on-error
** Near: func _*myspec2 [
_*loops: _*loops + 1
p1: [
set r refinement! (
either get bind to-word r 'comm [
append comm mold r
ref-mode: on
] [ref-mode: off]
)]
p2: [
set w word! (
if ref-mode [
append/only statement get bind to-word w 'comm
]
)]
ref-mode: on
comm: copy "_*innerfunc"
statement: copy []
parse _*myspec [any [p1 | p2]]
insert statement to-path comm
_*mycall: copy statement
if _*loops = 2 [
_*loops: 1
_*loop-detected: true
return]
until [
_*loop-detected: false
set/any 'ret do bind _*mycall '_*loops
not _*loop-detected]
_*loops: 0
_*loop-detected: false
_*mycall: copy []
return get/any 'ret]
<<Maarten>>
(...)
OK, rethought it some more, and despite that you are right I thought it
would
be enough (most of the time) to prefix all local variables with _* for
now....
> Can you give me a sample function that doesn't work?
(...)
<</Maarten>>
[9/11] 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]
]
]
]
[10/11] from: rotenca:telvia:it at: 22-Nov-2001 17:30
Hi Ladislav,
Don't you copy the body?
>> x: tail-func [a][either a <= 0 [20] [x a - 1]]
>> x2: tail-func [a][either a <= 0 [200] [x a - 1]]
>> x 3
== 20
>> x2 3
== 20
---
Ciao
Romano
[11/11] from: rotenca:telvia:it at: 22-Nov-2001 17:34
Hi, Ladislav
forget my message on body, it was my error (with x and x2).
---
Ciao
Romano