Add >biassoc word, and define new-assoc on biassocs so that assoc-map and such can...

diff --git a/basis/biassocs/biassocs-docs.factor b/basis/biassocs/biassocs-docs.factor
index 1fde3d05b30c72c9d6abfd2a722f986c2ceec4b9..31258a7ddc1e847d15e203a719486b5acdfe5815 100644 (file)
--- a/basis/biassocs/biassocs-docs.factor
+++ b/basis/biassocs/biassocs-docs.factor
@@ -16,13 +16,22 @@ HELP: once-at
 { $values { "value" object } { "key" object } { "assoc" assoc } }
 { $description "If the assoc does not contain the given key, adds the key/value pair to the assoc, otherwise does nothing." } ;
 
+HELP: >biassoc
+{ $values { "assoc" assoc } { "biassoc" biassoc } }
+{ $description "Costructs a new biassoc with the same key/value pairs as the given assoc." } ;
+
 ARTICLE: "biassocs" "Bidirectional assocs"
 "A " { $emphasis "bidirectional assoc" } " combines a pair of assocs to form a data structure where both normal assoc opeartions (eg, " { $link at } "), as well as " { $link "assocs-values" } " (eg, " { $link value-at } ") run in sub-linear time."
 $nl
-"Bidirectional assocs implement the entire assoc protocol with the exception of " { $link delete-at } ". Duplicate values are allowed, however value lookups with " { $link value-at } " only return the first key that a given value was stored with."
+"Bidirectional assocs implement the entire " { $link "assoc-protocol" } " with the exception of " { $link delete-at } ". Duplicate values are allowed, however value lookups with " { $link value-at } " only return the first key that a given value was stored with."
+$nl
+"The class of biassocs:"
 { $subsection biassoc }
 { $subsection biassoc? }
+"Creating new biassocs:"
 { $subsection <biassoc> }
-{ $subsection <bihash> } ;
+{ $subsection <bihash> }
+"Converting existing assocs to biassocs:"
+{ $subsection >biassoc } ;
 
 ABOUT: "biassocs"

diff --git a/basis/biassocs/biassocs-tests.factor b/basis/biassocs/biassocs-tests.factor
index 4cd7f00f80836836b09e702285c6b1bb975197c1..f408cc82a8be1ffabd378af6814a78c11b65fa05 100644 (file)
--- a/basis/biassocs/biassocs-tests.factor
+++ b/basis/biassocs/biassocs-tests.factor
@@ -20,3 +20,13 @@ USING: biassocs assocs namespaces tools.test ;
 [ 2 ] [ 1 "h" get value-at ] unit-test
 
 [ 2 ] [ "h" get assoc-size ] unit-test
+
+H{ { "a" "A" } { "b" "B" } } "a" set
+
+[ ] [ "a" get >biassoc "b" set ] unit-test
+
+[ t ] [ "b" get biassoc? ] unit-test
+
+[ "A" ] [ "a" "b" get at ] unit-test
+
+[ "a" ] [ "A" "b" get value-at ] unit-test
\ No newline at end of file

diff --git a/basis/biassocs/biassocs.factor b/basis/biassocs/biassocs.factor
index a9f0cabd1036f5cdcc76edf3dc251ac157da140f..5956589ba56eefce12c97af5c7276426bff61652 100644 (file)
--- a/basis/biassocs/biassocs.factor
+++ b/basis/biassocs/biassocs.factor
@@ -1,6 +1,6 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs accessors summary ;
+USING: kernel assocs accessors summary hashtables ;
 IN: biassocs
 
 TUPLE: biassoc from to ;
@@ -37,4 +37,10 @@ M: biassoc >alist
 M: biassoc clear-assoc
     [ from>> clear-assoc ] [ to>> clear-assoc ] bi ;
 
+M: biassoc new-assoc
+    drop [ <hashtable> ] [ <hashtable> ] bi biassoc boa ;
+
 INSTANCE: biassoc assoc
+
+: >biassoc ( assoc -- biassoc )
+    T{ biassoc } assoc-clone-like ;
\ No newline at end of file