Add push-at to core
parent
045b657474
commit
375020b7fe
|
@ -150,6 +150,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
|
||||||
: value-at ( value assoc -- key/f )
|
: value-at ( value assoc -- key/f )
|
||||||
swap [ = nip ] curry assoc-find 2drop ;
|
swap [ = nip ] curry assoc-find 2drop ;
|
||||||
|
|
||||||
|
: push-at ( value key assoc -- )
|
||||||
|
[ ?push ] change-at ;
|
||||||
|
|
||||||
: zip ( keys values -- alist )
|
: zip ( keys values -- alist )
|
||||||
2array flip ; inline
|
2array flip ; inline
|
||||||
|
|
||||||
|
|
|
@ -13,7 +13,7 @@ SYMBOL: def-use
|
||||||
used-by empty? ;
|
used-by empty? ;
|
||||||
|
|
||||||
: uses-values ( node seq -- )
|
: uses-values ( node seq -- )
|
||||||
[ def-use get [ ?push ] change-at ] with each ;
|
[ def-use get push-at ] with each ;
|
||||||
|
|
||||||
: defs-values ( seq -- )
|
: defs-values ( seq -- )
|
||||||
#! If there is no value, set it to a new empty vector,
|
#! 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
|
#! degree of accuracy; the new values should be marked as
|
||||||
#! having _some_ usage, so that flushing doesn't erronously
|
#! having _some_ usage, so that flushing doesn't erronously
|
||||||
#! flush them away.
|
#! flush them away.
|
||||||
nest-def-use keys
|
nest-def-use keys def-use get [ t -rot push-at ] curry each ;
|
||||||
def-use get [ [ t swap ?push ] change-at ] curry each ;
|
|
||||||
|
|
|
@ -17,9 +17,6 @@ IN: assocs.lib
|
||||||
: replace-at ( assoc value key -- assoc )
|
: replace-at ( assoc value key -- assoc )
|
||||||
>r >r dup r> 1vector r> rot set-at ;
|
>r >r dup r> 1vector r> rot set-at ;
|
||||||
|
|
||||||
: insert-at ( value key assoc -- )
|
|
||||||
[ ?push ] change-at ;
|
|
||||||
|
|
||||||
: peek-at* ( assoc key -- obj ? )
|
: peek-at* ( assoc key -- obj ? )
|
||||||
swap at* dup [ >r peek r> ] when ;
|
swap at* dup [ >r peek r> ] when ;
|
||||||
|
|
||||||
|
@ -32,7 +29,7 @@ IN: assocs.lib
|
||||||
: multi-assoc-each ( assoc quot -- )
|
: multi-assoc-each ( assoc quot -- )
|
||||||
[ with each ] curry assoc-each ; inline
|
[ with each ] curry assoc-each ; inline
|
||||||
|
|
||||||
: insert ( value variable -- ) namespace insert-at ;
|
: insert ( value variable -- ) namespace push-at ;
|
||||||
|
|
||||||
: generate-key ( assoc -- str )
|
: generate-key ( assoc -- str )
|
||||||
>r 32 random-bits >hex r>
|
>r 32 random-bits >hex r>
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2007 Alex Chapman All Rights Reserved.
|
! Copyright (C) 2007 Alex Chapman All Rights Reserved.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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 ;
|
sequences quotations ;
|
||||||
IN: gap-buffer.cursortree
|
IN: gap-buffer.cursortree
|
||||||
|
|
||||||
|
@ -21,7 +21,7 @@ TUPLE: right-cursor ;
|
||||||
|
|
||||||
: cursor-index ( cursor -- i ) cursor-i ;
|
: 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 -- )
|
: remove-cursor ( cursortree cursor -- )
|
||||||
tuck cursor-index swap cursortree-cursors at* [ delete ] [ 2drop ] if ;
|
tuck cursor-index swap cursortree-cursors at* [ delete ] [ 2drop ] if ;
|
||||||
|
|
|
@ -114,7 +114,7 @@ M: help-error error.
|
||||||
H{ } clone [
|
H{ } clone [
|
||||||
[
|
[
|
||||||
>r >r dup >link where dup
|
>r >r dup >link where dup
|
||||||
[ first r> at r> [ ?push ] change-at ]
|
[ first r> at r> push-at ]
|
||||||
[ r> r> 2drop 2drop ]
|
[ r> r> 2drop 2drop ]
|
||||||
if
|
if
|
||||||
] 2curry each
|
] 2curry each
|
||||||
|
|
|
@ -44,14 +44,11 @@ TUPLE: mx fd reads writes ;
|
||||||
|
|
||||||
GENERIC: add-input-callback ( thread fd mx -- )
|
GENERIC: add-input-callback ( thread fd mx -- )
|
||||||
|
|
||||||
: add-callback ( thread fd assoc -- )
|
M: mx add-input-callback reads>> push-at ;
|
||||||
[ ?push ] change-at ;
|
|
||||||
|
|
||||||
M: mx add-input-callback reads>> add-callback ;
|
|
||||||
|
|
||||||
GENERIC: add-output-callback ( thread fd mx -- )
|
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 )
|
GENERIC: remove-input-callbacks ( fd mx -- callbacks )
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: assocs math kernel sequences io.files hashtables
|
USING: assocs math kernel sequences io.files hashtables
|
||||||
quotations splitting grouping arrays math.parser hash2 math.order
|
quotations splitting grouping arrays math.parser hash2 math.order
|
||||||
byte-arrays words namespaces words compiler.units parser
|
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 ;
|
combinators.lib combinators locals math.ranges sorting ;
|
||||||
IN: unicode.data
|
IN: unicode.data
|
||||||
|
|
||||||
|
@ -151,7 +151,7 @@ C: <code-point> code-point
|
||||||
|
|
||||||
: properties>intervals ( properties -- assoc[str,interval] )
|
: properties>intervals ( properties -- assoc[str,interval] )
|
||||||
dup values prune [ f ] H{ } map>assoc
|
dup values prune [ f ] H{ } map>assoc
|
||||||
[ [ insert-at ] curry assoc-each ] keep
|
[ [ push-at ] curry assoc-each ] keep
|
||||||
[ <interval-set> ] assoc-map ;
|
[ <interval-set> ] assoc-map ;
|
||||||
|
|
||||||
: load-properties ( -- assoc )
|
: load-properties ( -- assoc )
|
||||||
|
|
|
@ -42,7 +42,7 @@ MEMO: standard-rule-set ( id -- ruleset )
|
||||||
rule-set-imports push ;
|
rule-set-imports push ;
|
||||||
|
|
||||||
: inverted-index ( hashes key index -- )
|
: inverted-index ( hashes key index -- )
|
||||||
[ swapd [ ?push ] change-at ] 2curry each ;
|
[ swapd push-at ] 2curry each ;
|
||||||
|
|
||||||
: ?push-all ( seq1 seq2 -- seq1+seq2 )
|
: ?push-all ( seq1 seq2 -- seq1+seq2 )
|
||||||
[
|
[
|
||||||
|
|
Loading…
Reference in New Issue