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

linked-assocs: some performance improvements.

db4
John Benediktsson 2013-03-07 10:05:28 -08:00
parent 30cbce3f41
commit 8c161df10e
1 changed files with 22 additions and 11 deletions
basis/linked-assocs

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

@ -1,9 +1,10 @@
! Copyright (C) 2008 Slava Pestov, James Cash.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs arrays kernel deques dlists sequences fry ;
USING: accessors arrays assocs deques dlists fry kernel
sequences sequences.private ;
IN: linked-assocs
TUPLE: linked-assoc assoc dlist ;
TUPLE: linked-assoc { assoc read-only } { dlist dlist read-only } ;
: <linked-assoc> ( exemplar -- assoc )
0 swap new-assoc <dlist> linked-assoc boa ;
@ -13,20 +14,30 @@ TUPLE: linked-assoc assoc dlist ;
M: linked-assoc assoc-size assoc>> assoc-size ;
M: linked-assoc at* assoc>> at* [ [ obj>> second ] when ] keep ;
M: linked-assoc delete-at
[ [ assoc>> ] [ dlist>> ] bi [ at ] dip '[ _ delete-node ] when* ]
[ assoc>> delete-at ] 2bi ;
M: linked-assoc at*
assoc>> at* [ [ obj>> second-unsafe ] when ] keep ;
<PRIVATE
: add-to-dlist ( value key lassoc -- node )
[ swap 2array ] dip dlist>> push-back* ;
: (delete-at) ( key assoc dlist -- )
'[ at [ _ delete-node ] when* ] [ delete-at ] 2bi ; inline
PRIVATE>
M: linked-assoc delete-at
[ assoc>> ] [ dlist>> ] bi (delete-at) ;
<PRIVATE
: add-to-dlist ( value key dlist -- node )
[ swap 2array ] dip push-back* ; inline
PRIVATE>
M: linked-assoc set-at
[ 2dup assoc>> key? [ 2dup delete-at ] when add-to-dlist ] 2keep
assoc>> set-at ;
[ assoc>> ] [ dlist>> ] bi
'[ _ 2over key? [ 3dup (delete-at) ] when nip add-to-dlist ]
[ set-at ] 2bi ;
M: linked-assoc >alist
dlist>> dlist>sequence ;