[REBOL] nforeach
From: g:santilli:tiscalinet:it at: 22-Jul-2003 13:12
Hello all,
it often happens to me to have to iterate in parallel over two
or more series. Today I thought it was the time to solve the issue
once and for all with a specific function. :)
Note: this is rather a QAD implementation. It surely needs
improvements.
It works this way:
>> nforeach [a [1 2 3] b [4 5 6]] [print [a b]]
1 4
2 5
3 6
It also handles more complicated cases:
>> w: 'c b: [d e] nforeach [file read %./ [a b] [1 2 3 4 5 6] :w [x y z] :b [9 8 7 6
5]] [print [file a b c d e]]
desktop/ 1 2 x 9 8
edit-prefs.r 3 4 y 7 6
license.key 5 6 z 5 none
local/ none none none none none
prefs.r none none none none none
public/ none none none none none
rebol-1.2.1.exe none none none none none
rebol-link.exe none none none none none
rebol.exe none none none none none
rebol.r none none none none none
user.r none none none none none
view1210031.exe none none none none none
viewtop1200.zip none none none none none
Let me know what you think.
context [
invalid: func [arg] [throw make error! join [script invalid-arg] :arg]
ceil: func [num [number!]] [
either num > num: to integer! num [num + 1] [num]
]
set 'nforeach func [[catch] args [block!] body [block!] /local bargs words end word]
[
bargs: head clear next [body]
words: clear [ ]
end: 0
while [not tail? args] [
word: pick args 1
if not any [word? :word block? :word all [get-word? :word any [word? word: get :word
block? :word]]] [
invalid :word
]
use [series] [
set [series args] do/next next args
if not series? :series [
invalid :series
]
insert tail words word
either block? word [
repeat j length? word [
insert insert insert insert tail bargs [pick :series i - 1 *] length? word '+ j
]
end: max end ceil divide length? :series length? word
] [
insert tail bargs [pick :series i]
end: max end length? :series
]
]
]
if any [empty? words empty? bargs] [return none]
body: func words body
repeat i end bargs
]
]
Regards,
Gabriele.
--
Gabriele Santilli <[g--santilli--tiscalinet--it]> -- REBOL Programmer
Amiga Group Italia sez. L'Aquila --- SOON: http://www.rebol.it/