basis/persistent/hashtables/hashtables.factor

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