* Gregg Irwin <[EMAIL PROTECTED]> [060510 13:36]:
I modified Andrew Martin's 'collect function based on the
following premise:
A persistant "good guess" about memory usage could be more
efficient that frequent re-allocating and resizing:
this is what 'yield looks like:
;
-----------------------------------------------------------------------------------------
make object! [
type-len: 100 ;; length of string or other non-block series type
block-len: 50 ;; length of block
type-used: false ;; set to 'true if initializing with 'type
block-used: false ;; set to 'true if initializing with 'block
use-type: func[][ ;; initialize a 'non-block' 'Results word
block-used: false
type-used: true
type-len
]
use-block: func[][ ;; initialize a block 'Results word.
block-used: true
type-used: false
block-len
]
set-len: func[Results /local len][ ;; adjust lengths to accomodate growing
memory usage
len: length? Results
if series? Results[
either block-used
[if block-len < len[block-len: to-integer 1.5 * len]]
[if type-len < len[type-len: to-integer 1.5 * len]]]
]
set 'yield func [ {Collects the results of block evaluations.}
Block [block!] "The block to 'do."
/Only "Inserts the result as a series." /Full "Don't ignore none!
values."
/Initial Type [series! datatype!] "Specifies the type of the result."
/str "return as string, 'rejoining if block"
] [
use [Break Result Results] [
if str[Type: string!]
Break: func [ "Breaks out of the 'Collect."
/Return "Forces the loop function to return a Value."
Value [any-type!]
][system/words/break/return either Return [ Value ] [ Results ]
]
Results: any [
all [datatype? Type make Type use-type]
Type
make block! use-block
]
compose/deep [
if not any [
unset? set/any 'Result do [(bind Block 'Break)]
(pick [[none? :Result] []] not Full)
] [
(pick [insert insert/only] not Only) tail Results :Result
Results
]
set-len Results ;; record length and make adjustments for
further allocations, if necessary
Results
]
] ;; end 'use
] ;; end 'yield
] ;;
;; Disclaimer:
;; 1)I did not fully follow Martin's code.
;; He is head and shoulders above me in knowledge of rebol
;; 2)Has never been used with any type but string! and block!
;; My job was to
;; 1)modify some refinements and add the memory allocation
;; scheme,
;; 2)encapsulate in anonymous context
;; 3)Add helper functions for the memory usage tracking.
;; Next step would be to add code that enables the data buffer itself to be
;; persistant.
;
------------------------------------------------------------------------------------------
;; examples
;; Using a block
swaps: def[[catch] {swaps pairs in block. Block must be of even length.
Example: swaps[2 1 4 3 6 5] => [1 2 3 4 5 6] }
blk[block!]
][
if not even? (length? blk)[toss["'blk argument must be of even length."]]
foreach [a b] blk yield[reduce[b a]]
]
;; using a string
nbsp: def[ {returns string with 'n' number of non-breaking spaces ( )}
n[integer!]][
loop n yield/str[" "]
]
Like Gregg, I use this function extensively in my own libraries and I
haven't seem any ill effects. I did note some speedup, but didn't record
it. Cuts down on a *lot* of code.
Tim
> 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
>
> --
> To unsubscribe from the list, just send an email to
> lists at rebol.com with unsubscribe as the subject.
--
Tim Johnson <[EMAIL PROTECTED]>
http://www.alaska-internet-solutions.com
--
To unsubscribe from the list, just send an email to
lists at rebol.com with unsubscribe as the subject.
