Skip to content

Commit

Permalink
persistent.hashtables: cleanup.
Browse files Browse the repository at this point in the history
  • Loading branch information
mrjbq7 committed Jan 29, 2020
1 parent 548109b commit 6aa8f64
Showing 1 changed file with 13 additions and 20 deletions.
33 changes: 13 additions & 20 deletions basis/persistent/hashtables/hashtables.factor
@@ -1,33 +1,26 @@
! Based on Clojure's PersistentHashMap by Rich Hickey.

USING: kernel math accessors assocs fry combinators parser
prettyprint.custom locals make sequences
persistent.assocs
persistent.hashtables.nodes
persistent.hashtables.nodes.empty
persistent.hashtables.nodes.leaf
persistent.hashtables.nodes.full
persistent.hashtables.nodes.bitmap
persistent.hashtables.nodes.collision ;
USING: accessors assocs combinators kernel make math
parser persistent.assocs persistent.hashtables.nodes
prettyprint.custom ;

IN: persistent.hashtables

TUPLE: persistent-hash
{ root read-only initial: empty-node }
{ count fixnum read-only } ;
{ root read-only initial: empty-node }
{ count fixnum read-only } ;

M: persistent-hash assoc-size count>> ;

M: persistent-hash at*
[ dup hashcode >fixnum ] [ root>> ] bi* (entry-at)
dup [ value>> t ] [ f ] if ;

M: persistent-hash new-at ( value key assoc -- assoc' )
M: persistent-hash new-at
[
[ 0 ] 3dip
[ dup hashcode >fixnum ] [ root>> ] bi*
(new-at) 1 0 ?
] [ count>> ] bi +
persistent-hash boa ;
[ dup hashcode >fixnum ] [ root>> ] bi* (new-at) 1 0 ?
] [ count>> ] bi + persistent-hash boa ;

M: persistent-hash pluck-at
[ [ dup hashcode >fixnum ] [ root>> ] bi* (pluck-at) ] keep
Expand All @@ -39,12 +32,12 @@ M: persistent-hash pluck-at

M: persistent-hash >alist [ root>> >alist% ] { } make ;

M: persistent-hash keys >alist [ first ] map ;
M: persistent-hash keys >alist keys ;

M: persistent-hash values >alist [ second ] map ;
M: persistent-hash values >alist values ;

:: >persistent-hash ( assoc -- phash )
T{ persistent-hash } assoc [| ph k v | v k ph new-at ] assoc-each ;
: >persistent-hash ( assoc -- phash )
T{ persistent-hash } swap [ swap rot new-at ] assoc-each ;

M: persistent-hash equal?
over persistent-hash? [ assoc= ] [ 2drop f ] if ;
Expand Down

0 comments on commit 6aa8f64

Please sign in to comment.