• Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

World: r4wp

[Rebol School] REBOL School

Steeve
3-Oct-2012
[1102]
I just decided it would be a new paradigm :-)
MarcS
3-Oct-2012
[1103x2]
heh, good stuff
thanks again for the help
Steeve
3-Oct-2012
[1105]
No prob I was lazy on my couch
Ladislav
3-Oct-2012
[1106]
Marc, to no pollute this group I posted a private conversation mentioning 
how to define a TAIL-CALL function using the function spec and how 
to handle the situation even if the function spec is "more complicated" 
than just a block of words.
Steeve
3-Oct-2012
[1107]
It's Rebol School group here. Why would your post be a pollution 
? I don't get it
Ladislav
3-Oct-2012
[1108]
It is a bit long to my taste, but I can repost here if you prefer. 
Also, BTW, welcome to REBOL, Marc
Steeve
3-Oct-2012
[1109]
Yes wellcome Marc. (Not really a beginner though)

Yes Ladislav I've nothing against a long post here since it's related 
to the topic, or if you prefer you can use a copy/past service in 
the cloud.
MarcS
3-Oct-2012
[1110]
thanks guys
Ladislav
3-Oct-2012
[1111]
OK, this is the long version:

tail-func: func [
    {

  Define a recursive user function with the supplied SPEC and BODY.
     	The function can use a special TAIL-CALL local function
     	to perform a tail-recursive function call.
    }
    [catch]


 spec [block!] {Help string (opt) followed by arg words (and opt type 
 and string)}
    body [block!] {The body block of the function}
    /local the-function tail-call context-word
] [
	; define a new 'tail-call local variable
	tail-call: use [tail-call] ['tail-call]
	
	; bind the given BODY to "know" the 'tail-call variable
	body: bind/copy body tail-call
	
	; find a local word in SPEC
	context-word: find spec word!
	if context-word [context-word: first context-word]
	
	; define the TAIL-CALL function
	set tail-call func spec compose [
		(
			either context-word [
				; set parameters to the new arguments
				compose [set parameters values? (context-word)]
			] [[]]
		)
		throw/name none 'tail-call
	]
	
	; define the function
	the-function: throw-on-error [
		func spec compose/deep [
			(either context-word [context-word] [[]])
			while [true] [
				catch/name [
					return do [(body)]
				] 'tail-call
			]
		]
	]
	
	if context-word [
		; get the function context
		context-word: bind? first second :the-function
		
		; replace the context word in the function body by NONE
		change second :the-function none

		; adjust the TAIL-CALL body
		; replace the 'parameters word

  change/only at second get tail-call 2 bind first context-word context-word
	]

    :the-function
]

values?: func ['word] [second bind? word]
Steeve
3-Oct-2012
[1112]
Hum Ok, I see the 
>> return do [(body)]
as a nice optimization of my code.
But for the rest, I'm not sure...
Ladislav
3-Oct-2012
[1113]
example:

            safe: tail-func [x] [
                if x > 20000 [print x exit]
                tail-call x + 1
            ]
Steeve
3-Oct-2012
[1114x3]
yeah I see that the purpose is to get ride of the block passing style 
of the arguments, but it looks not anymore as simple
I think I included all your modifications Ladislav but shortly :-)

rfunc: [spec body /local args][
	args: to-block form first (

  do second func spec compose [bind? (to-lit-word first find spec word!)]
	)
	funct spec compose/deep [
		recur: func spec [
				throw/name reduce [(args)] 'recur
		]
		forever [
		   set [(args)] catch/name [
			  return do [(body)]
		   ] 'recur
		]
	]
]
I used a trick not well known.
>> do second function!
allow to execute a function without having to pass its arguments.
Kaj
3-Oct-2012
[1117]
Neat
Steeve
3-Oct-2012
[1118x3]
Mmmmh, the function recur could be defined outside
Should do the trick:

rfunc: [spec body /local args][
	args: to-block form first do second 
		func spec compose [bind? (to-lit-word first find spec word!)]
	funct spec compose/deep [

  recur: quote (func spec compose/deep [throw/name reduce [(args)] 
  'recur])
		forever [
		   set [(args)] catch/name [return do [(body)]] 'recur
		]
	]
]
Notice the weird sequence
>> to-block form first object!

That is because the local context returned from a function is not 
well formed.

If the specs of the function are [a [block!] /local b], it will return 
a strange objetc! where:
>> first object!
== [a /local b]
So to correct its format, I do 
>> to-block form first object
== [a local b]
Gregg
3-Oct-2012
[1121x2]
Marc, a simple naming question. Why did you choose 'recur instead 
of 'recurse?
Ah, I love how AltMe optimizes code. :-) Thanks all. Very fun chat 
on this.
Steeve
3-Oct-2012
[1123]
I think Marc like to tease us with his naming convention
Gregg
3-Oct-2012
[1124]
Now, there is this gloal RECUR func that is only usable inside RFUNC 
created funcs. While I'm still not very fond of the special KEEP 
func in COLLECT, should RECURSE be hidden/protected somehow?
Steeve
3-Oct-2012
[1125]
Well it could be protected but see, you can also redefine standard 
words in every functions, at your own risk
Gregg
3-Oct-2012
[1126]
Of course. For this, I'm also OK with the doc-string making the use 
clear. e.g. adding ONLY or MUST.
Ladislav
3-Oct-2012
[1127x3]
I think I included all your modifications Ladislav but shortly :-)
 - well, your version still
- misses error handling

- uses the arg-block passing method (which is a matter of preference, 
i.e. some may prefer that)
- uses REDUCE which does not "tolerate" certain argument types
Ah, I love how AltMe optimizes code.
 - some "optimizations" are "at high cost" though.
however, I noticed that even my version would need to use one more 
THROW-ON-ERROR call
MarcS
4-Oct-2012
[1130x2]
morning all
re: naming, borrowed from http://clojure.org/special_forms#toc12
Ladislav
4-Oct-2012
[1132x2]
regarding the tail recursive functions:


- there is also an implementation by Maarten Koopmans at rebol.org

http://www.rebol.org/view-script.r?script=tailfunc.r&sid=l844jn

- also, all above versions have some bugs worth correcting
(that also seems to be the case of Maarten's code)
Steeve
4-Oct-2012
[1134]
Ladislav, 

- uses the arg-block passing method (which is a matter of preference, 
i.e. some may prefer that)
No it uses the regular passing method, like yours. 
- misses error handling

True, though it's not that hard to figure where to add some throw-on-error.
 "- uses REDUCE which does not "tolerate" certain argument types"
Good catch
Ladislav
4-Oct-2012
[1135]
No it uses the regular passing method, like yours. 

 - aha, sorry, did not read the last version, or did not read it thoroughly 
 enough.
DocKimbel
4-Oct-2012
[1136]
Just a question about that very interesting thread on tail calls 
optimization: does at least one of the proposed solution support 
recursive function calls with refinements? (I had a quick look and 
it seems not, but I might have missed it).
Ladislav
4-Oct-2012
[1137x3]
I put my last version to:

http://www.rebol.org/view-script.r?script=tail-func.r

Need to test it, but it should suport refinement calls as well.
One more problem with all the versions mentioned except for my last 
version:


- e.g the last Steeve's version "reserves" 'bind?, 'quote, 'forever, 
'catch, 'set, 'return and 'do (and 'recur, but that is by design), 
while my last version does not "reserve" any word except for 'tail-call, 
which is by design.
(by "reserve" I mean that these words cannot appear in the function 
spec)
Steeve
4-Oct-2012
[1140x2]
Last version.

- Any spec accepted but needs at least one parameter (can be just 
a local)

rfunc: func [
    [catch]
    spec [block!] body [block!] /local arg obj recur
][
    throw-on-error [

        if error? try [arg: to-lit-word first find spec any-word!][
            make error! "rfunc needs at least one parameter."
        ]
        recur: func spec compose [throw/name bind? (:arg) 'recur]
        obj: catch/name [do second :recur] 'recur
        funct spec compose/deep [
            recur: quote (:recur)
            forever [

                set/any [(to-block form first obj)] second catch/name [
                    return do [(body)]
                ] 'recur
            ]
        ]
    ]
]
Test case:

safe: rfunc [x] [
    if x < 5000 [recur x + 1]
    x
]
safe 1000
== 5000
Ladislav
4-Oct-2012
[1142]
re "any spec accepted", here are differences:

>> safe: rfunc [throw] [if x < 20000 [recur x + 1]]
** Script Error: throw has no value
** Where: throw-on-error
** Near: rfunc [throw] [if x < 20000 [recur x + 1]]

, while:


>> safe: tail-func [throw] [if throw < 20000 [tail-call throw + 1]]
>> safe 0
== none
Steeve
4-Oct-2012
[1143]
Not really fair, you redefine the throw word and expect it to work 
as is ?

Your function got the same problem on my pc, except it occurs at 
the execution time.
** Script Error: Cannot use path on integer! value
** Where: tail-call
** Near: throw/name none 'tail-cal
or maybe you have a new version right now

(Actually I have problems with Altme to synchronize with some recent 
posts I can't see all of them currenly)
Ladislav
4-Oct-2012
[1144x5]
My version
 is this one:

http://www.rebol.org/view-script.r?script=tail-func.r
...and it works as posted above
(no "reserved words" at all, except that the 'tail-call word has 
got a special meaning as a function to make the tail call, however, 
it still *can* be redefined at the cost that the tail call cannot 
be made in such case since it is redefined)
...and it is not about "redefining the 'throw word", it is rather 
about allowing any word in the function spec...
Doc, regarding your question, see this example:


>> safe2: tail-func [/local throw] [if throw < 20000 [tail-call/local 
throw + 1] throw]
>> safe2/local 0
== 20000
DocKimbel
4-Oct-2012
[1149x3]
Ladislav: thanks!
Ladislav: would you be interested in improving the 'proxify function 
from the REBOL profiler I've built for Red project, it has the same 
kind of constraints as 'tail-call? The current code is a bit "rough", 
I don't have time to make a cleaner and simpler version of it.


See code at: https://github.com/dockimbel/Red/blob/v0.3.0/red-system/utils/profiler.r
Also runtime performance is a big concern for such functions, so 
every little speed gain is good to take.