-! Copyright (C) 2009 Slava Pestov.
+!r Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs bit-arrays bit-sets fry
hashtables hints kernel locals math namespaces sequences sets
cfg get reverse-post-order ; inline
: filter-by ( flags seq -- seq' )
- [ drop ] pusher [ 2each ] dip ;
+ [ drop ] selector [ 2each ] dip ;
HINTS: filter-by { bit-array object } ;
] 2each ; inline
: merge-set ( bbs -- bbs' )
- (merge-set) filter-by ;
\ No newline at end of file
+ (merge-set) filter-by ;
2dup [ length ] bi@ max '[ _ 1 pad-tail ] bi@ [ bitand ] 2map ;
: (uninitialized-locs) ( seq quot -- seq' )
- [ [ drop 0 = ] pusher [ each-index ] dip ] dip map ; inline
+ [ [ drop 0 = ] selector [ each-index ] dip ] dip map ; inline
PRIVATE>
] (parallel-each) ; inline\r
\r
: parallel-filter ( seq quot -- newseq )\r
- over [ pusher [ parallel-each ] dip ] dip like ; inline\r
+ over [ selector [ parallel-each ] dip ] dip like ; inline\r
\r
<PRIVATE\r
\r
] if ; inline recursive
: query-map ( statement quot -- seq )
- accumulator [ query-each ] dip { } like ; inline
+ collector [ query-each ] dip { } like ; inline
: with-db ( db quot -- )
[ db-open db-connection ] dip
'[ obj>> @ ] dlist-each-node ; inline
: dlist>seq ( dlist -- seq )
- [ ] accumulator [ dlist-each ] dip ;
+ [ ] collector [ dlist-each ] dip ;
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
] if ; inline
: map-lines ( from to quot -- results )
- accumulator [ each-line ] dip ; inline
+ collector [ each-line ] dip ; inline
: start/end-on-line ( from to line# document -- n1 n2 )
[ start-on-line ] [ end-on-line ] bi-curry bi-curry bi* ;
[ bitstream>> ]
[ [ [ <huffman-decoder> ] with map ] change-huff-tables drop ] bi
jpeg> components>> [ fetch-tables ] each
- [ decode-macroblock 2array ] accumulator
+ [ decode-macroblock 2array ] collector
[ all-macroblocks ] dip
jpeg> setup-bitmap draw-macroblocks
jpeg> bitmap>> 3 <groups> [ color-transform ] map! drop
setup-traversal iterate-directory-entries drop ; inline
: recursive-directory-files ( path bfs? -- paths )
- [ ] accumulator [ each-file ] dip ; inline
+ [ ] collector [ each-file ] dip ; inline
: recursive-directory-entries ( path bfs? -- directory-entries )
- [ ] accumulator [ each-directory-entry ] dip ; inline
+ [ ] collector [ each-directory-entry ] dip ; inline
: find-file ( path bfs? quot -- path/f )
[ <directory-iterator> ] dip
[ keep and ] curry iterate-directory ; inline
: find-all-files ( path quot -- paths/f )
- [ f <directory-iterator> ] dip pusher
+ [ f <directory-iterator> ] dip selector
[ [ f ] compose iterate-directory drop ] dip ; inline
ERROR: file-not-found path bfs? quot ;
<reversed> nil [ swons ] reduce ;
: lmap>array ( list quot -- array )
- accumulator [ leach ] dip { } like ; inline
+ collector [ leach ] dip { } like ; inline
: list>array ( list -- array )
[ ] lmap>array ;
[ prepare-match-iterator ] dip (each-match) ; inline
: map-matches ( string regexp quot: ( start end string -- obj ) -- seq )
- accumulator [ each-match ] dip >array ; inline
+ collector [ each-match ] dip >array ; inline
: all-matching-slices ( string regexp -- seq )
[ slice boa ] map-matches ;
[ '[ _ deep-map ] map ] [ drop ] if ; inline recursive
: deep-filter ( obj quot: ( elt -- ? ) -- seq )
- over [ pusher [ deep-each ] dip ] dip
+ over [ selector [ deep-each ] dip ] dip
dup branch? [ like ] [ drop ] if ; inline recursive
: (deep-find) ( obj quot: ( elt -- ? ) -- elt ? )
: mnmap ( m*seq quot m n -- result*n )
2dup '[ [ _ npick ] dip swap _ dupn ] 2dip mnmap-as ; inline
-: naccumulator-for ( quot ...exemplar n -- quot' vec... )
+: ncollector-for ( quot ...exemplar n -- quot' vec... )
5 dupn '[
[ [ length ] keep new-resizable ] _ napply
[ [ [ push ] _ apply-curry _ spread* ] _ ncurry compose ] _ nkeep
] call ; inline
-: naccumulator ( quot n -- quot' vec... )
- [ V{ } swap dupn ] keep naccumulator-for ; inline
+: ncollector ( quot n -- quot' vec... )
+ [ V{ } swap dupn ] keep ncollector-for ; inline
: nproduce-as ( pred quot ...exemplar n -- seq... )
7 dupn '[
_ ndup
- [ _ naccumulator-for [ while ] _ ndip ]
+ [ _ ncollector-for [ while ] _ ndip ]
_ ncurry _ ndip
[ like ] _ apply-curry _ spread*
] call ; inline
(assoc-each) each ; inline
: assoc>map ( assoc quot exemplar -- seq )
- [ accumulator [ assoc-each ] dip ] dip like ; inline
+ [ collector [ assoc-each ] dip ] dip like ; inline
: assoc-map-as ( assoc quot exemplar -- newassoc )
[ [ 2array ] compose V{ } assoc>map ] dip assoc-like ; inline
input-stream get swap each-stream-line ; inline
: stream-lines ( stream -- seq )
- [ [ ] accumulator [ each-stream-line ] dip { } like ] with-disposal ;
+ [ [ ] collector [ each-stream-line ] dip { } like ] with-disposal ;
: lines ( -- seq )
input-stream get stream-lines ; inline
{ $code "'[ 2 _ + ]" } ;
ARTICLE: "namespaces-make" "Making sequences with variables"
-"The " { $vocab-link "make" } " vocabulary implements a facility for constructing sequences by holding an accumulator sequence in a variable. Storing the accumulator sequence in a variable rather than the stack may allow code to be written with less stack manipulation."
+"The " { $vocab-link "make" } " vocabulary implements a facility for constructing sequences by holding an collector sequence in a variable. Storing the collector sequence in a variable rather than the stack may allow code to be written with less stack manipulation."
$nl
"Sequence construction is wrapped in a combinator:"
{ $subsections make }
%
#
}
-"The accumulator sequence can be accessed directly from inside a " { $link make } ":"
+"The collector sequence can be accessed directly from inside a " { $link make } ":"
{ $subsections building }
{ $example
"USING: make math.parser ;"
"50"
} ;
-HELP: pusher
+HELP: selector
{ $values
{ "quot" "a predicate quotation" }
{ "quot" quotation } { "accum" vector } }
-{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the accumulator if the test yields true. The accumulator is left on the stack for convenience." }
+{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the collector if the test yields true. The collector is left on the stack for convenience." }
{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;"
- "10 iota [ even? ] pusher [ each ] dip ."
+ "10 iota [ even? ] selector [ each ] dip ."
"V{ 0 2 4 6 8 }"
}
-{ $notes "Used to implement the " { $link filter } " word. Compare this word with " { $link accumulator } ", which is an unfiltering version." } ;
+{ $notes "Used to implement the " { $link filter } " word. Compare this word with " { $link collector } ", which is an unfiltering version." } ;
HELP: trim-head
{ $values
"1290"
} } ;
-HELP: 2pusher
+HELP: 2selector
{ $values
{ "quot" quotation }
{ "quot" quotation } { "accum1" vector } { "accum2" vector } }
"T{ slice { from 1 } { to 2 } { seq { 1 2 } } }\nT{ slice { from 1 } { to 2 } { seq { 3 4 } } }\n1\n3"
} } ;
-HELP: accumulator
+HELP: collector
{ $values
{ "quot" quotation }
{ "quot'" quotation } { "vec" vector } }
{ $description "Creates a new quotation that pushes its result to a vector and outputs that vector on the stack." }
{ $examples { $example "USING: sequences prettyprint kernel math ;"
- "{ 1 2 } [ 30 + ] accumulator [ each ] dip ."
+ "{ 1 2 } [ 30 + ] collector [ each ] dip ."
"V{ 31 32 }"
} } ;
ARTICLE: "sequences-combinator-implementation" "Implementing sequence combinators"
"Creating a new sequence unconditionally:"
{ $subsections
- accumulator
- accumulator-for
+ collector
+ collector-for
}
"Creating a new sequence conditionally:"
{ $subsections
- pusher
- pusher-for
- 2pusher
+ selector
+ selector-for
+ 2selector
} ;
ARTICLE: "sequences" "Sequence operations"
: push-if ( elt quot accum -- )
[ keep ] dip rot [ push ] [ 2drop ] if ; inline
-: pusher-for ( quot exemplar -- quot accum )
+: selector-for ( quot exemplar -- quot accum )
[ length ] keep new-resizable [ [ push-if ] 2curry ] keep ; inline
-: pusher ( quot -- quot accum )
- V{ } pusher-for ; inline
+: selector ( quot -- quot accum )
+ V{ } selector-for ; inline
: filter-as ( seq quot exemplar -- subseq )
- dup [ pusher-for [ each ] dip ] curry dip like ; inline
+ dup [ selector-for [ each ] dip ] curry dip like ; inline
: filter ( seq quot -- subseq )
over filter-as ; inline
: push-either ( elt quot accum1 accum2 -- )
[ keep swap ] 2dip ? push ; inline
-: 2pusher ( quot -- quot accum1 accum2 )
+: 2selector ( quot -- quot accum1 accum2 )
V{ } clone V{ } clone [ [ push-either ] 3curry ] 2keep ; inline
: partition ( seq quot -- trueseq falseseq )
- over [ 2pusher [ each ] 2dip ] dip [ like ] curry bi@ ; inline
+ over [ 2selector [ each ] 2dip ] dip [ like ] curry bi@ ; inline
-: accumulator-for ( quot exemplar -- quot' vec )
+: collector-for ( quot exemplar -- quot' vec )
[ length ] keep new-resizable [ [ push ] curry compose ] keep ; inline
-: accumulator ( quot -- quot' vec )
- V{ } accumulator-for ; inline
+: collector ( quot -- quot' vec )
+ V{ } collector-for ; inline
: produce-as ( pred quot exemplar -- seq )
- dup [ accumulator-for [ while ] dip ] curry dip like ; inline
+ dup [ collector-for [ while ] dip ] curry dip like ; inline
: produce ( pred quot -- seq )
{ } produce-as ; inline
read-longlong >>cursor
read-int32 >>start#
read-int32 [ >>returned# ] keep
- [ H{ } stream>assoc ] accumulator [ times ] dip >>objects ;
+ [ H{ } stream>assoc ] collector [ times ] dip >>objects ;
: read-header ( message -- message )
read-int32 >>length
syn keyword factorKeyword ?at assoc? assoc-clone-like assoc= delete-at* assoc-partition extract-keys new-assoc value? assoc-size map>assoc push-at assoc-like key? assoc-intersect assoc-refine update assoc-union assoc-combine at* assoc-empty? at+ set-at assoc-all? assoc-subset? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at inc-at enum? at cache assoc>map <enum> assoc assoc-map enum value-at* assoc-map-as >alist assoc-filter-as clear-assoc assoc-stack maybe-set-at substitute assoc-filter 2cache delete-at assoc-find keys assoc-any? unzip
syn keyword factorKeyword case execute-effect no-cond no-case? 3cleave>quot 2cleave cond>quot wrong-values? no-cond? cleave>quot no-case case>quot 3cleave wrong-values to-fixed-point alist>quot case-find cond cleave call-effect 2cleave>quot recursive-hashcode linear-case-quot spread spread>quot
syn keyword factorKeyword number= if-zero next-power-of-2 each-integer ?1+ fp-special? imaginary-part unless-zero float>bits number? fp-infinity? bignum? fp-snan? denominator fp-bitwise= * + power-of-2? - u>= / >= bitand log2-expects-positive < log2 > integer? number bits>double 2/ zero? (find-integer) bits>float float? shift ratio? even? ratio fp-sign bitnot >fixnum complex? /i /f byte-array>bignum when-zero sgn >bignum next-float u< u> mod recip rational find-last-integer >float (all-integers?) 2^ times integer fixnum? neg fixnum sq bignum (each-integer) bit? fp-qnan? find-integer complex <fp-nan> real double>bits bitor rem fp-nan-payload all-integers? real-part log2-expects-positive? prev-float align unordered? float fp-nan? abs bitxor u<= odd? <= /mod rational? >integer real? numerator
-syn keyword factorKeyword member-eq? append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as last-index-from reversed index-from cut* pad-tail remove-eq! concat-as but-last snip trim-tail nths nth 2pusher sequence slice? <slice> partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length drop-prefix unclip unclip-last-slice iota map-sum bounds-error? sequence-hashcode-step pusher-for accumulate-as map start midpoint@ (accumulate) rest-slice prepend fourth sift accumulate! new-sequence follow map! like first4 1sequence reverse slice unless-empty padding virtual@ repetition? set-last index 4sequence max-length set-second immutable-sequence first2 first3 replicate-as reduce-index unclip-slice supremum suffix! insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? reverse! 2sequence map-integers delete-all start* indices snip-slice check-slice sequence? head map-find filter! append-as reduce sequence= halves collapse-slice interleave 2map filter-as binary-reduce slice-error? product bounds-check? bounds-check harvest immutable virtual-exemplar find produce remove pad-head last replicate set-fourth remove-eq shorten reversed? map-find-last 3map-as 2unclip-slice shorter? 3map find-last head-slice pop* 2map-as tail-slice* but-last-slice 2map-reduce iota? accumulator-for accumulate each pusher append! new-resizable cut-slice each-index head-slice* 2reverse-each sequence-hashcode pop set-nth ?nth <flat-slice> second join when-empty accumulator immutable-sequence? <reversed> all? 3append-as virtual-sequence subseq? remove-nth! push-either new-like length last-index push-if 2all? lengthen assert-sequence copy map-reduce move third first 3each tail? set-first prefix bounds-error any? <repetition> trim-slice exchange surround 2reduce cut change-nth min-length set-third produce-as push-all head? delete-slice rest sum-lengths 2each head* infimum remove! glue slice-error subseq trim replace-slice push repetition map-index trim-head unclip-last mismatch
+syn keyword factorKeyword member-eq? append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as last-index-from reversed index-from cut* pad-tail remove-eq! concat-as but-last snip trim-tail nths nth 2selector sequence slice? <slice> partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length drop-prefix unclip unclip-last-slice iota map-sum bounds-error? sequence-hashcode-step selector-for accumulate-as map start midpoint@ (accumulate) rest-slice prepend fourth sift accumulate! new-sequence follow map! like first4 1sequence reverse slice unless-empty padding virtual@ repetition? set-last index 4sequence max-length set-second immutable-sequence first2 first3 replicate-as reduce-index unclip-slice supremum suffix! insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? reverse! 2sequence map-integers delete-all start* indices snip-slice check-slice sequence? head map-find filter! append-as reduce sequence= halves collapse-slice interleave 2map filter-as binary-reduce slice-error? product bounds-check? bounds-check harvest immutable virtual-exemplar find produce remove pad-head last replicate set-fourth remove-eq shorten reversed? map-find-last 3map-as 2unclip-slice shorter? 3map find-last head-slice pop* 2map-as tail-slice* but-last-slice 2map-reduce iota? collector-for accumulate each selector append! new-resizable cut-slice each-index head-slice* 2reverse-each sequence-hashcode pop set-nth ?nth <flat-slice> second join when-empty collector immutable-sequence? <reversed> all? 3append-as virtual-sequence subseq? remove-nth! push-either new-like length last-index push-if 2all? lengthen assert-sequence copy map-reduce move third first 3each tail? set-first prefix bounds-error any? <repetition> trim-slice exchange surround 2reduce cut change-nth min-length set-third produce-as push-all head? delete-slice rest sum-lengths 2each head* infimum remove! glue slice-error subseq trim replace-slice push repetition map-index trim-head unclip-last mismatch
syn keyword factorKeyword global +@ change set-namestack change-global init-namespaces on off set-global namespace set with-scope bind with-variable inc dec counter initialize namestack get get-global make-assoc
syn keyword factorKeyword <array> 2array 3array pair >array 1array 4array pair? array resize-array array?
syn keyword factorKeyword +character+ bad-seek-type? readln each-morsel stream-seek read print with-output-stream contents write1 stream-write1 stream-copy stream-element-type with-input-stream stream-print stream-read stream-contents stream-tell tell-output bl seek-output bad-seek-type nl stream-nl write flush stream-lines +byte+ stream-flush read1 seek-absolute? stream-read1 lines stream-readln stream-read-until each-line seek-end with-output-stream* seek-absolute with-streams seek-input seek-relative? input-stream stream-write read-partial seek-end? seek-relative error-stream read-until with-input-stream* with-streams* tell-input each-block output-stream stream-read-partial each-stream-block each-stream-line
projects / factor.git / commitdiff