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/basis/persistent/assocs/assocs.factor b/basis/persistent/assocs/assocs.factor new file mode 100644 index 0000000000..59fbd3a51e --- /dev/null +++ b/basis/persistent/assocs/assocs.factor @@ -0,0 +1,18 @@ +! 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 assoc -- assoc' ) + +M: assoc new-at clone [ set-at ] keep ; + +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 ; diff --git a/extra/persistent-vectors/authors.txt b/basis/persistent/assocs/authors.txt similarity index 100% rename from extra/persistent-vectors/authors.txt rename to basis/persistent/assocs/authors.txt diff --git a/basis/persistent/assocs/summary.txt b/basis/persistent/assocs/summary.txt new file mode 100644 index 0000000000..5fe330f444 --- /dev/null +++ b/basis/persistent/assocs/summary.txt @@ -0,0 +1 @@ +Persistent associative mapping protocol diff --git a/extra/persistent-heaps/tags.txt b/basis/persistent/assocs/tags.txt similarity index 100% rename from extra/persistent-heaps/tags.txt rename to basis/persistent/assocs/tags.txt diff --git a/basis/persistent/hashtables/authors.txt b/basis/persistent/hashtables/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/persistent/hashtables/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/persistent/hashtables/config/config.factor b/basis/persistent/hashtables/config/config.factor new file mode 100644 index 0000000000..a761e2d327 --- /dev/null +++ b/basis/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/basis/persistent/hashtables/hashtables-tests.factor b/basis/persistent/hashtables/hashtables-tests.factor new file mode 100644 index 0000000000..accebfd778 --- /dev/null +++ b/basis/persistent/hashtables/hashtables-tests.factor @@ -0,0 +1,110 @@ +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 ) + 1000000 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 ] [ 6000 test-persistent-hashtables-2 ] unit-test diff --git a/basis/persistent/hashtables/hashtables.factor b/basis/persistent/hashtables/hashtables.factor new file mode 100644 index 0000000000..a68fa7c365 --- /dev/null +++ b/basis/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/basis/persistent/hashtables/nodes/bitmap/bitmap.factor b/basis/persistent/hashtables/nodes/bitmap/bitmap.factor new file mode 100644 index 0000000000..7fb14a4541 --- /dev/null +++ b/basis/persistent/hashtables/nodes/bitmap/bitmap.factor @@ -0,0 +1,86 @@ +! 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 eq? [ 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 eq? [ + [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 eq? [ 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 eq? [ f ] [ + bitmap bit bitnot bitand + idx nodes remove-nth + shift + + ] if + ] if + ] if + ] + ] if + ] ; + +M: bitmap-node >alist% ( node -- ) nodes>> >alist-each% ; diff --git a/basis/persistent/hashtables/nodes/collision/collision.factor b/basis/persistent/hashtables/nodes/collision/collision.factor new file mode 100644 index 0000000000..b74a2ed45d --- /dev/null +++ b/basis/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>> eq? [ + [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>> eq? [ + 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/basis/persistent/hashtables/nodes/empty/empty.factor b/basis/persistent/hashtables/nodes/empty/empty.factor new file mode 100644 index 0000000000..95a310acd9 --- /dev/null +++ b/basis/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/basis/persistent/hashtables/nodes/full/full.factor b/basis/persistent/hashtables/nodes/full/full.factor new file mode 100644 index 0000000000..e0fcc1a0ab --- /dev/null +++ b/basis/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 full-bitmap-mask bitand + 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/basis/persistent/hashtables/nodes/leaf/leaf.factor b/basis/persistent/hashtables/nodes/leaf/leaf.factor new file mode 100644 index 0000000000..7fa4cfe401 --- /dev/null +++ b/basis/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/basis/persistent/hashtables/nodes/nodes.factor b/basis/persistent/hashtables/nodes/nodes.factor new file mode 100644 index 0000000000..6201e68c6a --- /dev/null +++ b/basis/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/basis/persistent/hashtables/summary.txt b/basis/persistent/hashtables/summary.txt new file mode 100644 index 0000000000..27321fa936 --- /dev/null +++ b/basis/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/basis/persistent/hashtables/tags.txt similarity index 100% rename from extra/persistent-vectors/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/persistent-heaps-docs.factor b/basis/persistent/heaps/heaps-docs.factor similarity index 99% rename from extra/persistent-heaps/persistent-heaps-docs.factor rename to basis/persistent/heaps/heaps-docs.factor index d538fe88d4..dbfadc4ed2 100644 --- a/extra/persistent-heaps/persistent-heaps-docs.factor +++ b/basis/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/basis/persistent/heaps/heaps-tests.factor similarity index 82% rename from extra/persistent-heaps/persistent-heaps-tests.factor rename to basis/persistent/heaps/heaps-tests.factor index 6e559971a0..cecd6dab53 100644 --- a/extra/persistent-heaps/persistent-heaps-tests.factor +++ b/basis/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/basis/persistent/heaps/heaps.factor similarity index 99% rename from extra/persistent-heaps/persistent-heaps.factor rename to basis/persistent/heaps/heaps.factor index 5b57898da0..81c9959f84 100644 --- a/extra/persistent-heaps/persistent-heaps.factor +++ b/basis/persistent/heaps/heaps.factor @@ -1,6 +1,6 @@ USING: kernel accessors multi-methods locals combinators math arrays assocs namespaces sequences ; -IN: persistent-heaps +IN: persistent.heaps ! These are minheaps 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/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+ 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/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