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

linked-assocs passes tests

db4
James Cash 2008-11-08 02:18:03 -05:00
parent b68d3c94a7
commit b3acebc350
1 changed files with 10 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
basis/linked-assocs/linked-assocs.factor
View File

@ -10,25 +10,22 @@ TUPLE: linked-assoc assoc dlist ;
M: linked-assoc assoc-size assoc>> assoc-size ; M: linked-assoc assoc-size assoc>> assoc-size ;
M: linked-assoc at* assoc>> at* tuck [ obj>> ] when swap ; M: linked-assoc at* assoc>> at* tuck [ obj>> ] when second swap ;
<PRIVATE
: add-to-dlist ( value key lassoc -- node )
[ swap 2array ] dip dlist>> push-back* ;
: remove-from-dlist ( key dlist -- )
swap '[ _ = ] delete-node-if ;
PRIVATE>
M: linked-assoc set-at
[ add-to-dlist ] 2keep
assoc>> set-at ;
M: linked-assoc delete-at M: linked-assoc delete-at
[ [ assoc>> ] [ dlist>> ] bi [ at ] dip '[ _ delete-node ] when* ] [ [ assoc>> ] [ dlist>> ] bi [ at ] dip '[ _ delete-node ] when* ]
[ assoc>> delete-at ] [ assoc>> delete-at ]
2bi ; 2bi ;
<PRIVATE
: add-to-dlist ( value key lassoc -- node )
[ swap 2array ] dip dlist>> push-back* ;
PRIVATE>
M: linked-assoc set-at
[ 2dup assoc>> key? [ 2dup delete-at ] when add-to-dlist ] 2keep
assoc>> set-at ;
: dlist>seq ( dlist -- seq ) : dlist>seq ( dlist -- seq )
[ ] pusher [ dlist-each ] dip ; [ ] pusher [ dlist-each ] dip ;