hash-sets.identity: adding identity hashsets.

basis/hash-sets/identity/authors.txt

@@ -0,0 +1 @@
+John Benediktsson

basis/hash-sets/identity/identity-tests.factor

@@ -0,0 +1,27 @@
+USING: hash-sets.identity kernel literals sets tools.test ;
+IN: hash-sets.identity.tests
+
+CONSTANT: the-real-slim-shady "marshall mathers"
+
+CONSTANT: will
+    IHS{
+        $ the-real-slim-shady
+        "marshall mathers"
+    }
+
+: please-stand-up ( set obj -- ? )
+    swap in? ;
+
+[ t ] [ will the-real-slim-shady please-stand-up ] unit-test
+[ t ] [ will clone the-real-slim-shady please-stand-up ] unit-test
+
+[ 2 ] [ will cardinality ] unit-test
+[ { "marshall mathers" } ] [
+    the-real-slim-shady will clone
+    [ delete ] [ members ] bi
+] unit-test
+
+CONSTANT: same-as-it-ever-was "same as it ever was"
+
+{ IHS{ $ same-as-it-ever-was } }
+[ HS{ $ same-as-it-ever-was } IHS{ } set-like ] unit-test

basis/hash-sets/identity/identity.factor

@@ -0,0 +1,37 @@
+! Copyright (C) 2013 John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors hash-sets hash-sets.wrapped kernel parser
+sequences sets sets.private vocabs.loader ;
+IN: hash-sets.identity
+
+TUPLE: identity-wrapper < wrapped-key identity-hashcode ;
+
+: <identity-wrapper> ( wrapped-key -- identity-wrapper )
+    dup identity-hashcode identity-wrapper boa ; inline
+
+M: identity-wrapper equal?
+    over identity-wrapper?
+    [ [ underlying>> ] bi@ eq? ]
+    [ 2drop f ] if ; inline
+
+M: identity-wrapper hashcode* nip identity-hashcode>> ; inline
+
+TUPLE: identity-hash-set < wrapped-hash-set ;
+
+: <identity-hash-set> ( n -- ihash-set )
+    <hash-set> identity-hash-set boa ; inline
+
+M: identity-hash-set wrap-key drop <identity-wrapper> ;
+
+M: identity-hash-set clone
+    underlying>> clone identity-hash-set boa ; inline
+
+: >identity-hash-set ( members -- ihash-set )
+    [ <identity-wrapper> ] map >hash-set identity-hash-set boa ; inline
+
+M: identity-hash-set set-like
+    drop dup identity-hash-set? [ ?members >identity-hash-set ] unless ; inline
+
+SYNTAX: IHS{ \ } [ >identity-hash-set ] parse-literal ;
+
+{ "hash-sets.identity" "prettyprint" } "hash-sets.identity.prettyprint" require-when

basis/hash-sets/identity/prettyprint/prettyprint.factor

@@ -0,0 +1,8 @@
+! Copyright (C) 2013 John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license
+
+USING: hash-sets.identity kernel prettyprint.custom ;
+
+IN: hash-sets.identity.prettyprint
+
+M: identity-hash-set pprint-delims drop \ IHS{ \ } ;