Adding linked-assocs

diff --git a/basis/linked-assocs/authors.txt b/basis/linked-assocs/authors.txt
new file mode 100644 (file)
index 0000000..35a4db1
--- /dev/null
+++ b/basis/linked-assocs/authors.txt
@@ -0,0 +1,2 @@
+Slava Pestov
+James Cash

diff --git a/basis/linked-assocs/linked-assocs-docs.factor b/basis/linked-assocs/linked-assocs-docs.factor
new file mode 100644 (file)
index 0000000..74a5fb5
--- /dev/null
+++ b/basis/linked-assocs/linked-assocs-docs.factor
@@ -0,0 +1,3 @@
+IN: linked-assocs
+USING: help.markup help.syntax ;
+

diff --git a/basis/linked-assocs/linked-assocs-tests.factor b/basis/linked-assocs/linked-assocs-tests.factor
new file mode 100644 (file)
index 0000000..3ac5900
--- /dev/null
+++ b/basis/linked-assocs/linked-assocs-tests.factor
@@ -0,0 +1,26 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences assocs tools.test linked-assocs ;
+IN: linked-assocs.test
+
+{ { 1 2 3 } } [
+    <linked-hash> 1 "b" pick set-at
+                  2 "c" pick set-at
+                  3 "a" pick set-at
+    values
+] unit-test
+
+{ 2 t } [
+    <linked-hash> 1 "b" pick set-at
+                  2 "c" pick set-at
+                  3 "a" pick set-at
+    "c" swap at*
+] unit-test
+
+{ { 2 3 4 } { "c" "a" "d" } } [
+    <linked-hash> 1 "a" pick set-at
+                  2 "c" pick set-at
+                  3 "a" pick set-at
+                  4 "d" pick set-at
+    [ values ] [ keys ] bi 
+] unit-test 
\ No newline at end of file

diff --git a/basis/linked-assocs/linked-assocs.factor b/basis/linked-assocs/linked-assocs.factor
new file mode 100644 (file)
index 0000000..f984932
--- /dev/null
+++ b/basis/linked-assocs/linked-assocs.factor
@@ -0,0 +1,38 @@
+! Copyright (C) 2008 Slava Pestov, James Cash.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs arrays kernel deques dlists sequences hashtables fry ;
+IN: linked-assocs
+
+TUPLE: linked-assoc assoc dlist ;
+
+: <linked-hash> ( -- assoc )
+    0 <hashtable> <dlist> linked-assoc boa ;
+
+M: linked-assoc assoc-size assoc>> assoc-size ;
+
+M: linked-assoc at* assoc>> at* tuck [ obj>> ] when 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
+    [ [ assoc>> ] [ dlist>> ] bi [ at ] dip '[ _ delete-node ] when* ]
+    [ assoc>> delete-at ]
+    2bi ;
+
+: dlist>seq ( dlist -- seq )
+    [ ] pusher [ dlist-each ] dip ;
+
+M: linked-assoc >alist
+    dlist>> dlist>seq ;
+
+INSTANCE: linked-assoc assoc

diff --git a/basis/linked-assocs/summary.txt b/basis/linked-assocs/summary.txt
new file mode 100644 (file)
index 0000000..54b0d14
--- /dev/null
+++ b/basis/linked-assocs/summary.txt
@@ -0,0 +1 @@
+Assocs that yield items in insertion order

diff --git a/basis/linked-assocs/tags.txt b/basis/linked-assocs/tags.txt
new file mode 100644 (file)
index 0000000..031765c
--- /dev/null
+++ b/basis/linked-assocs/tags.txt
@@ -0,0 +1 @@
+assocs