From 7f8e378be7554d31185179290e9068352fd30887 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Sat, 26 Jul 2008 11:31:40 +0100 Subject: [PATCH 01/13] added wordtimer-call word to make timing simpler --- extra/wordtimer/wordtimer-docs.factor | 7 ++++++- extra/wordtimer/wordtimer.factor | 6 ++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/extra/wordtimer/wordtimer-docs.factor b/extra/wordtimer/wordtimer-docs.factor index 47b85bb007..c13399e0f8 100644 --- a/extra/wordtimer/wordtimer-docs.factor +++ b/extra/wordtimer/wordtimer-docs.factor @@ -34,8 +34,13 @@ HELP: profile-vocab { $description "Annotates the words in the vocab with timing code then runs the quotation. Finally resets the words and prints the timings information." } ; +HELP: wordtimer-call +{ $values { "quot" "a quotation to run" } } +{ $description "Resets the wordtimer hash and runs the quotation. After the quotation has run it prints out the timed words" +} ; + ARTICLE: "wordtimer" "Word Timer" -"The " { $vocab-link "wordtimer" } " vocabulary measures accumulated execution time for words. If you just want to profile the accumulated time taken by all words in a vocab you can use " { $vocab-link "profile-vocab" } ". If you need more fine grained control then do the following: First annotate individual words with the " { $link add-timer } " word or whole vocabularies with " { $link add-timers } ". Then reset the clock with " { $link reset-word-timer } " and execute your code. Finally you can view the timings with " { $link print-word-timings } ". If you have functions that are quick and called often you may want to " { $link correct-for-timing-overhead } ". To remove all the annotations in the vocab you can use " { $link reset-vocab } ". Alternatively if you just want to time the contents of a vocabulary you can use profile-vocab." ; +"The " { $vocab-link "wordtimer" } " vocabulary measures accumulated execution time for words. If you just want to profile the accumulated time taken by all words in a vocab you can use " { $vocab-link "profile-vocab" } ". If you need more fine grained control then do the following: First annotate individual words with the " { $link add-timer } " word or whole vocabularies with " { $link add-timers } ". Then use " { $link wordtimer-call } " to invoke a quotation and print out the timings." ; ABOUT: "wordtimer" diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor index 5da17e28d5..15f50faa15 100644 --- a/extra/wordtimer/wordtimer.factor +++ b/extra/wordtimer/wordtimer.factor @@ -67,6 +67,12 @@ SYMBOL: *calling* : print-word-timings ( -- ) *wordtimes* get-global [ swap suffix ] { } assoc>map natural-sort reverse pprint ; +: wordtimer-call ( quot -- ) + reset-word-timer + [ call ] micro-time >r + correct-for-timing-overhead + "total time:" write r> pprint nl + print-word-timings nl ; : profile-vocab ( vocabspec quot -- ) "annotating vocab..." print flush From 5ddb166caac45e1a89f38a2e7e8bccd55bb935ae Mon Sep 17 00:00:00 2001 From: Rex Ford Date: Sat, 2 Aug 2008 13:57:17 -0400 Subject: [PATCH 02/13] renamed some defs --- extra/math/newtons-method/newtons-method.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/math/newtons-method/newtons-method.factor b/extra/math/newtons-method/newtons-method.factor index b2778a2d85..5bf71deac8 100644 --- a/extra/math/newtons-method/newtons-method.factor +++ b/extra/math/newtons-method/newtons-method.factor @@ -1,4 +1,4 @@ -! Copyright © 2008 Reginald Keith Ford II +! Copyright © 2008 Reginald Keith Ford II ! Newton's Method of approximating roots USING: kernel math math.derivatives ; @@ -6,6 +6,6 @@ IN: math.newtons-method -: newton-method ( guess function -- x ) newton-precision [ [ newton-step ] keep ] times drop ; +: newtons-method ( guess function -- x ) newton-precision [ [ newton-step ] keep ] times drop ; From 0e34b0259ad48aae467a67494ba3c7c1fd94a438 Mon Sep 17 00:00:00 2001 From: Rex Ford Date: Sat, 2 Aug 2008 13:57:59 -0400 Subject: [PATCH 03/13] Now with statistically unbiased approx. --- extra/math/derivatives/derivatives.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/math/derivatives/derivatives.factor b/extra/math/derivatives/derivatives.factor index fef93cabc4..d92066efaf 100644 --- a/extra/math/derivatives/derivatives.factor +++ b/extra/math/derivatives/derivatives.factor @@ -3,7 +3,8 @@ USING: kernel math math.points math.function-tools ; IN: math.derivatives -: small-amount ( -- n ) 1.0e-12 ; -: near ( x -- y ) small-amount + ; -: derivative ( x function -- m ) 2dup [ near ] dip [ eval ] 2bi@ slope ; +: small-amount ( -- n ) 1.0e-14 ; +: some-more ( x -- y ) small-amount + ; +: some-less ( x -- y ) small-amount - ; +: derivative ( x function -- m ) [ [ some-more ] dip eval ] [ [ some-less ] dip eval ] 2bi slope ; : derivative-func ( function -- function ) [ derivative ] curry ; \ No newline at end of file From 2b2a91db0adc08c8465d00f02a4c68a0b5f6821a Mon Sep 17 00:00:00 2001 From: Rex Ford Date: Sat, 2 Aug 2008 14:02:33 -0400 Subject: [PATCH 04/13] erased extra vocabs, added inversed function support --- extra/math/function-tools/function-tools.factor | 3 ++- extra/math/secant-method/secant-method.factor | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/math/function-tools/function-tools.factor b/extra/math/function-tools/function-tools.factor index 042b5f0897..802bf9e14e 100644 --- a/extra/math/function-tools/function-tools.factor +++ b/extra/math/function-tools/function-tools.factor @@ -1,8 +1,9 @@ ! Copyright © 2008 Reginald Keith Ford II ! Tools for quickly comparing, transforming, and evaluating mathematical Factor functions -USING: kernel math arrays ; +USING: kernel math arrays sequences sequences.lib ; IN: math.function-tools : difference-func ( func func -- func ) [ bi - ] 2curry ; : eval ( x func -- pt ) dupd call 2array ; +: eval-inverse ( y func -- pt ) dupd call swap 2array ; : eval3d ( x y func -- pt ) [ 2dup ] dip call 3array ; diff --git a/extra/math/secant-method/secant-method.factor b/extra/math/secant-method/secant-method.factor index 2089dde848..e039b42bbd 100644 --- a/extra/math/secant-method/secant-method.factor +++ b/extra/math/secant-method/secant-method.factor @@ -7,8 +7,8 @@ IN: math.secant-method -: secant-method ( left right function -- x ) secant-precision [ secant-step ] times drop v+ 2 v*n ; +: secant-method ( left right function -- x ) secant-precision [ secant-step ] times drop + 2 / ; ! : close-enough? ( a b -- t/f ) - abs tiny-amount < ; ! : secant-method2 ( left right function -- x ) 2over close-enough? [ drop average ] [ secant-step secant-method ] if ; \ No newline at end of file From 14ab1c7177f451fb944a06281d5ac40e66268241 Mon Sep 17 00:00:00 2001 From: Phil Dawes Date: Tue, 5 Aug 2008 10:36:13 +0100 Subject: [PATCH 05/13] Ammended csv to use a global var for default delimiter. Also removed dependency on vars --- extra/csv/csv.factor | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/extra/csv/csv.factor b/extra/csv/csv.factor index 3d1fb64492..9779c37ed4 100644 --- a/extra/csv/csv.factor +++ b/extra/csv/csv.factor @@ -4,12 +4,16 @@ ! Simple CSV Parser ! Phil Dawes phil@phildawes.net -USING: kernel sequences io namespaces combinators unicode.categories vars ; +USING: kernel sequences io namespaces combinators unicode.categories ; IN: csv -DEFER: quoted-field +SYMBOL: delimiter -VAR: delimiter +CHAR: , delimiter set-global + +: delimiter> delimiter get ; inline + +DEFER: quoted-field ( -- endchar ) ! trims whitespace from either end of string : trim-whitespace ( str -- str ) @@ -44,7 +48,7 @@ VAR: delimiter : (row) ( -- sep ) field , - dup delimiter> = [ drop (row) ] when ; + dup delimiter get = [ drop (row) ] when ; : row ( -- eof? array[string] ) [ (row) ] { } make ; @@ -55,25 +59,18 @@ VAR: delimiter : (csv) ( -- ) row append-if-row-not-empty [ (csv) ] when ; - -: init-vars ( -- ) - delimiter> [ CHAR: , >delimiter ] unless ; inline : csv-row ( stream -- row ) - init-vars [ row nip ] with-input-stream ; : csv ( stream -- rows ) - init-vars [ [ (csv) ] { } make ] with-input-stream ; : with-delimiter ( char quot -- ) delimiter swap with-variable ; inline - - : needs-escaping? ( cell -- ? ) - [ "\n\"" delimiter> suffix member? ] contains? ; inline ! " + [ [ "\n\"" member? ] [ delimiter get = ] bi or ] contains? ; inline ! " : escape-quotes ( cell -- cell' ) [ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline @@ -85,8 +82,7 @@ VAR: delimiter dup needs-escaping? [ escape-quotes enclose-in-quotes ] when ; inline : write-row ( row -- ) - [ delimiter> write1 ] [ escape-if-required write ] interleave nl ; inline + [ delimiter get write1 ] [ escape-if-required write ] interleave nl ; inline : write-csv ( rows outstream -- ) - init-vars [ [ write-row ] each ] with-output-stream ; From 3edf1db4a34f9018d5e9c9e2ceb447c349e696f2 Mon Sep 17 00:00:00 2001 From: Rex Ford Date: Tue, 5 Aug 2008 16:30:47 -0500 Subject: [PATCH 06/13] adding animations lib --- extra/animations/animations-docs.factor | 34 +++++++++++++++++++++++++ extra/animations/animations.factor | 12 +++++++++ extra/animations/authors.txt | 1 + 3 files changed, 47 insertions(+) create mode 100644 extra/animations/animations-docs.factor create mode 100644 extra/animations/animations.factor create mode 100644 extra/animations/authors.txt diff --git a/extra/animations/animations-docs.factor b/extra/animations/animations-docs.factor new file mode 100644 index 0000000000..6a1e89a28e --- /dev/null +++ b/extra/animations/animations-docs.factor @@ -0,0 +1,34 @@ +USING: help.markup help.syntax ; +IN: extra.animations + +HELP: animate ( quot duration -- ) +{ $values + { "quot" "a quot which uses " { $link progress } } + { "duration" "a duration of time" } +} +{ $description { $link animate } " calls " { $link reset-progress } " , then continously calls the given quot until the duration of time has elapsed. The quot should use " { $link progress } " at least once." } +{ $example + "USING: extra.animations calendar threads prettyprint ;" + "[ 1 sleep progress unparse write \" ms elapsed\" print ] 1/20 seconds animate ;" + "46 ms elapsed\n17 ms elapsed" +} ; + +HELP: reset-progress ( -- ) +{ $description "Initiates the timer. Call this before using a loop which makes use of " { $link progress } "." } ; + +HELP: progress ( -- time ) +{ $values { "time" "an integer" } } +{ $description "Gives the time elapsed since the last time this word was called, in milliseconds." } +{ $example + "USING: extra.animations threads prettyprint ;" + "reset-progress 3 [ 1 sleep progress unparse write \"ms elapsed\" print ] times ;" + "31 ms elapsed\n18 ms elapsed\n16 ms elapsed" +} ; + +ARTICLE: "extra.animations" "Animations" +"Provides a lightweight framework for properly simulating continuous functions of real time. This framework helps one create animations that use rates which do not change across platforms. The speed of the computer should correlate with the smoothness of the animation, not the speed of the animation!" +{ $subsection animate } +{ $subsection reset-progress } +{ $subsection progress } +{ $link progress } " specifically provides the length of time since " { $link reset-progress } " was called, and also calls " { $link reset-progress } " as its last action. This can be directly used when one's quote runs for a specific number of iterations, instead of a length of time. If the animation is like most, and is expected to run for a specific length of time, " { $link animate } " should be used." ; +ABOUT: "extra.animations" \ No newline at end of file diff --git a/extra/animations/animations.factor b/extra/animations/animations.factor new file mode 100644 index 0000000000..7efd618bbf --- /dev/null +++ b/extra/animations/animations.factor @@ -0,0 +1,12 @@ +! Small library for cross-platform continuous functions of real time + +USING: kernel shuffle system locals +prettyprint math io namespaces threads calendar ; +IN: extra.animations + +SYMBOL: last-loop +: reset-progress ( -- ) millis last-loop set ; +: progress ( -- progress ) millis last-loop get - reset-progress ; +: set-end ( duration -- end-time ) dt>milliseconds millis + ; +: loop ( quot end -- ) dup millis > [ [ dup call ] dip loop ] [ 2drop ] if ; +: animate ( quot duration -- ) reset-progress set-end loop ; \ No newline at end of file diff --git a/extra/animations/authors.txt b/extra/animations/authors.txt new file mode 100644 index 0000000000..dac0cb42fe --- /dev/null +++ b/extra/animations/authors.txt @@ -0,0 +1 @@ +Reginald Keith Ford II \ No newline at end of file From 7e1ba0ce67831f8c25b9bf2d6d9d40aaa80beb79 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 Aug 2008 19:31:49 -0500 Subject: [PATCH 07/13] New propagation tests --- .../tree/propagation/propagation-tests.factor | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/unfinished/compiler/tree/propagation/propagation-tests.factor b/unfinished/compiler/tree/propagation/propagation-tests.factor index b14e94ab8c..515d1bf474 100644 --- a/unfinished/compiler/tree/propagation/propagation-tests.factor +++ b/unfinished/compiler/tree/propagation/propagation-tests.factor @@ -536,3 +536,15 @@ M: array iterate first t ; [ V{ f } ] [ [ 10 eq? [ drop 3 ] unless ] final-literals ] unit-test + +GENERIC: bad-generic ( a -- b ) +M: fixnum bad-generic 1 fixnum+fast ; +: bad-behavior 4 bad-generic ; inline recursive + +[ V{ fixnum } ] [ [ bad-behavior ] final-classes ] unit-test + +[ V{ number } ] [ + [ + 0 10 [ bad-generic dup 123 bitand drop bad-generic 1 + ] times + ] final-classes +] unit-test From 3d2871ca617c67f170f52c6dae152f0076103f32 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 5 Aug 2008 22:56:42 -0700 Subject: [PATCH 08/13] 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 09/13] 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 10/13] 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 11/13] 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 12/13] 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 13/13] 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 ;