hash-sets.wrapped: support for "wrapped" hash-sets.

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

diff --git a/basis/hash-sets/wrapped/prettyprint/prettyprint.factor b/basis/hash-sets/wrapped/prettyprint/prettyprint.factor
new file mode 100644 (file)
index 0000000..a8b0bb0
--- /dev/null
+++ b/basis/hash-sets/wrapped/prettyprint/prettyprint.factor
@@ -0,0 +1,15 @@
+! Copyright (C) 2013 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: continuations hash-sets.wrapped namespaces
+prettyprint.config prettyprint.custom sets ;
+
+IN: hash-sets.wrapped.prettyprint
+
+M: wrapped-hash-set >pprint-sequence members ;
+
+M: wrapped-hash-set pprint*
+    nesting-limit inc
+    [ pprint-object ] [ nesting-limit dec ] [ ] cleanup ;
+
+

diff --git a/basis/hash-sets/wrapped/wrapped.factor b/basis/hash-sets/wrapped/wrapped.factor
new file mode 100644 (file)
index 0000000..b70b7da
--- /dev/null
+++ b/basis/hash-sets/wrapped/wrapped.factor
@@ -0,0 +1,50 @@
+! Copyright (C) 2013 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors arrays hash-sets kernel sequences sets
+vocabs.loader ;
+
+IN: hash-sets.wrapped
+
+TUPLE: wrapped-key
+    { underlying read-only } ;
+
+TUPLE: wrapped-hash-set
+    { underlying hash-set read-only } ;
+
+GENERIC: wrap-key ( key wrapped-hash -- wrapped-key )
+
+<PRIVATE
+
+: wrapper@ ( key wrapped-hash -- wrapped-key hash-set )
+    [ wrap-key ] [ nip underlying>> ] 2bi ; inline
+
+PRIVATE>
+
+M: wrapped-hash-set adjoin
+    wrapper@ adjoin ; inline
+
+M: wrapped-hash-set ?adjoin
+    wrapper@ ?adjoin ; inline
+
+M: wrapped-hash-set in?
+    wrapper@ in? ; inline
+
+M: wrapped-hash-set clear-set
+    underlying>> clear-set ; inline
+
+M: wrapped-hash-set delete
+    wrapper@ delete ; inline
+
+M: wrapped-hash-set cardinality
+    underlying>> cardinality ; inline
+
+M: wrapped-hash-set members
+    underlying>> members [ underlying>> ] map ;
+
+M: wrapped-hash-set equal?
+    over wrapped-hash-set? [ [ underlying>> ] same? ] [ 2drop f ] if ;
+
+INSTANCE: wrapped-hash-set set
+
+{ "hash-sets.wrapped" "prettyprint" } "hash-sets.wrapped.prettyprint" require-when