http://snippets.dzone.com/posts Sat, 17 May 2008 14:28:27 GMT DZone Snippets: collect code http://snippets.dzone.com/posts/show/2091 // description of your code here <br /> <br /><code> <br />file-size-comparison-ctx: context [ <br /> =negate-op?: none <br /> =or-equal?: none <br /> =op: none <br /> =size: 0 <br /> =size-mul: 1 <br /> =parse-end-mark: none <br /> <br /> make-lit-word: func [val] [to lit-word! :val] <br /> lit-lesser: make-lit-word "<" <br /> lit-greater: make-lit-word ">" <br /> lit-lesser-or-equal: make-lit-word "<=" <br /> lit-greater-or-equal: make-lit-word ">=" <br /> <br /> size=: [ <br /> (=size-mul: 1) <br /> set =size number! <br /> opt [ <br /> 'bytes ; no change to size-mul <br /> | ['kilobytes | 'KB] (=size-mul: 1024.0) <br /> | ['megabytes | 'MB] (=size-mul: 1048576.0) <br /> | ['gigabytes | 'GB] (=size-mul: 1073741824.0) <br /> ] <br /> (=size: =size * =size-mul) <br /> ] <br /> word-comparison=: [ <br /> [ <br /> ['more | 'bigger | 'larger | 'greater] (=op: 'greater) <br /> | ['less | 'smaller] (=op: 'lesser) <br /> ] 'than <br /> opt ['or 'equal 'to (=or-equal?: true)] <br /> ] <br /> lit-comparison=: [ <br /> lit-lesser (=or-equal?: false =op: 'lesser) <br /> | lit-greater (=or-equal?: false =op: 'greater) <br /> | lit-lesser-or-equal (=or-equal?: true =op: 'lesser) <br /> | lit-greater-or-equal (=or-equal?: true =op: 'greater) <br /> ] <br /> rules=: [ <br /> (=negate-op?: =or-equal?: =op: =parse-end-mark: none) <br /> opt 'if opt ['size | size?] <br /> opt [['no | 'not] (=negate-op?: true)] <br /> [word-comparison= | lit-comparison=] <br /> (if =negate-op? [=op: pick [greater lesser] =op = 'lesser]) <br /> (=op: to word! rejoin [=op either =or-equal? ['-or-equal] [""] '?]) <br /> size= <br /> =parse-end-mark: <br /> ] <br /> <br /> set 'size-comparison-cmd? func [input [block!]] [ <br /> parse input rules= <br /> return =parse-end-mark <br /> ] <br /> <br /> set 'make-file-size-comparison-func func [spec] [ <br /> parse spec rules= <br /> either =parse-end-mark [ <br /> func [file] reduce [=op 'size? 'file =size] <br /> ] [none] <br /> ] <br /> <br /> set 'files-matching-size-spec func [ <br /> files [block!] <br /> spec [block!] <br /> ][ <br /> if match?: make-file-size-comparison-func spec [ <br /> collect 'keep [ <br /> foreach file files [if match? file [keep: file]] <br /> ] <br /> ] <br /> ] <br />] <br />;foreach file files-matching-size-spec read %. [>= 64 kb] [print [file size? file]] <br /></code> Tue, 23 May 2006 21:43:57 GMT http://snippets.dzone.com/posts/show/2091 gregg.irwin (Gregg Irwin) http://snippets.dzone.com/posts/show/2090 // description of your code here <br /> <br /><code> <br />file-date-comparison-ctx: context [ <br /> =negate-op?: none <br /> =or-equal?: none <br /> =op: none <br /> =parse-end-mark: none <br /> =attr: 'modification-date <br /> =date: none <br /> <br /> make-lit-word: func [val] [to lit-word! :val] <br /> lit-equal: make-lit-word "=" <br /> lit-lesser: make-lit-word "<" <br /> lit-greater: make-lit-word ">" <br /> lit-lesser-or-equal: make-lit-word "<=" <br /> lit-greater-or-equal: make-lit-word ">=" <br /> <br /> attr=: [ <br /> ['changed | 'modified | 'upated | 'modification-date] <br /> | ['created | 'creation-date | 'create-date] (=attr: 'creation-date) <br /> | ['accessed | 'access-date] (=attr: 'access-date) <br /> ] <br /> date=: [ <br /> [ <br /> set =date date! <br /> | set =date file! (=date: get-modes =date =attr) <br /> | 'yesterday (=date: now/date - 1) <br /> | 'today (=date: now/date) <br /> | 'tomorrow (=date: now/date + 1) <br /> ] <br /> ] <br /> word-comparison=: [ <br /> [ <br /> ['after | 'since | 'newer 'than] (=op: 'greater) <br /> | ['before | 'older 'than] (=op: 'lesser) <br /> ] <br /> opt ['or 'equal 'to (=or-equal?: true)] <br /> ] <br /> lit-comparison=: [ <br /> lit-equal (=or-equal?: false =op: 'equal) <br /> | lit-lesser (=or-equal?: false =op: 'lesser) <br /> | lit-greater (=or-equal?: false =op: 'greater) <br /> | lit-lesser-or-equal (=or-equal?: true =op: 'lesser) <br /> | lit-greater-or-equal (=or-equal?: true =op: 'greater) <br /> ] <br /> rules=: [ <br /> ( <br /> =negate-op?: =or-equal?: =op: =parse-end-mark: =date: none <br /> =attr: 'modification-date <br /> ) <br /> opt 'if opt ['date | 'date?] <br /> opt [['no | 'not] (=negate-op?: true)] <br /> opt ['date | 'date?] <br /> opt attr= <br /> [word-comparison= | lit-comparison=] <br /> (if =negate-op? [=op: pick [greater lesser] =op = 'lesser]) <br /> (=op: to word! rejoin [=op either =or-equal? ['-or-equal] [""] '?]) <br /> date= <br /> =parse-end-mark: <br /> ] <br /> <br /> set 'date-comparison-cmd? func [input [block!]] [ <br /> parse input rules= <br /> return =parse-end-mark <br /> ] <br /> <br /> set 'make-file-date-comparison-func func [spec] [ <br /> parse spec rules= <br /> either =parse-end-mark [ <br /> func [file] reduce [=op 'get-modes 'file to lit-word! =attr =date] <br /> ] [none] <br /> ] <br /> <br /> set 'files-matching-date-spec func [ <br /> files [block!] <br /> spec [block!] <br /> ][ <br /> if match?: make-file-date-comparison-func spec [ <br /> collect 'keep [ <br /> foreach file files [if match? file [keep: file]] <br /> ] <br /> ] <br /> ] <br />] <br />;foreach file files-matching-date-spec read %. [accessed after 1-jan-2006] [print [file modified? file]] <br />;foreach file files-matching-date-spec read %. [date < 1-jan-2006] [print [file modified? file]] <br /></code> Tue, 23 May 2006 21:42:36 GMT http://snippets.dzone.com/posts/show/2090 gregg.irwin (Gregg Irwin) http://snippets.dzone.com/posts/show/2049 <code> <br /> parse-replace: func [ <br /> {Replaces the search value with the replace value within the target series.} <br /> target [series!] "Series that is being modified." <br /> search "Value to be replaced." <br /> replace "Value to replace with." <br /> /all "Replace all occurrences." <br /> /case "Case-sensitive replacement." <br /> /local len data rule text <br /> ][ <br /> len: length? search <br /> collect/into data [ <br /> rule: [ <br /> [copy text to search (if text [data: join text replace]) len skip] <br /> copy text to end (if text [data: text]) <br /> ] <br /> if all [insert rule 'any] <br /> either case [parse/all/case target rule] [parse/all target rule] <br /> ] copy make target length? target <br /> ] <br /></code> Wed, 17 May 2006 01:37:48 GMT http://snippets.dzone.com/posts/show/2049 gregg.irwin (Gregg Irwin) http://snippets.dzone.com/posts/show/1130 <code> <br /> ; What about extending this to work on string values? <br /> collect: func [ ; a.k.a. gather ? <br /> [throw] <br /> {Collects block evaluations.} <br /> 'word "Word to collect (as a set-word! in the block)" <br /> block [any-block!] "Block to evaluate" <br /> /into dest [series!] "Where to append results" <br /> /only "Insert series results as series" <br /> ;/debug <br /> /local code marker at-marker? marker* mark replace-marker rules <br /> ] [ <br /> block: copy/deep block <br /> dest: any [dest make block! []] <br /> ; "not only" forces the result to logic!, for use with PICK. <br /> ; insert+tail pays off here over append. <br /> ;code: reduce [pick [insert insert/only] not only 'tail 'dest] <br /> ; FIRST BACK allows pass-thru assignment of value. Speed hit though. <br /> ;code: reduce ['first 'back pick [insert insert/only] not only 'tail 'dest] <br /> code: compose [first back (pick [insert insert/only] not only) tail dest] <br /> marker: to set-word! word <br /> at-marker?: does [mark/1 = marker] <br /> ; We have to use change/part since we want to replace only one <br /> ; item (the marker), but our code is more than one item long. <br /> replace-marker: does [change/part mark code 1] <br /> ;if debug [probe code probe marker] <br /> marker*: [mark: set-word! (if at-marker? [replace-marker])] <br /> parse block rules: [any [marker* | into rules | skip]] <br /> ;if debug [probe block] <br /> do block <br /> head :dest <br /> ] <br /> <br /> comment { <br /> ;collect/debug zz [repeat n 10 [zz: n * 100]] <br /> collect zz [] <br /> collect zz [repeat i 10 [if (zz: i) >= 3 [break]]] <br /> collect zz [repeat i 10 [zz: i if i >= 3 [break]]] <br /> collect zz [repeat i 10 [either i <= 3 [zz: i][break]]] <br /> dest: copy [] <br /> collect/into zz [repeat n 10 [zz: n * 100]] dest <br /> collect zz [for i 1 10 2 [zz: i * 10]] <br /> collect zz [for x 1 10 1 [zz: x]] <br /> collect zz [foreach [a b] [1 2 3 4] [zz: a + b]] <br /> collect zz [foreach w [a b c d] [zz: w]] <br /> collect zz [repeat e [a b c %.txt] [zz: file? e]] <br /> iota: func [n [integer!]][collect zz [repeat i n [zz: i]]] <br /> iota 10 <br /> collect zz [foreach x first system [zz: to-set-word x]] <br /> x: first system <br /> collect zz [forall x [zz: length? x]] <br /> x: first system <br /> collect zz [forskip x 2 [zz: length? x]] <br /> collect zz [forskip x 2 [zz: (length? x) / 0]] <br /> collect/only zz [foreach [a b] [1 2 3 4] [zz: a zz: b zz: reduce [a b a + b]]] <br /> collect/only zz [ <br /> foreach [a b] [1 2 3 4] [ <br /> zz: a zz: b zz: reduce [a b a + b] <br /> foreach n reduce [a b a + b] [zz: n * 10] <br /> ] <br /> ] <br /> <br /> dest: copy "" <br /> collect/into zz [repeat n 10 [zz: n * 100 zz: " "]] dest <br /> <br /> dest: copy [] <br /> collect/into zz [ <br /> foreach [num blk] [1 [a b c] 2 [d e f] 3 [g h i]] [ <br /> zz: num <br /> collect/only/into yy [ <br /> zz: blk <br /> foreach word blk [zz: yy: num yy: word] <br /> yy: blk <br /> ] dest <br /> ] <br /> ] dest <br /> <br /> } <br /></code> Tue, 10 Jan 2006 06:25:51 GMT http://snippets.dzone.com/posts/show/1130 gregg.irwin (Gregg Irwin)