REBOL [
    Title: "Tail recursion"
    Date: 14-Nov-2001/15:58:27+1:00
    Version: 1.0.0
    File: %tailfunc.r
    Author: "Maarten Koopmans"
    Purpose: {Provides transparent tail recursive functions with refinement transferral. Source code 4 gurus only}
    Email: m.koopmans2@chello.nl
    Web: http://www.vrijheid.net
    library: [
        level: 'advanced 
        platform: 'all 
        type: [Tool function] 
        domain: 'UI 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]

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


;some samples

rec-fun: tail-func [x [integer!]][x: x + 1 print x rec-fun x]
rec-fun2: tail-func [x /y z]
[
    x: x + 1
    either y
    [ print [ x z ] rec-fun2 x]
    [ print x rec-fun2/y x x ]
]