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 <PRIVATE
   8
   9 TUPLE: identity-wrapper
  10     { underlying read-only } identity-hashcode ;
  11
  12 : <identity-wrapper> ( wrapped-key -- identity-wrapper )
  13     dup identity-hashcode identity-wrapper boa ; inline
  14
  15 M: identity-wrapper equal?
  16     over identity-wrapper?
  17     [ [ underlying>> ] bi@ eq? ]
  18     [ 2drop f ] if ; inline
  19
  20 M: identity-wrapper hashcode* nip identity-hashcode>> ; inline
  21
  22 PRIVATE>
  23
  24 TUPLE: identity-hash-set < wrapped-hash-set ;
  25
  26 : <identity-hash-set> ( n -- ihash-set )
  27     <hash-set> identity-hash-set boa ; inline
  28
  29 M: identity-hash-set wrap-key drop <identity-wrapper> ;
  30
  31 M: identity-hash-set clone
  32     underlying>> clone identity-hash-set boa ; inline
  33
  34 : >identity-hash-set ( members -- ihash-set )
  35     [ <identity-wrapper> ] map >hash-set identity-hash-set boa ; inline
  36
  37 M: identity-hash-set set-like
  38     drop dup identity-hash-set? [ ?members >identity-hash-set ] unless ; inline
  39
  40 SYNTAX: IHS{ \ } [ >identity-hash-set ] parse-literal ;
  41
  42 USE-WHEN-LOADED: hash-sets.identity.prettyprint { "hash-sets.identity" "prettyprint" }