Gregg Irwin napsal(a):
> Hi All!
>
> I've posted this before--never got much response--but I'll try again,
> since I really want to pester Carl to add something like this to R3 if
> others think it would be useful.
>
> What is it?
>
> A function to collect values into a block, so you can avoid the
> local/copy/append/return dance in functions. e.g.
>
> fn: func [series /local res] [
> res: copy []
> foreach val series [append res val]
> res
> ]
>
> It was inspired by Brett Handley and Romano Paolo Tenca. I just
> came up with a different approach that worked better for me.
>
> How does it work?
>
> It takes a word and a block as arguments. Anytime the word appears
> as a set-word! in the block, the value assigned to it is
> "collected".
>
> The above func would look like this:
>
> fn: func [series] [
> collect v [foreach val series [v: val]
> ]
>
> Why bother?
>
> 1) It reduces tedious code.
>
> 2) It makes it clear that you're collecting values.
>
> What are the downsides?
>
> It's a subtle dialect that overrides the meaning of set-words.
> (I've been using it for quite a while now, so I can't judge how
> unnatural it feels to others)
>
> Where's the code?
>
> collect: func [
> [throw]
> {Collects block evaluations.}
> 'word "Word to collect (as a set-word! in the block)"
> block [any-block!] "Block to evaluate"
> /into dest [series!] "Where to append results"
> /only "Insert series results as series"
> /local code marker at-marker? marker* mark replace-marker rules
> ] [
> block: copy/deep block
> dest: any [dest make block! []]
> ; "not only" forces the result to logic!, for use with PICK.
> ; insert+tail pays off here over append.
> ; FIRST BACK allows pass-thru assignment of value.
> code: compose [first back (pick [insert insert/only] not only) tail
> dest]
> marker: to set-word! word
> at-marker?: does [mark/1 = marker]
> ; We have to use change/part since we want to replace only one
> ; item (the marker), but our code is more than one item long.
> replace-marker: does [change/part mark code 1]
> marker*: [mark: set-word! (if at-marker? [replace-marker])]
> parse block rules: [any [marker* | into rules | skip]]
> do block
> head :dest
> ]
>
> Got any examples?
>
> collect zz []
> collect zz [repeat i 10 [if (zz: i) >= 3 [break]]]
> collect zz [repeat i 10 [zz: i if i >= 3 [break]]]
> collect zz [repeat i 10 [either i <= 3 [zz: i][break]]]
> dest: copy []
> collect/into zz [repeat n 10 [zz: n * 100]] dest
> collect zz [for i 1 10 2 [zz: i * 10]]
> collect zz [for x 1 10 1 [zz: x]]
> collect zz [foreach [a b] [1 2 3 4] [zz: a + b]]
> collect zz [foreach w [a b c d] [zz: w]]
> collect zz [repeat e [a b c %.txt] [zz: file? e]]
> iota: func [n [integer!]][collect zz [repeat i n [zz: i]]]
> iota 10
> collect zz [foreach x first system [zz: to-set-word x]]
> x: first system
> collect zz [forall x [zz: length? x]]
> x: first system
> collect zz [forskip x 2 [zz: length? x]]
> collect/only zz [foreach [a b] [1 2 3 4] [zz: a zz: b zz: reduce [a b
> a + b]]]
> collect/only zz [
> foreach [a b] [1 2 3 4] [
> zz: a zz: b zz: reduce [a b a + b]
> foreach n reduce [a b a + b] [zz: n * 10]
> ]
> ]
>
> dest: copy ""
> collect/into zz [repeat n 10 [zz: n * 100 zz: " "]] dest
>
> dest: copy []
> collect/into zz [
> foreach [num blk] [1 [a b c] 2 [d e f] 3 [g h i]] [
> zz: num
> collect/only/into yy [
> zz: blk
> foreach word blk [zz: yy: num yy: word]
> yy: blk
> ] dest
> ]
> ] dest
>
> Comments?
>
> This is where you come in.
>
> Is it something worth asking RT to include?
>
> How could it be improved?
>
>
> -- Gregg
>
>
here is my attempt:
collect-var: func [
[throw]
{Collects block evaluations.}
'yield "Yield-function name"
block [any-block!] "Block to evaluate"
/into dest [series!] "Where to append results"
/only "Insert series results as series"
] [
yield: reduce [yield]
yield: first use yield reduce [yield]
use [dst] copy/deep [
dst: any [:dest make block! []]
set yield func [value [any-type!]] either only [
[
insert/only tail :dst get/any 'value
return get/any 'value
]
] [
[
insert tail :dst get/any 'value
return get/any 'value
]
]
do bind/copy block yield
head :dst
]
]
; example
collect-var x [
probe collect-var y [
foreach i [1 2] [
x i
y negate i
]
]
]
--
To unsubscribe from the list, just send an email to
lists at rebol.com with unsubscribe as the subject.
