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?
>
>
>
>
