steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

persistent.hashtables: cleanup.

flac
John Benediktsson 2020-01-28 16:22:33 -08:00 committed by Steve Ayerhart
parent ebd1b62a30
commit 3555f86bb9
No known key found for this signature in database
GPG Key ID: 5BFD39C5359E967D
1 changed files with 13 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
basis/persistent/hashtables/hashtables.factor
View File

@ -1,19 +1,14 @@
! Based on Clojure's PersistentHashMap by Rich Hickey. ! Based on Clojure's PersistentHashMap by Rich Hickey.
USING: kernel math accessors assocs fry combinators parser USING: accessors assocs combinators kernel make math
prettyprint.custom locals make sequences parser persistent.assocs persistent.hashtables.nodes
persistent.assocs prettyprint.custom ;
persistent.hashtables.nodes
persistent.hashtables.nodes.empty
persistent.hashtables.nodes.leaf
persistent.hashtables.nodes.full
persistent.hashtables.nodes.bitmap
persistent.hashtables.nodes.collision ;
IN: persistent.hashtables IN: persistent.hashtables
TUPLE: persistent-hash TUPLE: persistent-hash
{ root read-only initial: empty-node } { root read-only initial: empty-node }
{ count fixnum read-only } ; { count fixnum read-only } ;
M: persistent-hash assoc-size count>> ; M: persistent-hash assoc-size count>> ;
@ -21,13 +16,11 @@ M: persistent-hash at*
[ dup hashcode >fixnum ] [ root>> ] bi* (entry-at) [ dup hashcode >fixnum ] [ root>> ] bi* (entry-at)
dup [ value>> t ] [ f ] if ; dup [ value>> t ] [ f ] if ;
M: persistent-hash new-at ( value key assoc -- assoc' ) M: persistent-hash new-at
[ [
[ 0 ] 3dip [ 0 ] 3dip
[ dup hashcode >fixnum ] [ root>> ] bi* [ dup hashcode >fixnum ] [ root>> ] bi* (new-at) 1 0 ?
(new-at) 1 0 ? ] [ count>> ] bi + persistent-hash boa ;
] [ count>> ] bi +
persistent-hash boa ;
M: persistent-hash pluck-at M: persistent-hash pluck-at
[ [ dup hashcode >fixnum ] [ root>> ] bi* (pluck-at) ] keep [ [ dup hashcode >fixnum ] [ root>> ] bi* (pluck-at) ] keep
@ -39,12 +32,12 @@ M: persistent-hash pluck-at
M: persistent-hash >alist [ root>> >alist% ] { } make ; 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 ) : >persistent-hash ( assoc -- phash )
T{ persistent-hash } assoc [| ph k v | v k ph new-at ] assoc-each ; T{ persistent-hash } swap [ swap rot new-at ] assoc-each ;
M: persistent-hash equal? M: persistent-hash equal?
over persistent-hash? [ assoc= ] [ 2drop f ] if ; over persistent-hash? [ assoc= ] [ 2drop f ] if ;