linked-assocs: some performance improvements.

basis/linked-assocs/linked-assocs.factor

@@ -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 ;