I've considered adding apply to REBOL for many years. Every few months I write a
script that could use it.
Also, here is another way to do nargs:
nargs: func [f [any-function!]] [
-1 + index? any [find first :f refinement! tail first :f]
]
-Carl
At 5/20/00 09:09 PM +0200, you wrote:
>Hi, here you are:
>
>Rebol [
> Title: "Enum"
> Date: 15/12/1999
> File: %enum.r
> Author: "Ladislav Mecir"
> Email: [EMAIL PROTECTED]
>]
>
>enum: func [
> {Enumerates a block}
> from [integer!]
> to [integer!]
> /local result
>][
> result: make block! to + 1 - from
> for i from to 1 [
> append/only result i
> ]
> result
>]
>
>{
> Example:
>
> enum 1 3
>}
>
>Rebol [
> Title: "Map"
> Date: 15/12/1999
> File: %map.r
> Author: "Ladislav Mecir"
> Email: [EMAIL PROTECTED]
>]
>
>map: func ["Maps a function to all elements of a block"
> f [any-function!] blk [block!]
> /local result
>][
> result: make block! length? blk
> foreach elem blk [
> append/only result f :elem
> ]
> result
>]
>
>{
> Example:
>
> map :- [1 2 3]
>}
>
>Rebol [
> Title: "Nargs"
> Date: 31/1/2000
> Version: 1.0.0
> File: %nargs.r
> Author: "Ladislav Mecir"
> Email: [EMAIL PROTECTED]
> Limitations: {
> ignores refinements
> }
>]
>
>nargs: func [
> "The number of the function arguments"
> f [any-function!]
> /local result args
>] [
> result: 0
> args: first :f
> while [not empty? args] [
> either refinement? first :args [args: tail args] [
> result: result + 1
> args: next args
> ]
> ]
> result
>]
>
>{
> Examples:
>
> nargs :-
>}
>
>Rebol [
> Title: "Apply"
> Date: 31/1/2000
> File: %apply.r
> Author: "Ladislav Mecir"
> Email: [EMAIL PROTECTED]
> Purpose: {
> Apply a function to its arguments stored in a block
> }
>]
>
>include %enum.r
>include %map.r
>include %nargs.r
>
>toarg: func [i [integer!]] [
> to word! append copy "a" form i
>]
>
>apply: func [
> {Apply a function to its arguments}
> f [any-function!]
> blkargs [block!] {Argument values}
> /local numargs args getargs
>] [
> numargs: nargs :f
> args: map :toarg enum 1 :numargs
> use :args compose [
> set/any (reduce [args]) (reduce [blkargs])
> f (
> getargs: make block! 2 * numargs
> foreach arg args [
> append getargs compose [
> get/any (to lit-word! arg)
> ]
> ]
> )
> ]
>]
>
>{
> Example:
>
> apply :subtract [2 1]
> apply :type? reduce [()]
>}
>
>Rebol [
> Title: "SFun"
> Author: "Ladislav Mecir"
> Email: [EMAIL PROTECTED]
> Date: 8/3/2000
> File: %sfun.r
> Purpose: {
> A function with static variables
> }
> Category: [General]
>]
>
>sfun: func [
> {create a function with static local variables}
> init [block!]
> args [block!]
> body [block!]
> /local ini words
>] [
> words: copy []
> foreach elem :init [
> if set-word? :elem [
> append :words to word! :elem
> ]
> ]
> words: union :words []
> ini: function [] :words compose [
> (reduce [:words])
> (:init)
> ]
> ini
> if not empty? :words [
> words: first first second :ini
> body: compose [
> (reduce [reduce [:ini]])
> (bind/copy :body :words)
> ]
> ]
> func :args :body
>]
>
>{
> Example #1:
>
> counter: sfun [count: 0] [] [
> count: count + 1
> print count
> ]
>
> counter
> counter
> recycle
> counter
>
>
> Example #2
>
> cell: func [
> {create a function that holds a value}
> initval [any-type!]
> ] [
> sfun [value: none set/any 'value get/any 'initval origset:
>:set] [
> /set newval [any-type!]
> ] [
> either set [origset/any 'value get/any 'newval] [
> get/any 'value
> ]
> ]
> ]
>
> a: cell 5
> print a
> a/set 18
> print a
>}
>
>
>Rebol [
> Title: "Curry"
> Date: 31/1/2000
> Version: 2.0.4
> File: %curry.r
> Author: "Ladislav Mecir"
> Email: [EMAIL PROTECTED]
> History: [
> 1.0.0 {alpha, problems with GC and function contexts}
> 2.0.0 {still GC problems}
> 2.0.2 {incorrect handling of natives/actions}
> 2.0.3 {incorrect handling of unset arguments}
> 2.0.4 {
> CATCH/THROW attributes of the argument function
>ignored
> refinements of the argument function ignored
> incompatible with literal/fetched arguments of the
>argument function
> }
> ]
>]
>
>include %map.r
>include %enum.r
>include %nargs.r
>include %sfun.r
>
>toarg: func [i [integer!]] [
> to word! append copy "a" form i
>]
>
>tla: func [i [integer!]] [
> to lit-word! append copy "a" form i
>]
>
>tsa: func [i [integer!]] [
> to set-word! append copy "a" form i
>]
>
>ga: func [a] [get/any a]
>
>curry: func ["Create curried functions"
> f [any-function!] "Function to be curried"
> cargs [integer!] "Number of the arguments of the result"
> /local numargs args restargs getargs setargs
>] [
> numargs: nargs :f
> args: map :toarg enum 1 cargs
> restargs: map :toarg enum cargs + 1 numargs
> setargs: make block! 2 * cargs
> for i 1 cargs 1 [
> append setargs compose [
> (tsa i) none
> ]
> ]
> getargs: make block! 2 * numargs
> for i 1 numargs 1 [
> append getargs compose [get/any (tla i)]
> ]
> sfun compose [
> f: first (reduce [reduce [:f]])
> restargs: (reduce [restargs])
> getargs: (reduce [getargs])
> setargs: (reduce [setargs])
> ] compose [
> (args) /local args
> ] compose [
> args: (reduce [copy args])
> sfun compose [
> f: first (reduce [reduce [:f]])
> (copy setargs)
> set/any (reduce [copy args]) map :ga args
> ] restargs compose [
> f (copy getargs)
> ]
> ]
>]
>
>curryfirst: func [f [any-function!]] [curry :f 1]
>
>{
> 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 reduce [:odd?]
>
> composition: curry func [f [any-function!] g [any-function!]
>x] [f g :x] 2
> cf: composition func [x] [x + 1] func [x] [10 * x]
> cf 1
>
> mapper: curry :map 1
> oddm: mapper :odd?
> oddm [1 2 3 4 5 6]
>
>}
>
>
>----- Puvodn� zpr�va -----
>Od: <[EMAIL PROTECTED]>
>Komu: <[EMAIL PROTECTED]>
>Odesl�no: 20. kvetna 2000 13:10
>Predmet: [REBOL] higher order functions
>
>
>> Is it possible to write a higher order functions like apply,
>map,
>> compose etc in rebol?
>>
>>
>>
>>
>
