hash-sets.identity: adding identity hashsets.

db4
John Benediktsson 2013-04-06 14:12:47 -07:00
parent 06754951d3
commit fd879b16c7
4 changed files with 73 additions and 0 deletions

View File

@ -0,0 +1 @@
John Benediktsson

View File

@ -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

View File

@ -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

View File

@ -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{ \ } ;