From 08e7d25dc5fa0836e4fd593a6098642d3f4d697c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 27 Oct 2009 22:32:56 -0500 Subject: [PATCH 01/17] change-each -> map!, deep-change-each -> deep-map! --- basis/bit-arrays/bit-arrays-docs.factor | 4 ++-- basis/bit-arrays/bit-arrays-tests.factor | 2 +- basis/bootstrap/image/image.factor | 2 +- basis/columns/columns-tests.factor | 2 +- basis/compiler/cfg/utilities/utilities.factor | 4 ++-- basis/concurrency/combinators/combinators.factor | 2 +- basis/images/jpeg/jpeg.factor | 2 +- basis/io/mmap/mmap-docs.factor | 4 ++-- basis/math/ranges/ranges-docs.factor | 2 +- basis/sequences/deep/deep-docs.factor | 10 +++++----- basis/sequences/deep/deep-tests.factor | 2 +- basis/sequences/deep/deep.factor | 6 +++--- basis/serialize/serialize.factor | 2 +- .../specialized-arrays/specialized-arrays-tests.factor | 2 +- basis/tools/deploy/shaker/shaker.factor | 2 +- basis/tr/tr.factor | 2 +- basis/ui/gadgets/editors/editors.factor | 4 ++-- core/assocs/assocs.factor | 2 +- core/hashtables/hashtables.factor | 2 +- core/sequences/sequences-docs.factor | 10 +++++----- core/sequences/sequences-tests.factor | 2 +- core/sequences/sequences.factor | 4 ++-- extra/benchmark/nsieve-bytes/nsieve-bytes.factor | 2 +- extra/benchmark/simd-1/simd-1.factor | 2 +- extra/random/lagged-fibonacci/lagged-fibonacci.factor | 2 +- extra/tokyo/assoc-functor/assoc-functor.factor | 4 ++-- misc/vim/syntax/factor.vim | 2 +- 27 files changed, 43 insertions(+), 43 deletions(-) diff --git a/basis/bit-arrays/bit-arrays-docs.factor b/basis/bit-arrays/bit-arrays-docs.factor index e9c9e1dc51..76b636c3f3 100644 --- a/basis/bit-arrays/bit-arrays-docs.factor +++ b/basis/bit-arrays/bit-arrays-docs.factor @@ -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" } ; diff --git a/basis/bit-arrays/bit-arrays-tests.factor b/basis/bit-arrays/bit-arrays-tests.factor index 1de49d353d..7397791ab5 100644 --- a/basis/bit-arrays/bit-arrays-tests.factor +++ b/basis/bit-arrays/bit-arrays-tests.factor @@ -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 diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index e086215e91..567a3b8bfd 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -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 ' ; diff --git a/basis/columns/columns-tests.factor b/basis/columns/columns-tests.factor index a53f5c1185..434c233936 100644 --- a/basis/columns/columns-tests.factor +++ b/basis/columns/columns-tests.factor @@ -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 >array ] unit-test -[ ] [ "seq" get 1 [ sq ] change-each ] unit-test +[ ] [ "seq" get 1 [ sq ] map! drop ] unit-test [ { 4 25 64 } ] [ "seq" get 1 >array ] unit-test diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index 19c73eebd4..be8c9ad0ad 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -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 '[ diff --git a/basis/concurrency/combinators/combinators.factor b/basis/concurrency/combinators/combinators.factor index 3d18b9e029..918b3c5ba0 100755 --- a/basis/concurrency/combinators/combinators.factor +++ b/basis/concurrency/combinators/combinators.factor @@ -29,7 +29,7 @@ PRIVATE> : [future] ( quot -- quot' ) '[ _ curry future ] ; inline : future-values ( futures -- futures ) - dup [ ?future ] change-each ; inline + [ ?future ] map! ; inline PRIVATE> diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor index 6e45dd1ce8..4f10808b04 100644 --- a/basis/images/jpeg/jpeg.factor +++ b/basis/images/jpeg/jpeg.factor @@ -354,7 +354,7 @@ SINGLETONS: YUV420 YUV444 Y MAGIC! ; [ decode-macroblock 2array ] accumulator [ all-macroblocks ] dip jpeg> setup-bitmap draw-macroblocks - jpeg> bitmap>> 3 [ color-transform ] change-each + jpeg> bitmap>> 3 [ color-transform ] map! drop jpeg> [ >byte-array ] change-bitmap drop ; ERROR: not-a-jpeg-image ; diff --git a/basis/io/mmap/mmap-docs.factor b/basis/io/mmap/mmap-docs.factor index caa2f95dae..6e7662befd 100644 --- a/basis/io/mmap/mmap-docs.factor +++ b/basis/io/mmap/mmap-docs.factor @@ -81,7 +81,7 @@ ARTICLE: "io.mmap.examples" "Memory-mapped file examples" "" "\"mydata.dat\" char [" " 4 " - " [ 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" } ; diff --git a/basis/math/ranges/ranges-docs.factor b/basis/math/ranges/ranges-docs.factor index 584bb3115b..1c82f516c9 100644 --- a/basis/math/ranges/ranges-docs.factor +++ b/basis/math/ranges/ranges-docs.factor @@ -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" diff --git a/basis/sequences/deep/deep-docs.factor b/basis/sequences/deep/deep-docs.factor index ae9d67e29c..e8b9ddea6d 100755 --- a/basis/sequences/deep/deep-docs.factor +++ b/basis/sequences/deep/deep-docs.factor @@ -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 } ; diff --git a/basis/sequences/deep/deep-tests.factor b/basis/sequences/deep/deep-tests.factor index e26241abc3..63611967b9 100755 --- a/basis/sequences/deep/deep-tests.factor +++ b/basis/sequences/deep/deep-tests.factor @@ -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 diff --git a/basis/sequences/deep/deep.factor b/basis/sequences/deep/deep.factor index bfc102fdc2..8e01025b94 100755 --- a/basis/sequences/deep/deep.factor +++ b/basis/sequences/deep/deep.factor @@ -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 ; diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor index 2b4294bda4..4de858e811 100644 --- a/basis/serialize/serialize.factor +++ b/basis/serialize/serialize.factor @@ -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) ; diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 423c7ad1ee..bc293b19e0 100755 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -45,7 +45,7 @@ SPECIALIZED-ARRAYS: bool ushort char uint float ulonglong ; [ ushort-array{ 0 0 0 } ] [ 3 ALIEN: 123 100 new-sequence - dup [ drop 0 ] change-each + [ drop 0 ] map! ] unit-test STRUCT: test-struct diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 0c703cae13..48e33be43e 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -258,7 +258,7 @@ IN: tools.deploy.shaker ! otherwise do nothing [ 2drop ] } cond - ] change-each ; + ] map! drop ; : strip-default-method ( generic new-default -- ) [ diff --git a/basis/tr/tr.factor b/basis/tr/tr.factor index daac3c96c7..f75adcbf04 100644 --- a/basis/tr/tr.factor +++ b/basis/tr/tr.factor @@ -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 ; diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 071ac1cffe..f42fdf4616 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -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 ; diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index e633a54843..109ef125e3 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -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 ; diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index 8547f53a0e..9faf587b51 100644 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -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 [ diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 2156557fff..b74d24f90d 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -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" } diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index e36bfaf9d2..897af3599b 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -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 diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index dc63acb749..c9f652c58a 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -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 diff --git a/extra/benchmark/nsieve-bytes/nsieve-bytes.factor b/extra/benchmark/nsieve-bytes/nsieve-bytes.factor index 15c0f9ee0b..e27d5159fd 100644 --- a/extra/benchmark/nsieve-bytes/nsieve-bytes.factor +++ b/extra/benchmark/nsieve-bytes/nsieve-bytes.factor @@ -20,7 +20,7 @@ byte-arrays make io ; ] if ; inline recursive : nsieve ( m -- count ) - 0 2 rot 1 + dup [ drop 1 ] change-each (nsieve) ; + 0 2 rot 1 + [ drop 1 ] map! (nsieve) ; : nsieve. ( m -- ) [ "Primes up to " % dup # " " % nsieve # ] "" make print ; diff --git a/extra/benchmark/simd-1/simd-1.factor b/extra/benchmark/simd-1/simd-1.factor index 4b3c4a5b9f..ff0cb98a00 100644 --- a/extra/benchmark/simd-1/simd-1.factor +++ b/extra/benchmark/simd-1/simd-1.factor @@ -15,7 +15,7 @@ IN: benchmark.simd-1 iota [ ] 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 diff --git a/extra/random/lagged-fibonacci/lagged-fibonacci.factor b/extra/random/lagged-fibonacci/lagged-fibonacci.factor index c31620dd6c..7905c575bd 100644 --- a/extra/random/lagged-fibonacci/lagged-fibonacci.factor +++ b/extra/random/lagged-fibonacci/lagged-fibonacci.factor @@ -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 diff --git a/extra/tokyo/assoc-functor/assoc-functor.factor b/extra/tokyo/assoc-functor/assoc-functor.factor index 1df1325eef..122e613387 100644 --- a/extra/tokyo/assoc-functor/assoc-functor.factor +++ b/extra/tokyo/assoc-functor/assoc-functor.factor @@ -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 \ No newline at end of file +;FUNCTOR diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim index c1b614b786..80d9287352 100644 --- a/misc/vim/syntax/factor.vim +++ b/misc/vim/syntax/factor.vim @@ -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 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 < 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? 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 second change-each join when-empty accumulator immutable-sequence? 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? 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? 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 second map! join when-empty accumulator immutable-sequence? 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? 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 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 From f5a0a8b6e195dab0acb30fb6711064be739710ae Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 27 Oct 2009 23:25:35 -0500 Subject: [PATCH 02/17] delete -> remove! --- basis/documents/documents.factor | 2 +- basis/http/http.factor | 2 +- basis/models/models.factor | 4 ++-- basis/prettyprint/prettyprint-tests.factor | 2 +- basis/ui/backend/windows/windows.factor | 6 +++--- basis/ui/gadgets/gadgets.factor | 2 +- basis/ui/gestures/gestures.factor | 2 +- basis/windows/com/wrapper/wrapper.factor | 2 +- core/sequences/sequences-docs.factor | 12 ++++++------ core/sequences/sequences-tests.factor | 10 +++++----- core/sequences/sequences.factor | 4 ++-- core/sets/sets.factor | 2 +- core/vocabs/parser/parser.factor | 2 +- extra/digraphs/digraphs.factor | 4 ++-- 14 files changed, 28 insertions(+), 28 deletions(-) diff --git a/basis/documents/documents.factor b/basis/documents/documents.factor index b05c86c365..aef4f4de78 100644 --- a/basis/documents/documents.factor +++ b/basis/documents/documents.factor @@ -34,7 +34,7 @@ TUPLE: document < model locs undos redos inside-undo? ; : add-loc ( loc document -- ) locs>> push ; -: remove-loc ( loc document -- ) locs>> delete ; +: remove-loc ( loc document -- ) locs>> remove! drop ; : update-locs ( loc document -- ) locs>> [ set-model ] with each ; diff --git a/basis/http/http.factor b/basis/http/http.factor index 4c32954eee..4bcfbeb76d 100755 --- a/basis/http/http.factor +++ b/basis/http/http.factor @@ -193,7 +193,7 @@ M: response clone [ cookies>> ] dip '[ [ _ ] dip name>> = ] find nip ; : delete-cookie ( request/response name -- ) - over cookies>> [ get-cookie ] dip delete ; + over cookies>> [ get-cookie ] dip remove! drop ; : put-cookie ( request/response cookie -- request/response ) [ name>> dupd get-cookie [ dupd delete-cookie ] when* ] keep diff --git a/basis/models/models.factor b/basis/models/models.factor index 27504bc0fa..1c03bb224c 100644 --- a/basis/models/models.factor +++ b/basis/models/models.factor @@ -23,7 +23,7 @@ M: model hashcode* drop model hashcode* ; dependencies>> push ; : remove-dependency ( dep model -- ) - dependencies>> delete ; + dependencies>> remove! drop ; DEFER: add-connection @@ -63,7 +63,7 @@ GENERIC: model-changed ( model observer -- ) connections>> push ; : remove-connection ( observer model -- ) - [ connections>> delete ] keep + [ connections>> remove! drop ] keep dup connections>> empty? [ dup deactivate-model ] when drop ; diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index db3331305e..8ba6e94a49 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -196,7 +196,7 @@ DEFER: parse-error-file " {" " { [ dup continuation? ] [ append ] }" " { [ dup not ] [ drop reverse ] }" - " { [ dup pair? ] [ [ delete ] keep ] }" + " { [ dup pair? ] [ [ remove! drop ] keep ] }" " } cond ;" } ; diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 7dbe3a3c48..b099917e7c 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -470,7 +470,7 @@ SYMBOL: nc-buttons : handle-wm-ncbutton ( hWnd uMsg wParam lParam -- ) 2drop nip message>button nc-buttons get - swap [ push ] [ delete ] if ; + swap [ push ] [ remove! drop ] if ; : mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ; @@ -498,13 +498,13 @@ SYMBOL: nc-buttons : handle-wm-buttondown ( hWnd uMsg wParam lParam -- ) [ over set-capture - dup message>button drop nc-buttons get delete + dup message>button drop nc-buttons get remove! drop ] 2dip prepare-mouse send-button-down ; : handle-wm-buttonup ( hWnd uMsg wParam lParam -- ) mouse-captured get [ release-capture ] when pick message>button drop dup nc-buttons get member? [ - nc-buttons get delete 4drop + nc-buttons get remove! drop 4drop ] [ drop prepare-mouse send-button-up ] if ; diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index e4a0e672d2..12d0ef580d 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -306,7 +306,7 @@ M: gadget remove-gadget 2drop ; [ remove-gadget ] [ over (unparent) [ unfocus-gadget ] - [ children>> delete ] + [ children>> remove! drop ] [ nip relayout ] 2tri ] 2bi diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index 26eb45c8d0..8e982f8e45 100644 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -297,7 +297,7 @@ SYMBOL: drag-timer : send-button-up ( gesture loc world -- ) move-hand - dup #>> hand-buttons get-global delete + dup #>> hand-buttons get-global remove! drop stop-drag-timer button-gesture ; diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor index 27672df833..39f5ce1dad 100755 --- a/basis/windows/com/wrapper/wrapper.factor +++ b/basis/windows/com/wrapper/wrapper.factor @@ -159,7 +159,7 @@ PRIVATE> M: com-wrapper dispose* [ [ free ] each f ] change-vtbls - +live-wrappers+ get-global delete ; + +live-wrappers+ get-global remove! drop ; : com-wrap ( object wrapper -- wrapped-object ) [ vtbls>> ] [ (malloc-wrapped-object) ] bi diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index b74d24f90d..5a301256b0 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -491,9 +491,9 @@ HELP: move { $description "Sets the element with index " { $snippet "m" } " to the element with index " { $snippet "n" } "." } { $side-effects "seq" } ; -HELP: delete -{ $values { "elt" object } { "seq" "a resizable mutable sequence" } } -{ $description "Removes all elements equal to " { $snippet "elt" } " from " { $snippet "seq" } "." } +HELP: remove! +{ $values { "elt" object } { "seq" "a resizable mutable sequence" } { "elt" object } } +{ $description "Removes all elements equal to " { $snippet "elt" } " from " { $snippet "seq" } " and returns " { $snippet "seq" } "." } { $notes "This word uses equality comparison (" { $link = } ")." } { $side-effects "seq" } ; @@ -861,7 +861,7 @@ HELP: tail? { $values { "seq" sequence } { "end" sequence } { "?" "a boolean" } } { $description "Tests if " { $snippet "seq" } " ends with " { $snippet "end" } ". If " { $snippet "end" } " is longer than " { $snippet "seq" } ", this word outputs " { $link f } "." } ; -{ remove remove-nth remq delq delete delete-nth } related-words +{ remove remove-nth remq delq remove! delete-nth } related-words HELP: cut-slice { $values { "seq" sequence } { "n" "a non-negative integer" } { "before-slice" sequence } { "after-slice" "a slice" } } @@ -1593,7 +1593,7 @@ ARTICLE: "sequences-destructive" "Destructive operations" { $subsections map! change-nth } "Deleting elements:" { $subsections - delete + remove! delq delete-nth delete-slice @@ -1614,7 +1614,7 @@ ARTICLE: "sequences-destructive" "Destructive operations" { { $link suffix } { $link push } } { { $link but-last } { $link pop* } } { { $link unclip-last } { $link pop } } - { { $link remove } { $link delete } } + { { $link remove } { $link remove! } } { { $link remq } { $link delq } } { { $link remove-nth } { $link delete-nth } } { { $link reverse } { $link reverse-here } } diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 897af3599b..48dee92457 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -126,11 +126,11 @@ unit-test [ 4 [ CHAR: a ] map ] unit-test -[ V{ } ] [ "f" V{ } clone [ delete ] keep ] unit-test -[ V{ } ] [ "f" V{ "f" } clone [ delete ] keep ] unit-test -[ V{ } ] [ "f" V{ "f" "f" } clone [ delete ] keep ] unit-test -[ V{ "x" } ] [ "f" V{ "f" "x" "f" } clone [ delete ] keep ] unit-test -[ V{ "y" "x" } ] [ "f" V{ "y" "f" "x" "f" } clone [ delete ] keep ] unit-test +[ V{ } ] [ "f" V{ } clone remove! ] unit-test +[ V{ } ] [ "f" V{ "f" } clone remove! ] unit-test +[ V{ } ] [ "f" V{ "f" "f" } clone remove! ] unit-test +[ V{ "x" } ] [ "f" V{ "f" "x" "f" } clone remove! ] unit-test +[ V{ "y" "x" } ] [ "f" V{ "y" "f" "x" "f" } clone remove! ] unit-test [ V{ 0 1 4 5 } ] [ 6 >vector 2 4 pick delete-slice ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index c9f652c58a..236d38bfd5 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -632,8 +632,8 @@ PRIVATE> : filter-here ( seq quot -- ) swap [ 0 0 ] dip (filter-here) ; inline -: delete ( elt seq -- ) - [ = not ] with filter-here ; +: remove! ( elt seq -- seq ) + [ [ = not ] with filter-here ] keep ; : delq ( elt seq -- ) [ eq? not ] with filter-here ; diff --git a/core/sets/sets.factor b/core/sets/sets.factor index c7b834297a..38c1f73bb3 100755 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -3,7 +3,7 @@ USING: assocs hashtables kernel sequences vectors ; IN: sets -: adjoin ( elt seq -- ) [ delete ] [ push ] 2bi ; +: adjoin ( elt seq -- ) [ remove! drop ] [ push ] 2bi ; : conjoin ( elt assoc -- ) dupd set-at ; diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 2fc9d05d79..26655e728e 100755 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -172,7 +172,7 @@ TUPLE: rename word vocab words ; : use-words ( assoc -- ) (use-words) push ; -: unuse-words ( assoc -- ) (use-words) delete ; +: unuse-words ( assoc -- ) (use-words) remove! drop ; TUPLE: ambiguous-use-error words ; diff --git a/extra/digraphs/digraphs.factor b/extra/digraphs/digraphs.factor index 5ccc0d5a60..2b3379861f 100755 --- a/extra/digraphs/digraphs.factor +++ b/extra/digraphs/digraphs.factor @@ -21,10 +21,10 @@ TUPLE: vertex value edges ; : @edges ( from to digraph -- to edges ) swapd at edges>> ; : add-edge ( from to digraph -- ) @edges push ; -: delete-edge ( from to digraph -- ) @edges delete ; +: delete-edge ( from to digraph -- ) @edges remove! drop ; : delete-to-edges ( to digraph -- ) - [ nip dupd edges>> delete ] assoc-each drop ; + [ nip dupd edges>> remove! drop ] assoc-each drop ; : delete-vertex ( key digraph -- ) 2dup delete-at delete-to-edges ; From 951e3e9c834fd5d425b6f790da0c437c25259372 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 27 Oct 2009 23:41:57 -0500 Subject: [PATCH 03/17] delete-nth -> remove-nth! --- .../linear-scan/allocation/spilling/spilling.factor | 4 ++-- basis/random/random-docs.factor | 2 +- basis/random/random.factor | 2 +- basis/ui/gadgets/tracks/tracks.factor | 2 +- basis/ui/ui.factor | 2 +- basis/xml/data/data.factor | 2 +- core/assocs/assocs-docs.factor | 2 +- core/assocs/assocs.factor | 4 ++-- core/classes/algebra/algebra.factor | 2 +- core/sequences/sequences-docs.factor | 10 +++++----- core/sequences/sequences-tests.factor | 4 ++-- core/sequences/sequences.factor | 4 ++-- extra/multi-methods/multi-methods.factor | 2 +- misc/vim/syntax/factor.vim | 2 +- 14 files changed, 22 insertions(+), 22 deletions(-) diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor index 8b4dde59da..ec4fe02cfa 100644 --- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor +++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor @@ -103,7 +103,7 @@ ERROR: bad-live-ranges interval ; ! most one) are split and spilled and removed from the inactive ! set. new vreg>> active-intervals-for [ [ reg>> reg = ] find swap dup ] keep - '[ _ delete-nth new start>> spill ] [ 2drop ] if ; + '[ _ remove-nth! drop new start>> spill ] [ 2drop ] if ; :: spill-intersecting-inactive ( new reg -- ) ! Any inactive intervals using 'reg' are split and spilled @@ -141,4 +141,4 @@ ERROR: bad-live-ranges interval ; { [ 2dup spill-new? ] [ spill-new ] } { [ 2dup register-available? ] [ spill-available ] } [ spill-partially-available ] - } cond ; \ No newline at end of file + } cond ; diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index 59df4f6e27..788a6e700a 100755 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -96,7 +96,7 @@ HELP: delete-random { $values { "seq" sequence } { "elt" object } } -{ $description "Deletes a random number from a sequence using " { $link delete-nth } " and returns the deleted object." } ; +{ $description "Deletes a random number from a sequence using " { $link remove-nth! } " and returns the deleted object." } ; ARTICLE: "random-protocol" "Random protocol" "A random number generator must implement one of these two words:" diff --git a/basis/random/random.factor b/basis/random/random.factor index 197c232404..0e7a0cc3f1 100755 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -82,7 +82,7 @@ PRIVATE> '[ _ dup random _ _ next-sample ] replicate ; : delete-random ( seq -- elt ) - [ length random-integer ] keep [ nth ] 2keep delete-nth ; + [ length random-integer ] keep [ nth ] 2keep remove-nth! drop ; : with-random ( tuple quot -- ) random-generator swap with-variable ; inline diff --git a/basis/ui/gadgets/tracks/tracks.factor b/basis/ui/gadgets/tracks/tracks.factor index 4bccab8c98..387f41a6a4 100644 --- a/basis/ui/gadgets/tracks/tracks.factor +++ b/basis/ui/gadgets/tracks/tracks.factor @@ -61,7 +61,7 @@ PRIVATE> pick sizes>> push add-gadget ; M: track remove-gadget - [ [ children>> index ] [ sizes>> ] bi delete-nth ] + [ [ children>> index ] [ sizes>> ] bi remove-nth! drop ] [ call-next-method ] 2bi ; : clear-track ( track -- ) [ sizes>> delete-all ] [ clear-gadget ] bi ; diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index aa3c549cf0..6de303089e 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -34,7 +34,7 @@ SYMBOL: windows : raised-window ( world -- ) windows get-global [ [ second eq? ] with find drop ] keep - [ nth ] [ delete-nth ] [ nip ] 2tri push ; + [ nth ] [ remove-nth! drop ] [ nip ] 2tri push ; : focus-gestures ( new old -- ) drop-prefix diff --git a/basis/xml/data/data.factor b/basis/xml/data/data.factor index 6cd975d42d..419dfbba53 100644 --- a/basis/xml/data/data.factor +++ b/basis/xml/data/data.factor @@ -66,7 +66,7 @@ M: attrs clear-assoc f >>alist drop ; M: attrs delete-at [ nip ] [ attr@ drop ] 2bi - [ swap alist>> delete-nth ] [ drop ] if* ; + [ swap alist>> remove-nth! drop ] [ drop ] if* ; M: attrs clone alist>> clone ; diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index 22556ef94c..dd8f65c063 100755 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -28,7 +28,7 @@ ARTICLE: "enums" "Enumerations" HELP: enum { $class-description "An associative structure which wraps a sequence and maps integers to the corresponding elements of the sequence." $nl -"Enumerations are mutable; note that deleting a key calls " { $link delete-nth } ", which results in all subsequent elements being shifted down." } ; +"Enumerations are mutable; note that deleting a key calls " { $link remove-nth! } ", which results in all subsequent elements being shifted down." } ; HELP: { $values { "seq" sequence } { "enum" enum } } diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 109ef125e3..4c74ad796e 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -195,7 +195,7 @@ M: sequence clear-assoc delete-all ; inline M: sequence delete-at [ nip ] [ search-alist nip ] 2bi - [ swap delete-nth ] [ drop ] if* ; + [ swap remove-nth! drop ] [ drop ] if* ; M: sequence assoc-size length ; inline @@ -224,7 +224,7 @@ M: enum at* M: enum set-at seq>> set-nth ; inline -M: enum delete-at seq>> delete-nth ; inline +M: enum delete-at seq>> remove-nth! drop ; inline M: enum >alist ( enum -- alist ) seq>> [ length ] keep zip ; inline diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 2d67403f94..afaae444bc 100755 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -211,7 +211,7 @@ ERROR: topological-sort-failed ; : sort-classes ( seq -- newseq ) [ name>> ] sort-with >vector [ dup empty? not ] - [ dup largest-class [ over delete-nth ] dip ] + [ dup largest-class [ over remove-nth! drop ] dip ] produce nip ; : smallest-class ( classes -- class/f ) diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 5a301256b0..c156d9e4c3 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -503,8 +503,8 @@ HELP: delq { $notes "This word uses identity comparison (" { $link eq? } ")." } { $side-effects "seq" } ; -HELP: delete-nth -{ $values { "n" "a non-negative integer" } { "seq" "a resizable mutable sequence" } } +HELP: remove-nth! +{ $values { "n" "a non-negative integer" } { "seq" "a resizable mutable sequence" } { "seq" "a resizable mutable sequence" } } { $description "Removes the " { $snippet "n" } "th element from the sequence, shifting all other elements down and reducing its length by one." } { $side-effects "seq" } ; @@ -861,7 +861,7 @@ HELP: tail? { $values { "seq" sequence } { "end" sequence } { "?" "a boolean" } } { $description "Tests if " { $snippet "seq" } " ends with " { $snippet "end" } ". If " { $snippet "end" } " is longer than " { $snippet "seq" } ", this word outputs " { $link f } "." } ; -{ remove remove-nth remq delq remove! delete-nth } related-words +{ remove remove-nth remq delq remove! remove-nth! } related-words HELP: cut-slice { $values { "seq" sequence } { "n" "a non-negative integer" } { "before-slice" sequence } { "after-slice" "a slice" } } @@ -1595,7 +1595,7 @@ ARTICLE: "sequences-destructive" "Destructive operations" { $subsections remove! delq - delete-nth + remove-nth! delete-slice delete-all filter-here @@ -1616,7 +1616,7 @@ ARTICLE: "sequences-destructive" "Destructive operations" { { $link unclip-last } { $link pop } } { { $link remove } { $link remove! } } { { $link remq } { $link delq } } - { { $link remove-nth } { $link delete-nth } } + { { $link remove-nth } { $link remove-nth! } } { { $link reverse } { $link reverse-here } } { { $link append } { $link push-all } } { { $link map } { $link map! } } diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 48dee92457..0acc1b7344 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -207,7 +207,7 @@ unit-test [ 10 "hi" "bye" copy ] must-fail [ V{ 1 2 3 5 6 } ] [ - 3 V{ 1 2 3 4 5 6 } clone [ delete-nth ] keep + 3 V{ 1 2 3 4 5 6 } clone remove-nth! ] unit-test ! erg's random tester found this one @@ -227,7 +227,7 @@ unit-test [ -3 10 nth ] must-fail [ 11 10 nth ] must-fail -[ -1/0. 0 delete-nth ] must-fail +[ -1/0. 0 remove-nth! ] must-fail [ "" ] [ "" [ CHAR: \s = ] trim ] unit-test [ "" ] [ "" [ CHAR: \s = ] trim-head ] unit-test [ "" ] [ "" [ CHAR: \s = ] trim-tail ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 236d38bfd5..7876469f19 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -695,8 +695,8 @@ PRIVATE> : delete-slice ( from to seq -- ) check-slice [ over [ - ] dip ] dip open-slice ; -: delete-nth ( n seq -- ) - [ dup 1 + ] dip delete-slice ; +: remove-nth! ( n seq -- seq ) + [ [ dup 1 + ] dip delete-slice ] keep ; : snip ( from to seq -- head tail ) [ swap head ] [ swap tail ] bi-curry bi* ; inline diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index d3e1d443aa..de131df3c6 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -81,7 +81,7 @@ SYMBOL: total : topological-sort ( seq quot -- newseq ) [ >vector [ dup empty? not ] ] dip - [ dupd maximal-element [ over delete-nth ] dip ] curry + [ dupd maximal-element [ over remove-nth! drop ] dip ] curry produce nip ; inline : classes< ( seq1 seq2 -- lt/eq/gt ) diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim index 80d9287352..8ba1e00052 100644 --- a/misc/vim/syntax/factor.vim +++ b/misc/vim/syntax/factor.vim @@ -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 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 < 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? 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 second map! join when-empty accumulator immutable-sequence? 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? 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? 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 remove-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 second map! join when-empty accumulator immutable-sequence? 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? 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 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 From b7e05a525bd956675ae63692d9d1fa5aabbcbd77 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 27 Oct 2009 23:45:03 -0500 Subject: [PATCH 04/17] remove unused and really confusing remove-all word --- core/assocs/assocs-docs.factor | 6 ------ core/assocs/assocs-tests.factor | 2 -- core/assocs/assocs.factor | 3 --- misc/vim/syntax/factor.vim | 2 +- 4 files changed, 1 insertion(+), 12 deletions(-) diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index dd8f65c063..c1b9e2cb56 100755 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -96,7 +96,6 @@ ARTICLE: "assocs-sets" "Set-theoretic operations on assocs" update assoc-union assoc-diff - remove-all substitute substitute-here extract-keys @@ -348,11 +347,6 @@ HELP: assoc-diff { $values { "assoc1" assoc } { "assoc2" assoc } { "diff" "a new assoc" } } { $description "Outputs an assoc consisting of all entries from " { $snippet "assoc1" } " whose key is not contained in " { $snippet "assoc2" } "." } ; -HELP: remove-all -{ $values { "assoc" assoc } { "seq" "a sequence" } { "subseq" "a new sequence" } } -{ $description "Constructs a sequence consisting of all elements in " { $snippet "seq" } " which do not appear as keys in " { $snippet "assoc" } "." } -{ $notes "The values of the keys in the assoc are disregarded, so this word is usually used for set-theoretic calculations where the assoc in question either has dummy sentinels as values, or the values equal the keys." } -{ $side-effects "assoc" } ; HELP: substitute-here { $values { "seq" "a mutable sequence" } { "assoc" assoc } } diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor index 53c3adcf3e..646f9a4561 100644 --- a/core/assocs/assocs-tests.factor +++ b/core/assocs/assocs-tests.factor @@ -79,8 +79,6 @@ H{ } clone "cache-test" set H{ { 1 f } } H{ { 1 f } } assoc-intersect ] unit-test -[ { 1 3 } ] [ H{ { 2 2 } } { 1 2 3 } remove-all ] unit-test - [ H{ { "hi" 2 } { 3 4 } } ] [ "hi" 1 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ] unit-test diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 4c74ad796e..9e4a6e221e 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -135,9 +135,6 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) : assoc-diff ( assoc1 assoc2 -- diff ) [ nip key? not ] curry assoc-filter ; -: remove-all ( assoc seq -- subseq ) - swap [ key? not ] curry filter ; - : substitute-here ( seq assoc -- ) substituter map! drop ; diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim index 8ba1e00052..0f47b795ca 100644 --- a/misc/vim/syntax/factor.vim +++ b/misc/vim/syntax/factor.vim @@ -50,7 +50,7 @@ syn keyword factorCompileDirective inline foldable recursive syn keyword factorKeyword boolean syn keyword factorKeyword or tuck 2bi 2tri while wrapper nip 4dip wrapper? bi* callstack>array both? hashcode die dupd callstack callstack? 3dup tri@ pick curry build ?execute 3bi prepose >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep clear 2dup when not tuple? dup 2bi* 2tri* call tri-curry object bi@ do unless* if* loop bi-curry* drop when* assert= retainstack assert? -rot execute 2bi@ 2tri@ boa with either? 3drop bi curry? datastack until 3dip over 3curry roll tri-curry* swap tri-curry@ 2nip and throw set-retainstack bi-curry (clone) hashcode* compose spin 2dip if 3tri unless compose? tuple keep 2curry equal? set-datastack assert tri 2drop most boolean? identity-tuple? null new set-callstack dip bi-curry@ rot -roll xor identity-tuple boolean -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 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 ?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 assoc assoc-map enum value-at* 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 < 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? 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 remove-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 second map! join when-empty accumulator immutable-sequence? 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? 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 From 50f5c3d116b2f06ab788778f75b5ce3082480d01 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 28 Oct 2009 00:23:08 -0500 Subject: [PATCH 05/17] remq -> remove-eq, delq -> remove-eq! --- .../cfg/linear-scan/allocation/state/state.factor | 4 ++-- basis/help/tips/tips.factor | 4 ++-- basis/ui/gadgets/worlds/worlds.factor | 2 +- core/compiler/units/units.factor | 2 +- core/sequences/sequences-docs.factor | 14 +++++++------- core/sequences/sequences.factor | 6 +++--- core/source-files/errors/errors.factor | 4 ++-- core/vocabs/parser/parser.factor | 2 +- core/vocabs/vocabs.factor | 4 ++-- misc/vim/syntax/factor.vim | 2 +- 10 files changed, 22 insertions(+), 22 deletions(-) diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state.factor b/basis/compiler/cfg/linear-scan/allocation/state/state.factor index aeebe31dcc..ea0879032d 100644 --- a/basis/compiler/cfg/linear-scan/allocation/state/state.factor +++ b/basis/compiler/cfg/linear-scan/allocation/state/state.factor @@ -33,7 +33,7 @@ SYMBOL: active-intervals dup vreg>> active-intervals-for push ; : delete-active ( live-interval -- ) - dup vreg>> active-intervals-for delq ; + dup vreg>> active-intervals-for remove-eq! drop ; : assign-free-register ( new registers -- ) pop >>reg add-active ; @@ -48,7 +48,7 @@ SYMBOL: inactive-intervals dup vreg>> inactive-intervals-for push ; : delete-inactive ( live-interval -- ) - dup vreg>> inactive-intervals-for delq ; + dup vreg>> inactive-intervals-for remove-eq! drop ; ! Vector of handled live intervals SYMBOL: handled-intervals diff --git a/basis/help/tips/tips.factor b/basis/help/tips/tips.factor index 8569be0b8f..06f2255dfa 100644 --- a/basis/help/tips/tips.factor +++ b/basis/help/tips/tips.factor @@ -10,7 +10,7 @@ tips [ V{ } clone ] initialize TUPLE: tip < identity-tuple content loc ; -M: tip forget* tips get delq ; +M: tip forget* tips get remove-eq! drop ; M: tip where loc>> ; @@ -58,4 +58,4 @@ H{ : $tips-of-the-day ( element -- ) drop tips get [ nl nl ] [ content>> print-element ] interleave ; -INSTANCE: tip definition \ No newline at end of file +INSTANCE: tip definition diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index b736c3f74f..61f84870e5 100755 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -152,7 +152,7 @@ M: world children-on nip children>> ; M: world remove-gadget 2dup layers>> memq? - [ layers>> delq ] [ call-next-method ] if ; + [ layers>> remove-eq! drop ] [ call-next-method ] if ; SYMBOL: flush-layout-cache-hook diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index f1f9131f08..8b6625d014 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -69,7 +69,7 @@ GENERIC: definitions-changed ( assoc obj -- ) definition-observers get push ; : remove-definition-observer ( obj -- ) - definition-observers get delq ; + definition-observers get remove-eq! drop ; : notify-definition-observers ( assoc -- ) definition-observers get diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index c156d9e4c3..775734f0f7 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -471,7 +471,7 @@ HELP: remove { $description "Outputs a new sequence containing all elements of the input sequence except for given element." } { $notes "This word uses equality comparison (" { $link = } ")." } ; -HELP: remq +HELP: remove-eq { $values { "elt" object } { "seq" sequence } { "newseq" "a new sequence" } } { $description "Outputs a new sequence containing all elements of the input sequence except those equal to the given element." } { $notes "This word uses identity comparison (" { $link eq? } ")." } ; @@ -497,8 +497,8 @@ HELP: remove! { $notes "This word uses equality comparison (" { $link = } ")." } { $side-effects "seq" } ; -HELP: delq -{ $values { "elt" object } { "seq" "a resizable mutable sequence" } } +HELP: remove-eq! +{ $values { "elt" object } { "seq" "a resizable mutable sequence" } { "seq" "a resizable mutable sequence" } } { $description "Outputs a new sequence containing all elements of the input sequence except the given element." } { $notes "This word uses identity comparison (" { $link eq? } ")." } { $side-effects "seq" } ; @@ -861,7 +861,7 @@ HELP: tail? { $values { "seq" sequence } { "end" sequence } { "?" "a boolean" } } { $description "Tests if " { $snippet "seq" } " ends with " { $snippet "end" } ". If " { $snippet "end" } " is longer than " { $snippet "seq" } ", this word outputs " { $link f } "." } ; -{ remove remove-nth remq delq remove! remove-nth! } related-words +{ remove remove-nth remove-eq remove-eq! remove! remove-nth! } related-words HELP: cut-slice { $values { "seq" sequence } { "n" "a non-negative integer" } { "before-slice" sequence } { "after-slice" "a slice" } } @@ -1416,7 +1416,7 @@ ARTICLE: "sequences-add-remove" "Adding and removing sequence elements" "Adding elements:" { $subsections prefix suffix insert-nth } "Removing elements:" -{ $subsections remove remq remove-nth } ; +{ $subsections remove remove-eq remove-nth } ; ARTICLE: "sequences-reshape" "Reshaping sequences" "A " { $emphasis "repetition" } " is a virtual sequence consisting of a single element repeated multiple times:" @@ -1594,7 +1594,7 @@ ARTICLE: "sequences-destructive" "Destructive operations" "Deleting elements:" { $subsections remove! - delq + remove-eq! remove-nth! delete-slice delete-all @@ -1615,7 +1615,7 @@ ARTICLE: "sequences-destructive" "Destructive operations" { { $link but-last } { $link pop* } } { { $link unclip-last } { $link pop } } { { $link remove } { $link remove! } } - { { $link remq } { $link delq } } + { { $link remove-eq } { $link remove-eq! } } { { $link remove-nth } { $link remove-nth! } } { { $link reverse } { $link reverse-here } } { { $link append } { $link push-all } } diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 7876469f19..940bfe0137 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -573,7 +573,7 @@ PRIVATE> : remove ( elt seq -- newseq ) [ = not ] with filter ; -: remq ( elt seq -- newseq ) +: remove-eq ( elt seq -- newseq ) [ eq? not ] with filter ; : sift ( seq -- newseq ) @@ -635,8 +635,8 @@ PRIVATE> : remove! ( elt seq -- seq ) [ [ = not ] with filter-here ] keep ; -: delq ( elt seq -- ) - [ eq? not ] with filter-here ; +: remove-eq! ( elt seq -- seq ) + [ [ eq? not ] with filter-here ] keep ; : prefix ( seq elt -- newseq ) over [ over length 1 + ] dip [ diff --git a/core/source-files/errors/errors.factor b/core/source-files/errors/errors.factor index f021944f86..b240b6929e 100644 --- a/core/source-files/errors/errors.factor +++ b/core/source-files/errors/errors.factor @@ -72,7 +72,7 @@ SYMBOL: error-observers : add-error-observer ( observer -- ) error-observers get push ; -: remove-error-observer ( observer -- ) error-observers get delq ; +: remove-error-observer ( observer -- ) error-observers get remove-eq! drop ; : notify-error-observers ( -- ) error-observers get [ errors-changed ] each ; @@ -87,4 +87,4 @@ SYMBOL: error-observers error-types get [ second forget-quot>> dup [ call( definition -- ) ] [ 2drop ] if - ] with each ; \ No newline at end of file + ] with each ; diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 26655e728e..7ca2027ec2 100755 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -129,7 +129,7 @@ TUPLE: no-current-vocab ; : unuse-vocab ( vocab -- ) dup using-vocab? [ manifest get - [ [ load-vocab ] dip search-vocabs>> delq ] + [ [ load-vocab ] dip search-vocabs>> remove-eq! drop ] [ [ vocab-name ] dip search-vocab-names>> delete-at ] 2bi ] [ drop ] if ; diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index 914f1cd601..239b88a2e8 100644 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -73,7 +73,7 @@ GENERIC: vocabs-changed ( obj -- ) vocab-observers get push ; : remove-vocab-observer ( obj -- ) - vocab-observers get delq ; + vocab-observers get remove-eq! drop ; : notify-vocab-observers ( -- ) vocab-observers get [ vocabs-changed ] each ; @@ -131,4 +131,4 @@ SYMBOL: load-vocab-hook ! ( name -- vocab ) PREDICATE: runnable-vocab < vocab vocab-main >boolean ; -INSTANCE: vocab-spec definition \ No newline at end of file +INSTANCE: vocab-spec definition diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim index 0f47b795ca..e13834f904 100644 --- a/misc/vim/syntax/factor.vim +++ b/misc/vim/syntax/factor.vim @@ -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 assoc assoc-map enum value-at* 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 < 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? 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 remove-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 second map! join when-empty accumulator immutable-sequence? 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? 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 remove-eq but-last snip trim-tail nths nth 2pusher sequence slice? partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length remove-eq! 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 remove-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 second map! join when-empty accumulator immutable-sequence? 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? 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 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 From 299b5b0f6c9f19c1145c11cf1d12962cd8f3caae Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 28 Oct 2009 00:44:05 -0500 Subject: [PATCH 06/17] filter-here -> filter! --- basis/compiler/cfg/copy-prop/copy-prop.factor | 2 +- basis/compiler/cfg/dce/dce.factor | 2 +- .../cfg/linear-scan/allocation/allocation.factor | 2 +- .../linear-scan/allocation/spilling/spilling.factor | 6 +++--- .../cfg/linear-scan/allocation/state/state.factor | 2 +- .../compiler/cfg/ssa/destruction/destruction.factor | 4 ++-- .../compiler/cfg/write-barrier/write-barrier.factor | 2 +- basis/compiler/tree/cleanup/cleanup.factor | 2 +- core/assocs/assocs-docs.factor | 7 ------- core/assocs/assocs.factor | 3 --- core/hashtables/hashtables-tests.factor | 5 ----- core/sequences/sequences-docs.factor | 10 +++++----- core/sequences/sequences-tests.factor | 6 +++--- core/sequences/sequences.factor | 12 ++++++------ core/source-files/errors/errors.factor | 2 +- misc/vim/syntax/factor.vim | 4 ++-- 16 files changed, 28 insertions(+), 43 deletions(-) diff --git a/basis/compiler/cfg/copy-prop/copy-prop.factor b/basis/compiler/cfg/copy-prop/copy-prop.factor index 6919ba8b9b..23382c3dbe 100644 --- a/basis/compiler/cfg/copy-prop/copy-prop.factor +++ b/basis/compiler/cfg/copy-prop/copy-prop.factor @@ -63,7 +63,7 @@ M: insn update-insn rename-insn-uses t ; copies get dup assoc-empty? [ 2drop ] [ renamings set [ - instructions>> [ update-insn ] filter-here + instructions>> [ update-insn ] filter! drop ] each-basic-block ] if ; diff --git a/basis/compiler/cfg/dce/dce.factor b/basis/compiler/cfg/dce/dce.factor index b8735e224c..03a43d0ab7 100644 --- a/basis/compiler/cfg/dce/dce.factor +++ b/basis/compiler/cfg/dce/dce.factor @@ -117,5 +117,5 @@ M: insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ; dup [ [ instructions>> [ build-liveness-graph ] each ] each-basic-block ] [ [ instructions>> [ compute-live-vregs ] each ] each-basic-block ] - [ [ instructions>> [ live-insn? ] filter-here ] each-basic-block ] + [ [ instructions>> [ live-insn? ] filter! drop ] each-basic-block ] tri ; diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index ac32265e65..8951d7a1f1 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -42,7 +42,7 @@ IN: compiler.cfg.linear-scan.allocation : handle-sync-point ( n -- ) [ active-intervals get values ] dip - '[ [ _ spill-at-sync-point ] filter-here ] each ; + '[ [ _ spill-at-sync-point ] filter! drop ] each ; :: handle-progress ( n sync? -- ) n { diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor index ec4fe02cfa..845cb14d5c 100644 --- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor +++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor @@ -18,13 +18,13 @@ ERROR: bad-live-ranges interval ; : trim-before-ranges ( live-interval -- ) [ ranges>> ] [ uses>> last 1 + ] bi - [ '[ from>> _ <= ] filter-here ] + [ '[ from>> _ <= ] filter! drop ] [ swap last (>>to) ] 2bi ; : trim-after-ranges ( live-interval -- ) [ ranges>> ] [ uses>> first ] bi - [ '[ to>> _ >= ] filter-here ] + [ '[ to>> _ >= ] filter! drop ] [ swap first (>>from) ] 2bi ; @@ -114,7 +114,7 @@ ERROR: bad-live-ranges interval ; new start>> spill f ] [ drop t ] if ] [ drop t ] if - ] filter-here ; + ] filter! drop ; : spill-intersecting ( new reg -- ) ! Split and spill all active and inactive intervals diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state.factor b/basis/compiler/cfg/linear-scan/allocation/state/state.factor index ea0879032d..4c825c9d7c 100644 --- a/basis/compiler/cfg/linear-scan/allocation/state/state.factor +++ b/basis/compiler/cfg/linear-scan/allocation/state/state.factor @@ -83,7 +83,7 @@ ERROR: register-already-used live-interval ; ! Moving intervals between active and inactive sets : process-intervals ( n symbol quots -- ) ! symbol stores an alist mapping register classes to vectors - [ get values ] dip '[ [ _ cond ] with filter-here ] with each ; inline + [ get values ] dip '[ [ _ cond ] with filter! drop ] with each ; inline : deactivate-intervals ( n -- ) ! Any active intervals which have ended are moved to handled diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor index 071b5d4b20..d93045da55 100644 --- a/basis/compiler/cfg/ssa/destruction/destruction.factor +++ b/basis/compiler/cfg/ssa/destruction/destruction.factor @@ -102,7 +102,7 @@ M: ##phi prepare-insn [ rename-insn-defs ] [ rename-insn-uses ] [ [ useless-copy? ] [ ##phi? ] bi or not ] tri - ] filter-here + ] filter! drop ] each-basic-block ; : destruct-ssa ( cfg -- cfg' ) @@ -114,4 +114,4 @@ M: ##phi prepare-insn dup compute-live-ranges dup prepare-coalescing process-copies - dup perform-renaming ; \ No newline at end of file + dup perform-renaming ; diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor index 0217055923..523f7c6d1c 100644 --- a/basis/compiler/cfg/write-barrier/write-barrier.factor +++ b/basis/compiler/cfg/write-barrier/write-barrier.factor @@ -37,7 +37,7 @@ M: insn eliminate-write-barrier drop t ; : write-barriers-step ( bb -- ) H{ } clone fresh-allocations set H{ } clone mutated-objects set - instructions>> [ eliminate-write-barrier ] filter-here ; + instructions>> [ eliminate-write-barrier ] filter! drop ; : eliminate-write-barriers ( cfg -- cfg' ) dup [ write-barriers-step ] each-basic-block ; diff --git a/basis/compiler/tree/cleanup/cleanup.factor b/basis/compiler/tree/cleanup/cleanup.factor index 1cd9589065..8ed83188e5 100644 --- a/basis/compiler/tree/cleanup/cleanup.factor +++ b/basis/compiler/tree/cleanup/cleanup.factor @@ -20,7 +20,7 @@ IN: compiler.tree.cleanup GENERIC: delete-node ( node -- ) M: #call-recursive delete-node - dup label>> calls>> [ node>> eq? not ] with filter-here ; + dup label>> calls>> [ node>> eq? not ] with filter! drop ; M: #return-recursive delete-node label>> f >>return drop ; diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index c1b9e2cb56..5a69df8cb4 100755 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -97,7 +97,6 @@ ARTICLE: "assocs-sets" "Set-theoretic operations on assocs" assoc-union assoc-diff substitute - substitute-here extract-keys } { $see-also key? assoc-any? assoc-all? "sets" } ; @@ -348,12 +347,6 @@ HELP: assoc-diff { $description "Outputs an assoc consisting of all entries from " { $snippet "assoc1" } " whose key is not contained in " { $snippet "assoc2" } "." } ; -HELP: substitute-here -{ $values { "seq" "a mutable sequence" } { "assoc" assoc } } -{ $description "Replaces elements of " { $snippet "seq" } " which appear as keys in " { $snippet "assoc" } " with the corresponding values, acting as the identity on all other elements." } -{ $errors "Throws an error if " { $snippet "assoc" } " contains values whose types are not permissible in " { $snippet "seq" } "." } -{ $side-effects "seq" } ; - HELP: substitute { $values { "seq" sequence } { "assoc" assoc } { "newseq" sequence } } { $description "Creates a new sequence where elements of " { $snippet "seq" } " which appear as keys in " { $snippet "assoc" } " are replaced by the corresponding values, and all other elements are unchanged." } ; diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 9e4a6e221e..6b66a79358 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -135,9 +135,6 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) : assoc-diff ( assoc1 assoc2 -- diff ) [ nip key? not ] curry assoc-filter ; -: substitute-here ( seq assoc -- ) - substituter map! drop ; - : substitute ( seq assoc -- newseq ) substituter map ; diff --git a/core/hashtables/hashtables-tests.factor b/core/hashtables/hashtables-tests.factor index 54e58c0282..05cc27f5e8 100644 --- a/core/hashtables/hashtables-tests.factor +++ b/core/hashtables/hashtables-tests.factor @@ -155,11 +155,6 @@ H{ } "x" set ] { } make ] unit-test -[ { "one" "two" 3 } ] [ - { 1 2 3 } clone dup - H{ { 1 "one" } { 2 "two" } } substitute-here -] unit-test - [ { "one" "two" 3 } ] [ { 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute ] unit-test diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 775734f0f7..6740b51d4d 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -430,8 +430,8 @@ HELP: filter-as { $values { "seq" sequence } { "quot" { $quotation "( elt -- ? )" } } { "exemplar" sequence } { "subseq" "a new sequence" } } { $description "Applies the quotation to each element in turn, and outputs a new sequence of the same type as " { $snippet "exemplar" } " containing the elements of the original sequence for which the quotation output a true value." } ; -HELP: filter-here -{ $values { "seq" "a resizable mutable sequence" } { "quot" { $quotation "( elt -- ? )" } } } +HELP: filter! +{ $values { "seq" "a resizable mutable sequence" } { "quot" { $quotation "( elt -- ? )" } } { "seq" "a resizable mutable sequence" } } { $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." } { $side-effects "seq" } ; @@ -1065,7 +1065,7 @@ HELP: harvest } } ; -{ filter filter-here sift harvest } related-words +{ filter filter! sift harvest } related-words HELP: set-first { $values @@ -1598,7 +1598,7 @@ ARTICLE: "sequences-destructive" "Destructive operations" remove-nth! delete-slice delete-all - filter-here + filter! } "Other destructive words:" { $subsections @@ -1620,7 +1620,7 @@ ARTICLE: "sequences-destructive" "Destructive operations" { { $link reverse } { $link reverse-here } } { { $link append } { $link push-all } } { { $link map } { $link map! } } - { { $link filter } { $link filter-here } } + { { $link filter } { $link filter! } } } { $heading "Related Articles" } { $subsections diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 0acc1b7344..d25c62c561 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -59,10 +59,10 @@ IN: sequences.tests [ [ 3 ] ] [ [ 1 2 3 ] 2 [ swap < ] curry filter ] unit-test -[ V{ 1 2 3 } ] [ V{ 1 4 2 5 3 6 } clone [ [ 4 < ] filter-here ] keep ] unit-test -[ V{ 4 2 6 } ] [ V{ 1 4 2 5 3 6 } clone [ [ 2 mod 0 = ] filter-here ] keep ] unit-test +[ V{ 1 2 3 } ] [ V{ 1 4 2 5 3 6 } clone [ 4 < ] filter! ] unit-test +[ V{ 4 2 6 } ] [ V{ 1 4 2 5 3 6 } clone [ 2 mod 0 = ] filter! ] unit-test -[ V{ 3 } ] [ V{ 1 2 3 } clone [ 2 [ swap < ] curry filter-here ] keep ] unit-test +[ V{ 3 } ] [ V{ 1 2 3 } clone 2 [ swap < ] curry filter! ] unit-test [ "hello world how are you" ] [ { "hello" "world" "how" "are" "you" } " " join ] diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 940bfe0137..c74a7c3ad0 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -619,24 +619,24 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; -: filter-here ( seq quot -- ) - swap [ 0 0 ] dip (filter-here) ; inline +: filter! ( seq quot -- seq ) + swap [ [ 0 0 ] dip (filter!) ] keep ; inline : remove! ( elt seq -- seq ) - [ [ = not ] with filter-here ] keep ; + [ = not ] with filter! ; : remove-eq! ( elt seq -- seq ) - [ [ eq? not ] with filter-here ] keep ; + [ eq? not ] with filter! ; : prefix ( seq elt -- newseq ) over [ over length 1 + ] dip [ diff --git a/core/source-files/errors/errors.factor b/core/source-files/errors/errors.factor index b240b6929e..ebacc90f63 100644 --- a/core/source-files/errors/errors.factor +++ b/core/source-files/errors/errors.factor @@ -80,7 +80,7 @@ SYMBOL: error-observers [ [ swap file>> = ] [ swap error-type = ] bi-curry* bi and not - ] 2curry filter-here + ] 2curry filter! drop notify-error-observers ; : delete-definition-errors ( definition -- ) diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim index e13834f904..ef5046d6d6 100644 --- a/misc/vim/syntax/factor.vim +++ b/misc/vim/syntax/factor.vim @@ -50,10 +50,10 @@ syn keyword factorCompileDirective inline foldable recursive syn keyword factorKeyword boolean syn keyword factorKeyword or tuck 2bi 2tri while wrapper nip 4dip wrapper? bi* callstack>array both? hashcode die dupd callstack callstack? 3dup tri@ pick curry build ?execute 3bi prepose >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep clear 2dup when not tuple? dup 2bi* 2tri* call tri-curry object bi@ do unless* if* loop bi-curry* drop when* assert= retainstack assert? -rot execute 2bi@ 2tri@ boa with either? 3drop bi curry? datastack until 3dip over 3curry roll tri-curry* swap tri-curry@ 2nip and throw set-retainstack bi-curry (clone) hashcode* compose spin 2dip if 3tri unless compose? tuple keep 2curry equal? set-datastack assert tri 2drop most boolean? identity-tuple? null new set-callstack dip bi-curry@ rot -roll xor identity-tuple boolean -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 assoc assoc-map enum value-at* 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 ?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 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 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 < 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 remove-eq but-last snip trim-tail nths nth 2pusher sequence slice? partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length remove-eq! 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 remove-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 second map! join when-empty accumulator immutable-sequence? 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? 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! last-index-from reversed index-from cut* pad-tail (indices) concat-as remove-eq but-last snip trim-tail nths nth 2pusher sequence slice? partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length remove-eq! 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 remove-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 second map! join when-empty accumulator immutable-sequence? 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? 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 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 From 7ef15865a8dc427faa492f940deb1e820cc53967 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 28 Oct 2009 00:50:05 -0500 Subject: [PATCH 07/17] remove failed experiment --- unmaintained/newfx/newfx.factor | 248 -------------------------------- 1 file changed, 248 deletions(-) delete mode 100644 unmaintained/newfx/newfx.factor diff --git a/unmaintained/newfx/newfx.factor b/unmaintained/newfx/newfx.factor deleted file mode 100644 index bf7955fa84..0000000000 --- a/unmaintained/newfx/newfx.factor +++ /dev/null @@ -1,248 +0,0 @@ - -USING: kernel sequences assocs circular sets fry ; - -USING: math multi-methods ; - -QUALIFIED: sequences -QUALIFIED: assocs -QUALIFIED: circular -QUALIFIED: sets - -IN: newfx - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Now, we can see a new world coming into view. -! A world in which there is the very real prospect of a new world order. -! -! - George Herbert Walker Bush -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -GENERIC: at ( col key -- val ) -GENERIC: of ( key col -- val ) - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -GENERIC: grab ( col key -- col val ) - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -GENERIC: is ( col key val -- col ) -GENERIC: as ( col val key -- col ) - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -GENERIC: is-of ( key val col -- col ) -GENERIC: as-of ( val key col -- col ) - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -GENERIC: mutate-at ( col key val -- ) -GENERIC: mutate-as ( col val key -- ) - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -GENERIC: at-mutate ( key val col -- ) -GENERIC: as-mutate ( val key col -- ) - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! sequence -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: at { sequence number } swap nth ; -METHOD: of { number sequence } nth ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: grab { sequence number } dupd swap nth ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: is { sequence number object } swap pick set-nth ; -METHOD: as { sequence object number } pick set-nth ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: is-of { number object sequence } dup [ swapd set-nth ] dip ; -METHOD: as-of { object number sequence } dup [ set-nth ] dip ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: mutate-at { sequence number object } swap rot set-nth ; -METHOD: mutate-as { sequence object number } rot set-nth ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: at-mutate { number object sequence } swapd set-nth ; -METHOD: as-mutate { object number sequence } set-nth ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! assoc -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: at { assoc object } swap assocs:at ; -METHOD: of { object assoc } assocs:at ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: grab { assoc object } dupd swap assocs:at ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: is { assoc object object } swap pick set-at ; -METHOD: as { assoc object object } pick set-at ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: is-of { object object assoc } dup [ swapd set-at ] dip ; -METHOD: as-of { object object assoc } dup [ set-at ] dip ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: mutate-at { assoc object object } swap rot set-at ; -METHOD: mutate-as { assoc object object } rot set-at ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -METHOD: at-mutate { object object assoc } swapd set-at ; -METHOD: as-mutate { object object assoc } set-at ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: push ( seq obj -- seq ) over sequences:push ; -: push-on ( obj seq -- seq ) tuck sequences:push ; -: pushed ( seq obj -- ) swap sequences:push ; -: pushed-on ( obj seq -- ) sequences:push ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: member? ( seq obj -- ? ) swap sequences:member? ; -: member-of? ( obj seq -- ? ) sequences:member? ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: delete-at-key ( tbl key -- tbl ) over delete-at ; -: delete-key-of ( key tbl -- tbl ) tuck delete-at ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: delete ( seq elt -- seq ) over sequences:delete ; -: delete-from ( elt seq -- seq ) tuck sequences:delete ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: deleted ( seq elt -- ) swap sequences:delete ; -: deleted-from ( elt seq -- ) sequences:delete ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: remove ( seq obj -- seq ) swap sequences:remove ; -: remove-from ( obj seq -- seq ) sequences:remove ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: filter-of ( quot seq -- seq ) swap filter ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: map-over ( quot seq -- seq ) swap map ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: push-circular ( seq elt -- seq ) over circular:push-circular ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: prefix-on ( elt seq -- seq ) swap prefix ; -: suffix-on ( elt seq -- seq ) swap suffix ; - -: suffix! ( seq elt -- seq ) over sequences:push ; -: suffix-on! ( elt seq -- seq ) tuck sequences:push ; -: suffixed! ( seq elt -- ) swap sequences:push ; -: suffixed-on! ( elt seq -- ) sequences:push ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: subseq ( seq from to -- subseq ) rot sequences:subseq ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: key ( table val -- key ) swap assocs:value-at ; - -: key-of ( val table -- key ) assocs:value-at ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: index ( seq obj -- i ) swap sequences:index ; -: index-of ( obj seq -- i ) sequences:index ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: 1st ( seq -- obj ) 0 swap nth ; -: 2nd ( seq -- obj ) 1 swap nth ; -: 3rd ( seq -- obj ) 2 swap nth ; -: 4th ( seq -- obj ) 3 swap nth ; -: 5th ( seq -- obj ) 4 swap nth ; -: 6th ( seq -- obj ) 5 swap nth ; -: 7th ( seq -- obj ) 6 swap nth ; -: 8th ( seq -- obj ) 7 swap nth ; -: 9th ( seq -- obj ) 8 swap nth ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! A note about the 'mutate' qualifier. Other words also technically mutate -! their primary object. However, the 'mutate' qualifier is supposed to -! indicate that this is the main objective of the word, as a side effect. - -: adjoin ( seq elt -- seq ) over sets:adjoin ; -: adjoin-on ( elt seq -- seq ) tuck sets:adjoin ; -: adjoined ( set elt -- ) swap sets:adjoin ; -: adjoined-on ( elt set -- ) sets:adjoin ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: start ( seq subseq -- i ) swap sequences:start ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: pluck ( seq i -- seq ) cut-slice rest-slice append ; -: pluck-from ( i seq -- seq ) swap pluck ; -: pluck! ( seq i -- seq ) over delete-nth ; -: pluck-from! ( i seq -- seq ) tuck delete-nth ; -: plucked! ( seq i -- ) swap delete-nth ; -: plucked-from! ( i seq -- ) delete-nth ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: snip ( seq a b -- seq ) [ over ] dip [ head ] [ tail ] 2bi* append ; -: snip-this ( a b seq -- seq ) -rot snip ; -: snip! ( seq a b -- seq ) pick delete-slice ; -: snip-this! ( a b seq -- seq ) -rot pick delete-slice ; -: snipped! ( seq a b -- ) rot delete-slice ; -: snipped-from! ( a b seq -- ) delete-slice ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: invert-index ( seq i -- seq i ) [ dup length 1 - ] dip - ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: append! ( a b -- ab ) over sequences:push-all ; -: append-to! ( b a -- ab ) swap over sequences:push-all ; -: appended! ( a b -- ) swap sequences:push-all ; -: appended-to! ( b a -- ) sequences:push-all ; - -: prepend! ( a b -- ba ) over append 0 pick copy ; -: prepended! ( a b -- ) over append 0 rot copy ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: insert ( seq i obj -- seq ) [ cut ] dip prefix append ; - -: splice ( seq i seq -- seq ) [ cut ] dip prepend append ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: purge ( seq quot -- seq ) [ not ] compose filter ; inline - -: purge! ( seq quot -- seq ) - dupd '[ swap @ [ pluck! ] [ drop ] if ] each-index ; inline From 37a87e85ab75662f4c14e75102df0ba1439d79f2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 28 Oct 2009 12:50:18 -0500 Subject: [PATCH 08/17] annotations tests were broken if you have any TODOs yourself --- extra/annotations/annotations-tests.factor | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/extra/annotations/annotations-tests.factor b/extra/annotations/annotations-tests.factor index 48fd281c6c..b03494ce01 100644 --- a/extra/annotations/annotations-tests.factor +++ b/extra/annotations/annotations-tests.factor @@ -23,5 +23,8 @@ IN: annotations.tests } 1&& ] unit-test -[ { four three } ] [ BROKENs natural-sort ] unit-test -[ { five } ] [ TODOs ] unit-test +[ t ] [ + BROKENs { [ \ four swap member? ] [ \ three swap member? ] } 1&& +] unit-test + +[ t ] [ TODOs \ five swap member? ] unit-test From 7ce4b746e521fb7d97cfa1785106c529a997c0b5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 28 Oct 2009 13:38:27 -0500 Subject: [PATCH 09/17] parsed -> suffix!, add append! --- basis/alien/fortran/fortran.factor | 3 - basis/alien/syntax/syntax.factor | 6 +- basis/byte-arrays/hex/hex.factor | 2 +- basis/classes/struct/struct.factor | 6 +- basis/cocoa/cocoa.factor | 4 +- basis/colors/constants/constants.factor | 2 +- basis/compiler/cfg/registers/registers.factor | 6 +- basis/cpu/ppc/linux/bootstrap.factor | 4 +- basis/cpu/ppc/macosx/bootstrap.factor | 4 +- basis/cpu/x86/32/bootstrap.factor | 4 +- basis/cpu/x86/64/bootstrap.factor | 4 +- basis/cpu/x86/64/unix/bootstrap.factor | 7 +- basis/cpu/x86/64/winnt/bootstrap.factor | 4 +- basis/cpu/x86/bootstrap.factor | 8 +-- basis/functors/functors.factor | 70 +++++++++---------- basis/html/templates/fhtml/fhtml.factor | 6 +- basis/io/encodings/iso2022/iso2022.factor | 2 +- basis/locals/locals.factor | 2 +- basis/math/rectangles/rectangles.factor | 4 +- basis/multiline/multiline.factor | 4 +- basis/opengl/debug/debug.factor | 2 +- basis/peg/ebnf/ebnf.factor | 4 +- .../hashtables/config/config.factor | 4 +- basis/prettyprint/prettyprint-docs.factor | 2 +- basis/regexp/regexp.factor | 2 +- basis/roman/roman.factor | 2 +- basis/serialize/serialize-tests.factor | 2 +- basis/shuffle/shuffle.factor | 2 +- .../specialized-arrays.factor | 2 +- basis/tools/test/test.factor | 6 +- basis/tools/walker/walker.factor | 2 +- basis/urls/urls.factor | 2 +- basis/values/values.factor | 4 +- basis/windows/com/syntax/syntax.factor | 2 +- basis/xml/syntax/syntax.factor | 8 +-- core/parser/parser-docs.factor | 7 +- core/parser/parser.factor | 6 +- core/sequences/sequences.factor | 4 ++ core/syntax/syntax.factor | 28 ++++---- extra/alien/data/map/map.factor | 8 +-- extra/annotations/annotations.factor | 4 +- extra/db/info/info.factor | 4 +- extra/decimals/decimals.factor | 2 +- extra/infix/infix.factor | 2 +- extra/llvm/types/types.factor | 2 +- extra/money/money.factor | 2 +- extra/morse/morse.factor | 2 +- extra/pair-rocket/pair-rocket.factor | 2 +- extra/persistency/persistency.factor | 2 +- extra/qw/qw.factor | 4 +- extra/slides/slides.factor | 2 +- unmaintained/advice/advice.factor | 2 +- 52 files changed, 138 insertions(+), 143 deletions(-) diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor index bf8721b549..caa3b7a115 100644 --- a/basis/alien/fortran/fortran.factor +++ b/basis/alien/fortran/fortran.factor @@ -205,9 +205,6 @@ M: fortran-type (fortran-ret-type>c-type) (fortran-type>c-type) ; M: real-type (fortran-ret-type>c-type) drop real-functions-return-double? [ "double" ] [ "float" ] if ; -: suffix! ( seq elt -- seq ) over push ; inline -: append! ( seq-a seq-b -- seq-a ) over push-all ; inline - GENERIC: (fortran-arg>c-args) ( type -- main-quot added-quot ) : args?dims ( type quot -- main-quot added-quot ) diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index 7adf837841..c51a446b6c 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -7,11 +7,11 @@ effects assocs combinators lexer strings.parser alien.parser fry vocabs.parser words.constant alien.libraries ; IN: alien.syntax -SYNTAX: DLL" lexer get skip-blank parse-string dlopen parsed ; +SYNTAX: DLL" lexer get skip-blank parse-string dlopen suffix! ; -SYNTAX: ALIEN: 16 scan-base parsed ; +SYNTAX: ALIEN: 16 scan-base suffix! ; -SYNTAX: BAD-ALIEN parsed ; +SYNTAX: BAD-ALIEN suffix! ; SYNTAX: LIBRARY: scan "c-library" set ; diff --git a/basis/byte-arrays/hex/hex.factor b/basis/byte-arrays/hex/hex.factor index 5c381b7db0..ae9b9c8ba2 100644 --- a/basis/byte-arrays/hex/hex.factor +++ b/basis/byte-arrays/hex/hex.factor @@ -7,4 +7,4 @@ SYNTAX: HEX{ "}" parse-tokens "" join [ blank? not ] filter 2 group [ hex> ] B{ } map-as - parsed ; + suffix! ; diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index af23834383..417f188c3c 100755 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -365,10 +365,10 @@ SYNTAX: UNION-STRUCT: parse-struct-definition define-union-struct-class ; SYNTAX: S{ - scan-word dup struct-slots parse-tuple-literal-slots parsed ; + scan-word dup struct-slots parse-tuple-literal-slots suffix! ; SYNTAX: S@ - scan-word scan-object swap memory>struct parsed ; + scan-word scan-object swap memory>struct suffix! ; ! functor support @@ -389,7 +389,7 @@ SYNTAX: S@ PRIVATE> FUNCTOR-SYNTAX: STRUCT: - scan-param parsed + scan-param suffix! [ 8 ] over push-all [ parse-struct-slots` ] [ ] while [ >array define-struct-class ] over push-all ; diff --git a/basis/cocoa/cocoa.factor b/basis/cocoa/cocoa.factor index ec5db31940..ec09f8f2ba 100644 --- a/basis/cocoa/cocoa.factor +++ b/basis/cocoa/cocoa.factor @@ -14,14 +14,14 @@ SYMBOL: sent-messages : remember-send ( selector -- ) sent-messages (remember-send) ; -SYNTAX: -> scan dup remember-send parsed \ send parsed ; +SYNTAX: -> scan dup remember-send suffix! \ send suffix! ; SYMBOL: super-sent-messages : remember-super-send ( selector -- ) super-sent-messages (remember-send) ; -SYNTAX: SUPER-> scan dup remember-super-send parsed \ super-send parsed ; +SYNTAX: SUPER-> scan dup remember-super-send suffix! \ super-send suffix! ; SYMBOL: frameworks diff --git a/basis/colors/constants/constants.factor b/basis/colors/constants/constants.factor index 8598fc0663..c17d1069b2 100644 --- a/basis/colors/constants/constants.factor +++ b/basis/colors/constants/constants.factor @@ -30,4 +30,4 @@ ERROR: no-such-color name ; : named-color ( name -- color ) dup colors at [ ] [ no-such-color ] ?if ; -SYNTAX: COLOR: scan named-color parsed ; \ No newline at end of file +SYNTAX: COLOR: scan named-color suffix! ; diff --git a/basis/compiler/cfg/registers/registers.factor b/basis/compiler/cfg/registers/registers.factor index 0d518735af..2f4f2a99e6 100644 --- a/basis/compiler/cfg/registers/registers.factor +++ b/basis/compiler/cfg/registers/registers.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors namespaces kernel parser assocs ; +USING: accessors namespaces kernel parser assocs sequences ; IN: compiler.cfg.registers ! Virtual registers, used by CFG and machine IRs, are just integers @@ -42,5 +42,5 @@ C: ds-loc TUPLE: rs-loc < loc ; C: rs-loc -SYNTAX: D scan-word parsed ; -SYNTAX: R scan-word parsed ; +SYNTAX: D scan-word suffix! ; +SYNTAX: R scan-word suffix! ; diff --git a/basis/cpu/ppc/linux/bootstrap.factor b/basis/cpu/ppc/linux/bootstrap.factor index cf6517b664..a5250414ab 100644 --- a/basis/cpu/ppc/linux/bootstrap.factor +++ b/basis/cpu/ppc/linux/bootstrap.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: parser layouts system kernel ; +USING: parser layouts system kernel sequences ; IN: bootstrap.ppc : c-area-size ( -- n ) 10 bootstrap-cells ; : lr-save ( -- n ) bootstrap-cell ; -<< "vocab:cpu/ppc/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/ppc/bootstrap.factor" parse-file suffix! >> call diff --git a/basis/cpu/ppc/macosx/bootstrap.factor b/basis/cpu/ppc/macosx/bootstrap.factor index 0c383c2fb0..2aa0ddc4a2 100644 --- a/basis/cpu/ppc/macosx/bootstrap.factor +++ b/basis/cpu/ppc/macosx/bootstrap.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: parser layouts system kernel ; +USING: parser layouts system kernel sequences ; IN: bootstrap.ppc : c-area-size ( -- n ) 14 bootstrap-cells ; : lr-save ( -- n ) 2 bootstrap-cells ; -<< "vocab:cpu/ppc/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/ppc/bootstrap.factor" parse-file suffix! >> call diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor index c5f6975d33..e532d42dfe 100644 --- a/basis/cpu/x86/32/bootstrap.factor +++ b/basis/cpu/x86/32/bootstrap.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system cpu.x86.assembler cpu.x86.assembler.operands layouts -vocabs parser compiler.constants ; +vocabs parser compiler.constants sequences ; IN: bootstrap.x86 4 \ cell set @@ -35,5 +35,5 @@ IN: bootstrap.x86 0 JMP rc-relative rt-primitive jit-rel ] jit-primitive jit-define -<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >> call diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor index b42a38b2d2..662eaed3e0 100644 --- a/basis/cpu/x86/64/bootstrap.factor +++ b/basis/cpu/x86/64/bootstrap.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system layouts vocabs parser compiler.constants math -cpu.x86.assembler cpu.x86.assembler.operands ; +cpu.x86.assembler cpu.x86.assembler.operands sequences ; IN: bootstrap.x86 8 \ cell set @@ -35,5 +35,5 @@ IN: bootstrap.x86 temp1 JMP ] jit-primitive jit-define -<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >> call diff --git a/basis/cpu/x86/64/unix/bootstrap.factor b/basis/cpu/x86/64/unix/bootstrap.factor index 2ad3a721af..238fad984a 100644 --- a/basis/cpu/x86/64/unix/bootstrap.factor +++ b/basis/cpu/x86/64/unix/bootstrap.factor @@ -1,12 +1,13 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: bootstrap.image.private kernel namespaces system -cpu.x86.assembler cpu.x86.assembler.operands layouts vocabs parser ; +USING: bootstrap.image.private cpu.x86.assembler +cpu.x86.assembler.operands kernel layouts namespaces parser +sequences system vocabs ; IN: bootstrap.x86 : stack-frame-size ( -- n ) 4 bootstrap-cells ; : arg1 ( -- reg ) RDI ; : arg2 ( -- reg ) RSI ; -<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >> call diff --git a/basis/cpu/x86/64/winnt/bootstrap.factor b/basis/cpu/x86/64/winnt/bootstrap.factor index 2dd3e889a5..723c9baf37 100644 --- a/basis/cpu/x86/64/winnt/bootstrap.factor +++ b/basis/cpu/x86/64/winnt/bootstrap.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system -layouts vocabs parser cpu.x86.assembler +layouts vocabs sequences cpu.x86.assembler cpu.x86.assembler.operands ; IN: bootstrap.x86 @@ -9,5 +9,5 @@ IN: bootstrap.x86 : arg1 ( -- reg ) RCX ; : arg2 ( -- reg ) RDX ; -<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >> +<< "vocab:cpu/x86/64/bootstrap.factor" parse-file suffix! >> call diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index fb94445f78..7930970193 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: bootstrap.image.private kernel kernel.private namespaces system -layouts compiler.units math math.private compiler.constants vocabs -slots.private words locals.backend make sequences combinators arrays - cpu.x86.assembler cpu.x86.assembler.operands ; +USING: bootstrap.image.private compiler.constants +compiler.units cpu.x86.assembler cpu.x86.assembler.operands +kernel kernel.private layouts locals.backend make math +math.private namespaces sequences slots.private vocabs ; IN: bootstrap.x86 big-endian off diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index dacd87507b..1d11d78b33 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -42,85 +42,85 @@ M: fake-call-next-method (fake-quotations>) M: object (fake-quotations>) , ; : parse-definition* ( accum -- accum ) - parse-definition >fake-quotations parsed + parse-definition >fake-quotations suffix! [ fake-quotations> first ] over push-all ; : parse-declared* ( accum -- accum ) complete-effect [ parse-definition* ] dip - parsed ; + suffix! ; FUNCTOR-SYNTAX: TUPLE: - scan-param parsed + scan-param suffix! scan { - { ";" [ tuple parsed f parsed ] } - { "<" [ scan-param parsed [ parse-tuple-slots ] { } make parsed ] } + { ";" [ tuple suffix! f suffix! ] } + { "<" [ scan-param suffix! [ parse-tuple-slots ] { } make suffix! ] } [ - [ tuple parsed ] dip + [ tuple suffix! ] dip [ parse-slot-name [ parse-tuple-slots ] when ] { } - make parsed + make suffix! ] } case - \ define-tuple-class parsed ; + \ define-tuple-class suffix! ; FUNCTOR-SYNTAX: SINGLETON: - scan-param parsed - \ define-singleton-class parsed ; + scan-param suffix! + \ define-singleton-class suffix! ; FUNCTOR-SYNTAX: MIXIN: - scan-param parsed - \ define-mixin-class parsed ; + scan-param suffix! + \ define-mixin-class suffix! ; FUNCTOR-SYNTAX: M: - scan-param parsed - scan-param parsed + scan-param suffix! + scan-param suffix! [ create-method-in dup method-body set ] over push-all parse-definition* - \ define* parsed ; + \ define* suffix! ; FUNCTOR-SYNTAX: C: - scan-param parsed - scan-param parsed + scan-param suffix! + scan-param suffix! complete-effect - [ [ [ boa ] curry ] over push-all ] dip parsed - \ define-declared* parsed ; + [ [ [ boa ] curry ] over push-all ] dip suffix! + \ define-declared* suffix! ; FUNCTOR-SYNTAX: : - scan-param parsed + scan-param suffix! parse-declared* - \ define-declared* parsed ; + \ define-declared* suffix! ; FUNCTOR-SYNTAX: SYMBOL: - scan-param parsed - \ define-symbol parsed ; + scan-param suffix! + \ define-symbol suffix! ; FUNCTOR-SYNTAX: SYNTAX: - scan-param parsed + scan-param suffix! parse-definition* - \ define-syntax parsed ; + \ define-syntax suffix! ; FUNCTOR-SYNTAX: INSTANCE: - scan-param parsed - scan-param parsed - \ add-mixin-instance parsed ; + scan-param suffix! + scan-param suffix! + \ add-mixin-instance suffix! ; FUNCTOR-SYNTAX: GENERIC: - scan-param parsed - complete-effect parsed - \ define-simple-generic* parsed ; + scan-param suffix! + complete-effect suffix! + \ define-simple-generic* suffix! ; FUNCTOR-SYNTAX: MACRO: - scan-param parsed + scan-param suffix! parse-declared* - \ define-macro parsed ; + \ define-macro suffix! ; FUNCTOR-SYNTAX: inline [ word make-inline ] over push-all ; -FUNCTOR-SYNTAX: call-next-method T{ fake-call-next-method } parsed ; +FUNCTOR-SYNTAX: call-next-method T{ fake-call-next-method } suffix! ; : (INTERPOLATE) ( accum quot -- accum ) [ scan interpolate-locals ] dip - '[ _ with-string-writer @ ] parsed ; + '[ _ with-string-writer @ ] suffix! ; PRIVATE> diff --git a/basis/html/templates/fhtml/fhtml.factor b/basis/html/templates/fhtml/fhtml.factor index a98a21f177..d4cb484a79 100644 --- a/basis/html/templates/fhtml/fhtml.factor +++ b/basis/html/templates/fhtml/fhtml.factor @@ -31,14 +31,14 @@ DEFER: <% delimiter : found-<% ( accum lexer col -- accum ) [ over line-text>> - [ column>> ] 2dip subseq parsed - \ write parsed + [ column>> ] 2dip subseq suffix! + \ write suffix! ] 2keep 2 + >>column drop ; : still-looking ( accum lexer -- accum ) [ [ line-text>> ] [ column>> ] bi tail - parsed \ print parsed + suffix! \ print suffix! ] keep next-line ; : parse-%> ( accum lexer -- accum ) diff --git a/basis/io/encodings/iso2022/iso2022.factor b/basis/io/encodings/iso2022/iso2022.factor index a057df28e0..1726426777 100644 --- a/basis/io/encodings/iso2022/iso2022.factor +++ b/basis/io/encodings/iso2022/iso2022.factor @@ -31,7 +31,7 @@ M: iso2022 M: iso2022 make-iso-coder ; -<< SYNTAX: ESC HEX: 16 parsed ; >> +<< SYNTAX: ESC HEX: 16 suffix! ; >> CONSTANT: switch-ascii B{ ESC CHAR: ( CHAR: B } CONSTANT: switch-jis201 B{ ESC CHAR: ( CHAR: J } diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index 9e26a8caaa..4f908aaf06 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -7,7 +7,7 @@ IN: locals SYNTAX: :> scan locals get [ :>-outside-lambda-error ] unless* - [ make-local ] bind parsed ; + [ make-local ] bind suffix! ; SYNTAX: [| parse-lambda over push-all ; diff --git a/basis/math/rectangles/rectangles.factor b/basis/math/rectangles/rectangles.factor index c8569dfdb9..bfde391884 100644 --- a/basis/math/rectangles/rectangles.factor +++ b/basis/math/rectangles/rectangles.factor @@ -8,7 +8,7 @@ TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ; : ( loc dim -- rect ) rect boa ; inline -SYNTAX: RECT: scan-object scan-object parsed ; +SYNTAX: RECT: scan-object scan-object suffix! ; : ( -- rect ) rect new ; inline @@ -64,4 +64,4 @@ M: rect contains-point? USING: vocabs vocabs.loader ; -"prettyprint" vocab [ "math.rectangles.prettyprint" require ] when \ No newline at end of file +"prettyprint" vocab [ "math.rectangles.prettyprint" require ] when diff --git a/basis/multiline/multiline.factor b/basis/multiline/multiline.factor index e28537066b..5182c33e59 100644 --- a/basis/multiline/multiline.factor +++ b/basis/multiline/multiline.factor @@ -81,10 +81,10 @@ SYNTAX: HEREDOC: lexer get skip-blank rest-of-line lexer get next-line - parse-til-line-begins parsed ; + parse-til-line-begins suffix! ; SYNTAX: DELIMITED: lexer get skip-blank rest-of-line lexer get next-line - 0 (parse-multiline-string) parsed ; + 0 (parse-multiline-string) suffix! ; diff --git a/basis/opengl/debug/debug.factor b/basis/opengl/debug/debug.factor index 7cbdf62346..cd0985b1b0 100644 --- a/basis/opengl/debug/debug.factor +++ b/basis/opengl/debug/debug.factor @@ -19,5 +19,5 @@ SYMBOL: G-world << \ gl-break t "break?" set-word-prop >> SYNTAX: GB - \ gl-break parsed ; + \ gl-break suffix! ; diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor index 136007e7ce..a7fd07a5ec 100644 --- a/basis/peg/ebnf/ebnf.factor +++ b/basis/peg/ebnf/ebnf.factor @@ -547,12 +547,12 @@ PRIVATE> SYNTAX: " reset-tokenizer parse-multiline-string parse-ebnf main swap at - parsed reset-tokenizer ; + suffix! reset-tokenizer ; SYNTAX: [EBNF "EBNF]" reset-tokenizer parse-multiline-string ebnf>quot nip - parsed \ call parsed reset-tokenizer ; + suffix! \ call suffix! reset-tokenizer ; SYNTAX: EBNF: reset-tokenizer CREATE-WORD dup ";EBNF" parse-multiline-string diff --git a/basis/persistent/hashtables/config/config.factor b/basis/persistent/hashtables/config/config.factor index cb2abd8015..190db9e9ab 100644 --- a/basis/persistent/hashtables/config/config.factor +++ b/basis/persistent/hashtables/config/config.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: layouts kernel parser math ; +USING: layouts kernel parser math sequences ; IN: persistent.hashtables.config -: radix-bits ( -- n ) << cell 4 = 4 5 ? parsed >> ; foldable +: radix-bits ( -- n ) << cell 4 = 4 5 ? suffix! >> ; foldable : radix-mask ( -- n ) radix-bits 2^ 1 - ; foldable : full-bitmap-mask ( -- n ) radix-bits 2^ 2^ 1 - ; inline diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor index e17e14f323..bd2c4bd924 100644 --- a/basis/prettyprint/prettyprint-docs.factor +++ b/basis/prettyprint/prettyprint-docs.factor @@ -121,7 +121,7 @@ ARTICLE: "prettyprint-literal" "Literal prettyprinting protocol" " scan-word \\ * assert=" " scan-word" " scan-word \\ ] assert=" - " parsed ;" + " suffix! ;" } "An example literal might be:" { $code "RECT[ 100 * 200 ]" } diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index ba4aa47e7b..e9a86516ca 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -200,7 +200,7 @@ PRIVATE> : parsing-regexp ( accum end -- accum ) lexer get [ take-until ] [ parse-noblank-token ] bi - compile-next-match parsed ; + compile-next-match suffix! ; PRIVATE> diff --git a/basis/roman/roman.factor b/basis/roman/roman.factor index 817b6637d6..bc86db31c6 100644 --- a/basis/roman/roman.factor +++ b/basis/roman/roman.factor @@ -69,4 +69,4 @@ ROMAN-OP: * ROMAN-OP: /i ROMAN-OP: /mod -SYNTAX: ROMAN: scan roman> parsed ; +SYNTAX: ROMAN: scan roman> suffix! ; diff --git a/basis/serialize/serialize-tests.factor b/basis/serialize/serialize-tests.factor index cebf69595f..6dbc76386d 100644 --- a/basis/serialize/serialize-tests.factor +++ b/basis/serialize/serialize-tests.factor @@ -50,7 +50,7 @@ CONSTANT: objects B{ 50 13 55 64 1 } ?{ t f t f f t f } double-array{ 1.0 3.0 4.0 1.0 2.35 0.33 } - << 1 [ 2 ] curry parsed >> + << 1 [ 2 ] curry suffix! >> { { "a" "bc" } { "de" "fg" } } H{ { "a" "bc" } { "de" "fg" } } } diff --git a/basis/shuffle/shuffle.factor b/basis/shuffle/shuffle.factor index d6a4ba8bbb..079e81d082 100644 --- a/basis/shuffle/shuffle.factor +++ b/basis/shuffle/shuffle.factor @@ -20,7 +20,7 @@ MACRO: shuffle-effect ( effect -- ) ] [ ] make ; SYNTAX: shuffle( - ")" parse-effect parsed \ shuffle-effect parsed ; + ")" parse-effect suffix! \ shuffle-effect suffix! ; : 2swap ( x y z t -- z t x y ) 2 2 mnswap ; inline diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 7a15e5067d..711354d803 100755 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -105,7 +105,7 @@ M: A pprint-delims drop \ A{ \ } ; M: A >pprint-sequence ; SYNTAX: A{ \ } [ >A ] parse-literal ; -SYNTAX: A@ scan-object scan-object parsed ; +SYNTAX: A@ scan-object scan-object suffix! ; INSTANCE: A specialized-array diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor index 097460837b..009789a739 100644 --- a/basis/tools/test/test.factor +++ b/basis/tools/test/test.factor @@ -96,9 +96,9 @@ MACRO: ( word -- ) ] [ drop ] if ; inline : parse-test ( accum word -- accum ) - literalize parsed - lexer get line>> parsed - \ experiment parsed ; inline + literalize suffix! + lexer get line>> suffix! + \ experiment suffix! ; inline << diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor index 19924d67e4..35a9ce7787 100644 --- a/basis/tools/walker/walker.factor +++ b/basis/tools/walker/walker.factor @@ -167,4 +167,4 @@ SYMBOL: +stopped+ ! For convenience IN: syntax -SYNTAX: B \ break parsed ; +SYNTAX: B \ break suffix! ; diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index a72fac567a..bf4a9bb76c 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -181,7 +181,7 @@ PRIVATE> clone dup protocol>> '[ _ protocol-port or ] change-port ; ! Literal syntax -SYNTAX: URL" lexer get skip-blank parse-string >url parsed ; +SYNTAX: URL" lexer get skip-blank parse-string >url suffix! ; USING: vocabs vocabs.loader ; diff --git a/basis/values/values.factor b/basis/values/values.factor index b15dcebe49..4329affe82 100644 --- a/basis/values/values.factor +++ b/basis/values/values.factor @@ -44,8 +44,8 @@ M: value-word definition drop f ; def>> first (>>obj) ; SYNTAX: to: - scan-word literalize parsed - \ set-value parsed ; + scan-word literalize suffix! + \ set-value suffix! ; : get-value ( word -- value ) def>> first obj>> ; diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor index bbade332cc..fc7d986cbc 100755 --- a/basis/windows/com/syntax/syntax.factor +++ b/basis/windows/com/syntax/syntax.factor @@ -101,7 +101,7 @@ SYNTAX: COM-INTERFACE: dup save-com-interface-definition define-words-for-com-interface ; -SYNTAX: GUID: scan string>guid parsed ; +SYNTAX: GUID: scan string>guid suffix! ; USING: vocabs vocabs.loader ; diff --git a/basis/xml/syntax/syntax.factor b/basis/xml/syntax/syntax.factor index 5b2a0bcfb4..4b9900d3b0 100644 --- a/basis/xml/syntax/syntax.factor +++ b/basis/xml/syntax/syntax.factor @@ -156,16 +156,16 @@ MACRO: interpolate-xml ( xml -- quot ) : collect ( accum variables -- accum ? ) { { [ dup empty? ] [ drop f ] } ! Just a literal - { [ dup [ ] all? ] [ >search-hash parsed t ] } ! locals - { [ dup [ not ] all? ] [ length parsed \ nenum parsed t ] } ! fry + { [ dup [ ] all? ] [ >search-hash suffix! t ] } ! locals + { [ dup [ not ] all? ] [ length suffix! \ nenum suffix! t ] } ! fry [ drop "XML interpolation contains both fry and locals" throw ] ! mixed } cond ; : parse-def ( accum delimiter quot -- accum ) [ parse-multiline-string [ blank? ] trim ] dip call [ extract-variables collect ] keep swap - [ number<-> parsed ] dip - [ \ interpolate-xml parsed ] when ; inline + [ number<-> suffix! ] dip + [ \ interpolate-xml suffix! ] when ; inline PRIVATE> diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 888f9f3b4c..844581c6d9 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -66,7 +66,7 @@ $nl $nl "Parsing words can read input, add word definitions to the dictionary, and do anything an ordinary word can." $nl -"Because of the stack restriction, parsing words cannot pass data to other words by leaving values on the stack; instead, use " { $link parsed } " to add the data to the parse tree so that it can be evaluated later." +"Because of the stack restriction, parsing words cannot pass data to other words by leaving values on the stack; instead, use " { $link suffix! } " to add the data to the parse tree so that it can be evaluated later." $nl "Parsing words cannot be called from the same source file where they are defined, because new definitions are only compiled at the end of the source file. An attempt to use a parsing word in its own source file raises an error:" { $subsections staging-violation } @@ -172,11 +172,6 @@ $parsing-note ; { parse-tokens (parse-until) parse-until } related-words -HELP: parsed -{ $values { "accum" vector } { "obj" object } } -{ $description "Convenience word for parsing words. It behaves exactly the same as " { $link push } ", except the accumulator remains on the stack." } -$parsing-note ; - HELP: (parse-lines) { $values { "lexer" lexer } { "quot" "a new " { $link quotation } } } { $description "Parses Factor source code using a custom lexer. The vocabulary search path is taken from the current scope." } diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 3152afc093..d920e1fc73 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -79,8 +79,6 @@ HOOK: parse-quotation quotation-parser ( -- quot ) M: f parse-quotation \ ] parse-until >quotation ; -: parsed ( accum obj -- accum ) over push ; - : (parse-lines) ( lexer -- quot ) [ f parse-until >quotation ] with-lexer ; @@ -88,7 +86,7 @@ M: f parse-quotation \ ] parse-until >quotation ; lexer-factory get call( lines -- lexer ) (parse-lines) ; : parse-literal ( accum end quot -- accum ) - [ parse-until ] dip call parsed ; inline + [ parse-until ] dip call suffix! ; inline : parse-definition ( -- quot ) \ ; parse-until >quotation ; @@ -104,7 +102,7 @@ ERROR: bad-number ; scan swap base> [ bad-number ] unless* ; : parse-base ( parsed base -- parsed ) - scan-base parsed ; + scan-base suffix! ; SYMBOL: bootstrap-syntax diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index c74a7c3ad0..6a40e2236b 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -650,6 +650,10 @@ PRIVATE> [ 0 swap copy ] keep ] new-like ; +: suffix! ( seq elt -- seq ) over push ; + +: append! ( seq1 seq2 -- seq1 ) over push-all ; + : last ( seq -- elt ) [ length 1 - ] [ nth ] bi ; : set-last ( elt seq -- ) [ length 1 - ] keep set-nth ; diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 80c7a42f30..dfb3e0bc10 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -73,9 +73,9 @@ IN: bootstrap.syntax "OCT:" [ 8 parse-base ] define-core-syntax "BIN:" [ 2 parse-base ] define-core-syntax - "NAN:" [ 16 scan-base parsed ] define-core-syntax + "NAN:" [ 16 scan-base suffix! ] define-core-syntax - "f" [ f parsed ] define-core-syntax + "f" [ f suffix! ] define-core-syntax "t" "syntax" lookup define-singleton-class "CHAR:" [ @@ -83,31 +83,31 @@ IN: bootstrap.syntax { [ dup length 1 = ] [ first ] } { [ "\\" ?head ] [ next-escape >string "" assert= ] } [ name>char-hook get call( name -- char ) ] - } cond parsed + } cond suffix! ] define-core-syntax - "\"" [ parse-multiline-string parsed ] define-core-syntax + "\"" [ parse-multiline-string suffix! ] define-core-syntax "SBUF\"" [ - lexer get skip-blank parse-string >sbuf parsed + lexer get skip-blank parse-string >sbuf suffix! ] define-core-syntax "P\"" [ - lexer get skip-blank parse-string parsed + lexer get skip-blank parse-string suffix! ] define-core-syntax - "[" [ parse-quotation parsed ] define-core-syntax + "[" [ parse-quotation suffix! ] define-core-syntax "{" [ \ } [ >array ] parse-literal ] define-core-syntax "V{" [ \ } [ >vector ] parse-literal ] define-core-syntax "B{" [ \ } [ >byte-array ] parse-literal ] define-core-syntax "BV{" [ \ } [ >byte-vector ] parse-literal ] define-core-syntax "H{" [ \ } [ >hashtable ] parse-literal ] define-core-syntax - "T{" [ parse-tuple-literal parsed ] define-core-syntax + "T{" [ parse-tuple-literal suffix! ] define-core-syntax "W{" [ \ } [ first ] parse-literal ] define-core-syntax - "POSTPONE:" [ scan-word parsed ] define-core-syntax - "\\" [ scan-word parsed ] define-core-syntax - "M\\" [ scan-word scan-word method parsed ] define-core-syntax + "POSTPONE:" [ scan-word suffix! ] define-core-syntax + "\\" [ scan-word suffix! ] define-core-syntax + "M\\" [ scan-word scan-word method suffix! ] define-core-syntax "inline" [ word make-inline ] define-core-syntax "recursive" [ word make-recursive ] define-core-syntax "foldable" [ word make-foldable ] define-core-syntax @@ -227,7 +227,7 @@ IN: bootstrap.syntax ] define-core-syntax "((" [ - "))" parse-effect parsed + "))" parse-effect suffix! ] define-core-syntax "MAIN:" [ scan-word current-vocab (>>main) ] define-core-syntax @@ -240,8 +240,8 @@ IN: bootstrap.syntax "call-next-method" [ current-method get [ - literalize parsed - \ (call-next-method) parsed + literalize suffix! + \ (call-next-method) suffix! ] [ not-in-a-method-error ] if* diff --git a/extra/alien/data/map/map.factor b/extra/alien/data/map/map.factor index 62bd45938b..6c93e8f4b6 100644 --- a/extra/alien/data/map/map.factor +++ b/extra/alien/data/map/map.factor @@ -118,14 +118,14 @@ MACRO: data-map! ( ins outs -- ) : parse-data-map-effect ( accum -- accum ) ")" parse-effect - [ in>> [ (parse-c-type) ] map parsed ] - [ out>> [ (parse-c-type) ] map parsed ] bi ; + [ in>> [ (parse-c-type) ] map suffix! ] + [ out>> [ (parse-c-type) ] map suffix! ] bi ; PRIVATE> SYNTAX: data-map( - parse-data-map-effect \ data-map parsed ; + parse-data-map-effect \ data-map suffix! ; SYNTAX: data-map!( - parse-data-map-effect \ data-map! parsed ; + parse-data-map-effect \ data-map! suffix! ; diff --git a/extra/annotations/annotations.factor b/extra/annotations/annotations.factor index 387c73abe4..e463206e4f 100644 --- a/extra/annotations/annotations.factor +++ b/extra/annotations/annotations.factor @@ -7,7 +7,7 @@ IN: annotations << : (parse-annotation) ( accum -- accum ) - lexer get [ line-text>> parsed ] [ next-line ] bi ; + lexer get [ line-text>> suffix! ] [ next-line ] bi ; : (non-annotation-usage) ( word -- usages ) smart-usage @@ -24,7 +24,7 @@ NAMEs. DEFINES ${NAME}s. WHERE : (NAME) ( str -- ) drop ; inline -SYNTAX: !NAME (parse-annotation) \ (NAME) parsed ; +SYNTAX: !NAME (parse-annotation) \ (NAME) suffix! ; : NAMEs ( -- usages ) \ (NAME) (non-annotation-usage) ; diff --git a/extra/db/info/info.factor b/extra/db/info/info.factor index 66409f2834..4d17b6bf10 100644 --- a/extra/db/info/info.factor +++ b/extra/db/info/info.factor @@ -10,6 +10,6 @@ SYNTAX: get-psql-info get-info 5 firstn [ >>username ] [ [ f ] [ ] if-empty >>password ] [ >>database ] - } spread parsed ; + } spread suffix! ; -SYNTAX: get-sqlite-info get-info first parsed ; \ No newline at end of file +SYNTAX: get-sqlite-info get-info first suffix! ; diff --git a/extra/decimals/decimals.factor b/extra/decimals/decimals.factor index ae1fb2f9a3..8ca9ea91c5 100644 --- a/extra/decimals/decimals.factor +++ b/extra/decimals/decimals.factor @@ -20,7 +20,7 @@ TUPLE: decimal { mantissa read-only } { exponent read-only } ; : parse-decimal ( -- decimal ) scan string>decimal ; -SYNTAX: D: parse-decimal parsed ; +SYNTAX: D: parse-decimal suffix! ; : decimal>ratio ( decimal -- ratio ) >decimal< 10^ * ; : decimal>float ( decimal -- ratio ) decimal>ratio >float ; diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor index ce19780058..4530d6c5c4 100644 --- a/extra/infix/infix.factor +++ b/extra/infix/infix.factor @@ -82,7 +82,7 @@ M: ast-function infix-codegen PRIVATE> SYNTAX: [infix - "infix]" [infix-parse parsed \ call parsed ; + "infix]" [infix-parse suffix! \ call suffix! ; : morse> ( morse -- plain ) replace-underscores morse>sentence ; -SYNTAX: [MORSE "MORSE]" parse-multiline-string morse> parsed ; +SYNTAX: [MORSE "MORSE]" parse-multiline-string morse> suffix! ; dup pop scan-object 2array parsed ; +SYNTAX: => dup pop scan-object 2array suffix! ; diff --git a/extra/persistency/persistency.factor b/extra/persistency/persistency.factor index f459eca7e4..db999f4c98 100644 --- a/extra/persistency/persistency.factor +++ b/extra/persistency/persistency.factor @@ -26,5 +26,5 @@ SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-ty : remove-tuples ( tuple -- ) [ delete-tuples ] w/db ; TUPLE: pattern value ; C: pattern -SYNTAX: %" parse-string parsed ; +SYNTAX: %" parse-string suffix! ; M: pattern where value>> over column-name>> 0% " LIKE " 0% bind# ; diff --git a/extra/qw/qw.factor b/extra/qw/qw.factor index ce96587c92..e0ad6e0a74 100644 --- a/extra/qw/qw.factor +++ b/extra/qw/qw.factor @@ -1,5 +1,5 @@ ! (c)2009 Joe Groff bsd license -USING: lexer parser ; +USING: lexer sequences parser ; IN: qw -SYNTAX: qw{ "}" parse-tokens parsed ; +SYNTAX: qw{ "}" parse-tokens suffix! ; diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor index af37580ff2..19b0dead48 100755 --- a/extra/slides/slides.factor +++ b/extra/slides/slides.factor @@ -99,7 +99,7 @@ TUPLE: slides < book ; ] with map ; SYNTAX: STRIP-TEASE: - parse-definition strip-tease [ parsed ] each ; + parse-definition strip-tease [ suffix! ] each ; \ slides H{ { T{ button-down } [ request-focus ] } diff --git a/unmaintained/advice/advice.factor b/unmaintained/advice/advice.factor index 44280456c1..8e22609714 100644 --- a/unmaintained/advice/advice.factor +++ b/unmaintained/advice/advice.factor @@ -66,4 +66,4 @@ SYNTAX: ADVISE: ! word adname location => word adname quot loc scan-word scan scan-word parse-definition swap [ spin ] dip advise ; SYNTAX: UNADVISE: - scan-word parsed \ unadvise parsed ; + scan-word suffix! \ unadvise suffix! ; From b0e3c7a1fcd603863b452eac0bc6469fbc8e616d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 28 Oct 2009 13:48:16 -0500 Subject: [PATCH 10/17] add docs for append! and suffix! --- core/sequences/sequences-docs.factor | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 6740b51d4d..43e66da2d5 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -44,7 +44,7 @@ HELP: nths { $values { "indices" sequence } { "seq" sequence } { "seq'" sequence } } -{ $description "Ouptuts a sequence of elements from the input sequence indexed by the indices." } +{ $description "Outputs a sequence of elements from the input sequence indexed by the indices." } { $examples { $example "USING: prettyprint sequences ;" "{ 0 2 } { \"a\" \"b\" \"c\" } nths ." @@ -528,6 +528,21 @@ HELP: suffix { $example "USING: prettyprint sequences ;" "{ 1 2 3 } 4 suffix ." "{ 1 2 3 4 }" } } ; +HELP: suffix! +{ $values { "seq" sequence } { "elt" object } { "seq" sequence } } +{ $description "Modifiers a sequence in-place by adding " { $snippet "elt" } " to the end of " { $snippet "seq" } ". Outputs " { $snippet "seq" } "." } +{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq" } "." } +{ $examples + { $example "USING: prettyprint sequences ;" "V{ 1 2 3 } 4 suffix! ." "V{ 1 2 3 4 }" } +} ; + +HELP: append! +{ $values { "seq1" sequence } { "seq2" sequence } { "seq1" sequence } } +{ $description "Modifiers " { $snippet "seq1" } " in-place by adding the elements from " { $snippet "seq2" } " to the end and outputs " { $snippet "seq1" } "." } +{ $examples + { $example "USING: prettyprint sequences ;" "V{ 1 2 3 } { 4 5 6 } append! ." "V{ 1 2 3 4 5 6 }" } +} ; + HELP: prefix { $values { "seq" sequence } { "elt" object } { "newseq" sequence } } { $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the beginning of " { $snippet "seq" } "." } @@ -1611,14 +1626,14 @@ ARTICLE: "sequences-destructive" "Destructive operations" "Many operations have constructive and destructive variants:" { $table { "Constructive" "Destructive" } - { { $link suffix } { $link push } } + { { $link suffix } { $link suffix! } } { { $link but-last } { $link pop* } } { { $link unclip-last } { $link pop } } { { $link remove } { $link remove! } } { { $link remove-eq } { $link remove-eq! } } { { $link remove-nth } { $link remove-nth! } } { { $link reverse } { $link reverse-here } } - { { $link append } { $link push-all } } + { { $link append } { $link append! } } { { $link map } { $link map! } } { { $link filter } { $link filter! } } } From 1476cdb974478e9dbcad2a76e827496aa34e7982 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 28 Oct 2009 14:40:15 -0500 Subject: [PATCH 11/17] reverse-here -> reverse! --- .../linear-scan/live-intervals/live-intervals.factor | 6 +++--- .../cfg/representations/representations.factor | 2 +- basis/grouping/grouping-docs.factor | 4 ++-- basis/hints/hints.factor | 2 +- basis/io/encodings/gb18030/gb18030.factor | 2 +- basis/io/mmap/mmap-docs.factor | 2 +- core/io/binary/binary.factor | 2 +- core/math/parser/parser.factor | 2 +- core/sequences/sequences-docs.factor | 10 +++++----- core/sequences/sequences.factor | 11 ++++++----- core/strings/strings-tests.factor | 2 +- extra/benchmark/fannkuch/fannkuch.factor | 2 +- .../reverse-complement/reverse-complement.factor | 2 +- misc/vim/syntax/factor.vim | 2 +- 14 files changed, 26 insertions(+), 25 deletions(-) diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor index 75dda9b475..00d6f73517 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -152,8 +152,8 @@ ERROR: bad-live-interval live-interval ; ! to reverse some sequences, and compute the start and end. values dup [ { - [ ranges>> reverse-here ] - [ uses>> reverse-here ] + [ ranges>> reverse! drop ] + [ uses>> reverse! drop ] [ compute-start/end ] [ check-start ] } cleave @@ -187,4 +187,4 @@ ERROR: bad-live-interval live-interval ; } cond ; : intervals-intersect? ( interval1 interval2 -- ? ) - relevant-ranges intersect-live-ranges >boolean ; inline \ No newline at end of file + relevant-ranges intersect-live-ranges >boolean ; inline diff --git a/basis/compiler/cfg/representations/representations.factor b/basis/compiler/cfg/representations/representations.factor index 42059f4152..9546721594 100644 --- a/basis/compiler/cfg/representations/representations.factor +++ b/basis/compiler/cfg/representations/representations.factor @@ -209,7 +209,7 @@ RENAMING: convert [ converted-value ] [ converted-value ] [ ] : perform-renaming ( insn -- ) needs-renaming? get [ - renaming-set get reverse-here + renaming-set get reverse! drop [ convert-insn-uses ] [ convert-insn-defs ] bi renaming-set get length 0 assert= ] [ drop ] if ; diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor index d64745b834..e1044b0feb 100644 --- a/basis/grouping/grouping-docs.factor +++ b/basis/grouping/grouping-docs.factor @@ -52,7 +52,7 @@ HELP: { $examples { $example "USING: arrays kernel prettyprint sequences grouping ;" - "9 >array 3 dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }" + "9 >array 3 reverse! concat >array ." "{ 6 7 8 3 4 5 0 1 2 }" } { $example "USING: kernel prettyprint sequences grouping ;" @@ -68,7 +68,7 @@ HELP: { $example "USING: arrays kernel prettyprint sequences grouping ;" "9 >array 3 " - "dup [ reverse-here ] each concat >array ." + "dup [ reverse! drop ] each concat >array ." "{ 2 1 0 5 4 3 8 7 6 }" } { $example diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index 738a960b4b..2c250aa66d 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -101,7 +101,7 @@ SYNTAX: HINTS: { { fixnum fixnum string } { fixnum fixnum array } } "specializer" set-word-prop -\ reverse-here +\ reverse! { { string } { array } } "specializer" set-word-prop diff --git a/basis/io/encodings/gb18030/gb18030.factor b/basis/io/encodings/gb18030/gb18030.factor index 2be709dbc9..2aa2c5d7a4 100644 --- a/basis/io/encodings/gb18030/gb18030.factor +++ b/basis/io/encodings/gb18030/gb18030.factor @@ -66,7 +66,7 @@ TUPLE: range ufirst ulast bfirst blast ; 126 /mod HEX: 81 + swap 10 /mod HEX: 30 + swap HEX: 81 + - 4byte-array dup reverse-here ; + 4byte-array reverse! ; : >interval-map-by ( start-quot end-quot value-quot seq -- interval-map ) '[ _ [ @ 2array ] _ tri ] { } map>assoc ; inline diff --git a/basis/io/mmap/mmap-docs.factor b/basis/io/mmap/mmap-docs.factor index 6e7662befd..33ba6850a5 100644 --- a/basis/io/mmap/mmap-docs.factor +++ b/basis/io/mmap/mmap-docs.factor @@ -81,7 +81,7 @@ ARTICLE: "io.mmap.examples" "Memory-mapped file examples" "" "\"mydata.dat\" char [" " 4 " - " [ reverse-here ] map! drop" + " [ reverse! drop ] map! drop" "] with-mapped-array" } "Normalize a file containing packed quadrupes of floats:" diff --git a/core/io/binary/binary.factor b/core/io/binary/binary.factor index f5467daea6..1275248613 100644 --- a/core/io/binary/binary.factor +++ b/core/io/binary/binary.factor @@ -11,7 +11,7 @@ IN: io.binary : nth-byte ( x n -- b ) -8 * shift mask-byte ; inline : >le ( x n -- byte-array ) iota [ nth-byte ] with B{ } map-as ; -: >be ( x n -- byte-array ) >le dup reverse-here ; +: >be ( x n -- byte-array ) >le reverse! ; : d>w/w ( d -- w1 w2 ) [ HEX: ffffffff bitand ] diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor index 9bf1e6a896..32220c4637 100644 --- a/core/math/parser/parser.factor +++ b/core/math/parser/parser.factor @@ -138,7 +138,7 @@ PRIVATE> : positive>base ( num radix -- str ) dup 1 <= [ "Invalid radix" throw ] when [ dup 0 > ] swap [ /mod >digit ] curry "" produce-as nip - dup reverse-here ; inline + reverse! ; inline PRIVATE> diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 43e66da2d5..99ad019063 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -605,9 +605,9 @@ HELP: exchange { $values { "m" "a non-negative integer" } { "n" "a non-negative integer" } { "seq" "a mutable sequence" } } { $description "Exchanges the " { $snippet "m" } "th and " { $snippet "n" } "th elements of " { $snippet "seq" } "." } ; -HELP: reverse-here +HELP: reverse! { $values { "seq" "a mutable sequence" } } -{ $description "Reverses a sequence in-place." } +{ $description "Reverses a sequence in-place and outputs that sequence." } { $side-effects "seq" } ; HELP: padding @@ -635,7 +635,7 @@ HELP: reverse { $values { "seq" sequence } { "newseq" "a new sequence" } } { $description "Outputs a new sequence having the same elements as " { $snippet "seq" } " but in reverse order." } ; -{ reverse reverse-here } related-words +{ reverse reverse! } related-words HELP: { $values { "seq" sequence } { "reversed" "a new sequence" } } @@ -1617,7 +1617,7 @@ ARTICLE: "sequences-destructive" "Destructive operations" } "Other destructive words:" { $subsections - reverse-here + reverse! push-all move exchange @@ -1632,7 +1632,7 @@ ARTICLE: "sequences-destructive" "Destructive operations" { { $link remove } { $link remove! } } { { $link remove-eq } { $link remove-eq! } } { { $link remove-nth } { $link remove-nth! } } - { { $link reverse } { $link reverse-here } } + { { $link reverse } { $link reverse! } } { { $link append } { $link append! } } { { $link map } { $link map! } } { { $link filter } { $link filter! } } diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 6a40e2236b..ee78daed17 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -723,15 +723,16 @@ PRIVATE> [ exchange-unsafe ] 3tri ; -: reverse-here ( seq -- ) - [ length 2/ iota ] [ length ] [ ] tri - [ [ over - 1 - ] dip exchange-unsafe ] 2curry each ; +: reverse! ( seq -- seq ) + [ + [ length 2/ iota ] [ length ] [ ] tri + [ [ over - 1 - ] dip exchange-unsafe ] 2curry each + ] keep ; : reverse ( seq -- newseq ) [ dup [ length ] keep new-sequence - [ 0 swap copy ] keep - [ reverse-here ] keep + [ 0 swap copy ] keep reverse! ] keep like ; : sum-lengths ( seq -- n ) diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor index 22bf7bb821..689d88be71 100644 --- a/core/strings/strings-tests.factor +++ b/core/strings/strings-tests.factor @@ -86,7 +86,7 @@ unit-test ] unit-test ! Make sure we clear aux vector when storing octets -[ "\u123456hi" ] [ "ih\u123456" clone dup reverse-here ] unit-test +[ "\u123456hi" ] [ "ih\u123456" clone reverse! ] unit-test ! Make sure aux vector is not shared [ "\udeadbe" ] [ diff --git a/extra/benchmark/fannkuch/fannkuch.factor b/extra/benchmark/fannkuch/fannkuch.factor index 63e635f3de..40dd54ca99 100644 --- a/extra/benchmark/fannkuch/fannkuch.factor +++ b/extra/benchmark/fannkuch/fannkuch.factor @@ -12,7 +12,7 @@ IN: benchmark.fannkuch : count-flips ( perm -- flip# ) '[ _ dup first dup 1 = - [ 2drop f ] [ head-slice reverse-here t ] if + [ 2drop f ] [ head-slice reverse! drop t ] if ] count ; inline : write-permutation ( perm -- ) diff --git a/extra/benchmark/reverse-complement/reverse-complement.factor b/extra/benchmark/reverse-complement/reverse-complement.factor index 4147ffabdf..39b7433a75 100755 --- a/extra/benchmark/reverse-complement/reverse-complement.factor +++ b/extra/benchmark/reverse-complement/reverse-complement.factor @@ -9,7 +9,7 @@ IN: benchmark.reverse-complement TR: trans-map ch>upper "ACGTUMRYKVHDB" "TGCAAKYRMBDHV" ; : translate-seq ( seq -- str ) - concat dup reverse-here dup trans-map-fast ; + concat reverse! dup trans-map-fast ; : show-seq ( seq -- ) translate-seq 60 [ print ] each ; diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim index ef5046d6d6..ed8fd0d9e6 100644 --- a/misc/vim/syntax/factor.vim +++ b/misc/vim/syntax/factor.vim @@ -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 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 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 < 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! last-index-from reversed index-from cut* pad-tail (indices) concat-as remove-eq but-last snip trim-tail nths nth 2pusher sequence slice? partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length remove-eq! 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 remove-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 second map! join when-empty accumulator immutable-sequence? 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? 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! last-index-from reversed index-from cut* pad-tail (indices) concat-as remove-eq but-last snip trim-tail nths nth 2pusher sequence slice? partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length remove-eq! 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 remove-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! 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 second map! join when-empty accumulator immutable-sequence? 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? 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 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 From bd13e018ddbe1a3b4fd73740f5a62daad507ba1b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 28 Oct 2009 15:02:00 -0500 Subject: [PATCH 12/17] memq? -> member-eq?, sorted-memq? -> sorted-member-eq? --- basis/alien/c-types/c-types.factor | 6 +++--- basis/binary-search/binary-search-docs.factor | 6 +++--- basis/binary-search/binary-search.factor | 2 +- basis/bootstrap/compiler/compiler.factor | 4 ++-- basis/compiler/cfg/checker/checker.factor | 2 +- basis/compiler/cfg/comparisons/comparisons.factor | 2 +- basis/compiler/cfg/hats/hats.factor | 2 +- basis/compiler/cfg/instructions/instructions.factor | 2 +- basis/compiler/cfg/predecessors/predecessors.factor | 4 ++-- .../cfg/representations/preferred/preferred.factor | 2 +- .../cfg/useless-conditionals/useless-conditionals.factor | 2 +- basis/compiler/cfg/utilities/utilities.factor | 2 +- .../cfg/value-numbering/expressions/expressions.factor | 2 +- basis/compiler/cfg/value-numbering/rewrite/rewrite.factor | 6 +++--- basis/compiler/tests/stack-trace.factor | 2 +- .../tree/modular-arithmetic/modular-arithmetic.factor | 6 +++--- basis/compiler/tree/propagation/inlining/inlining.factor | 4 ++-- basis/compiler/tree/propagation/propagation-tests.factor | 4 ++-- basis/compiler/tree/propagation/slots/slots.factor | 2 +- .../tree/propagation/transforms/transforms.factor | 6 +++--- basis/cpu/x86/assembler/operands/operands.factor | 6 +++--- basis/cpu/x86/x86.factor | 8 ++++---- basis/fry/fry.factor | 2 +- basis/hints/hints.factor | 2 +- basis/inverse/inverse.factor | 4 ++-- basis/io/buffers/buffers.factor | 2 +- basis/io/streams/limited/limited.factor | 2 +- basis/locals/rewrite/sugar/sugar.factor | 2 +- basis/logging/analysis/analysis.factor | 2 +- basis/math/intervals/intervals.factor | 2 +- basis/math/partial-dispatch/partial-dispatch-tests.factor | 8 ++++---- basis/math/vectors/conversion/conversion.factor | 4 ++-- basis/math/vectors/simd/simd.factor | 2 +- basis/models/arrow/arrow-tests.factor | 4 ++-- basis/prettyprint/backend/backend.factor | 2 +- basis/tools/crossref/crossref.factor | 6 +++--- basis/tools/deploy/shaker/shaker.factor | 2 +- basis/ui/backend/cocoa/cocoa.factor | 2 +- basis/ui/backend/windows/windows.factor | 2 +- basis/ui/gadgets/labels/labels.factor | 2 +- basis/ui/gadgets/worlds/worlds.factor | 4 ++-- basis/ui/tools/listener/completion/completion.factor | 4 ++-- basis/ui/tools/profiler/profiler.factor | 2 +- core/alien/strings/strings.factor | 2 +- core/classes/mixin/mixin.factor | 2 +- core/classes/tuple/tuple-tests.factor | 2 +- core/io/streams/c/c.factor | 2 +- core/io/streams/sequence/sequence.factor | 2 +- core/parser/parser-tests.factor | 6 +++--- core/sequences/sequences-docs.factor | 4 ++-- core/sequences/sequences-tests.factor | 2 +- core/sequences/sequences.factor | 2 +- core/sets/sets-docs.factor | 2 +- .../reverse-complement/reverse-complement.factor | 2 +- extra/mongodb/tuple/collection/collection.factor | 2 +- misc/vim/syntax/factor.vim | 2 +- 56 files changed, 88 insertions(+), 88 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index d622a42c9d..119e437734 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -501,9 +501,9 @@ M: double-2-rep rep-component-type drop double ; : c-type-interval ( c-type -- from to ) { - { [ dup { float double } memq? ] [ drop -1/0. 1/0. ] } - { [ dup { char short int long longlong } memq? ] [ signed-interval ] } - { [ dup { uchar ushort uint ulong ulonglong } memq? ] [ unsigned-interval ] } + { [ dup { float double } member-eq? ] [ drop -1/0. 1/0. ] } + { [ dup { char short int long longlong } member-eq? ] [ signed-interval ] } + { [ dup { uchar ushort uint ulong ulonglong } member-eq? ] [ unsigned-interval ] } } cond ; foldable : c-type-clamp ( value c-type -- value' ) c-type-interval clamp ; inline diff --git a/basis/binary-search/binary-search-docs.factor b/basis/binary-search/binary-search-docs.factor index 728ac41e94..aa015c5502 100644 --- a/basis/binary-search/binary-search-docs.factor +++ b/basis/binary-search/binary-search-docs.factor @@ -25,11 +25,11 @@ HELP: sorted-member? { member? sorted-member? } related-words -HELP: sorted-memq? +HELP: sorted-member-eq? { $values { "obj" object } { "seq" "a sorted sequence" } { "?" "a boolean" } } { $description "Tests if the sorted sequence contains " { $snippet "elt" } ". Equality is tested with " { $link eq? } "." } ; -{ memq? sorted-memq? } related-words +{ member-eq? sorted-member-eq? } related-words ARTICLE: "binary-search" "Binary search" "The " { $emphasis "binary search" } " algorithm allows elements to be located in sorted sequence in " { $snippet "O(log n)" } " time." @@ -38,7 +38,7 @@ ARTICLE: "binary-search" "Binary search" { $subsections sorted-index sorted-member? - sorted-memq? + sorted-member-eq? } { $see-also "order-specifiers" "sequences-sorting" } ; diff --git a/basis/binary-search/binary-search.factor b/basis/binary-search/binary-search.factor index aba3cfbfe5..89a300202a 100644 --- a/basis/binary-search/binary-search.factor +++ b/basis/binary-search/binary-search.factor @@ -49,5 +49,5 @@ HINTS: natural-search array ; : sorted-member? ( obj seq -- ? ) dupd natural-search nip = ; -: sorted-memq? ( obj seq -- ? ) +: sorted-member-eq? ( obj seq -- ? ) dupd natural-search nip eq? ; diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor index e9187cc3b1..4c96ed4000 100755 --- a/basis/bootstrap/compiler/compiler.factor +++ b/basis/bootstrap/compiler/compiler.factor @@ -94,7 +94,7 @@ gc "." write flush { - memq? split harvest sift cut cut-slice start index clone + member-eq? split harvest sift cut cut-slice start index clone set-at reverse push-all class number>string string>number like clone-like } compile-unoptimized @@ -118,4 +118,4 @@ gc " done" print flush -] unless \ No newline at end of file +] unless diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index 510d7c45cb..051b0e3e1f 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -49,7 +49,7 @@ ERROR: bad-kill-insn bb ; ERROR: bad-successors ; : check-successors ( bb -- ) - dup successors>> [ predecessors>> memq? ] with all? + dup successors>> [ predecessors>> member-eq? ] with all? [ bad-successors ] unless ; : check-basic-block ( bb -- ) diff --git a/basis/compiler/cfg/comparisons/comparisons.factor b/basis/compiler/cfg/comparisons/comparisons.factor index 0b4a6f2f02..35f25c2d40 100644 --- a/basis/compiler/cfg/comparisons/comparisons.factor +++ b/basis/compiler/cfg/comparisons/comparisons.factor @@ -90,5 +90,5 @@ SYMBOLS: { cc/> { +lt+ +eq+ +unordered+ } } { cc/<> { +eq+ +unordered+ } } { cc/<>= { +unordered+ } } - } at memq? ; + } at member-eq? ; diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index 42aa5512bc..783df0678c 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -26,7 +26,7 @@ IN: compiler.cfg.hats : hat-effect ( insn -- effect ) "insn-slots" word-prop - [ type>> { def temp } memq? not ] filter [ name>> ] map + [ type>> { def temp } member-eq? not ] filter [ name>> ] map { "vreg" } ; : define-hat ( insn -- ) diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index bffa0e59d0..5712455988 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -833,7 +833,7 @@ SYMBOL: vreg-insn [ vreg-insn insn-classes get [ - "insn-slots" word-prop [ type>> { def use temp } memq? ] any? + "insn-slots" word-prop [ type>> { def use temp } member-eq? ] any? ] filter define-union-class ] with-compilation-unit diff --git a/basis/compiler/cfg/predecessors/predecessors.factor b/basis/compiler/cfg/predecessors/predecessors.factor index 8ab9f316a7..506d4aa46c 100644 --- a/basis/compiler/cfg/predecessors/predecessors.factor +++ b/basis/compiler/cfg/predecessors/predecessors.factor @@ -12,7 +12,7 @@ IN: compiler.cfg.predecessors : update-phi ( bb ##phi -- ) [ swap predecessors>> - '[ drop _ memq? ] assoc-filter + '[ drop _ member-eq? ] assoc-filter ] change-inputs drop ; : update-phis ( bb -- ) @@ -30,4 +30,4 @@ PRIVATE> : needs-predecessors ( cfg -- cfg' ) dup predecessors-valid?>> - [ compute-predecessors t >>predecessors-valid? ] unless ; \ No newline at end of file + [ compute-predecessors t >>predecessors-valid? ] unless ; diff --git a/basis/compiler/cfg/representations/preferred/preferred.factor b/basis/compiler/cfg/representations/preferred/preferred.factor index 4444290f05..1e07e56b35 100644 --- a/basis/compiler/cfg/representations/preferred/preferred.factor +++ b/basis/compiler/cfg/representations/preferred/preferred.factor @@ -26,7 +26,7 @@ GENERIC: uses-vreg-reps ( insn -- reps ) bi define ; : reps-getter-quot ( reps -- quot ) - dup [ rep>> { f scalar-rep } memq? not ] all? [ + dup [ rep>> { f scalar-rep } member-eq? not ] all? [ [ rep>> ] map [ drop ] swap suffix ] [ [ rep>> rep-getter-quot ] map dup length { diff --git a/basis/compiler/cfg/useless-conditionals/useless-conditionals.factor b/basis/compiler/cfg/useless-conditionals/useless-conditionals.factor index cd4978c585..a2885ae26e 100644 --- a/basis/compiler/cfg/useless-conditionals/useless-conditionals.factor +++ b/basis/compiler/cfg/useless-conditionals/useless-conditionals.factor @@ -13,7 +13,7 @@ IN: compiler.cfg.useless-conditionals ##compare-imm-branch ##compare-float-ordered-branch ##compare-float-unordered-branch - } memq? + } member-eq? ] [ successors>> first2 [ skip-empty-blocks ] bi@ eq? ] } 1&& ; diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index be8c9ad0ad..3710f4974b 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -40,7 +40,7 @@ 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 ] map! drop + to predecessors>> [ dup froms member-eq? [ drop bb ] when ] map! drop froms [ successors>> [ dup to eq? [ drop bb ] when ] map! drop ] each ; : add-instructions ( bb quot -- ) diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor index 0ac973a206..6534aa74ab 100644 --- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor +++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor @@ -42,7 +42,7 @@ M: ##load-constant >expr obj>> ; << : input-values ( slot-specs -- slot-specs' ) - [ type>> { use literal constant } memq? ] filter ; + [ type>> { use literal constant } member-eq? ] filter ; : expr-class ( insn -- expr ) name>> "##" ?head drop "-expr" append create-class-in ; diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor index 28c6741bc1..5d4ff5efb9 100755 --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -111,7 +111,7 @@ M: ##compare-imm rewrite-tagged-comparison { [ src1>> vreg>expr general-compare-expr? ] [ src2>> \ f tag-number = ] - [ cc>> { cc= cc/= } memq? ] + [ cc>> { cc= cc/= } member-eq? ] } 1&& ; inline : rewrite-redundant-comparison ( insn -- insn' ) @@ -174,7 +174,7 @@ M: ##compare-imm-branch rewrite [ src1>> ] [ src2>> ] bi [ vreg>vn ] bi@ = ; inline : (rewrite-self-compare) ( insn -- ? ) - cc>> { cc= cc<= cc>= } memq? ; + cc>> { cc= cc<= cc>= } member-eq? ; : rewrite-self-compare-branch ( insn -- insn' ) (rewrite-self-compare) fold-branch ; @@ -279,7 +279,7 @@ M: ##not rewrite ##sub-imm ##mul ##mul-imm - } memq? ; + } member-eq? ; : immediate? ( value op -- ? ) arithmetic-op? [ immediate-arithmetic? ] [ immediate-bitwise? ] if ; diff --git a/basis/compiler/tests/stack-trace.factor b/basis/compiler/tests/stack-trace.factor index 20a5cc867c..40aa1bb336 100755 --- a/basis/compiler/tests/stack-trace.factor +++ b/basis/compiler/tests/stack-trace.factor @@ -19,7 +19,7 @@ IN: compiler.tests.stack-trace : bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ; -: stack-trace-any? ( word -- ? ) symbolic-stack-trace memq? ; +: stack-trace-any? ( word -- ? ) symbolic-stack-trace member-eq? ; [ t ] [ [ { 1 "hi" } bleh ] ignore-errors \ + stack-trace-any? diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor index 8ca80ccbae..ece2ed80f3 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor +++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor @@ -75,7 +75,7 @@ M: #push compute-modular-candidates* 0 cell-bits tag-bits get - 1 - [a,b] interval-subset? ; : modular-word? ( #call -- ? ) - dup word>> { shift fixnum-shift bignum-shift } memq? + dup word>> { shift fixnum-shift bignum-shift } member-eq? [ node-input-infos second interval>> small-shift? ] [ word>> "modular-arithmetic" word-prop ] if ; @@ -178,10 +178,10 @@ MEMO: fixnum-coercion ( flags -- nodes ) ] when ; : like->fixnum? ( #call -- ? ) - word>> { >fixnum bignum>fixnum float>fixnum } memq? ; + word>> { >fixnum bignum>fixnum float>fixnum } member-eq? ; : like->integer? ( #call -- ? ) - word>> { >integer >bignum fixnum>bignum } memq? ; + word>> { >integer >bignum fixnum>bignum } member-eq? ; M: #call optimize-modular-arithmetic* { diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index 367427c716..634fade609 100755 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/basis/compiler/tree/propagation/inlining/inlining.factor @@ -90,7 +90,7 @@ M: callable splicing-nodes splicing-body ; ! Method body inlining SYMBOL: history -: already-inlined? ( obj -- ? ) history get memq? ; +: already-inlined? ( obj -- ? ) history get member-eq? ; : add-to-history ( obj -- ) history [ swap suffix ] change ; @@ -104,7 +104,7 @@ SYMBOL: history ] if ; : always-inline-word? ( word -- ? ) - { curry compose } memq? ; + { curry compose } member-eq? ; : never-inline-word? ( word -- ? ) { [ deferred? ] [ "default" word-prop ] [ \ call eq? ] } 1|| ; diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 5d12c14f5f..0f04a5e3d5 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -867,8 +867,8 @@ SYMBOL: not-an-assoc [ t ] [ [ { 1 2 3 } member? ] { member? } inlined? ] unit-test [ f ] [ [ { 1 2 3 } swap member? ] { member? } inlined? ] unit-test -[ t ] [ [ { 1 2 3 } memq? ] { memq? } inlined? ] unit-test -[ f ] [ [ { 1 2 3 } swap memq? ] { memq? } inlined? ] unit-test +[ t ] [ [ { 1 2 3 } member-eq? ] { member-eq? } inlined? ] unit-test +[ f ] [ [ { 1 2 3 } swap member-eq? ] { member-eq? } inlined? ] unit-test [ t ] [ [ V{ } clone ] { clone (clone) } inlined? ] unit-test [ f ] [ [ { } clone ] { clone (clone) } inlined? ] unit-test diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor index 4996729ded..11a4cdc4c6 100644 --- a/basis/compiler/tree/propagation/slots/slots.factor +++ b/basis/compiler/tree/propagation/slots/slots.factor @@ -11,7 +11,7 @@ IN: compiler.tree.propagation.slots UNION: fixed-length-sequence array byte-array string ; : sequence-constructor? ( word -- ? ) - { (byte-array) } memq? ; + { (byte-array) } member-eq? ; : constructor-output-class ( word -- class ) { diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index d1f5386450..1f40bf00a2 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -213,12 +213,12 @@ ERROR: bad-partial-eval quot word ; ] [ drop f ] if ] 1 define-partial-eval -: memq-quot ( seq -- newquot ) +: member-eq-quot ( seq -- newquot ) [ [ dupd eq? ] curry [ drop t ] ] { } map>assoc [ drop f ] suffix [ cond ] curry ; -\ memq? [ - dup sequence? [ memq-quot ] [ drop f ] if +\ member-eq? [ + dup sequence? [ member-eq-quot ] [ drop f ] if ] 1 define-partial-eval ! Membership testing diff --git a/basis/cpu/x86/assembler/operands/operands.factor b/basis/cpu/x86/assembler/operands/operands.factor index df49ae0a15..bd9a3f6cdd 100644 --- a/basis/cpu/x86/assembler/operands/operands.factor +++ b/basis/cpu/x86/assembler/operands/operands.factor @@ -65,7 +65,7 @@ M: indirect extended? base>> extended? ; ERROR: bad-index indirect ; : check-ESP ( indirect -- indirect ) - dup index>> { ESP RSP } memq? [ bad-index ] when ; + dup index>> { ESP RSP } member-eq? [ bad-index ] when ; : canonicalize ( indirect -- indirect ) #! Modify the indirect to work around certain addressing mode @@ -103,7 +103,7 @@ TUPLE: byte value ; C: byte : extended-8-bit-register? ( register -- ? ) - { SPL BPL SIL DIL } memq? ; + { SPL BPL SIL DIL } member-eq? ; : n-bit-version-of ( register n -- register' ) ! Certain 8-bit registers don't exist in 32-bit mode... @@ -115,4 +115,4 @@ C: byte : 16-bit-version-of ( register -- register' ) 16 n-bit-version-of ; : 32-bit-version-of ( register -- register' ) 32 n-bit-version-of ; : 64-bit-version-of ( register -- register' ) 64 n-bit-version-of ; -: native-version-of ( register -- register' ) cell-bits n-bit-version-of ; \ No newline at end of file +: native-version-of ( register -- register' ) cell-bits n-bit-version-of ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index d19a9b0c8c..07b21c9612 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -254,7 +254,7 @@ CONSTANT: have-byte-regs { EAX ECX EDX EBX } M: x86.32 has-small-reg? { - { 8 [ have-byte-regs memq? ] } + { 8 [ have-byte-regs member-eq? ] } { 16 [ drop t ] } { 32 [ drop t ] } } case ; @@ -264,7 +264,7 @@ M: x86.64 has-small-reg? 2drop t ; : small-reg-that-isn't ( exclude -- reg' ) [ have-byte-regs ] dip [ native-version-of ] map - '[ _ memq? not ] find nip ; + '[ _ member-eq? not ] find nip ; : with-save/restore ( reg quot -- ) [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline @@ -356,7 +356,7 @@ M: x86 %set-alien-float [ [+] ] dip MOVSS ; M: x86 %set-alien-double [ [+] ] dip MOVSD ; M: x86 %set-alien-vector [ [+] ] 2dip %copy ; -: shift-count? ( reg -- ? ) { ECX RCX } memq? ; +: shift-count? ( reg -- ? ) { ECX RCX } member-eq? ; :: emit-shift ( dst src quot -- ) src shift-count? [ @@ -893,7 +893,7 @@ M: x86 %compare-vector ( dst src1 src2 rep cc -- ) M: x86 %compare-vector-reps { - { [ dup { cc= cc/= cc/<>= cc<>= } memq? ] [ drop %compare-vector-eq-reps ] } + { [ dup { cc= cc/= cc/<>= cc<>= } member-eq? ] [ drop %compare-vector-eq-reps ] } [ drop %compare-vector-ord-reps ] } cond ; diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor index fd029cc329..046da86b7b 100644 --- a/basis/fry/fry.factor +++ b/basis/fry/fry.factor @@ -28,7 +28,7 @@ M: >r/r>-in-fry-error summary dup { load-local load-locals get-local drop-locals } intersect [ >r/r>-in-fry-error ] unless-empty ; -PREDICATE: fry-specifier < word { _ @ } memq? ; +PREDICATE: fry-specifier < word { _ @ } member-eq? ; GENERIC: count-inputs ( quot -- n ) diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index 2c250aa66d..d7c745500b 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -119,7 +119,7 @@ SYNTAX: HINTS: \ split, { string string } "specializer" set-word-prop -\ memq? { array } "specializer" set-word-prop +\ member-eq? { array } "specializer" set-word-prop \ member? { array } "specializer" set-word-prop diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor index 6b1e839ca6..1e941afed0 100755 --- a/basis/inverse/inverse.factor +++ b/basis/inverse/inverse.factor @@ -97,7 +97,7 @@ SYMBOL: visited [ dup flattenable? [ def>> - [ visited get memq? [ no-recursive-inverse ] when ] + [ visited get member-eq? [ no-recursive-inverse ] when ] [ flatten ] bi ] [ 1quotation ] if @@ -149,7 +149,7 @@ MACRO: undo ( quot -- ) [undo] ; \ tri* 3 [ [ [undo] ] tri@ '[ _ _ _ tri* ] ] define-pop-inverse \ not define-involution -\ >boolean [ dup { t f } memq? assure ] define-inverse +\ >boolean [ dup { t f } member-eq? assure ] define-inverse \ tuple>array \ >tuple define-dual \ reverse define-involution diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor index aa9cedf340..91524dd6e1 100644 --- a/basis/io/buffers/buffers.factor +++ b/basis/io/buffers/buffers.factor @@ -73,7 +73,7 @@ HINTS: >buffer byte-array buffer ; bi ; inline : search-buffer-until ( pos fill ptr separators -- n ) - [ [ swap alien-unsigned-1 ] dip memq? ] 2curry find-from drop ; inline + [ [ swap alien-unsigned-1 ] dip member-eq? ] 2curry find-from drop ; inline : finish-buffer-until ( buffer n -- byte-array separator ) [ diff --git a/basis/io/streams/limited/limited.factor b/basis/io/streams/limited/limited.factor index 403643ed73..f5aab9c976 100755 --- a/basis/io/streams/limited/limited.factor +++ b/basis/io/streams/limited/limited.factor @@ -123,7 +123,7 @@ M: limited-stream stream-read-partial r/r>-in-lambda-error ] [ call-next-method ] if ; M: object rewrite-sugar* , ; diff --git a/basis/logging/analysis/analysis.factor b/basis/logging/analysis/analysis.factor index 0ba98996b3..eb8a2eaf76 100644 --- a/basis/logging/analysis/analysis.factor +++ b/basis/logging/analysis/analysis.factor @@ -12,7 +12,7 @@ SYMBOL: word-histogram SYMBOL: message-histogram : analyze-entry ( entry -- ) - dup level>> { ERROR CRITICAL } memq? [ dup errors get push ] when + dup level>> { ERROR CRITICAL } member-eq? [ dup errors get push ] when dup word-name>> word-histogram get inc-at dup word-name>> word-names get member? [ dup [ level>> ] [ word-name>> ] [ message>> ] tri 3array diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index 05f9906bb9..ec742cb1ce 100755 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -192,7 +192,7 @@ MEMO: array-capacity-interval ( -- interval ) : interval-sq ( i1 -- i2 ) dup interval* ; : special-interval? ( interval -- ? ) - { empty-interval full-interval } memq? ; + { empty-interval full-interval } member-eq? ; : interval-singleton? ( int -- ? ) dup special-interval? [ diff --git a/basis/math/partial-dispatch/partial-dispatch-tests.factor b/basis/math/partial-dispatch/partial-dispatch-tests.factor index 29979b62d3..8bca1459c0 100644 --- a/basis/math/partial-dispatch/partial-dispatch-tests.factor +++ b/basis/math/partial-dispatch/partial-dispatch-tests.factor @@ -10,9 +10,9 @@ tools.test math kernel sequences ; [ f ] [ \ + object number math-both-known? ] unit-test [ f ] [ \ number= fixnum object math-both-known? ] unit-test [ t ] [ \ number= integer fixnum math-both-known? ] unit-test -[ f ] [ \ >fixnum \ shift derived-ops memq? ] unit-test -[ f ] [ \ >integer \ /i derived-ops memq? ] unit-test -[ t ] [ \ fixnum-shift \ shift derived-ops memq? ] unit-test +[ f ] [ \ >fixnum \ shift derived-ops member-eq? ] unit-test +[ f ] [ \ >integer \ /i derived-ops member-eq? ] unit-test +[ t ] [ \ fixnum-shift \ shift derived-ops member-eq? ] unit-test [ { integer fixnum } ] [ \ +-integer-fixnum integer-op-input-classes ] unit-test [ { fixnum fixnum } ] [ \ fixnum+ integer-op-input-classes ] unit-test @@ -30,4 +30,4 @@ tools.test math kernel sequences ; [ 3 ] [ 1 2 +-integer-integer ] unit-test [ 3 ] [ 1 >bignum 2 +-integer-integer ] unit-test [ 3 ] [ 1 2 >bignum +-integer-integer ] unit-test -[ 3 ] [ 1 >bignum 2 >bignum +-integer-integer ] unit-test \ No newline at end of file +[ 3 ] [ 1 >bignum 2 >bignum +-integer-integer ] unit-test diff --git a/basis/math/vectors/conversion/conversion.factor b/basis/math/vectors/conversion/conversion.factor index f70dfc9b27..a4f90ce938 100644 --- a/basis/math/vectors/conversion/conversion.factor +++ b/basis/math/vectors/conversion/conversion.factor @@ -11,9 +11,9 @@ ERROR: bad-vconvert-input value expected-type ; > "math.vectors.simd.instances." prepend ; : parse-base-type ( c-type -- c-type ) - dup { c:char c:uchar c:short c:ushort c:int c:uint c:longlong c:ulonglong c:float c:double } memq? + dup { c:char c:uchar c:short c:ushort c:int c:uint c:longlong c:ulonglong c:float c:double } member-eq? [ bad-base-type ] unless ; : forget-instances ( -- ) diff --git a/basis/models/arrow/arrow-tests.factor b/basis/models/arrow/arrow-tests.factor index d7900f1dbd..6bd6395ac0 100644 --- a/basis/models/arrow/arrow-tests.factor +++ b/basis/models/arrow/arrow-tests.factor @@ -6,12 +6,12 @@ IN: models.arrow.tests "x" get [ 2 * ] dup "z" set [ 1 + ] "y" set [ ] [ "y" get activate-model ] unit-test -[ t ] [ "z" get "x" get connections>> memq? ] unit-test +[ t ] [ "z" get "x" get connections>> member-eq? ] unit-test [ 7 ] [ "y" get value>> ] unit-test [ ] [ 4 "x" get set-model ] unit-test [ 9 ] [ "y" get value>> ] unit-test [ ] [ "y" get deactivate-model ] unit-test -[ f ] [ "z" get "x" get connections>> memq? ] unit-test +[ f ] [ "z" get "x" get connections>> member-eq? ] unit-test 3 "x" set "x" get [ sq ] "y" set diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index f919573ea9..0ba1d38ae6 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -119,7 +119,7 @@ M: pathname pprint* "~" over class name>> "~" 3append swap present-text ] [ - over recursion-check get memq? [ + over recursion-check get member-eq? [ drop "~circularity~" swap present-text ] [ over recursion-check get push diff --git a/basis/tools/crossref/crossref.factor b/basis/tools/crossref/crossref.factor index beaf1c0673..90fe7e8e9d 100644 --- a/basis/tools/crossref/crossref.factor +++ b/basis/tools/crossref/crossref.factor @@ -24,13 +24,13 @@ M: word quot-uses over crossref? [ conjoin ] [ 2drop ] if ; [ quot-uses ] curry each ; : seq-uses ( seq assoc -- ) - over visited get memq? [ 2drop ] [ + over visited get member-eq? [ 2drop ] [ over visited get push (seq-uses) ] if ; : assoc-uses ( assoc' assoc -- ) - over visited get memq? [ 2drop ] [ + over visited get member-eq? [ 2drop ] [ over visited get push [ >alist ] dip (seq-uses) ] if ; @@ -137,4 +137,4 @@ M: invalidate-crossref definitions-changed 2drop crossref global delete-at ; [ invalidate-crossref add-definition-observer ] "tools.crossref" add-init-hook -PRIVATE> \ No newline at end of file +PRIVATE> diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 48e33be43e..e42f478de6 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -477,7 +477,7 @@ SYMBOL: deploy-vocab next-method ; : calls-next-method? ( method -- ? ) - def>> flatten \ (call-next-method) swap memq? ; + def>> flatten \ (call-next-method) swap member-eq? ; : compute-next-methods ( -- ) [ standard-generic? ] instances [ diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index a262b549f2..9759dbfcc5 100755 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -130,7 +130,7 @@ CONSTANT: window-control>styleMask M:: cocoa-ui-backend (open-window) ( world -- ) world [ [ dim>> ] dip ] with-world-pixel-format :> view - world window-controls>> textured-background swap memq? + world window-controls>> textured-background swap member-eq? [ view make-context-transparent ] when view world [ world>NSRect ] [ world>styleMask ] bi :> window view -> release diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index b099917e7c..a6d73ca80f 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -537,7 +537,7 @@ SYMBOL: nc-buttons COLOR_BTNFACE GetSysColor RGB>color ; : ?make-glass ( world hwnd -- ) - over window-controls>> textured-background swap memq? [ + over window-controls>> textured-background swap member-eq? [ composition-enabled? [ full-window-margins DwmExtendFrameIntoClientArea drop T{ rgba f 0.0 0.0 0.0 0.0 } diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor index 83d15911e7..c655e289b0 100644 --- a/basis/ui/gadgets/labels/labels.factor +++ b/basis/ui/gadgets/labels/labels.factor @@ -22,7 +22,7 @@ PREDICATE: string-array < array [ string? ] all? ; PRIVATE> : ?string-lines ( string -- string/array ) - CHAR: \n over memq? [ string-lines ] when ; + CHAR: \n over member-eq? [ string-lines ] when ; ERROR: not-a-string object ; diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index 61f84870e5..8f38cee988 100755 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -120,7 +120,7 @@ M: world request-focus-on ( child gadget -- ) V{ } clone >>window-resources ; : initial-background-color ( attributes -- color ) - window-controls>> textured-background swap memq? + window-controls>> textured-background swap member-eq? [ T{ rgba f 0.0 0.0 0.0 0.0 } ] [ T{ rgba f 1.0 1.0 1.0 1.0 } ] if ; @@ -151,7 +151,7 @@ M: world focusable-child* children>> [ t ] [ first ] if-empty ; M: world children-on nip children>> ; M: world remove-gadget - 2dup layers>> memq? + 2dup layers>> member-eq? [ layers>> remove-eq! drop ] [ call-next-method ] if ; SYMBOL: flush-layout-cache-hook diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor index 5dd0581cf2..b069de1887 100644 --- a/basis/ui/tools/listener/completion/completion.factor +++ b/basis/ui/tools/listener/completion/completion.factor @@ -64,7 +64,7 @@ M: definition-completion row-columns M: word-completion row-color [ vocabulary>> ] [ manifest>> ] bi* { { [ dup not ] [ COLOR: black ] } - { [ 2dup search-vocabs>> memq? ] [ COLOR: black ] } + { [ 2dup search-vocabs>> member-eq? ] [ COLOR: black ] } { [ over ".private" tail? ] [ COLOR: dark-red ] } [ COLOR: dark-gray ] } cond 2nip ; @@ -181,4 +181,4 @@ completion-popup H{ M: completion-popup handle-gesture ( gesture completion -- ? ) 2dup completion-gesture dup [ [ nip hide-glass ] [ invoke-command ] 2bi* f - ] [ 2drop call-next-method ] if ; \ No newline at end of file + ] [ 2drop call-next-method ] if ; diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor index bb23bc0692..3de7c9cc70 100644 --- a/basis/ui/tools/profiler/profiler.factor +++ b/basis/ui/tools/profiler/profiler.factor @@ -107,7 +107,7 @@ M: method-renderer column-titles drop { "" "Method" "Count" } ; : method-matches? ( method generic class -- ? ) [ first ] 2dip { - [ drop dup [ subwords memq? ] [ 2drop t ] if ] + [ drop dup [ subwords member-eq? ] [ 2drop t ] if ] [ nip dup [ swap "method-class" word-prop = ] [ 2drop t ] if ] } 3&& ; diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor index e96b13478e..83758cd866 100644 --- a/core/alien/strings/strings.factor +++ b/core/alien/strings/strings.factor @@ -21,7 +21,7 @@ M: f alien>string ERROR: invalid-c-string string ; : check-string ( string -- ) - 0 over memq? [ invalid-c-string ] [ drop ] if ; + 0 over member-eq? [ invalid-c-string ] [ drop ] if ; GENERIC# string>alien 1 ( string encoding -- byte-array ) diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 6cf95716be..6514f36074 100644 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -34,7 +34,7 @@ TUPLE: check-mixin-class class ; ] unless ; : if-mixin-member? ( class mixin true false -- ) - [ check-mixin-class 2dup members memq? ] 2dip if ; inline + [ check-mixin-class 2dup members member-eq? ] 2dip if ; inline : change-mixin-class ( class mixin quot -- ) [ [ members swap bootstrap-word ] dip call ] [ drop ] 2bi diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 5ab83aa015..3555147542 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -110,7 +110,7 @@ TUPLE: yo-momma ; [ t ] [ \ yo-momma class? ] unit-test [ ] [ \ yo-momma forget ] unit-test [ ] [ \ forget ] unit-test - [ f ] [ \ yo-momma update-map get values memq? ] unit-test + [ f ] [ \ yo-momma update-map get values member-eq? ] unit-test ] with-compilation-unit TUPLE: loc-recording ; diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 6ff1a4b35c..1da30fe922 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -49,7 +49,7 @@ M: c-reader stream-read1 dup check-disposed handle>> fgetc ; : read-until-loop ( stream delim -- ch ) over stream-read1 dup [ - dup pick memq? [ 2nip ] [ , read-until-loop ] if + dup pick member-eq? [ 2nip ] [ , read-until-loop ] if ] [ 2nip ] if ; diff --git a/core/io/streams/sequence/sequence.factor b/core/io/streams/sequence/sequence.factor index 036bab2213..5ecbc321ce 100644 --- a/core/io/streams/sequence/sequence.factor +++ b/core/io/streams/sequence/sequence.factor @@ -32,7 +32,7 @@ SLOT: i : find-sep ( seps stream -- sep/f n ) swap [ >sequence-stream< swap tail-slice ] dip - [ memq? ] curry find swap ; inline + [ member-eq? ] curry find swap ; inline : sequence-read-until ( separators stream -- seq sep/f ) [ find-sep ] keep diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 791fe1fa36..f30eb68684 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -141,15 +141,15 @@ IN: parser.tests ] unit-test [ t ] [ - array "smudge-me" "parser.tests" lookup order memq? + array "smudge-me" "parser.tests" lookup order member-eq? ] unit-test [ t ] [ - integer "smudge-me" "parser.tests" lookup order memq? + integer "smudge-me" "parser.tests" lookup order member-eq? ] unit-test [ f ] [ - string "smudge-me" "parser.tests" lookup order memq? + string "smudge-me" "parser.tests" lookup order member-eq? ] unit-test [ ] [ diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 99ad019063..cb3968ab0f 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -461,7 +461,7 @@ HELP: member? { $description "Tests if the sequence contains an element equal to the object." } { $notes "This word uses equality comparison (" { $link = } ")." } ; -HELP: memq? +HELP: member-eq? { $values { "elt" object } { "seq" sequence } { "?" "a boolean" } } { $description "Tests if the sequence contains the object." } { $notes "This word uses identity comparison (" { $link eq? } ")." } ; @@ -1566,7 +1566,7 @@ ARTICLE: "sequences-tests" "Testing sequences" "Testing indices:" { $subsections bounds-check? } "Testing if a sequence contains an object:" -{ $subsections member? memq? } +{ $subsections member? member-eq? } "Testing if a sequence contains a subsequence:" { $subsections head? tail? subseq? } ; diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index d25c62c561..58e61cc94c 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -42,7 +42,7 @@ IN: sequences.tests [ t ] [ 2 [ 1 2 ] member? ] unit-test [ t ] -[ [ "hello" "world" ] [ second ] keep memq? ] unit-test +[ [ "hello" "world" ] [ second ] keep member-eq? ] unit-test [ 4 ] [ CHAR: x "tuvwxyz" >vector index ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index ee78daed17..8e15f73ed7 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -567,7 +567,7 @@ PRIVATE> : member? ( elt seq -- ? ) [ = ] with any? ; -: memq? ( elt seq -- ? ) +: member-eq? ( elt seq -- ? ) [ eq? ] with any? ; : remove ( elt seq -- newseq ) diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index 26bfc140fb..999e963f36 100755 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -32,7 +32,7 @@ $nl conjoin conjoin-at } -{ $see-also member? memq? any? all? "assocs-sets" } ; +{ $see-also member? member-eq? any? all? "assocs-sets" } ; ABOUT: "sets" diff --git a/extra/benchmark/reverse-complement/reverse-complement.factor b/extra/benchmark/reverse-complement/reverse-complement.factor index 39b7433a75..95035e6cd8 100755 --- a/extra/benchmark/reverse-complement/reverse-complement.factor +++ b/extra/benchmark/reverse-complement/reverse-complement.factor @@ -15,7 +15,7 @@ TR: trans-map ch>upper "ACGTUMRYKVHDB" "TGCAAKYRMBDHV" ; translate-seq 60 [ print ] each ; : do-line ( seq line -- seq ) - dup first ">;" memq? + dup first ">;" member-eq? [ over show-seq print dup delete-all ] [ over push ] if ; HINTS: do-line vector string ; diff --git a/extra/mongodb/tuple/collection/collection.factor b/extra/mongodb/tuple/collection/collection.factor index 6c2b89a571..85036c8d86 100644 --- a/extra/mongodb/tuple/collection/collection.factor +++ b/extra/mongodb/tuple/collection/collection.factor @@ -152,7 +152,7 @@ M: mdb-collection mdb-index-map : slot-option? ( tuple slot option -- ? ) [ swap mdb-slot-map at ] dip - '[ _ swap memq? ] [ f ] if* ; + '[ _ swap member-eq? ] [ f ] if* ; PRIVATE> diff --git a/misc/vim/syntax/factor.vim b/misc/vim/syntax/factor.vim index ed8fd0d9e6..13b999250d 100644 --- a/misc/vim/syntax/factor.vim +++ b/misc/vim/syntax/factor.vim @@ -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 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 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 < 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! last-index-from reversed index-from cut* pad-tail (indices) concat-as remove-eq but-last snip trim-tail nths nth 2pusher sequence slice? partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length remove-eq! 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 remove-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! 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 second map! join when-empty accumulator immutable-sequence? 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? 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! last-index-from reversed index-from cut* pad-tail (indices) concat-as remove-eq but-last snip trim-tail nths nth 2pusher sequence slice? partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length remove-eq! 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 remove-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! 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 member-eq? pop set-nth ?nth second map! join when-empty accumulator immutable-sequence? 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? 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 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 From 93de179c2fb478fa7a9aeb7b388706d0f636f707 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 28 Oct 2009 15:29:01 -0500 Subject: [PATCH 13/17] over push -> suffix!, over push-all -> append! --- basis/alien/syntax/syntax.factor | 2 +- basis/classes/struct/struct.factor | 8 ++++---- basis/fry/fry.factor | 2 +- basis/functors/functors.factor | 8 ++++---- basis/interpolate/interpolate.factor | 2 +- basis/io/ports/ports.factor | 4 ++-- basis/locals/locals.factor | 8 ++++---- basis/peg/parsers/parsers.factor | 2 +- basis/peg/peg.factor | 2 +- basis/random/random.factor | 2 +- basis/xmode/rules/rules.factor | 2 +- core/effects/parser/parser.factor | 2 +- core/sequences/sequences.factor | 2 +- extra/closures/closures.factor | 6 +++--- extra/fonts/syntax/syntax.factor | 2 +- extra/fries/fries.factor | 6 +++--- extra/gpu/demos/bunny/bunny.factor | 2 +- extra/infix/infix.factor | 2 +- extra/project-euler/017/017.factor | 2 +- extra/project-euler/038/038.factor | 2 +- extra/project-euler/040/040.factor | 2 +- extra/ui/gadgets/controls/controls.factor | 6 +++--- extra/ui/gadgets/layout/layout.factor | 8 ++++---- 23 files changed, 42 insertions(+), 42 deletions(-) diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index c51a446b6c..609ed2826d 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -37,7 +37,7 @@ ERROR: no-such-symbol name library ; 2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ; SYNTAX: &: - scan "c-library" get '[ _ _ address-of ] over push-all ; + scan "c-library" get '[ _ _ address-of ] append! ; : global-quot ( type word -- quot ) name>> "c-library" get '[ _ _ address-of 0 ] diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index 417f188c3c..d5e5fdc6c3 100755 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -350,7 +350,7 @@ PRIVATE> : parse-struct-slots ( slots -- slots' more? ) scan { { ";" [ f ] } - { "{" [ parse-struct-slot over push t ] } + { "{" [ parse-struct-slot suffix! t ] } { f [ unexpected-eof ] } [ invalid-struct-slot ] } case ; @@ -378,7 +378,7 @@ SYNTAX: S@ : parse-struct-slot` ( accum -- accum ) scan-string-param scan-c-type` \ } parse-until - [ over push ] 3curry over push-all ; + [ suffix! ] 3curry append! ; : parse-struct-slots` ( accum -- accum more? ) scan { @@ -390,9 +390,9 @@ PRIVATE> FUNCTOR-SYNTAX: STRUCT: scan-param suffix! - [ 8 ] over push-all + [ 8 ] append! [ parse-struct-slots` ] [ ] while - [ >array define-struct-class ] over push-all ; + [ >array define-struct-class ] append! ; USING: vocabs vocabs.loader ; diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor index 046da86b7b..d68e2d13a8 100644 --- a/basis/fry/fry.factor +++ b/basis/fry/fry.factor @@ -53,4 +53,4 @@ M: callable deep-fry M: object deep-fry , ; -SYNTAX: '[ parse-quotation fry over push-all ; +SYNTAX: '[ parse-quotation fry append! ; diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 1d11d78b33..56aa6f0d1b 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -43,7 +43,7 @@ M: object (fake-quotations>) , ; : parse-definition* ( accum -- accum ) parse-definition >fake-quotations suffix! - [ fake-quotations> first ] over push-all ; + [ fake-quotations> first ] append! ; : parse-declared* ( accum -- accum ) complete-effect @@ -74,7 +74,7 @@ FUNCTOR-SYNTAX: MIXIN: FUNCTOR-SYNTAX: M: scan-param suffix! scan-param suffix! - [ create-method-in dup method-body set ] over push-all + [ create-method-in dup method-body set ] append! parse-definition* \ define* suffix! ; @@ -82,7 +82,7 @@ FUNCTOR-SYNTAX: C: scan-param suffix! scan-param suffix! complete-effect - [ [ [ boa ] curry ] over push-all ] dip suffix! + [ [ [ boa ] curry ] append! ] dip suffix! \ define-declared* suffix! ; FUNCTOR-SYNTAX: : @@ -114,7 +114,7 @@ FUNCTOR-SYNTAX: MACRO: parse-declared* \ define-macro suffix! ; -FUNCTOR-SYNTAX: inline [ word make-inline ] over push-all ; +FUNCTOR-SYNTAX: inline [ word make-inline ] append! ; FUNCTOR-SYNTAX: call-next-method T{ fake-call-next-method } suffix! ; diff --git a/basis/interpolate/interpolate.factor b/basis/interpolate/interpolate.factor index ea965aac5b..6e5f68fcdf 100644 --- a/basis/interpolate/interpolate.factor +++ b/basis/interpolate/interpolate.factor @@ -40,4 +40,4 @@ MACRO: interpolate ( string -- ) SYNTAX: I[ "]I" parse-multiline-string - interpolate-locals over push-all ; + interpolate-locals append! ; diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 8cdd1d97bd..3ea4c105f5 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -53,7 +53,7 @@ M: input-port stream-read-partial ( max stream -- byte-array/f ) : read-loop ( count port accum -- ) pick over length - dup 0 > [ pick read-step dup [ - over push-all read-loop + append! read-loop ] [ 2drop 2drop ] if @@ -78,7 +78,7 @@ M: input-port stream-read : read-until-loop ( seps port buf -- separator/f ) 2over read-until-step over [ - [ over push-all ] dip dup [ + [ append! ] dip dup [ [ 3drop ] dip ] [ drop read-until-loop diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index 4f908aaf06..aa0a064c0d 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -9,13 +9,13 @@ SYNTAX: :> scan locals get [ :>-outside-lambda-error ] unless* [ make-local ] bind suffix! ; -SYNTAX: [| parse-lambda over push-all ; +SYNTAX: [| parse-lambda append! ; -SYNTAX: [let parse-let over push-all ; +SYNTAX: [let parse-let append! ; -SYNTAX: [let* parse-let* over push-all ; +SYNTAX: [let* parse-let* append! ; -SYNTAX: [wlet parse-wlet over push-all ; +SYNTAX: [wlet parse-wlet append! ; SYNTAX: :: (::) define-declared ; diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor index 850b585190..c8a8080f38 100644 --- a/basis/peg/parsers/parsers.factor +++ b/basis/peg/parsers/parsers.factor @@ -40,7 +40,7 @@ M: just-parser (compile) ( parser -- quot ) diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index 9e777b86af..4a247a8a0f 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -634,7 +634,7 @@ SYNTAX: PEG: word swap effect define-declared ] ] with-compilation-unit - ] over push-all + ] append! ] ; USING: vocabs vocabs.loader ; diff --git a/basis/random/random.factor b/basis/random/random.factor index 0e7a0cc3f1..bfd107dbb6 100755 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -19,7 +19,7 @@ M: object random-bytes* ( n tuple -- byte-array ) [ pick '[ _ random-32* 4 >le _ push-all ] times ] [ over zero? - [ 2drop ] [ random-32* 4 >le swap head over push-all ] if + [ 2drop ] [ random-32* 4 >le swap head append! ] if ] bi-curry bi* ; M: object random-32* ( tuple -- r ) 4 swap random-bytes* le> ; diff --git a/basis/xmode/rules/rules.factor b/basis/xmode/rules/rules.factor index 51f216fa44..ffe6db3b46 100644 --- a/basis/xmode/rules/rules.factor +++ b/basis/xmode/rules/rules.factor @@ -43,7 +43,7 @@ MEMO: standard-rule-set ( id -- ruleset ) : ?push-all ( seq1 seq2 -- seq1+seq2 ) [ - over [ [ V{ } like ] dip over push-all ] [ nip ] if + over [ [ V{ } like ] dip append! ] [ nip ] if ] when* ; : rule-set-no-word-sep* ( ruleset -- str ) diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor index da27dc28b4..d57fbd9707 100644 --- a/core/effects/parser/parser.factor +++ b/core/effects/parser/parser.factor @@ -35,4 +35,4 @@ ERROR: stack-effect-omits-dashes effect ; "(" expect ")" parse-effect ; : parse-call( ( accum word -- accum ) - [ ")" parse-effect ] dip 2array over push-all ; + [ ")" parse-effect ] dip 2array append! ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 8e15f73ed7..a32c9381a6 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -741,7 +741,7 @@ PRIVATE> : concat-as ( seq exemplar -- newseq ) swap [ { } ] [ [ sum-lengths over new-resizable ] keep - [ over push-all ] each + [ append! ] each ] if-empty swap like ; : concat ( seq -- newseq ) diff --git a/extra/closures/closures.factor b/extra/closures/closures.factor index 79fcf7564e..faa8ec07ee 100644 --- a/extra/closures/closures.factor +++ b/extra/closures/closures.factor @@ -4,10 +4,10 @@ SYMBOL: | ! Selective Binding : delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip >hashtable [ _ bind ] curry ] ; -SYNTAX: C[ | parse-until parse-quotation delayed-bind-with over push-all ; +SYNTAX: C[ | parse-until parse-quotation delayed-bind-with append! ; ! Common ones -SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with over push-all ; +SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with append! ; ! Namespace Binding : bind-to-namespace ( quot -- quot' ) '[ namespace [ _ bind ] curry ] ; -SYNTAX: NS[ parse-quotation bind-to-namespace over push-all ; \ No newline at end of file +SYNTAX: NS[ parse-quotation bind-to-namespace append! ; diff --git a/extra/fonts/syntax/syntax.factor b/extra/fonts/syntax/syntax.factor index c296dfb3df..34ccbc8aa8 100644 --- a/extra/fonts/syntax/syntax.factor +++ b/extra/fonts/syntax/syntax.factor @@ -13,4 +13,4 @@ SYNTAX: FONT: \ ; parse-until { [ [ italic = ] find nip [ >>italic? ] install ] [ [ bold = ] find nip [ >>bold? ] install ] [ [ fontname? ] find nip [ >>name* ] install ] -} cleave 4array concat '[ dup font>> @ drop ] over push-all ; +} cleave 4array concat '[ dup font>> @ drop ] append! ; diff --git a/extra/fries/fries.factor b/extra/fries/fries.factor index f67d0d7cd3..133e8913dd 100644 --- a/extra/fries/fries.factor +++ b/extra/fries/fries.factor @@ -8,6 +8,6 @@ IN: fries [ unclip-last [ [ spin 1array glue ] reduce-r ] 2curry ] [ length 1 - 1 [ call-effect ] 2curry ] bi ; -SYNTAX: i" parse-string rest "_" str-fry over push-all ; -SYNTAX: i{ \ } parse-until >array { _ } gen-fry over push-all ; -SYNTAX: iV{ \ } parse-until >vector V{ _ } gen-fry over push-all ; +SYNTAX: i" parse-string rest "_" str-fry append! ; +SYNTAX: i{ \ } parse-until >array { _ } gen-fry append! ; +SYNTAX: iV{ \ } parse-until >vector V{ _ } gen-fry append! ; diff --git a/extra/gpu/demos/bunny/bunny.factor b/extra/gpu/demos/bunny/bunny.factor index a741af8002..09853263ce 100755 --- a/extra/gpu/demos/bunny/bunny.factor +++ b/extra/gpu/demos/bunny/bunny.factor @@ -107,7 +107,7 @@ UNIFORM-TUPLE: loading-uniforms [ numbers { { [ dup length 5 = ] [ pick push ] } - { [ dup first 3 = ] [ rest over push-all ] } + { [ dup first 3 = ] [ rest append! ] } [ drop ] } cond ] each-line-tokens ; inline diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor index 4530d6c5c4..ab578124f8 100644 --- a/extra/infix/infix.factor +++ b/extra/infix/infix.factor @@ -93,4 +93,4 @@ PRIVATE> SYNTAX: [infix| "|" parse-bindings "infix]" parse-infix-locals - ?rewrite-closures over push-all ; + ?rewrite-closures append! ; diff --git a/extra/project-euler/017/017.factor b/extra/project-euler/017/017.factor index 53513691ff..827e478da0 100644 --- a/extra/project-euler/017/017.factor +++ b/extra/project-euler/017/017.factor @@ -24,7 +24,7 @@ IN: project-euler.017 ! -------- : euler017 ( -- answer ) - 1000 [1,b] SBUF" " clone [ number>text over push-all ] reduce [ Letter? ] count ; + 1000 [1,b] SBUF" " clone [ number>text append! ] reduce [ Letter? ] count ; ! [ euler017 ] 100 ave-time ! 15 ms ave run time - 1.71 SD (100 trials) diff --git a/extra/project-euler/038/038.factor b/extra/project-euler/038/038.factor index dd70051082..34b4cd91fa 100755 --- a/extra/project-euler/038/038.factor +++ b/extra/project-euler/038/038.factor @@ -39,7 +39,7 @@ IN: project-euler.038 pick length 8 > [ 2drop 10 digits>integer ] [ - [ * number>digits over push-all ] 2keep 1 + (concat-product) + [ * number>digits append! ] 2keep 1 + (concat-product) ] if ; : concat-product ( n -- m ) diff --git a/extra/project-euler/040/040.factor b/extra/project-euler/040/040.factor index a60714357e..09185e9a64 100755 --- a/extra/project-euler/040/040.factor +++ b/extra/project-euler/040/040.factor @@ -28,7 +28,7 @@ IN: project-euler.040 : (concat-upto) ( n limit str -- str ) 2dup length > [ - pick number>string over push-all rot 1 + -rot (concat-upto) + pick number>string append! [ 1 + ] 2dip (concat-upto) ] [ 2nip ] if ; diff --git a/extra/ui/gadgets/controls/controls.factor b/extra/ui/gadgets/controls/controls.factor index 0c7841b11f..5de6da8710 100644 --- a/extra/ui/gadgets/controls/controls.factor +++ b/extra/ui/gadgets/controls/controls.factor @@ -59,9 +59,9 @@ M: model-field model-changed 2dup model*>> = : ( init page min max step -- slider ) horizontal slider: ; : image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround dup cached-image drop ; -SYNTAX: IMG-MODEL-BTN: image-prep [ ] curry over push-all ; +SYNTAX: IMG-MODEL-BTN: image-prep [ ] curry append! ; -SYNTAX: IMG-BTN: image-prep [ swap