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/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor index 123246b1b9..d7659d8400 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..609ed2826d 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 ; @@ -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/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/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/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/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/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..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 ; @@ -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 @@ -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 { @@ -389,10 +389,10 @@ SYNTAX: S@ PRIVATE> FUNCTOR-SYNTAX: STRUCT: - scan-param parsed - [ 8 ] over push-all + scan-param suffix! + [ 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/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/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/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/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/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/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 8b4dde59da..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 ; @@ -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 @@ -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 @@ -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/compiler/cfg/linear-scan/allocation/state/state.factor b/basis/compiler/cfg/linear-scan/allocation/state/state.factor index aeebe31dcc..4c825c9d7c 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 @@ -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/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/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/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/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/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/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/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 19c73eebd4..3710f4974b 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 member-eq? [ 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/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/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/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/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/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/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/cpu/arm/assembler/tags.txt b/basis/cpu/arm/assembler/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/cpu/arm/assembler/tags.txt @@ -0,0 +1 @@ +unportable 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..a9ce6cd324 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 parser 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/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/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/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/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/fry/fry.factor b/basis/fry/fry.factor index fd029cc329..d68e2d13a8 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 ) @@ -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 676e0af786..a03463e911 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 - [ fake-quotations> first ] over push-all ; + parse-definition >fake-quotations suffix! + [ fake-quotations> first ] append! ; : 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 - [ create-method-in dup method-body set ] over push-all + scan-param suffix! + scan-param suffix! + [ create-method-in dup method-body set ] append! 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 ] append! ] 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: inline [ word make-inline ] append! ; -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/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/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/hints/hints.factor b/basis/hints/hints.factor index 738a960b4b..d7c745500b 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 @@ -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/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/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/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/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/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/encodings/gb18030/gb18030.factor b/basis/io/encodings/gb18030/gb18030.factor index 1590684326..512b52ef19 100644 --- a/basis/io/encodings/gb18030/gb18030.factor +++ b/basis/io/encodings/gb18030/gb18030.factor @@ -67,7 +67,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/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/io/mmap/mmap-docs.factor b/basis/io/mmap/mmap-docs.factor index caa2f95dae..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 ] change-each" + " [ reverse! drop ] 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/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/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 scan locals get [ :>-outside-lambda-error ] unless* - parse-def parsed ; + parse-def suffix! ; -SYNTAX: [| parse-lambda over push-all ; +SYNTAX: [| parse-lambda append! ; -SYNTAX: [let parse-let over push-all ; +SYNTAX: [let parse-let append! ; SYNTAX: :: (::) define-declared ; diff --git a/basis/locals/rewrite/sugar/sugar.factor b/basis/locals/rewrite/sugar/sugar.factor index e22e247336..a8a12d2614 100755 --- a/basis/locals/rewrite/sugar/sugar.factor +++ b/basis/locals/rewrite/sugar/sugar.factor @@ -112,7 +112,7 @@ M: wrapper rewrite-sugar* rewrite-wrapper ; M: word rewrite-sugar* - dup { load-locals get-local drop-locals } memq? + dup { load-locals get-local drop-locals } member-eq? [ >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/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/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/math/vectors/conversion/conversion.factor b/basis/math/vectors/conversion/conversion.factor index cb59aa95d5..fd58b11dc8 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/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/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 976ffc0dfa..5ddd5f9bf0 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/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 ec22955b7a..d4397627e8 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -624,7 +624,7 @@ SYNTAX: PEG: ] word swap effect define-declared ] with-compilation-unit - ] over push-all + ] append! ] ; USING: vocabs vocabs.loader ; 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/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/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/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/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..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> ; @@ -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/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/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-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/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/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-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/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/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 0c703cae13..e42f478de6 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 -- ) [ @@ -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/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/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/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 7dbe3a3c48..a6d73ca80f 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 ; @@ -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/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/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/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/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/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index b736c3f74f..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,8 +151,8 @@ M: world focusable-child* children>> [ t ] [ first ] if-empty ; M: world children-on nip children>> ; M: world remove-gadget - 2dup layers>> memq? - [ layers>> delq ] [ call-next-method ] if ; + 2dup layers>> member-eq? + [ layers>> remove-eq! drop ] [ call-next-method ] if ; SYMBOL: flush-layout-cache-hook 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/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/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/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/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/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/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/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/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/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index 22556ef94c..5a69df8cb4 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 } } @@ -96,9 +96,7 @@ ARTICLE: "assocs-sets" "Set-theoretic operations on assocs" update assoc-union assoc-diff - remove-all substitute - substitute-here extract-keys } { $see-also key? assoc-any? assoc-all? "sets" } ; @@ -348,17 +346,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 } } -{ $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 } } 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 e633a54843..6b66a79358 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -135,12 +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 change-each ; - : substitute ( seq assoc -- newseq ) substituter map ; @@ -195,7 +189,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 +218,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/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/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/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/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/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/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/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/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/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-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/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-docs.factor b/core/sequences/sequences-docs.factor index 2156557fff..97679821ea 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 ." @@ -295,6 +295,17 @@ $nl { $example "USING: math prettyprint sequences ;" "{ 2 2 2 2 2 } 0 [ + ] accumulate . ." "{ 0 2 4 6 8 }\n10" } } ; +HELP: accumulate! +{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } { "seq" sequence } } +{ $description "Combines successive elements of the sequence using a binary operation, and outputs the original sequence of intermediate results, together with the final result." +$nl +"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence." +$nl +"When given the empty sequence, outputs an empty sequence together with the " { $snippet "identity" } "." } +{ $examples + { $example "USING: math prettyprint sequences ;" "{ 2 2 2 2 2 } 0 [ + ] accumulate! . ." "{ 0 2 4 6 8 }\n10" } +} ; + HELP: map { $values { "seq" sequence } { "quot" { $quotation "( old -- new )" } } { "newseq" "a new sequence" } } { $description "Applies the quotation to each element of the sequence in order. The new elements are collected into a sequence of the same class as the input sequence." } ; @@ -332,9 +343,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" } ; @@ -430,8 +441,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" } ; @@ -461,7 +472,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? } ")." } ; @@ -471,7 +482,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? } ")." } ; @@ -491,20 +502,20 @@ 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" } ; -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" } ; -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" } ; @@ -528,6 +539,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" } "." } @@ -590,9 +616,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 @@ -620,7 +646,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" } } @@ -861,7 +887,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 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" } } @@ -1065,7 +1091,7 @@ HELP: harvest } } ; -{ filter filter-here sift harvest } related-words +{ filter filter! sift harvest } related-words HELP: set-first { $values @@ -1416,7 +1442,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:" @@ -1510,6 +1536,7 @@ ARTICLE: "sequences-combinators" "Sequence combinators" map-reduce accumulate accumulate-as + accumulate! produce produce-as } @@ -1551,7 +1578,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? } ; @@ -1590,19 +1617,19 @@ 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 - delq - delete-nth + remove! + remove-eq! + remove-nth! delete-slice delete-all - filter-here + filter! } "Other destructive words:" { $subsections - reverse-here + reverse! push-all move exchange @@ -1611,16 +1638,16 @@ 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 delete } } - { { $link remq } { $link delq } } - { { $link remove-nth } { $link delete-nth } } - { { $link reverse } { $link reverse-here } } - { { $link append } { $link push-all } } - { { $link map } { $link change-each } } - { { $link filter } { $link filter-here } } + { { $link remove } { $link remove! } } + { { $link remove-eq } { $link remove-eq! } } + { { $link remove-nth } { $link remove-nth! } } + { { $link reverse } { $link reverse! } } + { { $link append } { $link append! } } + { { $link map } { $link map! } } + { { $link filter } { $link filter! } } } { $heading "Related Articles" } { $subsections diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index e36bfaf9d2..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 @@ -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 ] @@ -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 @@ -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 @@ -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 dc63acb749..81e5401c4b 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -429,15 +429,21 @@ 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) ( seq identity quot -- seq identity quot ) + [ swap ] dip [ curry keep ] curry ; inline : accumulate-as ( seq identity quot exemplar -- final newseq ) - [ [ swap ] dip [ curry keep ] curry ] dip map-as ; inline + [ (accumulate) ] dip map-as ; inline : accumulate ( seq identity quot -- final newseq ) { } accumulate-as ; inline +: accumulate! ( seq identity quot -- final seq ) + (accumulate) map! ; inline + : 2each ( seq1 seq2 quot -- ) (2each) each-integer ; inline @@ -567,13 +573,13 @@ PRIVATE> : member? ( elt seq -- ? ) [ = ] with any? ; -: memq? ( elt seq -- ? ) +: member-eq? ( elt seq -- ? ) [ eq? ] with any? ; : remove ( elt seq -- newseq ) [ = not ] with filter ; -: remq ( elt seq -- newseq ) +: remove-eq ( elt seq -- newseq ) [ eq? not ] with filter ; : sift ( seq -- newseq ) @@ -619,24 +625,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 -: delete ( elt seq -- ) - [ = not ] with filter-here ; +: remove! ( elt seq -- seq ) + [ = not ] with filter! ; -: delq ( elt seq -- ) - [ eq? not ] with filter-here ; +: remove-eq! ( elt seq -- seq ) + [ eq? not ] with filter! ; : prefix ( seq elt -- newseq ) over [ over length 1 + ] dip [ @@ -650,6 +656,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 ; @@ -695,8 +705,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 @@ -719,15 +729,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 ) @@ -736,7 +747,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/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/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/source-files/errors/errors.factor b/core/source-files/errors/errors.factor index f021944f86..ebacc90f63 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 ; @@ -80,11 +80,11 @@ 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 -- ) 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/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/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/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 2fc9d05d79..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 ; @@ -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/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/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-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 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/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/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/reverse-complement/reverse-complement.factor b/extra/benchmark/reverse-complement/reverse-complement.factor index 4147ffabdf..95035e6cd8 100755 --- a/extra/benchmark/reverse-complement/reverse-complement.factor +++ b/extra/benchmark/reverse-complement/reverse-complement.factor @@ -9,13 +9,13 @@ 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 ; : 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/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/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/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 d13666e7ce..cc12b4fed1 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/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 ; 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 4efecb5fcf..48ac35264b 100644 --- a/extra/infix/infix.factor +++ b/extra/infix/infix.factor @@ -82,4 +82,4 @@ M: ast-function infix-codegen PRIVATE> SYNTAX: [infix - "infix]" [infix-parse parsed \ call parsed ; + "infix]" [infix-parse suffix! \ call suffix! ; diff --git a/extra/llvm/types/types.factor b/extra/llvm/types/types.factor index 426e464b1b..ddb54ecb27 100644 --- a/extra/llvm/types/types.factor +++ b/extra/llvm/types/types.factor @@ -242,4 +242,4 @@ Program = Type ;EBNF -SYNTAX: TYPE: ";" parse-multiline-string parse-type parsed ; \ No newline at end of file +SYNTAX: TYPE: ";" parse-multiline-string parse-type suffix! ; diff --git a/extra/money/money.factor b/extra/money/money.factor index 36dedb2a65..6cafeff289 100644 --- a/extra/money/money.factor +++ b/extra/money/money.factor @@ -30,4 +30,4 @@ ERROR: not-an-integer x ; ] keep length 10^ / + swap [ neg ] when ; -SYNTAX: DECIMAL: scan parse-decimal parsed ; +SYNTAX: DECIMAL: scan parse-decimal suffix! ; 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/extra/morse/morse.factor b/extra/morse/morse.factor index ddfd3c2042..cbe3c0f2fa 100644 --- a/extra/morse/morse.factor +++ b/extra/morse/morse.factor @@ -109,7 +109,7 @@ PRIVATE> : morse> ( morse -- plain ) replace-underscores morse>sentence ; -SYNTAX: [MORSE "MORSE]" parse-multiline-string morse> parsed ; +SYNTAX: [MORSE "MORSE]" parse-multiline-string morse> suffix! ; 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/extra/pair-rocket/pair-rocket.factor b/extra/pair-rocket/pair-rocket.factor index 3bd8a098f6..299c66cc23 100644 --- a/extra/pair-rocket/pair-rocket.factor +++ b/extra/pair-rocket/pair-rocket.factor @@ -2,5 +2,5 @@ USING: arrays kernel parser sequences ; IN: pair-rocket -SYNTAX: => 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/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/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/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/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/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/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