Rebol [
    Title: "Curry"
    File: %curry.r
    Date: 23-Aug-2005/9:47:16+2:00
    History: [
        9/Mar/2003/18:05 {using Tfunc}
        8/Dec/2004/14:22 {Tfunc usage change}
    ]
    Author: "Ladislav Mecir"
    Purpose: {defines the CURRY function}
]

#include-check %nargs.r
#include-check %tfunc.r
#include-check %closure.r

curry: function [
    {Create curried functions}
    [catch]
    f [any-function!] {Function to be curried}
    cargs [integer!] {Number of the arguments of the result}
] [
    numargs f-call args1-specs args2-specs
    i args-specs item cont
] [
    if any [cargs > (numargs: nargs :f) cargs < 0] [
        throw make error! [script out-of-range cargs]
    ]
    f-call: make block! 2 * numargs + 2
    append f-call reduce ['return' :f]
    args1-specs: make block! 16
    args2-specs: make block! 16
    i: 1
    args-specs: args1-specs
    parse third :f [
        [set item string! (append args2-specs item) | none]
        any [
            [
                refinement! (cont: [end skip]) | (cont: none) [
                    word! (
                        append args-specs
                            to word! append copy "a" form i
                        append/only f-call 'get/any
                        append f-call
                            to lit-word! append copy "a" form i
                        if i = cargs [args-specs: args2-specs]
                        i: i + 1
                    ) [
                        set item block! (
                            append/only args-specs load mold item
                        ) | none
                    ] | lit-word! (
                        throw make error!
                            {functions with unevaluated arguments not supported}
                    ) | get-word! (
                        throw make error!
                            {functions with fetched arguments not supported}
                    ) | skip
                ]
            ] cont
        ]
    ]
    closure args1-specs reduce [:tfunc args2-specs f-call]
]

curryfirst: func [f [any-function!]] [curry :f 1]

composition: curry tfunc [
    f [any-function!] g [any-function!] x [any-type!]
] ['return' f g get/any 'x] 2

mapper: curry :map 1

#do [i-comment {
    Examples:

    f: func [x y] [reduce [x y]]
    cfx: curryfirst :f
    cf777: cfx 777
    cf777 4
    cf5: cfx 5
    cf777 8
    cf5 6

    curryadd: curryfirst :add
    ca1: curryadd 1
    ca2: curryadd 2
    ca1 1
    ca2 1
    ca2 3
    ca1 4

    capp: curryfirst :apply
    cappt: capp :type?
    cappt [:odd?]

    cf: composition func [x] [x + 1] func [x] [10 * x]
    cf 1
}]