change-each -> map!, deep-change-each -> deep-map!
Slava Pestov
parent
d17ef38007
commit
08e7d25dc5
|
|
@ -55,7 +55,7 @@ HELP: clear-bits
|
|||
{ $values { "bit-array" bit-array } }
|
||||
{ $description "Sets all elements of the bit array to " { $link f } "." }
|
||||
{ $notes "Calling this word is more efficient than the following:"
|
||||
{ $code "[ drop f ] change-each" }
|
||||
{ $code "[ drop f ] map! drop" }
|
||||
}
|
||||
{ $side-effects "bit-array" } ;
|
||||
|
||||
|
|
@ -63,7 +63,7 @@ HELP: set-bits
|
|||
{ $values { "bit-array" bit-array } }
|
||||
{ $description "Sets all elements of the bit array to " { $link t } "." }
|
||||
{ $notes "Calling this word is more efficient than the following:"
|
||||
{ $code "[ drop t ] change-each" }
|
||||
{ $code "[ drop t ] map! drop" }
|
||||
}
|
||||
{ $side-effects "bit-array" } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@ IN: bit-arrays.tests
|
|||
[
|
||||
{ t f t } { f t f }
|
||||
] [
|
||||
{ t f t } >bit-array dup clone dup [ not ] change-each
|
||||
{ t f t } >bit-array dup clone [ not ] map!
|
||||
[ >array ] bi@
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -351,7 +351,7 @@ M: f '
|
|||
[ ] [ "Not in image: " word-error ] ?if ;
|
||||
|
||||
: fixup-words ( -- )
|
||||
image get [ dup word? [ fixup-word ] when ] change-each ;
|
||||
image get [ dup word? [ fixup-word ] when ] map! drop ;
|
||||
|
||||
M: word ' ;
|
||||
|
||||
|
|
|
|||
|
|
@ -5,5 +5,5 @@ IN: columns.tests
|
|||
{ { 1 2 3 } { 4 5 6 } { 7 8 9 } } [ clone ] map "seq" set
|
||||
|
||||
[ { 1 4 7 } ] [ "seq" get 0 <column> >array ] unit-test
|
||||
[ ] [ "seq" get 1 <column> [ sq ] change-each ] unit-test
|
||||
[ ] [ "seq" get 1 <column> [ sq ] map! drop ] unit-test
|
||||
[ { 4 25 64 } ] [ "seq" get 1 <column> >array ] unit-test
|
||||
|
|
|
|||
|
|
@ -40,8 +40,8 @@ SYMBOL: visited
|
|||
:: insert-basic-block ( froms to bb -- )
|
||||
bb froms V{ } like >>predecessors drop
|
||||
bb to 1vector >>successors drop
|
||||
to predecessors>> [ dup froms memq? [ drop bb ] when ] change-each
|
||||
froms [ successors>> [ dup to eq? [ drop bb ] when ] change-each ] each ;
|
||||
to predecessors>> [ dup froms memq? [ drop bb ] when ] map! drop
|
||||
froms [ successors>> [ dup to eq? [ drop bb ] when ] map! drop ] each ;
|
||||
|
||||
: add-instructions ( bb quot -- )
|
||||
[ instructions>> building ] dip '[
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ PRIVATE>
|
|||
: [future] ( quot -- quot' ) '[ _ curry future ] ; inline
|
||||
|
||||
: future-values ( futures -- futures )
|
||||
dup [ ?future ] change-each ; inline
|
||||
[ ?future ] map! ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -354,7 +354,7 @@ SINGLETONS: YUV420 YUV444 Y MAGIC! ;
|
|||
[ decode-macroblock 2array ] accumulator
|
||||
[ all-macroblocks ] dip
|
||||
jpeg> setup-bitmap draw-macroblocks
|
||||
jpeg> bitmap>> 3 <groups> [ color-transform ] change-each
|
||||
jpeg> bitmap>> 3 <groups> [ color-transform ] map! drop
|
||||
jpeg> [ >byte-array ] change-bitmap drop ;
|
||||
|
||||
ERROR: not-a-jpeg-image ;
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@ ARTICLE: "io.mmap.examples" "Memory-mapped file examples"
|
|||
""
|
||||
"\"mydata.dat\" char ["
|
||||
" 4 <sliced-groups>"
|
||||
" [ reverse-here ] change-each"
|
||||
" [ reverse-here ] map! drop"
|
||||
"] with-mapped-array"
|
||||
}
|
||||
"Normalize a file containing packed quadrupes of floats:"
|
||||
|
|
@ -91,7 +91,7 @@ ARTICLE: "io.mmap.examples" "Memory-mapped file examples"
|
|||
"SPECIALIZED-ARRAY: float-4"
|
||||
""
|
||||
"\"mydata.dat\" float-4 ["
|
||||
" [ normalize ] change-each"
|
||||
" [ normalize ] map! drop"
|
||||
"] with-mapped-array"
|
||||
} ;
|
||||
|
||||
|
|
|
|||
|
|
@ -23,6 +23,6 @@ $nl
|
|||
{ $code "3 10 [a,b] [ sqrt ] map" }
|
||||
"Computing the factorial of 100 with a descending range:"
|
||||
{ $code "100 1 [a,b] product" }
|
||||
"A range can be converted into a concrete sequence using a word such as " { $link >array } ". In most cases this is unnecessary since ranges implement the sequence protocol already. It is necessary if a mutable sequence is needed, for use with words such as " { $link set-nth } " or " { $link change-each } "." ;
|
||||
"A range can be converted into a concrete sequence using a word such as " { $link >array } ". In most cases this is unnecessary since ranges implement the sequence protocol already. It is necessary if a mutable sequence is needed, for use with words such as " { $link set-nth } " or " { $link map! } "." ;
|
||||
|
||||
ABOUT: "math.ranges"
|
||||
|
|
|
|||
|
|
@ -30,10 +30,10 @@ HELP: flatten
|
|||
{ $values { "obj" object } { "seq" "a sequence" } }
|
||||
{ $description "Creates a sequence of all of the leaf nodes (non-sequence nodes, but including strings and numbers) in the object." } ;
|
||||
|
||||
HELP: deep-change-each
|
||||
{ $values { "obj" object } { "quot" { $quotation "( elt -- newelt )" } } }
|
||||
{ $description "Modifies each sub-node of an object in place, in preorder." }
|
||||
{ $see-also change-each } ;
|
||||
HELP: deep-map!
|
||||
{ $values { "obj" object } { "quot" { $quotation "( elt -- newelt )" } } { "obj" object } }
|
||||
{ $description "Modifies each sub-node of an object in place, in preorder, and returns that object." }
|
||||
{ $see-also map! } ;
|
||||
|
||||
ARTICLE: "sequences.deep" "Deep sequence combinators"
|
||||
"The combinators in the " { $vocab-link "sequences.deep" } " vocabulary are variants of standard sequence combinators which traverse nested subsequences."
|
||||
|
|
@ -43,7 +43,7 @@ ARTICLE: "sequences.deep" "Deep sequence combinators"
|
|||
deep-filter
|
||||
deep-find
|
||||
deep-any?
|
||||
deep-change-each
|
||||
deep-map!
|
||||
}
|
||||
"A utility word to collapse nested subsequences:"
|
||||
{ $subsections flatten } ;
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ IN: sequences.deep.tests
|
|||
[ "hey" 1array 1array [ change-something ] deep-map ] unit-test
|
||||
|
||||
[ { { "heyhello" "hihello" } } ]
|
||||
[ "hey" 1array 1array [ [ change-something ] deep-change-each ] keep ] unit-test
|
||||
[ "hey" 1array 1array [ change-something ] deep-map! ] unit-test
|
||||
|
||||
[ t ] [ "foo" [ string? ] deep-any? ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -48,10 +48,10 @@ M: object branch? drop f ;
|
|||
_ swap dup branch? [ subseq? ] [ 2drop f ] if
|
||||
] deep-find >boolean ;
|
||||
|
||||
: deep-change-each ( obj quot: ( elt -- elt' ) -- )
|
||||
: deep-map! ( obj quot: ( elt -- elt' ) -- obj )
|
||||
over branch? [
|
||||
'[ _ [ call ] keep over [ deep-change-each ] dip ] change-each
|
||||
] [ 2drop ] if ; inline recursive
|
||||
'[ _ [ call ] keep over [ deep-map! drop ] dip ] map!
|
||||
] [ drop ] if ; inline recursive
|
||||
|
||||
: flatten ( obj -- seq )
|
||||
[ branch? not ] deep-filter ;
|
||||
|
|
|
|||
|
|
@ -222,7 +222,7 @@ SYMBOL: deserialized
|
|||
:: (deserialize-seq) ( exemplar quot -- seq )
|
||||
deserialize-cell exemplar new-sequence
|
||||
[ intern-object ]
|
||||
[ dup [ drop quot call ] change-each ] bi ; inline
|
||||
[ [ drop quot call ] map! ] bi ; inline
|
||||
|
||||
: deserialize-array ( -- array )
|
||||
{ } [ (deserialize) ] (deserialize-seq) ;
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ;
|
|||
|
||||
[ ushort-array{ 0 0 0 } ] [
|
||||
3 ALIEN: 123 100 <direct-ushort-array> new-sequence
|
||||
dup [ drop 0 ] change-each
|
||||
[ drop 0 ] map!
|
||||
] unit-test
|
||||
|
||||
STRUCT: test-struct
|
||||
|
|
|
|||
|
|
@ -258,7 +258,7 @@ IN: tools.deploy.shaker
|
|||
! otherwise do nothing
|
||||
[ 2drop ]
|
||||
} cond
|
||||
] change-each ;
|
||||
] map! drop ;
|
||||
|
||||
: strip-default-method ( generic new-default -- )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ M: bad-tr summary
|
|||
tr-quot (( seq -- translated )) define-declared ;
|
||||
|
||||
: fast-tr-quot ( mapping -- quot )
|
||||
'[ [ _ tr-nth ] change-each ] ;
|
||||
'[ [ _ tr-nth ] map! drop ] ;
|
||||
|
||||
: define-fast-tr ( word mapping -- )
|
||||
fast-tr-quot (( seq -- )) define-declared ;
|
||||
|
|
|
|||
|
|
@ -533,8 +533,8 @@ PRIVATE>
|
|||
|
||||
: join-lines ( string -- string' )
|
||||
"\n" split
|
||||
[ rest-slice [ [ blank? ] trim-head-slice ] change-each ]
|
||||
[ but-last-slice [ [ blank? ] trim-tail-slice ] change-each ]
|
||||
[ rest-slice [ [ blank? ] trim-head-slice ] map! drop ]
|
||||
[ but-last-slice [ [ blank? ] trim-tail-slice ] map! drop ]
|
||||
[ " " join ]
|
||||
tri ;
|
||||
|
||||
|
|
|
|||
|
|
@ -139,7 +139,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
|
|||
swap [ key? not ] curry filter ;
|
||||
|
||||
: substitute-here ( seq assoc -- )
|
||||
substituter change-each ;
|
||||
substituter map! drop ;
|
||||
|
||||
: substitute ( seq assoc -- newseq )
|
||||
substituter map ;
|
||||
|
|
|
|||
|
|
@ -101,7 +101,7 @@ M: hashtable at* ( key hash -- value ? )
|
|||
key@ [ 3 fixnum+fast slot t ] [ 2drop f f ] if ;
|
||||
|
||||
M: hashtable clear-assoc ( hash -- )
|
||||
[ init-hash ] [ array>> [ drop ((empty)) ] change-each ] bi ;
|
||||
[ init-hash ] [ array>> [ drop ((empty)) ] map! drop ] bi ;
|
||||
|
||||
M: hashtable delete-at ( key hash -- )
|
||||
[ nip ] [ key@ ] 2bi [
|
||||
|
|
|
|||
|
|
@ -332,9 +332,9 @@ HELP: change-nth
|
|||
{ $errors "Throws an error if the sequence is immutable, if the index is out of bounds, or the sequence cannot hold elements of the type output by " { $snippet "quot" } "." }
|
||||
{ $side-effects "seq" } ;
|
||||
|
||||
HELP: change-each
|
||||
{ $values { "seq" "a mutable sequence" } { "quot" { $quotation "( old -- new )" } } }
|
||||
{ $description "Applies the quotation to each element yielding a new element, storing the new elements back in the original sequence." }
|
||||
HELP: map!
|
||||
{ $values { "seq" "a mutable sequence" } { "quot" { $quotation "( old -- new )" } } { "seq" "a mutable sequence" } }
|
||||
{ $description "Applies the quotation to each element yielding a new element, storing the new elements back in the original sequence. Returns the original sequence." }
|
||||
{ $errors "Throws an error if the sequence is immutable, or the sequence cannot hold elements of the type output by " { $snippet "quot" } "." }
|
||||
{ $side-effects "seq" } ;
|
||||
|
||||
|
|
@ -1590,7 +1590,7 @@ ARTICLE: "sequences-destructive-discussion" "When to use destructive operations"
|
|||
|
||||
ARTICLE: "sequences-destructive" "Destructive operations"
|
||||
"Changing elements:"
|
||||
{ $subsections change-each change-nth }
|
||||
{ $subsections map! change-nth }
|
||||
"Deleting elements:"
|
||||
{ $subsections
|
||||
delete
|
||||
|
|
@ -1619,7 +1619,7 @@ ARTICLE: "sequences-destructive" "Destructive operations"
|
|||
{ { $link remove-nth } { $link delete-nth } }
|
||||
{ { $link reverse } { $link reverse-here } }
|
||||
{ { $link append } { $link push-all } }
|
||||
{ { $link map } { $link change-each } }
|
||||
{ { $link map } { $link map! } }
|
||||
{ { $link filter } { $link filter-here } }
|
||||
}
|
||||
{ $heading "Related Articles" }
|
||||
|
|
|
|||
|
|
@ -162,7 +162,7 @@ unit-test
|
|||
{ "a" } 0 2 { 1 2 3 } replace-slice
|
||||
] unit-test
|
||||
|
||||
[ { 1 4 9 } ] [ { 1 2 3 } clone dup [ sq ] change-each ] unit-test
|
||||
[ { 1 4 9 } ] [ { 1 2 3 } clone [ sq ] map! ] unit-test
|
||||
|
||||
[ 5 ] [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
|
||||
[ 5 ] [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
|
||||
|
|
|
|||
|
|
@ -429,8 +429,8 @@ PRIVATE>
|
|||
: replicate-as ( seq quot exemplar -- newseq )
|
||||
[ [ drop ] prepose ] dip map-as ; inline
|
||||
|
||||
: change-each ( seq quot -- )
|
||||
over map-into ; inline
|
||||
: map! ( seq quot -- seq )
|
||||
over [ map-into ] keep ; inline
|
||||
|
||||
: accumulate-as ( seq identity quot exemplar -- final newseq )
|
||||
[ [ swap ] dip [ curry keep ] curry ] dip map-as ; inline
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@ byte-arrays make io ;
|
|||
] if ; inline recursive
|
||||
|
||||
: nsieve ( m -- count )
|
||||
0 2 rot 1 + <byte-array> dup [ drop 1 ] change-each (nsieve) ;
|
||||
0 2 rot 1 + <byte-array> [ drop 1 ] map! (nsieve) ;
|
||||
|
||||
: nsieve. ( m -- )
|
||||
[ "Primes up to " % dup # " " % nsieve # ] "" make print ;
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ IN: benchmark.simd-1
|
|||
iota [ <point> ] float-4-array{ } map-as ; inline
|
||||
|
||||
: normalize-points ( points -- )
|
||||
[ normalize ] change-each ; inline
|
||||
[ normalize ] map! drop ; inline
|
||||
|
||||
: max-points ( points -- point )
|
||||
[ ] [ vmax ] map-reduce ; inline
|
||||
|
|
|
|||
|
|
@ -48,7 +48,7 @@ M:: lagged-fibonacci seed-random ( lagged-fibonacci seed! -- lagged-fibonacci )
|
|||
t 0.5 * t!
|
||||
] times
|
||||
s
|
||||
] change-each
|
||||
] map! drop
|
||||
lagged-fibonacci p-r >>pt0
|
||||
q-r >>pt1 ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ M: TYPE assoc-size ( db -- size ) handle>> DBRNUM ;
|
|||
] while 3drop ;
|
||||
|
||||
M: TYPE >alist ( db -- alist )
|
||||
[ DBKEYS dup ] keep '[ dup _ at 2array ] change-each ;
|
||||
[ DBKEYS dup ] keep '[ dup _ at 2array ] map! drop ;
|
||||
|
||||
M: TYPE set-at ( value key db -- )
|
||||
handle>> spin [ object>bytes dup length ] bi@ DBPUT drop ;
|
||||
|
|
@ -56,4 +56,4 @@ M: TYPE equal? assoc= ;
|
|||
|
||||
M: TYPE hashcode* assoc-hashcode ;
|
||||
|
||||
;FUNCTOR
|
||||
;FUNCTOR
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ syn keyword factorKeyword or tuck 2bi 2tri while wrapper nip 4dip wrapper? bi* c
|
|||
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* remove-all assoc-map-as >alist assoc-filter-as substitute-here 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 byte-array>bignum sgn >bignum next-float number= each-integer next-power-of-2 ?1+ fp-special? imaginary-part mod recip float>bits rational >float number? 2^ bignum? integer fixnum? neg fixnum sq bignum fp-snan? fp-infinity? denominator (all-integers?) times find-last-integer (each-integer) bit? * + fp-bitwise= - fp-qnan? / power-of-2? >= bitand find-integer complex <fp-nan> < log2 > integer? real number bits>double double>bits bitor 2/ zero? rem fp-nan-payload all-integers? (find-integer) real-part prev-float align bits>float float? shift float fp-nan? abs bitxor ratio? even? <= /mod odd? >integer ratio rational? bitnot real? >fixnum complex? /i numerator /f
|
||||
syn keyword factorKeyword append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as filter-here last-index-from reversed index-from cut* pad-tail (indices) concat-as remq 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 delq drop-prefix unclip iota unclip-last-slice bounds-error? sequence-hashcode-step map start midpoint@ rest-slice prepend fourth sift delete sigma new-sequence follow like delete-nth 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 insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? 2sequence map-integers delete-all start* indices snip-slice check-slice sequence? head map-find reduce append-as reverse-here sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check harvest immutable find produce remove pad-head last replicate set-fourth 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? accumulate each pusher cut-slice new-resizable each-index head-slice* 2reverse-each sequence-hashcode memq? pop set-nth ?nth <flat-slice> second change-each join when-empty accumulator immutable-sequence? <reversed> all? 3append-as virtual-sequence subseq? 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 glue slice-error subseq replace-slice push repetition map-index trim-head unclip-last mismatch trim
|
||||
syn keyword factorKeyword append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as filter-here last-index-from reversed index-from cut* pad-tail (indices) concat-as remq 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 delq drop-prefix unclip iota unclip-last-slice bounds-error? sequence-hashcode-step map start midpoint@ rest-slice prepend fourth sift delete sigma new-sequence follow like delete-nth 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 insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? 2sequence map-integers delete-all start* indices snip-slice check-slice sequence? head map-find reduce append-as reverse-here sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check harvest immutable find produce remove pad-head last replicate set-fourth 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? accumulate each pusher cut-slice new-resizable each-index head-slice* 2reverse-each sequence-hashcode memq? pop set-nth ?nth <flat-slice> second map! join when-empty accumulator immutable-sequence? <reversed> all? 3append-as virtual-sequence subseq? 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 glue slice-error subseq replace-slice push repetition map-index trim-head unclip-last mismatch trim
|
||||
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 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 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* each-block output-stream stream-read-partial
|
||||
|
|
|
|||
Loading…
Reference in New Issue