steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Move maybe-set-at to assocs

db4
Slava Pestov 2009-05-26 18:45:37 -05:00
parent ccb662c60e
commit eda44f28a6
3 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/compiler/cfg/stack-analysis/stack-analysis.factor
View File

@ -278,9 +278,6 @@ ERROR: cannot-merge-poisoned states ;
: block-in-state ( bb -- states ) : block-in-state ( bb -- states )
dup predecessors>> state-out get '[ _ at ] map merge-states ; dup predecessors>> state-out get '[ _ at ] map merge-states ;
: maybe-set-at ( value key assoc -- changed? )
3dup at* [ = [ 3drop f ] [ set-at t ] if ] [ 2drop set-at t ] if ;
: set-block-in-state ( state bb -- ) : set-block-in-state ( state bb -- )
[ clone ] dip state-in get set-at ; [ clone ] dip state-in get set-at ;

4
core/assocs/assocs-tests.factor
View File

@ -142,3 +142,7 @@ unit-test
[ 1 f ] [ 1 H{ } ?at ] unit-test [ 1 f ] [ 1 H{ } ?at ] unit-test
[ 2 t ] [ 1 H{ { 1 2 } } ?at ] unit-test [ 2 t ] [ 1 H{ { 1 2 } } ?at ] unit-test
[ f ] [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
[ t ] [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
[ t ] [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test

3
core/assocs/assocs.factor
View File

@ -22,6 +22,9 @@ M: assoc assoc-like drop ;
: ?at ( key assoc -- value/key ? ) : ?at ( key assoc -- value/key ? )
2dup at* [ 2nip t ] [ 2drop f ] if ; inline 2dup at* [ 2nip t ] [ 2drop f ] if ; inline
: maybe-set-at ( value key assoc -- changed? )
3dup at* [ = [ 3drop f ] [ set-at t ] if ] [ 2drop set-at t ] if ;
<PRIVATE <PRIVATE
: (assoc-each) ( assoc quot -- seq quot' ) : (assoc-each) ( assoc quot -- seq quot' )