From 556ab7324686d79f53b0e84c9c140d8244fe99d3 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 14 Jul 2008 01:30:33 -0700 Subject: [PATCH 1/2] Tuple array streamlining --- extra/tuple-arrays/tuple-arrays-docs.factor | 12 +++++++---- extra/tuple-arrays/tuple-arrays-tests.factor | 10 +++++++--- extra/tuple-arrays/tuple-arrays.factor | 21 ++++++++++---------- 3 files changed, 25 insertions(+), 18 deletions(-) diff --git a/extra/tuple-arrays/tuple-arrays-docs.factor b/extra/tuple-arrays/tuple-arrays-docs.factor index d0c86986fd..18f5547e7f 100644 --- a/extra/tuple-arrays/tuple-arrays-docs.factor +++ b/extra/tuple-arrays/tuple-arrays-docs.factor @@ -1,9 +1,13 @@ -USING: help.syntax help.markup splitting kernel ; +USING: help.syntax help.markup splitting kernel sequences ; IN: tuple-arrays HELP: tuple-array -{ $description "The class of packed homogeneous tuple arrays. They are created with " { $link } ". All elements are of the same tuple class. Mutations done to an element are not copied back to the packed array unless it is explicitly written back.." } ; +{ $description "The class of packed homogeneous tuple arrays. They are created with " { $link } ". All elements are of the same tuple class. Mutations done to an element are not copied back to the packed array unless it is explicitly written back. To convert a sequence to a tuple array, use the word " { $link >tuple-array } "." } ; HELP: -{ $values { "example" tuple } { "length" "a non-negative integer" } { "tuple-array" tuple-array } } -{ $description "Creates an instance of the " { $link } " class with the given length and containing the given tuple class. The tuple class is specified in the form of an example tuple. If the example tuple has a delegate, the tuple array will store a delegate for each element. Otherwise, the delegate will be assumed to be " { $link f } "." } ; +{ $values { "class" "a tuple class" } { "length" "a non-negative integer" } { "tuple-array" tuple-array } } +{ $description "Creates an instance of the " { $link } " class with the given length and containing the given tuple class." } ; + +HELP: >tuple-array +{ $values { "seq" sequence } { "tuple-array" tuple-array } } +{ $description "Converts a sequence into a homogeneous unboxed tuple array of the type indicated by the first element." } ; diff --git a/extra/tuple-arrays/tuple-arrays-tests.factor b/extra/tuple-arrays/tuple-arrays-tests.factor index 132a11f4a6..4c288b1c9e 100755 --- a/extra/tuple-arrays/tuple-arrays-tests.factor +++ b/extra/tuple-arrays/tuple-arrays-tests.factor @@ -1,16 +1,20 @@ -USING: tuple-arrays sequences tools.test namespaces kernel math ; +USING: tuple-arrays sequences tools.test namespaces kernel math accessors ; IN: tuple-arrays.tests SYMBOL: mat TUPLE: foo bar ; C: foo -[ 2 ] [ 2 T{ foo } dup mat set length ] unit-test +[ 2 ] [ 2 foo dup mat set length ] unit-test [ T{ foo } ] [ mat get first ] unit-test [ T{ foo 2 1 } ] [ T{ foo 2 1 } 0 mat get [ set-nth ] keep first ] unit-test [ t ] [ { T{ foo f 1 } T{ foo f 2 } } >tuple-array dup mat set tuple-array? ] unit-test [ T{ foo f 3 } t ] [ mat get [ foo-bar 2 + ] map [ first ] keep tuple-array? ] unit-test -[ 2 ] [ 2 T{ foo t } dup mat set length ] unit-test +[ 2 ] [ 2 foo dup mat set length ] unit-test [ T{ foo } ] [ mat get first ] unit-test [ T{ foo 2 1 } ] [ T{ foo 2 1 } 0 mat get [ set-nth ] keep first ] unit-test + +TUPLE: baz { bing integer } bong ; +[ 0 ] [ 1 baz first bing>> ] unit-test +[ f ] [ 1 baz first bong>> ] unit-test diff --git a/extra/tuple-arrays/tuple-arrays.factor b/extra/tuple-arrays/tuple-arrays.factor index 63e7541c95..5da7085773 100644 --- a/extra/tuple-arrays/tuple-arrays.factor +++ b/extra/tuple-arrays/tuple-arrays.factor @@ -4,27 +4,26 @@ USING: splitting grouping classes.tuple classes math kernel sequences arrays accessors ; IN: tuple-arrays -TUPLE: tuple-array seq class ; +TUPLE: tuple-array { seq read-only } { class read-only } ; -: ( length example -- tuple-array ) - [ tuple>array length 1- [ * { } new-sequence ] keep ] - [ class ] bi tuple-array boa ; +: ( length class -- tuple-array ) + [ + new tuple>array 1 tail + [ concat ] [ length ] bi + ] [ ] bi tuple-array boa ; M: tuple-array nth [ seq>> nth ] [ class>> ] bi prefix >tuple ; -: deconstruct ( tuple -- seq ) - tuple>array 1 tail ; - M: tuple-array set-nth ( elt n seq -- ) - >r >r deconstruct r> r> seq>> set-nth ; + >r >r tuple>array 1 tail r> r> seq>> set-nth ; M: tuple-array new-sequence - class>> new ; + class>> ; -: >tuple-array ( seq -- tuple-array/seq ) +: >tuple-array ( seq -- tuple-array ) dup empty? [ - 0 over first clone-like + 0 over first class clone-like ] unless ; M: tuple-array like From 6034e27d781603c39c900b6d30e26b42b0e17c99 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 14 Jul 2008 01:33:13 -0700 Subject: [PATCH 2/2] Removed superfluous mixin in heaps --- core/heaps/heaps.factor | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/core/heaps/heaps.factor b/core/heaps/heaps.factor index fe1fc4e172..1873db67b5 100755 --- a/core/heaps/heaps.factor +++ b/core/heaps/heaps.factor @@ -5,8 +5,6 @@ USING: kernel math sequences arrays assocs sequences.private growable accessors math.order ; IN: heaps -MIXIN: priority-queue - GENERIC: heap-push* ( value key heap -- entry ) GENERIC: heap-peek ( heap -- value key ) GENERIC: heap-pop* ( heap -- ) @@ -36,13 +34,10 @@ TUPLE: max-heap < heap ; : ( -- max-heap ) max-heap ; -INSTANCE: min-heap priority-queue -INSTANCE: max-heap priority-queue - -M: priority-queue heap-empty? ( heap -- ? ) +M: heap heap-empty? ( heap -- ? ) data>> empty? ; -M: priority-queue heap-size ( heap -- n ) +M: heap heap-size ( heap -- n ) data>> length ; -M: priority-queue heap-push* ( value key heap -- entry ) +M: heap heap-push* ( value key heap -- entry ) [ dup ] keep [ data-push ] keep up-heap ; : heap-push ( value key heap -- ) heap-push* drop ; @@ -163,7 +158,7 @@ M: priority-queue heap-push* ( value key heap -- entry ) : >entry< ( entry -- key value ) [ value>> ] [ key>> ] bi ; -M: priority-queue heap-peek ( heap -- value key ) +M: heap heap-peek ( heap -- value key ) data-first >entry< ; : entry>index ( entry heap -- n ) @@ -172,7 +167,7 @@ M: priority-queue heap-peek ( heap -- value key ) ] unless entry-index ; -M: priority-queue heap-delete ( entry heap -- ) +M: heap heap-delete ( entry heap -- ) [ entry>index ] keep 2dup heap-size 1- = [ nip data-pop* @@ -182,10 +177,10 @@ M: priority-queue heap-delete ( entry heap -- ) down-heap ] if ; -M: priority-queue heap-pop* ( heap -- ) +M: heap heap-pop* ( heap -- ) dup data-first swap heap-delete ; -M: priority-queue heap-pop ( heap -- value key ) +M: heap heap-pop ( heap -- value key ) dup data-first [ swap heap-delete ] keep >entry< ; : heap-pop-all ( heap -- alist )