Squashed commit of the following:

commit 7b6b0bdf21bca0856bfefc1859618e6e36b35d25
Author: John Benediktsson <mrjbq7@gmail.com>
Date:   Mon Sep 26 21:09:07 2011 -0700

    hashtables.wrapped: cleanup common prettyprint code.

commit aaed81f93dcfa295bd3dfd8102a5c39511209934
Author: John Benediktsson <mrjbq7@gmail.com>
Date:   Sun Sep 25 15:58:55 2011 -0700

    hashtables.wrapped: cleaner >foo-hashtable.

commit bb0f8379480935d1dcf482170e8e2a4a519d81d3
Author: John Benediktsson <mrjbq7@gmail.com>
Date:   Sun Sep 25 15:39:41 2011 -0700

    hashtables.identity: migrate to use hashtables.wrapped.

commit 2e71b3324f0803c15a55429acddc13f06b4876ae
Author: John Benediktsson <mrjbq7@gmail.com>
Date:   Sun Sep 25 15:39:19 2011 -0700

    hashtables.sequences: wrapped hashtable that uses "sequence=" for key comparison.

commit 040f33b40c424887d596af5c3bd9de0eef9a682e
Author: John Benediktsson <mrjbq7@gmail.com>
Date:   Sun Sep 25 15:39:05 2011 -0700

    hashtables.wrapped: base class for "wrapped hashtables".

diff --git a/basis/hashtables/identity/identity.factor b/basis/hashtables/identity/identity.factor
index 5f1aeca636f0a9fabc87488e26cfb3d84561d2c9..88f4de5c92d8c87c6dc2ce50563d52a887634c6e 100644 (file)
--- a/basis/hashtables/identity/identity.factor
+++ b/basis/hashtables/identity/identity.factor
@@ -1,10 +1,10 @@
 ! (c)2010 Joe Groff bsd license\r
-USING: accessors arrays assocs fry hashtables kernel parser\r
-sequences vocabs.loader ;\r
+USING: accessors arrays assocs hashtables hashtables.wrapped\r
+kernel parser sequences vocabs.loader ;\r
 IN: hashtables.identity\r
 \r
-TUPLE: identity-wrapper\r
-    { underlying read-only } ;\r
+TUPLE: identity-wrapper < wrapped-key ;\r
+\r
 C: <identity-wrapper> identity-wrapper\r
 \r
 M: identity-wrapper equal?\r
@@ -15,46 +15,21 @@ M: identity-wrapper equal?
 M: identity-wrapper hashcode*\r
     nip underlying>> identity-hashcode ; inline\r
 \r
-TUPLE: identity-hashtable\r
-    { underlying hashtable read-only } ;\r
+TUPLE: identity-hashtable < wrapped-hashtable ;\r
 \r
 : <identity-hashtable> ( n -- ihash )\r
     <hashtable> identity-hashtable boa ; inline\r
 \r
-<PRIVATE\r
-: identity@ ( key ihash -- ikey hash )\r
-    [ <identity-wrapper> ] [ underlying>> ] bi* ; inline\r
-PRIVATE>\r
-\r
-M: identity-hashtable at*\r
-    identity@ at* ; inline\r
-\r
-M: identity-hashtable clear-assoc\r
-    underlying>> clear-assoc ; inline\r
-\r
-M: identity-hashtable delete-at\r
-    identity@ delete-at ; inline\r
-\r
-M: identity-hashtable assoc-size\r
-    underlying>> assoc-size ; inline\r
-\r
-M: identity-hashtable set-at\r
-    identity@ set-at ; inline\r
+M: identity-hashtable wrap-key drop <identity-wrapper> ;\r
 \r
-: identity-associate ( value key -- hash )\r
-    2 <identity-hashtable> [ set-at ] keep ; inline\r
-\r
-M: identity-hashtable >alist\r
-    underlying>> >alist [ [ first underlying>> ] [ second ] bi 2array ] map ;\r
-    \r
 M: identity-hashtable clone\r
     underlying>> clone identity-hashtable boa ; inline\r
 \r
-M: identity-hashtable equal?\r
-    over identity-hashtable? [ [ underlying>> ] bi@ = ] [ 2drop f ] if ;\r
+: identity-associate ( value key -- hash )\r
+    2 <identity-hashtable> [ set-at ] keep ; inline\r
 \r
 : >identity-hashtable ( assoc -- ihashtable )\r
