linked-sets: adding an ordered-set.

(yes, it's an instance of unordered-set, patches to follow).

diff --git a/basis/linked-sets/authors.txt b/basis/linked-sets/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/basis/linked-sets/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/basis/linked-sets/linked-sets-tests.factor b/basis/linked-sets/linked-sets-tests.factor
new file mode 100644 (file)
index 0000000..8a45754
--- /dev/null
+++ b/basis/linked-sets/linked-sets-tests.factor
@@ -0,0 +1,42 @@
+USING: kernel linked-sets sets tools.test ;
+
+{ V{ 1 2 3 } 3 } [
+    0 <linked-set> 1 over adjoin
+                   2 over adjoin
+                   3 over adjoin
+    [ members ] [ cardinality ] bi
+] unit-test
+
+{ V{ 1 3 } 2 } [
+    0 <linked-set> 1 over adjoin
+                   2 over adjoin
+                   3 over adjoin
+                   2 over delete
+    [ members ] [ cardinality ] bi
+] unit-test
+
+{ V{ 1 3 4 } 3 } [
+    0 <linked-set> 1 over adjoin
+                   2 over adjoin
+                   3 over adjoin
+                   2 over delete
+                   4 over adjoin
+    [ members ] [ cardinality ] bi
+] unit-test
+
+{ V{ } 0 } [
+    0 <linked-set> 1 over adjoin
+                   2 over adjoin
+                   3 over adjoin
+                   dup clear-set
+    [ members ] [ cardinality ] bi
+] unit-test
+
+{ V{ 1 2 3 } 3 } [
+    { 1 2 3 } >linked-set
+    [ members ] [ cardinality ] bi
+] unit-test
+
+{ t } [
+    { 1 2 3 } [ >linked-set ] [ >linked-set ] bi =
+] unit-test

diff --git a/basis/linked-sets/linked-sets.factor b/basis/linked-sets/linked-sets.factor
new file mode 100644 (file)
index 0000000..46545c4
--- /dev/null
+++ b/basis/linked-sets/linked-sets.factor
@@ -0,0 +1,49 @@
+! Copyright (C) 2016 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs deques dlists fry hashtables
+kernel linked-assocs sets ;
+IN: linked-sets
+
+TUPLE: linked-set { assoc hashtable read-only } { dlist dlist read-only } ;
+
+: <linked-set> ( capacity -- linked-set )
+    <hashtable> <dlist> linked-set boa ;
+
+M: linked-set in? assoc>> key? ;
+
+M: linked-set clear-set
+    [ assoc>> clear-assoc ] [ dlist>> clear-deque ] bi ;
+
+<PRIVATE
+
+: (delete-at) ( key assoc dlist -- )
+    '[ at [ _ delete-node ] when* ] [ delete-at ] 2bi ; inline
+
+PRIVATE>
+
+M: linked-set delete
+    [ assoc>> ] [ dlist>> ] bi (delete-at) ;
+
+M: linked-set cardinality assoc>> assoc-size ;
+
+M: linked-set adjoin
+    [ assoc>> ] [ dlist>> ] bi
+    '[ _ 2over key? [ 3dup (delete-at) ] when nip push-back* ]
+    [ set-at ] 2bi ;
+
+M: linked-set members
+    dlist>> dlist>sequence ;
+
+M: linked-set clone
+    [ assoc>> clone ] [ dlist>> clone ] bi linked-set boa ;
+
+M: linked-set equal?
+    over linked-set? [ [ dlist>> ] bi@ = ] [ 2drop f ] if ;
+
+: >linked-set ( set -- linked-set )
+    [ 0 <linked-set> ] dip union! ;
+
+INSTANCE: linked-set unordered-set
+
+M: linked-set set-like
+    drop dup linked-set? [ >linked-set ] unless ;