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