basis/persistent/hashtables/hashtables.factor

   1 ! Based on Clojure's PersistentHashMap by Rich Hickey.
   2
   3 USING: accessors assocs combinators kernel make math
   4 parser persistent.assocs persistent.hashtables.nodes
   5 prettyprint.custom ;
   6
   7 IN: persistent.hashtables
   8
   9 TUPLE: persistent-hash
  10     { root read-only initial: empty-node }
  11     { count fixnum read-only } ;
  12
  13 M: persistent-hash assoc-size count>> ;
  14
  15 M: persistent-hash at*
  16      [ dup hashcode >fixnum ] [ root>> ] bi* (entry-at)
  17      dup [ value>> t ] [ f ] if ;
  18
  19 M: persistent-hash new-at
  20     [
  21         [ 0 ] 3dip
  22         [ dup hashcode >fixnum ] [ root>> ] bi* (new-at) 1 0 ?
  23     ] [ count>> ] bi + persistent-hash boa ;
  24
  25 M: persistent-hash pluck-at
  26     [ [ dup hashcode >fixnum ] [ root>> ] bi* (pluck-at) ] keep
  27     {
  28         { [ 2dup root>> eq? ] [ nip ] }
  29         { [ over not ] [ 2drop T{ persistent-hash } ] }
  30         [ count>> 1 - persistent-hash boa ]
  31     } cond ;
  32
  33 M: persistent-hash >alist [ root>> >alist% ] { } make ;
  34
  35 M: persistent-hash keys >alist keys ;
  36
  37 M: persistent-hash values >alist values ;
  38
  39 : >persistent-hash ( assoc -- phash )
  40     T{ persistent-hash } swap [ swap rot new-at ] assoc-each ;
  41
  42 M: persistent-hash equal?
  43     over persistent-hash? [ assoc= ] [ 2drop f ] if ;
  44
  45 M: persistent-hash hashcode* nip assoc-size ;
  46
  47 M: persistent-hash clone ;
  48
  49 SYNTAX: PH{ \ } [ >persistent-hash ] parse-literal ;
  50
  51 M: persistent-hash pprint-delims drop \ PH{ \ } ;
  52 M: persistent-hash >pprint-sequence >alist ;
  53 M: persistent-hash pprint* pprint-object ;
  54
  55 : passociate ( value key -- phash )
  56     T{ persistent-hash } new-at ; inline