basis/hash-sets/identity/identity.factor

   1 ! Copyright (C) 2013 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors hash-sets hash-sets.wrapped kernel parser
   4 sequences sets sets.private vocabs.loader ;
   5 IN: hash-sets.identity
   6
   7 TUPLE: identity-wrapper < wrapped-key identity-hashcode ;
   8
   9 : <identity-wrapper> ( wrapped-key -- identity-wrapper )
  10     dup identity-hashcode identity-wrapper boa ; inline
  11
  12 M: identity-wrapper equal?
  13     over identity-wrapper?
  14     [ [ underlying>> ] bi@ eq? ]
  15     [ 2drop f ] if ; inline
  16
  17 M: identity-wrapper hashcode* nip identity-hashcode>> ; inline
  18
  19 TUPLE: identity-hash-set < wrapped-hash-set ;
  20
  21 : <identity-hash-set> ( n -- ihash-set )
  22     <hash-set> identity-hash-set boa ; inline
  23
  24 M: identity-hash-set wrap-key drop <identity-wrapper> ;
  25
  26 M: identity-hash-set clone
  27     underlying>> clone identity-hash-set boa ; inline
  28
  29 : >identity-hash-set ( members -- ihash-set )
  30     [ <identity-wrapper> ] map >hash-set identity-hash-set boa ; inline
  31
  32 M: identity-hash-set set-like
  33     drop dup identity-hash-set? [ ?members >identity-hash-set ] unless ; inline
  34
  35 SYNTAX: IHS{ \ } [ >identity-hash-set ] parse-literal ;
  36
  37 { "hash-sets.identity" "prettyprint" } "hash-sets.identity.prettyprint" require-when