hash-sets.identity: adding identity hashsets.
parent
06754951d3
commit
fd879b16c7
|
@ -0,0 +1 @@
|
||||||
|
John Benediktsson
|
|
@ -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
|
|
@ -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
|
|
@ -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{ \ } ;
|
Loading…
Reference in New Issue