From 375020b7fe9d46bc9831a4f8790e5c3ae59be4be Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 13 Jun 2008 02:09:16 -0500 Subject: [PATCH] Add push-at to core --- core/assocs/assocs.factor | 3 +++ core/optimizer/def-use/def-use.factor | 5 ++--- extra/assocs/lib/lib.factor | 5 +---- extra/gap-buffer/cursortree/cursortree.factor | 4 ++-- extra/help/lint/lint.factor | 2 +- extra/io/unix/backend/backend.factor | 7 ++----- extra/unicode/data/data.factor | 4 ++-- extra/xmode/rules/rules.factor | 2 +- 8 files changed, 14 insertions(+), 18 deletions(-) diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index ca49b550b0..c875475278 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -150,6 +150,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) : value-at ( value assoc -- key/f ) swap [ = nip ] curry assoc-find 2drop ; +: push-at ( value key assoc -- ) + [ ?push ] change-at ; + : zip ( keys values -- alist ) 2array flip ; inline diff --git a/core/optimizer/def-use/def-use.factor b/core/optimizer/def-use/def-use.factor index a2e9f88135..d4905a1718 100755 --- a/core/optimizer/def-use/def-use.factor +++ b/core/optimizer/def-use/def-use.factor @@ -13,7 +13,7 @@ SYMBOL: def-use used-by empty? ; : uses-values ( node seq -- ) - [ def-use get [ ?push ] change-at ] with each ; + [ def-use get push-at ] with each ; : defs-values ( seq -- ) #! If there is no value, set it to a new empty vector, @@ -132,5 +132,4 @@ M: #r> kill-node* #! degree of accuracy; the new values should be marked as #! having _some_ usage, so that flushing doesn't erronously #! flush them away. - nest-def-use keys - def-use get [ [ t swap ?push ] change-at ] curry each ; + nest-def-use keys def-use get [ t -rot push-at ] curry each ; diff --git a/extra/assocs/lib/lib.factor b/extra/assocs/lib/lib.factor index c3e487a9fc..1c89c1eb16 100755 --- a/extra/assocs/lib/lib.factor +++ b/extra/assocs/lib/lib.factor @@ -17,9 +17,6 @@ IN: assocs.lib : replace-at ( assoc value key -- assoc ) >r >r dup r> 1vector r> rot set-at ; -: insert-at ( value key assoc -- ) - [ ?push ] change-at ; - : peek-at* ( assoc key -- obj ? ) swap at* dup [ >r peek r> ] when ; @@ -32,7 +29,7 @@ IN: assocs.lib : multi-assoc-each ( assoc quot -- ) [ with each ] curry assoc-each ; inline -: insert ( value variable -- ) namespace insert-at ; +: insert ( value variable -- ) namespace push-at ; : generate-key ( assoc -- str ) >r 32 random-bits >hex r> diff --git a/extra/gap-buffer/cursortree/cursortree.factor b/extra/gap-buffer/cursortree/cursortree.factor index a3a5075820..4249aea2d9 100644 --- a/extra/gap-buffer/cursortree/cursortree.factor +++ b/extra/gap-buffer/cursortree/cursortree.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Alex Chapman All Rights Reserved. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs assocs.lib kernel gap-buffer generic trees trees.avl math +USING: assocs kernel gap-buffer generic trees trees.avl math sequences quotations ; IN: gap-buffer.cursortree @@ -21,7 +21,7 @@ TUPLE: right-cursor ; : cursor-index ( cursor -- i ) cursor-i ; -: add-cursor ( cursortree cursor -- ) dup cursor-index rot insert-at ; +: add-cursor ( cursortree cursor -- ) dup cursor-index rot push-at ; : remove-cursor ( cursortree cursor -- ) tuck cursor-index swap cursortree-cursors at* [ delete ] [ 2drop ] if ; diff --git a/extra/help/lint/lint.factor b/extra/help/lint/lint.factor index 00a8e287e6..eef2463019 100755 --- a/extra/help/lint/lint.factor +++ b/extra/help/lint/lint.factor @@ -114,7 +114,7 @@ M: help-error error. H{ } clone [ [ >r >r dup >link where dup - [ first r> at r> [ ?push ] change-at ] + [ first r> at r> push-at ] [ r> r> 2drop 2drop ] if ] 2curry each diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 67856a0570..8e76be2632 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -44,14 +44,11 @@ TUPLE: mx fd reads writes ; GENERIC: add-input-callback ( thread fd mx -- ) -: add-callback ( thread fd assoc -- ) - [ ?push ] change-at ; - -M: mx add-input-callback reads>> add-callback ; +M: mx add-input-callback reads>> push-at ; GENERIC: add-output-callback ( thread fd mx -- ) -M: mx add-output-callback writes>> add-callback ; +M: mx add-output-callback writes>> push-at ; GENERIC: remove-input-callbacks ( fd mx -- callbacks ) diff --git a/extra/unicode/data/data.factor b/extra/unicode/data/data.factor index 8ef8658adb..5fb769e499 100755 --- a/extra/unicode/data/data.factor +++ b/extra/unicode/data/data.factor @@ -1,7 +1,7 @@ USING: assocs math kernel sequences io.files hashtables quotations splitting grouping arrays math.parser hash2 math.order byte-arrays words namespaces words compiler.units parser -io.encodings.ascii values interval-maps ascii sets assocs.lib +io.encodings.ascii values interval-maps ascii sets combinators.lib combinators locals math.ranges sorting ; IN: unicode.data @@ -151,7 +151,7 @@ C: code-point : properties>intervals ( properties -- assoc[str,interval] ) dup values prune [ f ] H{ } map>assoc - [ [ insert-at ] curry assoc-each ] keep + [ [ push-at ] curry assoc-each ] keep [ ] assoc-map ; : load-properties ( -- assoc ) diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor index df5580fc68..daaeac70a4 100755 --- a/extra/xmode/rules/rules.factor +++ b/extra/xmode/rules/rules.factor @@ -42,7 +42,7 @@ MEMO: standard-rule-set ( id -- ruleset ) rule-set-imports push ; : inverted-index ( hashes key index -- ) - [ swapd [ ?push ] change-at ] 2curry each ; + [ swapd push-at ] 2curry each ; : ?push-all ( seq1 seq2 -- seq1+seq2 ) [