-    dup assoc-size <identity-hashtable> [ '[ swap _ set-at ] assoc-each ] keep ;\r
+    [ assoc-size <identity-hashtable> ] keep assoc-union! ;\r
 \r
 SYNTAX: IH{ \ } [ >identity-hashtable ] parse-literal ;\r
 \r

diff --git a/basis/hashtables/identity/prettyprint/prettyprint.factor b/basis/hashtables/identity/prettyprint/prettyprint.factor
index 15a484925789052a163c4ee9b637c0ad448a4e83..e2dbd0b97241e0daabb4d07766287ba7633fab5a 100644 (file)
--- a/basis/hashtables/identity/prettyprint/prettyprint.factor
+++ b/basis/hashtables/identity/prettyprint/prettyprint.factor
@@ -1,12 +1,8 @@
-! (c)2010 Joe Groff bsd license\r
-USING: assocs continuations hashtables.identity kernel\r
-namespaces prettyprint.backend prettyprint.config\r
-prettyprint.custom ;\r
+! Copyright (C) 2010-2011 Joe Groff\r
+! See http://factorcode.org/license.txt for BSD license\r
+\r
+USING: hashtables.identity kernel prettyprint.custom ;\r
+\r
 IN: hashtables.identity.prettyprint\r
 \r
-M: identity-hashtable >pprint-sequence >alist ;\r
 M: identity-hashtable pprint-delims drop \ IH{ \ } ;\r
-\r
-M: identity-hashtable pprint*\r
-    nesting-limit inc\r
-    [ pprint-object ] [ nesting-limit dec ] [ ] cleanup ;\r

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

diff --git a/basis/hashtables/sequences/prettyprint/prettyprint.factor b/basis/hashtables/sequences/prettyprint/prettyprint.factor
new file mode 100644 (file)
index 0000000..8b80399
--- /dev/null
+++ b/basis/hashtables/sequences/prettyprint/prettyprint.factor
@@ -0,0 +1,8 @@
+! Copyright (C) 2011 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: hashtables.sequences kernel prettyprint.custom ;
+
+IN: hashtables.sequences.prettyprint
+
+M: sequence-hashtable pprint-delims drop \ SH{ \ } ;

diff --git a/basis/hashtables/sequences/sequences-tests.factor b/basis/hashtables/sequences/sequences-tests.factor
new file mode 100644 (file)
index 0000000..7fe68cc
--- /dev/null
+++ b/basis/hashtables/sequences/sequences-tests.factor
@@ -0,0 +1,22 @@
+! Copyright (C) 2011 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: assocs hashtables.sequences kernel literals sequences
+tools.test ;
+
+IN: hashtables.identity.tests
+
+[ 1000 ] [ 0 4 "asdf" <slice> SH{ { "asdf" 1000 } } at ] unit-test
+
+[ 1001 ] [
+    1001 0 4 "asdf" <slice> SH{ { "asdf" 1000 } }
+    [ set-at ] [ at ] 2bi
+] unit-test
+
+[ 1001 ] [
+    SH{ } clone 1001 0 4 "asdf" <slice> pick set-at
+    "asdf" swap at
+] unit-test
+
+[ { { "asdf" 1000 } } ] [ SH{ { "asdf" 1000 } } >alist ] unit-test
+

diff --git a/basis/hashtables/sequences/sequences.factor b/basis/hashtables/sequences/sequences.factor
new file mode 100644 (file)
index 0000000..fed1460
--- /dev/null
+++ b/basis/hashtables/sequences/sequences.factor
@@ -0,0 +1,36 @@
+! Copyright (C) 2011 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors assocs combinators hashtables
+hashtables.wrapped kernel parser sequences vocabs.loader ;
+
+IN: hashtables.sequences
+
+TUPLE: sequence-wrapper < wrapped-key ;
+
+C: <sequence-wrapper> sequence-wrapper
+
+M: sequence-wrapper equal?
+    over sequence-wrapper?
+    [ [ underlying>> ] bi@ sequence= ]
+    [ 2drop f ] if ; inline
+
+M: sequence-wrapper hashcode*
+    underlying>> [ sequence-hashcode ] recursive-hashcode ; inline
+
+TUPLE: sequence-hashtable < wrapped-hashtable ;
+
+: <sequence-hashtable> ( n -- ihash )
+    <hashtable> sequence-hashtable boa ; inline
+
+M: sequence-hashtable wrap-key drop <sequence-wrapper> ;
+
+M: sequence-hashtable clone
+    underlying>> clone sequence-hashtable boa ; inline
+
+: >sequence-hashtable ( assoc -- shashtable )
+    [ assoc-size <sequence-hashtable> ] keep assoc-union! ;
+
+SYNTAX: SH{ \ } [ >sequence-hashtable ] parse-literal ;
+
+{ "hashtables.sequences" "prettyprint" } "hashtables.sequences.prettyprint" require-when

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

diff --git a/basis/hashtables/wrapped/wrapped.factor b/basis/hashtables/wrapped/wrapped.factor
new file mode 100644 (file)
index 0000000..09a4d94
--- /dev/null
+++ b/basis/hashtables/wrapped/wrapped.factor
@@ -0,0 +1,45 @@
+! Copyright (C) 2011 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors arrays assocs fry hashtables kernel parser
+sequences vocabs.loader ;
+
+IN: hashtables.wrapped
+
+TUPLE: wrapped-key
+    { underlying read-only } ;
+
+TUPLE: wrapped-hashtable
+    { underlying hashtable read-only } ;
+
+GENERIC: wrap-key ( key wrapped-hash -- wrapped-key )
+
+<PRIVATE
+
+: wrapper@ ( key wrapped-hash -- wrapped-key hash )
+    [ wrap-key ] [ nip underlying>> ] 2bi ; inline
+
+PRIVATE>
+
+M: wrapped-hashtable at*
+    wrapper@ at* ; inline
+
+M: wrapped-hashtable clear-assoc
+    underlying>> clear-assoc ; inline
+
+M: wrapped-hashtable delete-at
+    wrapper@ delete-at ; inline
+
+M: wrapped-hashtable assoc-size
+    underlying>> assoc-size ; inline
+
+M: wrapped-hashtable set-at
+    wrapper@ set-at ; inline
+
+M: wrapped-hashtable >alist
+    underlying>> >alist [ [ first underlying>> ] [ second ] bi 2array ] map ;
+
+M: wrapped-hashtable equal?
+    over wrapped-hashtable? [ [ underlying>> ] bi@ = ] [ 2drop f ] if ;
+
+{ "hashtables.wrapped" "prettyprint" } "hashtables.wrapped.prettyprint" require-when