diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index d33edfab30..f6873429fe 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -95,10 +95,10 @@ M: hashtable hashcode* : (distribute-buckets) ( buckets pair keys -- ) dup t eq? [ - drop [ swap push-new ] curry each + drop [ swap adjoin ] curry each ] [ [ - >r 2dup r> hashcode pick length rem rot nth push-new + >r 2dup r> hashcode pick length rem rot nth adjoin ] each 2drop ] if ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index a31cd8de16..11c81f4097 100755 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -14,7 +14,7 @@ TUPLE: redefine-error def ; { { "Continue" t } } throw-restarts drop ; : add-once ( key assoc -- ) - 2dup key? [ over redefine-error ] when dupd set-at ; + 2dup key? [ over redefine-error ] when conjoin ; : (remember-definition) ( definition loc assoc -- ) >r over set-where r> add-once ; diff --git a/core/generator/fixup/fixup.factor b/core/generator/fixup/fixup.factor index 06895cd8ac..b38d70fb80 100755 --- a/core/generator/fixup/fixup.factor +++ b/core/generator/fixup/fixup.factor @@ -102,13 +102,13 @@ M: frame-required fixup* drop ; M: integer fixup* , ; -: push-new* ( obj table -- n ) +: adjoin* ( obj table -- n ) 2dup swap [ eq? ] curry find drop [ 2nip ] [ dup length >r push r> ] if* ; SYMBOL: literal-table -: add-literal ( obj -- n ) literal-table get push-new* ; +: add-literal ( obj -- n ) literal-table get adjoin* ; : add-dlsym-literals ( symbol dll -- ) >r string>symbol r> 2array literal-table get push-all ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 351ba89692..2c1a3b8ab9 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -191,7 +191,6 @@ $nl "Other destructive words:" { $subsection move } { $subsection exchange } -{ $subsection push-new } { $subsection copy } { $subsection replace-slice } { $see-also set-nth push pop "sequences-stacks" } ; @@ -624,22 +623,7 @@ HELP: replace-slice { $errors "Throws an error if " { $snippet "new" } " contains elements whose types are not permissible in " { $snippet "seq" } "." } { $side-effects "seq" } ; -HELP: push-new -{ $values { "elt" object } { "seq" "a resizable mutable sequence" } } -{ $description "Removes all elements equal to " { $snippet "elt" } ", and adds " { $snippet "elt" } " at the end of the sequence." } -{ $examples - { $example - "USING: namespaces prettyprint sequences ;" - "V{ \"beans\" \"salsa\" \"cheese\" } \"v\" set" - "\"nachos\" \"v\" get push-new" - "\"salsa\" \"v\" get push-new" - "\"v\" get ." - "V{ \"beans\" \"cheese\" \"nachos\" \"salsa\" }" - } -} -{ $side-effects "seq" } ; - -{ push push-new prefix suffix } related-words +{ push prefix suffix } related-words HELP: suffix { $values { "seq" sequence } { "elt" object } { "newseq" sequence } } diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 2479c125a2..0511721c18 100755 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -216,10 +216,10 @@ unit-test ] unit-test [ V{ 1 2 3 } ] -[ 3 V{ 1 2 } clone [ push-new ] keep ] unit-test +[ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test [ V{ 1 2 3 } ] -[ 3 V{ 1 3 2 } clone [ push-new ] keep ] unit-test +[ 3 V{ 1 3 2 } clone [ adjoin ] keep ] unit-test ! erg's random tester found this one [ SBUF" 12341234" ] [ diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 4153430514..4854ff8001 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -499,8 +499,6 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; : delete ( elt seq -- ) 0 0 rot (delete) nip set-length drop ; -: push-new ( elt seq -- ) [ delete ] 2keep push ; - : prefix ( seq elt -- newseq ) over >r over length 1+ r> [ [ 0 swap set-nth-unsafe ] keep diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index f4e2557a71..97fbc973f0 100644 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -16,10 +16,28 @@ $nl { $subsection set= } "A word used to implement the above:" { $subsection unique } +"Adding elements to sets:" +{ $subsection adjoin } +{ $subsection conjoin } { $see-also member? memq? contains? all? "assocs-sets" } ; ABOUT: "sets" +HELP: adjoin +{ $values { "elt" object } { "seq" "a resizable mutable sequence" } } +{ $description "Removes all elements equal to " { $snippet "elt" } ", and adds " { $snippet "elt" } " at the end of the sequence." } +{ $examples + { $example + "USING: namespaces prettyprint sequences ;" + "V{ \"beans\" \"salsa\" \"cheese\" } \"v\" set" + "\"nachos\" \"v\" get adjoin" + "\"salsa\" \"v\" get adjoin" + "\"v\" get ." + "V{ \"beans\" \"cheese\" \"nachos\" \"salsa\" }" + } +} +{ $side-effects "seq" } ; + HELP: unique { $values { "seq" "a sequence" } { "assoc" "an assoc" } } { $description "Outputs a new assoc where the keys and values are equal." } diff --git a/core/sets/sets.factor b/core/sets/sets.factor index b0d26e0f30..5fbec9a7c8 100644 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -3,10 +3,14 @@ USING: assocs hashtables kernel sequences vectors ; IN: sets +: adjoin ( elt seq -- ) [ delete ] [ push ] 2bi ; + +: conjoin ( elt assoc -- ) dupd set-at ; + : (prune) ( elt hash vec -- ) - 3dup drop key? - [ [ drop dupd set-at ] [ nip push ] [ ] 3tri ] unless - 3drop ; inline + 3dup drop key? [ 3drop ] [ + [ drop conjoin ] [ nip push ] 3bi + ] if ; inline : prune ( seq -- newseq ) [ ] [ length ] [ length ] tri @@ -16,7 +20,7 @@ IN: sets [ dup ] H{ } map>assoc ; : (all-unique?) ( elt hash -- ? ) - 2dup key? [ 2drop f ] [ dupd set-at t ] if ; + 2dup key? [ 2drop f ] [ conjoin t ] if ; : all-unique? ( seq -- ? ) dup length [ (all-unique?) ] curry all? ; diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index 59e8049232..b1073c116d 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -25,7 +25,7 @@ SYMBOL: total ] [ [ pair? ] filter - [ keys [ hooks get push-new ] each ] keep + [ keys [ hooks get adjoin ] each ] keep ] bi append ; : canonicalize-specializer-2 ( specializer -- specializer' ) diff --git a/extra/trees/splay/splay-tests.factor b/extra/trees/splay/splay-tests.factor index 29ea2eee2d..29bc153030 100644 --- a/extra/trees/splay/splay-tests.factor +++ b/extra/trees/splay/splay-tests.factor @@ -8,7 +8,7 @@ IN: trees.splay.tests 100 [ drop 100 random swap at drop ] with each ; : make-numeric-splay-tree ( n -- splay-tree ) - [ [ dupd set-at ] curry each ] keep ; + [ [ conjoin ] curry each ] keep ; [ t ] [ 100 make-numeric-splay-tree dup randomize-numeric-splay-tree diff --git a/extra/ui/tools/interactor/interactor.factor b/extra/ui/tools/interactor/interactor.factor index 2e59363531..c28e8aec7c 100755 --- a/extra/ui/tools/interactor/interactor.factor +++ b/extra/ui/tools/interactor/interactor.factor @@ -76,7 +76,7 @@ M: interactor model-changed ] with-output-stream* ; : add-interactor-history ( str interactor -- ) - over empty? [ 2drop ] [ interactor-history push-new ] if ; + over empty? [ 2drop ] [ interactor-history adjoin ] if ; : interactor-continue ( obj interactor -- ) mailbox>> mailbox-put ;