Rebol [
    Title: "funcs"
    File: %funcs.r
    Date: 6-Jun-2009/17:43:06+1:00
    Author: "Ladislav Mecir"
    Web: http://www.fm.vslib.cz/~ladislav/rebol
    History: [
        20/May/2000 "local variables"
        8/Jun/2002 "static variables"
        15/May/2004 "error handling"
        4/Nov/2004/22:13 "reimplemented without using Build-func"
        17-May-2006/12:27:37+2:00 "DEFAULT update reflected"
        5-Jun-2009/10:33:23+2:00 {
            /handle refinement dropped,
            Tfunc usage eliminated,
            deep scan for function body
            function and file name changed
        }
    ]
    Purpose: {define a function with auto static + local variables}
]

#include-check %set-words.r
#include-check %locals.r

funcs: func [
    {Define a function with auto local and static variables.}
    [throw]
    spec [block!] {Help string (opt) followed by arg words with opt type and string}
    init [block!] {Set-words become static variables, shallow scan}
    body [block!] {Set-words become local variables, deep scan}
    /local svars lvars
] [
    ; Preserve the original Spec, Init and Body
    spec: copy spec
    init: copy/deep init
    body: copy/deep body
    ; Collect static and local variables
    svars: set-words init
    lvars: set-words/deep body
    unless empty? svars [
        ; create the static context and bind Init and Body to it
        use svars reduce [reduce [init body]]
    ]
    unless empty? lvars: exclude exclude lvars locals? spec svars [
        ; declare local variables
        insert any [find spec /local insert tail spec /local] lvars
    ]
    do init
    make function! spec body
]

comment [
    ; Usage

    counter: funcs [] [self: 0] [
        self: self + 1
        print self
    ]

    counter
    counter
    counter

    ; Example #2

    cell: func [
        {create a function that holds a value}
        initval [any-type!]
    ] [
        funcs [
            {A cell}
            /set newval [any-type!]
        ] [
            value: none ; this makes the 'value variable static
            set/any 'value get/any 'initval
        ] [
            either set [rebol/words/set/any 'value get/any 'newval] [
                get/any 'value
            ]
        ]
    ]

    a: cell 5
    a ; == 5
    a/set 18
    a ; == 18

    ; Example #3

    cell: func [
        {create a function that holds a value}
        require-type [datatype!]
        initval [any-type!]
        /local result
    ] [
        result: funcs reduce [
            {A cell containing only specific type}
            /set 'newval reduce [load mold require-type]
        ] [
            value: none ; this makes the 'value variable static
        ] [
            either set [rebol/words/set/any 'value get/any 'newval] [
                get/any 'value
            ]
        ]
        result/set get/any 'initval
        :result
    ]

    a: cell integer! 5
    a ; == 5
    a/set 18
    a ; == 18

    ; A function using local variable 'a
    f: funcs [] [] [a: 2]
    source f ; f: func [/local a][a: 2]

    ; A function using static variable 'a
    normal-density: funcs [
        {density of the Normal Probability Distribution}
        x [number!]
        /param
            mu [number!]
            sigma [number!]
    ] [
        ; initialization of the variable 'a, which becomes static
        a: 1.0 / square-root 2.0 * pi
    ] [
        if param [x: x - mu / sigma]
        a * exp  -0.5 * x * x
    ]

    ; A function using local variables 'rows, 'c, 'cols, 'result and 'value
    m*m: funcs [
        {Multiply two matrices}
        a [block!] {Matrix a}
        b [block!] {Matrix b}
    ] [] [
        ; variables 'rows, 'c, 'cols and 'result become local
        rows: length? a
        c: length? b
        cols: length? b/1
        result: array reduce [rows cols]
        repeat row rows [
            repeat col cols [
                ; variable 'value becomes local,
                ; since the /deep refinement was used
                value: 0
                repeat i c [value: a/:row/:i * b/:i/:col + value]
                poke result/:row col value
            ]
        ]
        result
    ]
]