World: r4wp

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)

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

No it uses the regular passing method, like yours. 

 - aha, sorry, did not read the last version, or did not read it thoroughly 
 enough.

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

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)

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

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

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)

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

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.

(sorry, I should have posted that in #Red group)

I have a script that runs another script (via do) but when I launch 
it from an icon or through startup, the other script asks for permission 
to open a port. I've tried looking for some properties to change 
in the icon and setting secure to allow (which brings up its own 
requester). How do I do this?

see usage in the command level

rebol.exe --secure allow in the link string should work wit most 
versions
i

Thanks sqlab. I think that's my problem in setting that. The icon 
properties don't seem to let me do that.

For now I just encapped the script and launch it as an .exe with 
no problems.  Thanks anyway.

Completly changed my mind. It's lot leasier to manage /recur as a 
refinement! 
- eg. safe/recur instead of recur

- no words collision anymore (obviously /recur can't be used as a 
parameter).
Also really short code 

rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    spec: append copy spec /recur

    ctx: bind? first second fun: throw-on-error [func spec [recur]]
    change second :fun compose/deep [
        if (in ctx 'recur) [throw/name second (ctx) 'recur]
        while [true][

            set/any [(bind to-block form first ctx ctx)] catch/name [
                return do [(bind/copy body ctx)]
            ] 'recur
        ]
    ]
    :fun
]

It's lot leasier to manage /recur as a refinement! 
 - yes, that is an interesting idea

Also, this implementation would behave differently in some interesting 
cases

Aha, maybe not... But still, it is interesting

However, I found another problem...

Which looks to be specific to this version.

What I specifically mean is this:

f: rfunc [x] [if x = 2 [g/recur 3 5]]

which does not look like making sense, although it can be written

;Go back to recur as a function.
;Still recur can't be used as a parameter, local or a refinement.

;This implementation is much more clean (no shitty compose/deep) 
and still very short.

;The collision of words is avoided by the use of singleton functions 
#[function!]
;I'm confident with this one. It could be the last one -_-;


rfunc: func [[catch] spec [block!] body [block!] /local ctx args][
    ctx: bind? first second throw-on-error [
        ;* Temporary function created to retrieve parameters
        ;* and to get a new context for 'recur.
        ;* The context will remain alive (not GC'ed).
        func append copy spec /recur [recur]
    ]
    args: bind to-block form first ctx ctx
    ctx/recur: func spec reduce [

        quote #[function! ['word] [throw/name second bind? word 'recur]] 

        first args ;* may be 'recur if empty specs (still, it's ok)
    ]
    func spec reduce [
        quote #[function! [args body][

            while [true][set/any args catch/name [return do body] 'recur]
        ]] 
        head remove back tail args ;* remove 'recur
        bind/copy body ctx         ;* bound 'recur
    ]
]

;Go back to recur as a function.
;Still recur can't be used as a parameter, local or a refinement.

;This implementation is much more clean (no shitty compose/deep) 
and still very short.

;The collision of words is avoided by the use of singleton functions 
#[function!]
;I'm confident with this one. It could be the last one -_-;


rfunc: func [[catch] spec [block!] body [block!] /local ctx args][
    ctx: bind? first second throw-on-error [
        ;* Temporary function created to retrieve parameters
        ;* and to get a new context for 'recur.
        ;* The context will remain alive (not GC'ed).
        func append copy spec /recur [recur]
    ]
    args: bind to-block form first ctx ctx
    ctx/recur: func spec reduce [

        quote #[function! ['word] [throw/name second bind? word 'recur]] 

        first args ;* may be 'recur if empty specs (still, it's ok)
    ]
    func spec reduce [
        quote #[function! [args body][

            while [true][set/any args catch/name [return do body] 'recur]
        ]] 
        head remove back tail args ;* remove 'recur
        bind/copy body ctx         ;* bound 'recur
    ]
]

(Sorry for the double post)

Well, I do have a different suggestion, which might make sense....

The fact is that the CATCH/NAME+THROW/NAME pair is not ideal for 
this, but I do have a function which might be able to handle even 
the G/RECUR case.

Maybe I forgot a [throw] attribute somewhere

I haven't examined the code enough to determine if this would help, 
but one trick to avoid having to reserve a word to refer to your 
recursion function is to use an inline reference to the function 
value instead. That is a trick that has been used in some mezzanine 
functions, though I don't know if they're still in REBOL. Inline 
references to function values are not rebound when you bind the code 
block that references them.

Yup, it's still used in the CLOSURE function in R2.

BTW, Steeve:


    quote #[function! ['word] [throw/name second bind? word 'recur]]

is equivalent to

    func ['word] [throw/name second bind? word 'recur]

And, Brian, examining Steeve's code above, you are late with your 
note...

Not surprising :)

Functions specified with serialized syntax don't bind their words 
in R3, so you might want to use Ladislav's suggestion.

Regarding my G/RECUR note, this is a CATCH version I specifically 
had in mind:

Rebol [
    Title: "Catch"
    File: %catch.r
    Date: 5-Oct-2012/17:49:58+2:00
    Author: "Ladislav Mecir"
    Purpose: {
    	Catches local throw'
    	Ignores non-local throws
    }
]

; Error definition
system/error: make system/error [
	throw': make object! [
		code: system/error/throw/code + 50
		type: "throw' error"
    	not-caught: ["throw' not caught"]
    ]
]

catch': func [
    {Catches a throw' from a block and returns the value.}
    [throw]
    block [block!] "Block to evaluate"
    /local err disarmed
] [
	use [throw'] copy/deep compose/only [
		; "localize" 'throw' in the block
		block: (block)

		throw': func [[catch] value [any-type!]] [
			disarmed: disarm err: make error! [throw' not-caught]
			set/any in disarmed 'arg1 get/any 'value
			disarmed/arg2: 'throw'
			throw err
		]

		get/any either all [
			error? set/any 'err try block
			(
				disarmed: disarm err
				disarmed/type = 'throw'
			)
			disarmed/id = 'not-caught
			disarmed/arg2 =? 'throw'
		] [
			in disarmed 'arg1
		] [
			'err
		]
	]
]

Modifying your f/recur code as follows:

rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    spec: append copy spec /recur

    ctx: bind? first second fun: throw-on-error [func spec [recur]]
    change second :fun compose/deep [
        if (in ctx 'recur) [throw' second (ctx)]
        while [true][
            set/any [(bind to-block form first ctx ctx)] catch' [
                return do [(bind/copy body ctx)]
            ]
        ]
    ]
    :fun
]

aha, sorry, ignore my last attempt, it is wrong

; Sorry Ladislav I've stolen your idea one should avoid catch/throw 
interferences

; As an extra (also your idea ?), f/recur and recur are now both 
allowed.

rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    ctx: bind? take second fun: throw-on-error [
        func append copy spec /recur reduce ['recur body]
    ]
    insert second :fun reduce [

        quote #[function! [[throw] ctx args 'fun body /local ret][

            if :ctx/recur [ctx/recur: ctx throw/name second ctx 'recur]
            ctx/recur: :fun
            while [true][
                set/any 'ret catch/name [return do body] 'recur

                unless all [value? 'ret block? :ret same? ctx last ret][
                    throw/name get/any 'ret 'recur
                ]
                set/any args ret
            ]
        ]]

        ctx (bind head remove back tail to-block form first ctx ctx) :fun
    ]
    :fun
]