From 3d2871ca617c67f170f52c6dae152f0076103f32 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 5 Aug 2008 22:56:42 -0700 Subject: [PATCH 1/6] Removing dependency of persistent heaps on multimethods --- extra/persistent-heaps/persistent-heaps.factor | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/extra/persistent-heaps/persistent-heaps.factor b/extra/persistent-heaps/persistent-heaps.factor index 5b57898da0..e7e8213a4a 100644 --- a/extra/persistent-heaps/persistent-heaps.factor +++ b/extra/persistent-heaps/persistent-heaps.factor @@ -1,4 +1,4 @@ -USING: kernel accessors multi-methods locals combinators math arrays +USING: kernel accessors locals combinators math arrays assocs namespaces sequences ; IN: persistent-heaps ! These are minheaps @@ -36,14 +36,15 @@ PRIVATE> GENERIC: sift-down ( value prio left right -- heap ) -METHOD: sift-down { empty-heap empty-heap } ; - -METHOD: sift-down { singleton-heap empty-heap } +: sift-singleton ( value prio left right -- heap ) 3dup drop prio>> <= [ ] [ drop -rot [ [ value>> ] [ prio>> ] bi ] 2dip ] if ; +M: empty-heap sift-down + over empty-heap? [ ] [ sift-singleton ] if ; + :: reroot-left ( value prio left right -- heap ) left value>> left prio>> value prio left left>> left right>> sift-down @@ -54,7 +55,7 @@ METHOD: sift-down { singleton-heap empty-heap } value prio right left>> right right>> sift-down ; -METHOD: sift-down { branch branch } +M: branch sift-down 3dup [ prio>> <= ] both-with? [ ] [ 2dup [ prio>> ] bi@ <= [ reroot-left ] [ reroot-right ] if ] if ; From 3430c69c1e96cfcd86f9825cd82848c16e3e381b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Aug 2008 01:06:14 -0500 Subject: [PATCH 2/6] Re-organize persistent data structures --- extra/math/bit-count/bit-count.factor | 38 ++++++ extra/persistent-vectors/summary.txt | 1 - extra/persistent/assocs/assocs.factor | 12 ++ .../assocs}/authors.txt | 0 extra/persistent/assocs/summary.txt | 1 + .../assocs}/tags.txt | 0 extra/persistent/hashtables/authors.txt | 1 + .../hashtables/config/config.factor | 8 ++ .../hashtables/hashtables-tests.factor | 119 ++++++++++++++++++ extra/persistent/hashtables/hashtables.factor | 48 +++++++ .../hashtables/nodes/bitmap/bitmap.factor | 87 +++++++++++++ .../nodes/collision/collision.factor | 59 +++++++++ .../hashtables/nodes/empty/empty.factor | 15 +++ .../hashtables/nodes/full/full.factor | 51 ++++++++ .../hashtables/nodes/leaf/leaf.factor | 28 +++++ .../persistent/hashtables/nodes/nodes.factor | 64 ++++++++++ extra/persistent/hashtables/summary.txt | 1 + .../hashtables}/tags.txt | 0 .../heaps}/authors.txt | 0 .../heaps/heaps-docs.factor} | 2 +- .../heaps/heaps-tests.factor} | 4 +- .../heaps/heaps.factor} | 13 +- .../heaps}/summary.txt | 0 extra/persistent/heaps/tags.txt | 1 + extra/persistent/sequences/authors.txt | 1 + .../sequences/sequences-docs.factor | 17 +++ extra/persistent/sequences/sequences.factor | 16 +++ extra/persistent/sequences/summary.txt | 1 + extra/persistent/sequences/tags.txt | 1 + extra/persistent/vectors/authors.txt | 1 + extra/persistent/vectors/summary.txt | 1 + extra/persistent/vectors/tags.txt | 1 + .../vectors/vectors-docs.factor} | 15 --- .../vectors/vectors-tests.factor} | 5 +- .../vectors/vectors.factor} | 17 +-- extra/sequences/lib/lib.factor | 7 +- 36 files changed, 592 insertions(+), 44 deletions(-) create mode 100644 extra/math/bit-count/bit-count.factor delete mode 100644 extra/persistent-vectors/summary.txt create mode 100644 extra/persistent/assocs/assocs.factor rename extra/{persistent-vectors => persistent/assocs}/authors.txt (100%) create mode 100644 extra/persistent/assocs/summary.txt rename extra/{persistent-heaps => persistent/assocs}/tags.txt (100%) create mode 100644 extra/persistent/hashtables/authors.txt create mode 100644 extra/persistent/hashtables/config/config.factor create mode 100644 extra/persistent/hashtables/hashtables-tests.factor create mode 100644 extra/persistent/hashtables/hashtables.factor create mode 100644 extra/persistent/hashtables/nodes/bitmap/bitmap.factor create mode 100644 extra/persistent/hashtables/nodes/collision/collision.factor create mode 100644 extra/persistent/hashtables/nodes/empty/empty.factor create mode 100644 extra/persistent/hashtables/nodes/full/full.factor create mode 100644 extra/persistent/hashtables/nodes/leaf/leaf.factor create mode 100644 extra/persistent/hashtables/nodes/nodes.factor create mode 100644 extra/persistent/hashtables/summary.txt rename extra/{persistent-vectors => persistent/hashtables}/tags.txt (100%) rename extra/{persistent-heaps => persistent/heaps}/authors.txt (100%) rename extra/{persistent-heaps/persistent-heaps-docs.factor => persistent/heaps/heaps-docs.factor} (99%) rename extra/{persistent-heaps/persistent-heaps-tests.factor => persistent/heaps/heaps-tests.factor} (82%) rename extra/{persistent-heaps/persistent-heaps.factor => persistent/heaps/heaps.factor} (92%) rename extra/{persistent-heaps => persistent/heaps}/summary.txt (100%) create mode 100644 extra/persistent/heaps/tags.txt create mode 100644 extra/persistent/sequences/authors.txt create mode 100644 extra/persistent/sequences/sequences-docs.factor create mode 100644 extra/persistent/sequences/sequences.factor create mode 100644 extra/persistent/sequences/summary.txt create mode 100644 extra/persistent/sequences/tags.txt create mode 100644 extra/persistent/vectors/authors.txt create mode 100644 extra/persistent/vectors/summary.txt create mode 100644 extra/persistent/vectors/tags.txt rename extra/{persistent-vectors/persistent-vectors-docs.factor => persistent/vectors/vectors-docs.factor} (60%) rename extra/{persistent-vectors/persistent-vectors-tests.factor => persistent/vectors/vectors-tests.factor} (92%) rename extra/{persistent-vectors/persistent-vectors.factor => persistent/vectors/vectors.factor} (95%) diff --git a/extra/math/bit-count/bit-count.factor b/extra/math/bit-count/bit-count.factor new file mode 100644 index 0000000000..f5b0cc53df --- /dev/null +++ b/extra/math/bit-count/bit-count.factor @@ -0,0 +1,38 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.functions quotations words sequences +sequences.private combinators fry ; +IN: math.bit-count + +> + +GENERIC: (bit-count) ( x -- n ) + +M: fixnum (bit-count) + { + [ byte-bit-count ] + [ -8 shift byte-bit-count ] + [ -16 shift byte-bit-count ] + [ -24 shift byte-bit-count ] + } cleave + + + ; + +M: bignum (bit-count) + dup 0 = [ drop 0 ] [ + [ byte-bit-count ] [ -8 shift (bit-count) ] bi + + ] if ; + +PRIVATE> + +: bit-count ( x -- n ) + dup 0 >= [ (bit-count) ] [ bitnot (bit-count) ] if ; inline diff --git a/extra/persistent-vectors/summary.txt b/extra/persistent-vectors/summary.txt deleted file mode 100644 index 19f3f66ca3..0000000000 --- a/extra/persistent-vectors/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Immutable vectors with O(log_32 n) random access and amortized O(1) push/pop diff --git a/extra/persistent/assocs/assocs.factor b/extra/persistent/assocs/assocs.factor new file mode 100644 index 0000000000..8ea88caf33 --- /dev/null +++ b/extra/persistent/assocs/assocs.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel assocs ; +IN: persistent.assocs + +GENERIC: new-at ( value key phash -- phash' ) + +M: assoc new-at clone [ set-at ] keep ; + +GENERIC: pluck-at ( key phash -- phash' ) + +M: assoc pluck-at clone [ delete-at ] keep ; diff --git a/extra/persistent-vectors/authors.txt b/extra/persistent/assocs/authors.txt similarity index 100% rename from extra/persistent-vectors/authors.txt rename to extra/persistent/assocs/authors.txt diff --git a/extra/persistent/assocs/summary.txt b/extra/persistent/assocs/summary.txt new file mode 100644 index 0000000000..5fe330f444 --- /dev/null +++ b/extra/persistent/assocs/summary.txt @@ -0,0 +1 @@ +Persistent associative mapping protocol diff --git a/extra/persistent-heaps/tags.txt b/extra/persistent/assocs/tags.txt similarity index 100% rename from extra/persistent-heaps/tags.txt rename to extra/persistent/assocs/tags.txt diff --git a/extra/persistent/hashtables/authors.txt b/extra/persistent/hashtables/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/persistent/hashtables/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/persistent/hashtables/config/config.factor b/extra/persistent/hashtables/config/config.factor new file mode 100644 index 0000000000..a761e2d327 --- /dev/null +++ b/extra/persistent/hashtables/config/config.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: layouts kernel parser math ; +IN: persistent.hashtables.config + +: radix-bits ( -- n ) << cell 4 = 4 5 ? parsed >> ; foldable +: radix-mask ( -- n ) radix-bits 2^ 1- ; foldable +: full-bitmap-mask ( -- n ) radix-bits 2^ 2^ 1- ; inline diff --git a/extra/persistent/hashtables/hashtables-tests.factor b/extra/persistent/hashtables/hashtables-tests.factor new file mode 100644 index 0000000000..2c8ffaee00 --- /dev/null +++ b/extra/persistent/hashtables/hashtables-tests.factor @@ -0,0 +1,119 @@ +IN: persistent.hashtables.tests +USING: persistent.hashtables persistent.assocs hashtables assocs +tools.test kernel namespaces random math.ranges sequences fry ; + +[ t ] [ PH{ } assoc-empty? ] unit-test + +[ PH{ { "A" "B" } } ] [ PH{ } "B" "A" rot new-at ] unit-test + +[ "B" ] [ "A" PH{ { "A" "B" } } at ] unit-test + +[ f ] [ "X" PH{ { "A" "B" } } at ] unit-test + +TUPLE: hash-0-a ; + +M: hash-0-a hashcode* 2drop 0 ; + +TUPLE: hash-0-b ; + +M: hash-0-b hashcode* 2drop 0 ; + +[ ] [ + PH{ } + "a" T{ hash-0-a } rot new-at + "b" T{ hash-0-b } rot new-at + "ph" set +] unit-test + +[ + H{ + { T{ hash-0-a } "a" } + { T{ hash-0-b } "b" } + } +] [ "ph" get >hashtable ] unit-test + +[ + H{ + { T{ hash-0-b } "b" } + } +] [ "ph" get T{ hash-0-a } swap pluck-at >hashtable ] unit-test + +[ + H{ + { T{ hash-0-a } "a" } + } +] [ "ph" get T{ hash-0-b } swap pluck-at >hashtable ] unit-test + +[ + H{ + { T{ hash-0-a } "a" } + { T{ hash-0-b } "b" } + } +] [ "ph" get "X" swap pluck-at >hashtable ] unit-test + +[ ] [ + PH{ } + "B" "A" rot new-at + "D" "C" rot new-at + "ph" set +] unit-test + +[ H{ { "A" "B" } { "C" "D" } } ] [ + "ph" get >hashtable +] unit-test + +[ H{ { "C" "D" } } ] [ + "ph" get "A" swap pluck-at >hashtable +] unit-test + +[ H{ { "A" "B" } { "C" "D" } { "E" "F" } } ] [ + "ph" get "F" "E" rot new-at >hashtable +] unit-test + +[ H{ { "C" "D" } { "E" "F" } } ] [ + "ph" get "F" "E" rot new-at "A" swap pluck-at >hashtable +] unit-test + +: random-string ( -- str ) + 100 random [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ; + +: random-assocs ( -- hash phash ) + [ random-string ] replicate + [ H{ } clone [ '[ swap , set-at ] each-index ] keep ] + [ PH{ } clone swap [ spin new-at ] each-index ] + bi ; + +: ok? ( assoc1 assoc2 -- ? ) + [ assoc= ] [ [ assoc-size ] bi@ = ] 2bi and ; + +: test-persistent-hashtables-1 ( n -- ) + random-assocs ok? ; + +! [ t ] [ 10 test-persistent-hashtables-1 ] unit-test +! [ t ] [ 20 test-persistent-hashtables-1 ] unit-test +! [ t ] [ 30 test-persistent-hashtables-1 ] unit-test +! [ t ] [ 50 test-persistent-hashtables-1 ] unit-test +! [ t ] [ 100 test-persistent-hashtables-1 ] unit-test +! [ t ] [ 500 test-persistent-hashtables-1 ] unit-test +! [ t ] [ 1000 test-persistent-hashtables-1 ] unit-test +! [ t ] [ 5000 test-persistent-hashtables-1 ] unit-test +! [ t ] [ 10000 test-persistent-hashtables-1 ] unit-test +! [ t ] [ 50000 test-persistent-hashtables-1 ] unit-test + +: test-persistent-hashtables-2 ( n -- ) + random-assocs + dup keys [ + [ nip over delete-at ] [ swap pluck-at nip ] 3bi + 2dup ok? + ] all? 2nip ; + +[ t ] [ 10 test-persistent-hashtables-2 ] unit-test +[ t ] [ 20 test-persistent-hashtables-2 ] unit-test +[ t ] [ 30 test-persistent-hashtables-2 ] unit-test +[ t ] [ 50 test-persistent-hashtables-2 ] unit-test +[ t ] [ 100 test-persistent-hashtables-2 ] unit-test +[ t ] [ 500 test-persistent-hashtables-2 ] unit-test +[ t ] [ 1000 test-persistent-hashtables-2 ] unit-test +[ t ] [ 5000 test-persistent-hashtables-2 ] unit-test +[ t ] [ 10000 test-persistent-hashtables-2 ] unit-test +[ t ] [ 50000 test-persistent-hashtables-2 ] unit-test diff --git a/extra/persistent/hashtables/hashtables.factor b/extra/persistent/hashtables/hashtables.factor new file mode 100644 index 0000000000..a68fa7c365 --- /dev/null +++ b/extra/persistent/hashtables/hashtables.factor @@ -0,0 +1,48 @@ +! Based on Clojure's PersistentHashMap by Rich Hickey. + +USING: kernel math accessors assocs fry combinators parser +prettyprint.backend namespaces +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 ; +IN: persistent.hashtables + +TUPLE: persistent-hash +{ 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' ) + [ + { [ 0 ] [ ] [ dup hashcode >fixnum ] [ root>> ] } spread + (new-at) 1 0 ? + ] [ count>> ] bi + + persistent-hash boa ; + +M: persistent-hash pluck-at + [ [ dup hashcode >fixnum ] [ root>> ] bi* (pluck-at) ] keep + { + { [ 2dup root>> eq? ] [ nip ] } + { [ over not ] [ 2drop T{ persistent-hash } ] } + [ count>> 1- persistent-hash boa ] + } cond ; + +M: persistent-hash >alist [ root>> >alist% ] { } make ; + +: >persistent-hash ( assoc -- phash ) + T{ persistent-hash } swap [ spin new-at ] assoc-each ; + +: PH{ \ } [ >persistent-hash ] parse-literal ; parsing + +M: persistent-hash pprint-delims drop \ PH{ \ } ; + +M: persistent-hash >pprint-sequence >alist ; diff --git a/extra/persistent/hashtables/nodes/bitmap/bitmap.factor b/extra/persistent/hashtables/nodes/bitmap/bitmap.factor new file mode 100644 index 0000000000..a08b2748d8 --- /dev/null +++ b/extra/persistent/hashtables/nodes/bitmap/bitmap.factor @@ -0,0 +1,87 @@ +! Based on Clojure's PersistentHashMap by Rich Hickey. + +USING: math math.bit-count arrays kernel accessors locals sequences +sequences.private sequences.lib +persistent.sequences +persistent.hashtables.config +persistent.hashtables.nodes ; +IN: persistent.hashtables.nodes.bitmap + +: index ( bit bitmap -- n ) [ 1- ] dip bitand bit-count ; inline + +M:: bitmap-node (entry-at) ( key hashcode bitmap-node -- entry ) + [let* | shift [ bitmap-node shift>> ] + bit [ hashcode shift bitpos ] + bitmap [ bitmap-node bitmap>> ] + nodes [ bitmap-node nodes>> ] | + bitmap bit bitand 0 = [ f ] [ + key hashcode + bit bitmap index nodes nth-unsafe + (entry-at) + ] if + ] ; + +M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-leaf ) + [let* | shift [ bitmap-node shift>> ] + bit [ hashcode shift bitpos ] + bitmap [ bitmap-node bitmap>> ] + idx [ bit bitmap index ] + nodes [ bitmap-node nodes>> ] | + bitmap bit bitand 0 = [ + [let | new-leaf [ value key hashcode ] | + bitmap bit bitor + new-leaf idx nodes insert-nth + shift + + new-leaf + ] + ] [ + [let | n [ idx nodes nth ] | + shift radix-bits + value key hashcode n (new-at) + [let | new-leaf [ ] n' [ ] | + n n' eq? [ + bitmap-node + ] [ + bitmap + n' idx nodes new-nth + shift + + ] if + new-leaf + ] + ] + ] if + ] ; + +M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' ) + [let | bit [ hashcode bitmap-node shift>> bitpos ] + bitmap [ bitmap-node bitmap>> ] + nodes [ bitmap-node nodes>> ] + shift [ bitmap-node shift>> ] | + bit bitmap bitand 0 = [ bitmap-node ] [ + [let* | idx [ bit bitmap index ] + n [ idx nodes nth-unsafe ] + n' [ key hashcode n (pluck-at) ] | + n n' eq? [ + bitmap-node + ] [ + n' [ + bitmap + n' idx nodes new-nth + shift + + ] [ + bitmap bit = [ f ] [ + nodes length 1 = [ bitmap bit 2array throw ] when + bitmap bit bitnot bitand + idx nodes remove-nth + shift + + ] if + ] if + ] if + ] + ] if + ] ; + +M: bitmap-node >alist% ( node -- ) nodes>> >alist-each% ; diff --git a/extra/persistent/hashtables/nodes/collision/collision.factor b/extra/persistent/hashtables/nodes/collision/collision.factor new file mode 100644 index 0000000000..cb2f40c682 --- /dev/null +++ b/extra/persistent/hashtables/nodes/collision/collision.factor @@ -0,0 +1,59 @@ +! Based on Clojure's PersistentHashMap by Rich Hickey. + +USING: kernel accessors math arrays fry sequences sequences.lib +locals persistent.sequences +persistent.hashtables.config +persistent.hashtables.nodes +persistent.hashtables.nodes.leaf ; +IN: persistent.hashtables.nodes.collision + +: find-index ( key hashcode collision-node -- n leaf-node ) + leaves>> -rot '[ , , _ matching-key? ] find ; inline + +M:: collision-node (entry-at) ( key hashcode collision-node -- leaf-node ) + key hashcode collision-node find-index nip ; + +M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node ) + hashcode collision-node hashcode>> = [ + [let | idx [ key hashcode collision-node find-index drop ] | + idx [ + idx collision-node leaves>> smash [ + collision-node hashcode>> + + ] when + ] [ collision-node ] if + ] + ] [ collision-node ] if ; + +M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' added-leaf ) + hashcode collision-node hashcode>> = [ + key hashcode collision-node find-index + [let | leaf-node [ ] idx [ ] | + idx [ + value leaf-node value>> = [ + collision-node f + ] [ + hashcode + value key hashcode + idx + collision-node leaves>> + new-nth + + f + ] if + ] [ + [let | new-leaf-node [ value key hashcode ] | + hashcode + collision-node leaves>> + new-leaf-node + suffix + + new-leaf-node + ] + ] if + ] + ] [ + shift collision-node value key hashcode make-bitmap-node + ] if ; + +M: collision-node >alist% leaves>> >alist-each% ; diff --git a/extra/persistent/hashtables/nodes/empty/empty.factor b/extra/persistent/hashtables/nodes/empty/empty.factor new file mode 100644 index 0000000000..95a310acd9 --- /dev/null +++ b/extra/persistent/hashtables/nodes/empty/empty.factor @@ -0,0 +1,15 @@ +! Based on Clojure's PersistentHashMap by Rich Hickey. + +USING: accessors kernel locals persistent.hashtables.nodes ; +IN: persistent.hashtables.nodes.empty + +M: empty-node (entry-at) 3drop f ; + +M: empty-node (pluck-at) 2nip ; + +M:: empty-node (new-at) ( shift value key hashcode node -- node' added-leaf ) + value key hashcode dup ; + +M: empty-node >alist% drop ; + +M: empty-node hashcode>> drop 0 ; diff --git a/extra/persistent/hashtables/nodes/full/full.factor b/extra/persistent/hashtables/nodes/full/full.factor new file mode 100644 index 0000000000..59123758ad --- /dev/null +++ b/extra/persistent/hashtables/nodes/full/full.factor @@ -0,0 +1,51 @@ +! Based on Clojure's PersistentHashMap by Rich Hickey. + +USING: math accessors kernel arrays sequences sequences.private +locals sequences.lib +persistent.sequences +persistent.hashtables.config +persistent.hashtables.nodes ; +IN: persistent.hashtables.nodes.full + +M:: full-node (new-at) ( shift value key hashcode full-node -- node' added-leaf ) + [let* | nodes [ full-node nodes>> ] + idx [ hashcode full-node shift>> mask ] + n [ idx nodes nth-unsafe ] | + shift radix-bits + value key hashcode n (new-at) + [let | new-leaf [ ] n' [ ] | + n n' eq? [ + full-node + ] [ + n' idx nodes new-nth shift + ] if + new-leaf + ] + ] ; + +M:: full-node (pluck-at) ( key hashcode full-node -- node' ) + [let* | idx [ hashcode full-node shift>> mask ] + n [ idx full-node nodes>> nth ] + n' [ key hashcode n (pluck-at) ] | + n n' eq? [ + full-node + ] [ + n' [ + n' idx full-node nodes>> new-nth + full-node shift>> + + ] [ + hashcode full-node shift>> bitpos bitnot + idx full-node nodes>> remove-nth + full-node shift>> + + ] if + ] if + ] ; + +M:: full-node (entry-at) ( key hashcode full-node -- node' ) + key hashcode + hashcode full-node shift>> mask + full-node nodes>> nth-unsafe + (entry-at) ; + +M: full-node >alist% nodes>> >alist-each% ; diff --git a/extra/persistent/hashtables/nodes/leaf/leaf.factor b/extra/persistent/hashtables/nodes/leaf/leaf.factor new file mode 100644 index 0000000000..7fa4cfe401 --- /dev/null +++ b/extra/persistent/hashtables/nodes/leaf/leaf.factor @@ -0,0 +1,28 @@ +! Based on Clojure's PersistentHashMap by Rich Hickey. + +USING: kernel accessors locals math arrays namespaces +persistent.hashtables.config +persistent.hashtables.nodes ; +IN: persistent.hashtables.nodes.leaf + +: matching-key? ( key hashcode leaf-node -- ? ) + tuck hashcode>> eq? [ key>> = ] [ 2drop f ] if ; inline + +M: leaf-node (entry-at) [ matching-key? ] keep and ; + +M: leaf-node (pluck-at) [ matching-key? not ] keep and ; + +M:: leaf-node (new-at) ( shift value key hashcode leaf-node -- node' added-leaf ) + hashcode leaf-node hashcode>> eq? [ + key leaf-node key>> = [ + value leaf-node value>> = + [ leaf-node f ] [ value key hashcode f ] if + ] [ + [let | new-leaf [ value key hashcode ] | + hashcode leaf-node new-leaf 2array + new-leaf + ] + ] if + ] [ shift leaf-node value key hashcode make-bitmap-node ] if ; + +M: leaf-node >alist% [ key>> ] [ value>> ] bi 2array , ; diff --git a/extra/persistent/hashtables/nodes/nodes.factor b/extra/persistent/hashtables/nodes/nodes.factor new file mode 100644 index 0000000000..6201e68c6a --- /dev/null +++ b/extra/persistent/hashtables/nodes/nodes.factor @@ -0,0 +1,64 @@ +! Based on Clojure's PersistentHashMap by Rich Hickey. + +USING: math arrays kernel sequences sequences.lib +accessors locals persistent.hashtables.config ; +IN: persistent.hashtables.nodes + +SINGLETON: empty-node + +TUPLE: leaf-node +{ value read-only } +{ key read-only } +{ hashcode fixnum read-only } ; + +C: leaf-node + +TUPLE: collision-node +{ hashcode fixnum read-only } +{ leaves array read-only } ; + +C: collision-node + +TUPLE: full-node +{ nodes array read-only } +{ shift fixnum read-only } +{ hashcode fixnum read-only } ; + +: ( nodes shift -- node ) + over first hashcode>> full-node boa ; + +TUPLE: bitmap-node +{ bitmap fixnum read-only } +{ nodes array read-only } +{ shift fixnum read-only } +{ hashcode fixnum read-only } ; + +: ( bitmap nodes shift -- node ) + pick full-bitmap-mask = + [ nip ] + [ over first hashcode>> bitmap-node boa ] if ; + +GENERIC: (entry-at) ( key hashcode node -- entry ) + +GENERIC: (new-at) ( shift value key hashcode node -- node' added-leaf ) + +GENERIC: (pluck-at) ( key hashcode node -- node' ) + +GENERIC: >alist% ( node -- ) + +: >alist-each% ( nodes -- ) [ >alist% ] each ; + +: mask ( hash shift -- n ) neg shift radix-mask bitand ; inline + +: bitpos ( hash shift -- n ) mask 2^ ; inline + +: smash ( idx seq -- seq/elt ? ) + dup length 2 = [ [ 1 = ] dip first2 ? f ] [ remove-nth t ] if ; inline + +:: make-bitmap-node ( shift branch value key hashcode -- node' added-leaf ) + shift value key hashcode + branch hashcode>> shift bitpos + branch 1array + shift + + (new-at) ; inline diff --git a/extra/persistent/hashtables/summary.txt b/extra/persistent/hashtables/summary.txt new file mode 100644 index 0000000000..27321fa936 --- /dev/null +++ b/extra/persistent/hashtables/summary.txt @@ -0,0 +1 @@ +Persistent hashtables with O(1) insertion, removal and lookup diff --git a/extra/persistent-vectors/tags.txt b/extra/persistent/hashtables/tags.txt similarity index 100% rename from extra/persistent-vectors/tags.txt rename to extra/persistent/hashtables/tags.txt diff --git a/extra/persistent-heaps/authors.txt b/extra/persistent/heaps/authors.txt similarity index 100% rename from extra/persistent-heaps/authors.txt rename to extra/persistent/heaps/authors.txt diff --git a/extra/persistent-heaps/persistent-heaps-docs.factor b/extra/persistent/heaps/heaps-docs.factor similarity index 99% rename from extra/persistent-heaps/persistent-heaps-docs.factor rename to extra/persistent/heaps/heaps-docs.factor index d538fe88d4..dbfadc4ed2 100644 --- a/extra/persistent-heaps/persistent-heaps-docs.factor +++ b/extra/persistent/heaps/heaps-docs.factor @@ -1,5 +1,5 @@ USING: help.syntax help.markup kernel arrays assocs ; -IN: persistent-heaps +IN: persistent.heaps HELP: { $values { "heap" "a persistent heap" } } diff --git a/extra/persistent-heaps/persistent-heaps-tests.factor b/extra/persistent/heaps/heaps-tests.factor similarity index 82% rename from extra/persistent-heaps/persistent-heaps-tests.factor rename to extra/persistent/heaps/heaps-tests.factor index 6e559971a0..cecd6dab53 100644 --- a/extra/persistent-heaps/persistent-heaps-tests.factor +++ b/extra/persistent/heaps/heaps-tests.factor @@ -1,5 +1,5 @@ -USING: persistent-heaps tools.test ; -IN: persistent-heaps.tests +USING: persistent.heaps tools.test ; +IN: persistent.heaps.tests : test-input { { "hello" 3 } { "goodbye" 2 } { "whatever" 5 } diff --git a/extra/persistent-heaps/persistent-heaps.factor b/extra/persistent/heaps/heaps.factor similarity index 92% rename from extra/persistent-heaps/persistent-heaps.factor rename to extra/persistent/heaps/heaps.factor index e7e8213a4a..81c9959f84 100644 --- a/extra/persistent-heaps/persistent-heaps.factor +++ b/extra/persistent/heaps/heaps.factor @@ -1,6 +1,6 @@ -USING: kernel accessors locals combinators math arrays +USING: kernel accessors multi-methods locals combinators math arrays assocs namespaces sequences ; -IN: persistent-heaps +IN: persistent.heaps ! These are minheaps GENERIC: sift-down ( value prio left right -- heap ) -: sift-singleton ( value prio left right -- heap ) +METHOD: sift-down { empty-heap empty-heap } ; + +METHOD: sift-down { singleton-heap empty-heap } 3dup drop prio>> <= [ ] [ drop -rot [ [ value>> ] [ prio>> ] bi ] 2dip ] if ; -M: empty-heap sift-down - over empty-heap? [ ] [ sift-singleton ] if ; - :: reroot-left ( value prio left right -- heap ) left value>> left prio>> value prio left left>> left right>> sift-down @@ -55,7 +54,7 @@ M: empty-heap sift-down value prio right left>> right right>> sift-down ; -M: branch sift-down +METHOD: sift-down { branch branch } 3dup [ prio>> <= ] both-with? [ ] [ 2dup [ prio>> ] bi@ <= [ reroot-left ] [ reroot-right ] if ] if ; diff --git a/extra/persistent-heaps/summary.txt b/extra/persistent/heaps/summary.txt similarity index 100% rename from extra/persistent-heaps/summary.txt rename to extra/persistent/heaps/summary.txt diff --git a/extra/persistent/heaps/tags.txt b/extra/persistent/heaps/tags.txt new file mode 100644 index 0000000000..42d711b32b --- /dev/null +++ b/extra/persistent/heaps/tags.txt @@ -0,0 +1 @@ +collections diff --git a/extra/persistent/sequences/authors.txt b/extra/persistent/sequences/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/persistent/sequences/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/persistent/sequences/sequences-docs.factor b/extra/persistent/sequences/sequences-docs.factor new file mode 100644 index 0000000000..beacf58966 --- /dev/null +++ b/extra/persistent/sequences/sequences-docs.factor @@ -0,0 +1,17 @@ +IN: persistent.sequences +USING: help.markup help.syntax math sequences kernel ; + +HELP: new-nth +{ $values { "val" object } { "i" integer } { "seq" sequence } { "seq'" sequence } } +{ $contract "Persistent analogue of " { $link set-nth } ". Outputs a new sequence with the " { $snippet "i" } "th element replaced by " { $snippet "val" } "." } +{ $notes "This operation runs in " { $snippet "O(log_32 n)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ; + +HELP: ppush +{ $values { "val" object } { "seq" sequence } { "seq'" sequence } } +{ $contract "Persistent analogue of " { $link push } ". Outputs a new sequence with all elements of " { $snippet "seq" } " together with " { $snippet "val" } " added at the end." } +{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ; + +HELP: ppop +{ $values { "seq" sequence } { "seq'" sequence } } +{ $contract "Persistent analogue of " { $link pop* } ". Outputs a new sequence with all elements of " { $snippet "seq" } " except for the final element." } +{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ; diff --git a/extra/persistent/sequences/sequences.factor b/extra/persistent/sequences/sequences.factor new file mode 100644 index 0000000000..961e8bfce7 --- /dev/null +++ b/extra/persistent/sequences/sequences.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: sequences kernel ; +IN: persistent.sequences + +GENERIC: ppush ( val seq -- seq' ) + +M: sequence ppush swap suffix ; + +GENERIC: ppop ( seq -- seq' ) + +M: sequence ppop 1 head* ; + +GENERIC: new-nth ( val i seq -- seq' ) + +M: sequence new-nth clone [ set-nth ] keep ; diff --git a/extra/persistent/sequences/summary.txt b/extra/persistent/sequences/summary.txt new file mode 100644 index 0000000000..a2184274d6 --- /dev/null +++ b/extra/persistent/sequences/summary.txt @@ -0,0 +1 @@ +Persistent sequence protocol diff --git a/extra/persistent/sequences/tags.txt b/extra/persistent/sequences/tags.txt new file mode 100644 index 0000000000..42d711b32b --- /dev/null +++ b/extra/persistent/sequences/tags.txt @@ -0,0 +1 @@ +collections diff --git a/extra/persistent/vectors/authors.txt b/extra/persistent/vectors/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/persistent/vectors/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/persistent/vectors/summary.txt b/extra/persistent/vectors/summary.txt new file mode 100644 index 0000000000..e190af57eb --- /dev/null +++ b/extra/persistent/vectors/summary.txt @@ -0,0 +1 @@ +Immutable vectors with O(log_32 n) random access, push, and pop diff --git a/extra/persistent/vectors/tags.txt b/extra/persistent/vectors/tags.txt new file mode 100644 index 0000000000..42d711b32b --- /dev/null +++ b/extra/persistent/vectors/tags.txt @@ -0,0 +1 @@ +collections diff --git a/extra/persistent-vectors/persistent-vectors-docs.factor b/extra/persistent/vectors/vectors-docs.factor similarity index 60% rename from extra/persistent-vectors/persistent-vectors-docs.factor rename to extra/persistent/vectors/vectors-docs.factor index 0be443e38d..f17fca1ded 100644 --- a/extra/persistent-vectors/persistent-vectors-docs.factor +++ b/extra/persistent/vectors/vectors-docs.factor @@ -1,21 +1,6 @@ USING: help.markup help.syntax kernel math sequences ; IN: persistent-vectors -HELP: new-nth -{ $values { "val" object } { "i" integer } { "seq" sequence } { "seq'" sequence } } -{ $contract "Persistent analogue of " { $link set-nth } ". Outputs a new sequence with the " { $snippet "i" } "th element replaced by " { $snippet "val" } "." } -{ $notes "This operation runs in " { $snippet "O(log_32 n)" } " time on " { $link persistent-vector } " instances and " { $snippet "O(n)" } " time on all other sequences." } ; - -HELP: ppush -{ $values { "val" object } { "seq" sequence } { "seq'" sequence } } -{ $contract "Persistent analogue of " { $link push } ". Outputs a new sequence with all elements of " { $snippet "seq" } " together with " { $snippet "val" } " added at the end." } -{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link persistent-vector } " instances and " { $snippet "O(n)" } " time on all other sequences." } ; - -HELP: ppop -{ $values { "seq" sequence } { "seq'" sequence } } -{ $contract "Persistent analogue of " { $link pop* } ". Outputs a new sequence with all elements of " { $snippet "seq" } " except for the final element." } -{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link persistent-vector } " instances and " { $snippet "O(n)" } " time on all other sequences." } ; - HELP: PV{ { $syntax "elements... }" } { $description "Parses a literal " { $link persistent-vector } "." } ; diff --git a/extra/persistent-vectors/persistent-vectors-tests.factor b/extra/persistent/vectors/vectors-tests.factor similarity index 92% rename from extra/persistent-vectors/persistent-vectors-tests.factor rename to extra/persistent/vectors/vectors-tests.factor index 1e2fae6a39..c232db8533 100644 --- a/extra/persistent-vectors/persistent-vectors-tests.factor +++ b/extra/persistent/vectors/vectors-tests.factor @@ -1,6 +1,7 @@ IN: persistent-vectors.tests -USING: accessors tools.test persistent-vectors sequences kernel -arrays random namespaces vectors math math.order ; +USING: accessors tools.test persistent.vectors +persistent.sequences sequences kernel arrays random namespaces +vectors math math.order ; \ new-nth must-infer \ ppush must-infer diff --git a/extra/persistent-vectors/persistent-vectors.factor b/extra/persistent/vectors/vectors.factor similarity index 95% rename from extra/persistent-vectors/persistent-vectors.factor rename to extra/persistent/vectors/vectors.factor index e071ae69d2..a636d31f48 100644 --- a/extra/persistent-vectors/persistent-vectors.factor +++ b/extra/persistent/vectors/vectors.factor @@ -1,8 +1,9 @@ ! Based on Clojure's PersistentVector by Rich Hickey. USING: math accessors kernel sequences.private sequences arrays -combinators combinators.short-circuit parser prettyprint.backend ; -IN: persistent-vectors +combinators combinators.short-circuit parser prettyprint.backend +persistent.sequences ; +IN: persistent.vectors ERROR: empty-error pvec ; -GENERIC: ppush ( val seq -- seq' ) - -M: sequence ppush swap suffix ; - -GENERIC: ppop ( seq -- seq' ) - -M: sequence ppop 1 head* ; - -GENERIC: new-nth ( val i seq -- seq' ) - -M: sequence new-nth clone [ set-nth ] keep ; - TUPLE: persistent-vector { count fixnum } { root node initial: T{ node f { } 1 } } diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 9f8e5be3d5..1167a3b7b4 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -205,8 +205,11 @@ PRIVATE> : nths ( seq indices -- seq' ) swap [ nth ] curry map ; -: remove-nth ( seq n -- seq' ) - cut-slice rest-slice append ; +: remove-nth ( n seq -- seq' ) + [ swap head-slice ] [ swap 1+ tail-slice ] 2bi append ; + +: insert-nth ( elt n seq -- seq' ) + swap cut-slice [ swap 1array ] dip 3append ; : if-seq ( seq quot1 quot2 -- ) [ f like ] 2dip if* ; inline From f279015b8578630415ddec01a6d841533e1ddf90 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Aug 2008 04:46:30 -0500 Subject: [PATCH 3/6] Minor fixes --- basis/disjoint-sets/disjoint-sets-docs.factor | 2 +- basis/io/windows/nt/launcher/launcher-tests.factor | 2 +- core/math/math-docs.factor | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/disjoint-sets/disjoint-sets-docs.factor b/basis/disjoint-sets/disjoint-sets-docs.factor index b1d7cf685a..40e14b7fca 100644 --- a/basis/disjoint-sets/disjoint-sets-docs.factor +++ b/basis/disjoint-sets/disjoint-sets-docs.factor @@ -32,7 +32,7 @@ HELP: assoc>disjoint-set "4 5 pick equiv? ." "1 5 pick equiv? ." "drop" - "t\nt\nf\n" + "t\nt\nf" } } ; diff --git a/basis/io/windows/nt/launcher/launcher-tests.factor b/basis/io/windows/nt/launcher/launcher-tests.factor index d82871ec9e..d5e77caa19 100755 --- a/basis/io/windows/nt/launcher/launcher-tests.factor +++ b/basis/io/windows/nt/launcher/launcher-tests.factor @@ -1,7 +1,7 @@ IN: io.windows.launcher.nt.tests USING: io.launcher tools.test calendar accessors namespaces kernel system arrays io io.files io.encodings.ascii -sequences parser assocs hashtables math continuations ; +sequences parser assocs hashtables math continuations eval ; [ ] [ diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index 237438e69a..697f3d81be 100755 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -212,7 +212,7 @@ HELP: bit? HELP: log2 { $values { "x" "a positive integer" } { "n" integer } } -{ $description "Outputs the largest integer " { $snippet "n" } " such that " { $snippet "2^n" } " is less than " { $snippet "x" } "." } +{ $description "Outputs the largest integer " { $snippet "n" } " such that " { $snippet "2^n" } " is less than or equal to " { $snippet "x" } "." } { $errors "Throws an error if " { $snippet "x" } " is zero or negative." } ; HELP: 1+ From 5670a157ef5821cd1b537517405774de161ec2fe Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Aug 2008 04:46:44 -0500 Subject: [PATCH 4/6] Debugging persistent hashtables --- .../hashtables/hashtables-tests.factor | 33 +++++++------------ .../hashtables/nodes/bitmap/bitmap.factor | 9 +++-- .../nodes/collision/collision.factor | 4 +-- .../hashtables/nodes/full/full.factor | 2 +- 4 files changed, 19 insertions(+), 29 deletions(-) diff --git a/extra/persistent/hashtables/hashtables-tests.factor b/extra/persistent/hashtables/hashtables-tests.factor index 2c8ffaee00..accebfd778 100644 --- a/extra/persistent/hashtables/hashtables-tests.factor +++ b/extra/persistent/hashtables/hashtables-tests.factor @@ -75,7 +75,7 @@ M: hash-0-b hashcode* 2drop 0 ; ] unit-test : random-string ( -- str ) - 100 random [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ; + 1000000 random ; ! [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ; : random-assocs ( -- hash phash ) [ random-string ] replicate @@ -89,16 +89,16 @@ M: hash-0-b hashcode* 2drop 0 ; : test-persistent-hashtables-1 ( n -- ) random-assocs ok? ; -! [ t ] [ 10 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 20 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 30 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 50 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 100 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 500 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 1000 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 5000 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 10000 test-persistent-hashtables-1 ] unit-test -! [ t ] [ 50000 test-persistent-hashtables-1 ] unit-test +[ t ] [ 10 test-persistent-hashtables-1 ] unit-test +[ t ] [ 20 test-persistent-hashtables-1 ] unit-test +[ t ] [ 30 test-persistent-hashtables-1 ] unit-test +[ t ] [ 50 test-persistent-hashtables-1 ] unit-test +[ t ] [ 100 test-persistent-hashtables-1 ] unit-test +[ t ] [ 500 test-persistent-hashtables-1 ] unit-test +[ t ] [ 1000 test-persistent-hashtables-1 ] unit-test +[ t ] [ 5000 test-persistent-hashtables-1 ] unit-test +[ t ] [ 10000 test-persistent-hashtables-1 ] unit-test +[ t ] [ 50000 test-persistent-hashtables-1 ] unit-test : test-persistent-hashtables-2 ( n -- ) random-assocs @@ -107,13 +107,4 @@ M: hash-0-b hashcode* 2drop 0 ; 2dup ok? ] all? 2nip ; -[ t ] [ 10 test-persistent-hashtables-2 ] unit-test -[ t ] [ 20 test-persistent-hashtables-2 ] unit-test -[ t ] [ 30 test-persistent-hashtables-2 ] unit-test -[ t ] [ 50 test-persistent-hashtables-2 ] unit-test -[ t ] [ 100 test-persistent-hashtables-2 ] unit-test -[ t ] [ 500 test-persistent-hashtables-2 ] unit-test -[ t ] [ 1000 test-persistent-hashtables-2 ] unit-test -[ t ] [ 5000 test-persistent-hashtables-2 ] unit-test -[ t ] [ 10000 test-persistent-hashtables-2 ] unit-test -[ t ] [ 50000 test-persistent-hashtables-2 ] unit-test +[ t ] [ 6000 test-persistent-hashtables-2 ] unit-test diff --git a/extra/persistent/hashtables/nodes/bitmap/bitmap.factor b/extra/persistent/hashtables/nodes/bitmap/bitmap.factor index a08b2748d8..7fb14a4541 100644 --- a/extra/persistent/hashtables/nodes/bitmap/bitmap.factor +++ b/extra/persistent/hashtables/nodes/bitmap/bitmap.factor @@ -14,7 +14,7 @@ M:: bitmap-node (entry-at) ( key hashcode bitmap-node -- entry ) bit [ hashcode shift bitpos ] bitmap [ bitmap-node bitmap>> ] nodes [ bitmap-node nodes>> ] | - bitmap bit bitand 0 = [ f ] [ + bitmap bit bitand 0 eq? [ f ] [ key hashcode bit bitmap index nodes nth-unsafe (entry-at) @@ -27,7 +27,7 @@ M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-l bitmap [ bitmap-node bitmap>> ] idx [ bit bitmap index ] nodes [ bitmap-node nodes>> ] | - bitmap bit bitand 0 = [ + bitmap bit bitand 0 eq? [ [let | new-leaf [ value key hashcode ] | bitmap bit bitor new-leaf idx nodes insert-nth @@ -58,7 +58,7 @@ M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' ) bitmap [ bitmap-node bitmap>> ] nodes [ bitmap-node nodes>> ] shift [ bitmap-node shift>> ] | - bit bitmap bitand 0 = [ bitmap-node ] [ + bit bitmap bitand 0 eq? [ bitmap-node ] [ [let* | idx [ bit bitmap index ] n [ idx nodes nth-unsafe ] n' [ key hashcode n (pluck-at) ] | @@ -71,8 +71,7 @@ M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' ) shift ] [ - bitmap bit = [ f ] [ - nodes length 1 = [ bitmap bit 2array throw ] when + bitmap bit eq? [ f ] [ bitmap bit bitnot bitand idx nodes remove-nth shift diff --git a/extra/persistent/hashtables/nodes/collision/collision.factor b/extra/persistent/hashtables/nodes/collision/collision.factor index cb2f40c682..b74a2ed45d 100644 --- a/extra/persistent/hashtables/nodes/collision/collision.factor +++ b/extra/persistent/hashtables/nodes/collision/collision.factor @@ -14,7 +14,7 @@ M:: collision-node (entry-at) ( key hashcode collision-node -- leaf-node ) key hashcode collision-node find-index nip ; M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node ) - hashcode collision-node hashcode>> = [ + hashcode collision-node hashcode>> eq? [ [let | idx [ key hashcode collision-node find-index drop ] | idx [ idx collision-node leaves>> smash [ @@ -26,7 +26,7 @@ M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node ) ] [ collision-node ] if ; M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' added-leaf ) - hashcode collision-node hashcode>> = [ + hashcode collision-node hashcode>> eq? [ key hashcode collision-node find-index [let | leaf-node [ ] idx [ ] | idx [ diff --git a/extra/persistent/hashtables/nodes/full/full.factor b/extra/persistent/hashtables/nodes/full/full.factor index 59123758ad..e0fcc1a0ab 100644 --- a/extra/persistent/hashtables/nodes/full/full.factor +++ b/extra/persistent/hashtables/nodes/full/full.factor @@ -34,7 +34,7 @@ M:: full-node (pluck-at) ( key hashcode full-node -- node' ) full-node shift>> ] [ - hashcode full-node shift>> bitpos bitnot + hashcode full-node shift>> bitpos bitnot full-bitmap-mask bitand idx full-node nodes>> remove-nth full-node shift>> From efb6c73f286aad3d451b0f59eb7918ee6c2c8cda Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Aug 2008 04:59:58 -0500 Subject: [PATCH 5/6] Move persistent collections to basis --- {extra => basis}/persistent/assocs/assocs.factor | 0 {extra => basis}/persistent/assocs/authors.txt | 0 {extra => basis}/persistent/assocs/summary.txt | 0 {extra => basis}/persistent/assocs/tags.txt | 0 {extra => basis}/persistent/hashtables/authors.txt | 0 {extra => basis}/persistent/hashtables/config/config.factor | 0 {extra => basis}/persistent/hashtables/hashtables-tests.factor | 0 {extra => basis}/persistent/hashtables/hashtables.factor | 0 {extra => basis}/persistent/hashtables/nodes/bitmap/bitmap.factor | 0 .../persistent/hashtables/nodes/collision/collision.factor | 0 {extra => basis}/persistent/hashtables/nodes/empty/empty.factor | 0 {extra => basis}/persistent/hashtables/nodes/full/full.factor | 0 {extra => basis}/persistent/hashtables/nodes/leaf/leaf.factor | 0 {extra => basis}/persistent/hashtables/nodes/nodes.factor | 0 {extra => basis}/persistent/hashtables/summary.txt | 0 {extra => basis}/persistent/hashtables/tags.txt | 0 {extra => basis}/persistent/heaps/authors.txt | 0 {extra => basis}/persistent/heaps/heaps-docs.factor | 0 {extra => basis}/persistent/heaps/heaps-tests.factor | 0 {extra => basis}/persistent/heaps/heaps.factor | 0 {extra => basis}/persistent/heaps/summary.txt | 0 {extra => basis}/persistent/heaps/tags.txt | 0 {extra => basis}/persistent/sequences/authors.txt | 0 {extra => basis}/persistent/sequences/sequences-docs.factor | 0 {extra => basis}/persistent/sequences/sequences.factor | 0 {extra => basis}/persistent/sequences/summary.txt | 0 {extra => basis}/persistent/sequences/tags.txt | 0 {extra => basis}/persistent/vectors/authors.txt | 0 {extra => basis}/persistent/vectors/summary.txt | 0 {extra => basis}/persistent/vectors/tags.txt | 0 {extra => basis}/persistent/vectors/vectors-docs.factor | 0 {extra => basis}/persistent/vectors/vectors-tests.factor | 0 {extra => basis}/persistent/vectors/vectors.factor | 0 33 files changed, 0 insertions(+), 0 deletions(-) rename {extra => basis}/persistent/assocs/assocs.factor (100%) rename {extra => basis}/persistent/assocs/authors.txt (100%) rename {extra => basis}/persistent/assocs/summary.txt (100%) rename {extra => basis}/persistent/assocs/tags.txt (100%) rename {extra => basis}/persistent/hashtables/authors.txt (100%) rename {extra => basis}/persistent/hashtables/config/config.factor (100%) rename {extra => basis}/persistent/hashtables/hashtables-tests.factor (100%) rename {extra => basis}/persistent/hashtables/hashtables.factor (100%) rename {extra => basis}/persistent/hashtables/nodes/bitmap/bitmap.factor (100%) rename {extra => basis}/persistent/hashtables/nodes/collision/collision.factor (100%) rename {extra => basis}/persistent/hashtables/nodes/empty/empty.factor (100%) rename {extra => basis}/persistent/hashtables/nodes/full/full.factor (100%) rename {extra => basis}/persistent/hashtables/nodes/leaf/leaf.factor (100%) rename {extra => basis}/persistent/hashtables/nodes/nodes.factor (100%) rename {extra => basis}/persistent/hashtables/summary.txt (100%) rename {extra => basis}/persistent/hashtables/tags.txt (100%) rename {extra => basis}/persistent/heaps/authors.txt (100%) rename {extra => basis}/persistent/heaps/heaps-docs.factor (100%) rename {extra => basis}/persistent/heaps/heaps-tests.factor (100%) rename {extra => basis}/persistent/heaps/heaps.factor (100%) rename {extra => basis}/persistent/heaps/summary.txt (100%) rename {extra => basis}/persistent/heaps/tags.txt (100%) rename {extra => basis}/persistent/sequences/authors.txt (100%) rename {extra => basis}/persistent/sequences/sequences-docs.factor (100%) rename {extra => basis}/persistent/sequences/sequences.factor (100%) rename {extra => basis}/persistent/sequences/summary.txt (100%) rename {extra => basis}/persistent/sequences/tags.txt (100%) rename {extra => basis}/persistent/vectors/authors.txt (100%) rename {extra => basis}/persistent/vectors/summary.txt (100%) rename {extra => basis}/persistent/vectors/tags.txt (100%) rename {extra => basis}/persistent/vectors/vectors-docs.factor (100%) rename {extra => basis}/persistent/vectors/vectors-tests.factor (100%) rename {extra => basis}/persistent/vectors/vectors.factor (100%) diff --git a/extra/persistent/assocs/assocs.factor b/basis/persistent/assocs/assocs.factor similarity index 100% rename from extra/persistent/assocs/assocs.factor rename to basis/persistent/assocs/assocs.factor diff --git a/extra/persistent/assocs/authors.txt b/basis/persistent/assocs/authors.txt similarity index 100% rename from extra/persistent/assocs/authors.txt rename to basis/persistent/assocs/authors.txt diff --git a/extra/persistent/assocs/summary.txt b/basis/persistent/assocs/summary.txt similarity index 100% rename from extra/persistent/assocs/summary.txt rename to basis/persistent/assocs/summary.txt diff --git a/extra/persistent/assocs/tags.txt b/basis/persistent/assocs/tags.txt similarity index 100% rename from extra/persistent/assocs/tags.txt rename to basis/persistent/assocs/tags.txt diff --git a/extra/persistent/hashtables/authors.txt b/basis/persistent/hashtables/authors.txt similarity index 100% rename from extra/persistent/hashtables/authors.txt rename to basis/persistent/hashtables/authors.txt diff --git a/extra/persistent/hashtables/config/config.factor b/basis/persistent/hashtables/config/config.factor similarity index 100% rename from extra/persistent/hashtables/config/config.factor rename to basis/persistent/hashtables/config/config.factor diff --git a/extra/persistent/hashtables/hashtables-tests.factor b/basis/persistent/hashtables/hashtables-tests.factor similarity index 100% rename from extra/persistent/hashtables/hashtables-tests.factor rename to basis/persistent/hashtables/hashtables-tests.factor diff --git a/extra/persistent/hashtables/hashtables.factor b/basis/persistent/hashtables/hashtables.factor similarity index 100% rename from extra/persistent/hashtables/hashtables.factor rename to basis/persistent/hashtables/hashtables.factor diff --git a/extra/persistent/hashtables/nodes/bitmap/bitmap.factor b/basis/persistent/hashtables/nodes/bitmap/bitmap.factor similarity index 100% rename from extra/persistent/hashtables/nodes/bitmap/bitmap.factor rename to basis/persistent/hashtables/nodes/bitmap/bitmap.factor diff --git a/extra/persistent/hashtables/nodes/collision/collision.factor b/basis/persistent/hashtables/nodes/collision/collision.factor similarity index 100% rename from extra/persistent/hashtables/nodes/collision/collision.factor rename to basis/persistent/hashtables/nodes/collision/collision.factor diff --git a/extra/persistent/hashtables/nodes/empty/empty.factor b/basis/persistent/hashtables/nodes/empty/empty.factor similarity index 100% rename from extra/persistent/hashtables/nodes/empty/empty.factor rename to basis/persistent/hashtables/nodes/empty/empty.factor diff --git a/extra/persistent/hashtables/nodes/full/full.factor b/basis/persistent/hashtables/nodes/full/full.factor similarity index 100% rename from extra/persistent/hashtables/nodes/full/full.factor rename to basis/persistent/hashtables/nodes/full/full.factor diff --git a/extra/persistent/hashtables/nodes/leaf/leaf.factor b/basis/persistent/hashtables/nodes/leaf/leaf.factor similarity index 100% rename from extra/persistent/hashtables/nodes/leaf/leaf.factor rename to basis/persistent/hashtables/nodes/leaf/leaf.factor diff --git a/extra/persistent/hashtables/nodes/nodes.factor b/basis/persistent/hashtables/nodes/nodes.factor similarity index 100% rename from extra/persistent/hashtables/nodes/nodes.factor rename to basis/persistent/hashtables/nodes/nodes.factor diff --git a/extra/persistent/hashtables/summary.txt b/basis/persistent/hashtables/summary.txt similarity index 100% rename from extra/persistent/hashtables/summary.txt rename to basis/persistent/hashtables/summary.txt diff --git a/extra/persistent/hashtables/tags.txt b/basis/persistent/hashtables/tags.txt similarity index 100% rename from extra/persistent/hashtables/tags.txt rename to basis/persistent/hashtables/tags.txt diff --git a/extra/persistent/heaps/authors.txt b/basis/persistent/heaps/authors.txt similarity index 100% rename from extra/persistent/heaps/authors.txt rename to basis/persistent/heaps/authors.txt diff --git a/extra/persistent/heaps/heaps-docs.factor b/basis/persistent/heaps/heaps-docs.factor similarity index 100% rename from extra/persistent/heaps/heaps-docs.factor rename to basis/persistent/heaps/heaps-docs.factor diff --git a/extra/persistent/heaps/heaps-tests.factor b/basis/persistent/heaps/heaps-tests.factor similarity index 100% rename from extra/persistent/heaps/heaps-tests.factor rename to basis/persistent/heaps/heaps-tests.factor diff --git a/extra/persistent/heaps/heaps.factor b/basis/persistent/heaps/heaps.factor similarity index 100% rename from extra/persistent/heaps/heaps.factor rename to basis/persistent/heaps/heaps.factor diff --git a/extra/persistent/heaps/summary.txt b/basis/persistent/heaps/summary.txt similarity index 100% rename from extra/persistent/heaps/summary.txt rename to basis/persistent/heaps/summary.txt diff --git a/extra/persistent/heaps/tags.txt b/basis/persistent/heaps/tags.txt similarity index 100% rename from extra/persistent/heaps/tags.txt rename to basis/persistent/heaps/tags.txt diff --git a/extra/persistent/sequences/authors.txt b/basis/persistent/sequences/authors.txt similarity index 100% rename from extra/persistent/sequences/authors.txt rename to basis/persistent/sequences/authors.txt diff --git a/extra/persistent/sequences/sequences-docs.factor b/basis/persistent/sequences/sequences-docs.factor similarity index 100% rename from extra/persistent/sequences/sequences-docs.factor rename to basis/persistent/sequences/sequences-docs.factor diff --git a/extra/persistent/sequences/sequences.factor b/basis/persistent/sequences/sequences.factor similarity index 100% rename from extra/persistent/sequences/sequences.factor rename to basis/persistent/sequences/sequences.factor diff --git a/extra/persistent/sequences/summary.txt b/basis/persistent/sequences/summary.txt similarity index 100% rename from extra/persistent/sequences/summary.txt rename to basis/persistent/sequences/summary.txt diff --git a/extra/persistent/sequences/tags.txt b/basis/persistent/sequences/tags.txt similarity index 100% rename from extra/persistent/sequences/tags.txt rename to basis/persistent/sequences/tags.txt diff --git a/extra/persistent/vectors/authors.txt b/basis/persistent/vectors/authors.txt similarity index 100% rename from extra/persistent/vectors/authors.txt rename to basis/persistent/vectors/authors.txt diff --git a/extra/persistent/vectors/summary.txt b/basis/persistent/vectors/summary.txt similarity index 100% rename from extra/persistent/vectors/summary.txt rename to basis/persistent/vectors/summary.txt diff --git a/extra/persistent/vectors/tags.txt b/basis/persistent/vectors/tags.txt similarity index 100% rename from extra/persistent/vectors/tags.txt rename to basis/persistent/vectors/tags.txt diff --git a/extra/persistent/vectors/vectors-docs.factor b/basis/persistent/vectors/vectors-docs.factor similarity index 100% rename from extra/persistent/vectors/vectors-docs.factor rename to basis/persistent/vectors/vectors-docs.factor diff --git a/extra/persistent/vectors/vectors-tests.factor b/basis/persistent/vectors/vectors-tests.factor similarity index 100% rename from extra/persistent/vectors/vectors-tests.factor rename to basis/persistent/vectors/vectors-tests.factor diff --git a/extra/persistent/vectors/vectors.factor b/basis/persistent/vectors/vectors.factor similarity index 100% rename from extra/persistent/vectors/vectors.factor rename to basis/persistent/vectors/vectors.factor From 569657a2dfeb93f05cd1046980f8c5b26a54d34a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Aug 2008 05:35:01 -0500 Subject: [PATCH 6/6] Another utility --- basis/persistent/assocs/assocs.factor | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/basis/persistent/assocs/assocs.factor b/basis/persistent/assocs/assocs.factor index 8ea88caf33..59fbd3a51e 100644 --- a/basis/persistent/assocs/assocs.factor +++ b/basis/persistent/assocs/assocs.factor @@ -3,10 +3,16 @@ USING: kernel assocs ; IN: persistent.assocs -GENERIC: new-at ( value key phash -- phash' ) +GENERIC: new-at ( value key assoc -- assoc' ) M: assoc new-at clone [ set-at ] keep ; -GENERIC: pluck-at ( key phash -- phash' ) +GENERIC: pluck-at ( key assoc -- assoc' ) M: assoc pluck-at clone [ delete-at ] keep ; + +: changed-at ( key assoc quot -- assoc' ) + [ [ at ] dip call ] [ drop new-at ] 3bi ; inline + +: conjoined ( key assoc -- assoc' ) + dupd new-at ;