Tuple array streamlining

db4
Daniel Ehrenberg 2008-07-14 01:30:33 -07:00
parent b668936d9f
commit 556ab73246
3 changed files with 25 additions and 18 deletions

View File

@ -1,9 +1,13 @@
USING: help.syntax help.markup splitting kernel ; USING: help.syntax help.markup splitting kernel sequences ;
IN: tuple-arrays IN: tuple-arrays
HELP: tuple-array HELP: tuple-array
{ $description "The class of packed homogeneous tuple arrays. They are created with " { $link <tuple-array> } ". 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 <tuple-array> } ". 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: <tuple-array> HELP: <tuple-array>
{ $values { "example" tuple } { "length" "a non-negative integer" } { "tuple-array" tuple-array } } { $values { "class" "a tuple class" } { "length" "a non-negative integer" } { "tuple-array" tuple-array } }
{ $description "Creates an instance of the " { $link <tuple-array> } " 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 } "." } ; { $description "Creates an instance of the " { $link <tuple-array> } " 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." } ;

View File

@ -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 IN: tuple-arrays.tests
SYMBOL: mat SYMBOL: mat
TUPLE: foo bar ; TUPLE: foo bar ;
C: <foo> foo C: <foo> foo
[ 2 ] [ 2 T{ foo } <tuple-array> dup mat set length ] unit-test [ 2 ] [ 2 foo <tuple-array> dup mat set length ] unit-test
[ T{ foo } ] [ mat get first ] 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{ 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 ] [ { T{ foo f 1 } T{ foo f 2 } } >tuple-array dup mat set tuple-array? ] unit-test
[ T{ foo f 3 } t ] [ T{ foo f 3 } t ]
[ mat get [ foo-bar 2 + <foo> ] map [ first ] keep tuple-array? ] unit-test [ mat get [ foo-bar 2 + <foo> ] map [ first ] keep tuple-array? ] unit-test
[ 2 ] [ 2 T{ foo t } <tuple-array> dup mat set length ] unit-test [ 2 ] [ 2 foo <tuple-array> dup mat set length ] unit-test
[ T{ foo } ] [ mat get first ] 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{ foo 2 1 } ] [ T{ foo 2 1 } 0 mat get [ set-nth ] keep first ] unit-test
TUPLE: baz { bing integer } bong ;
[ 0 ] [ 1 baz <tuple-array> first bing>> ] unit-test
[ f ] [ 1 baz <tuple-array> first bong>> ] unit-test

View File

@ -4,27 +4,26 @@ USING: splitting grouping classes.tuple classes math kernel
sequences arrays accessors ; sequences arrays accessors ;
IN: tuple-arrays IN: tuple-arrays
TUPLE: tuple-array seq class ; TUPLE: tuple-array { seq read-only } { class read-only } ;
: <tuple-array> ( length example -- tuple-array ) : <tuple-array> ( length class -- tuple-array )
[ tuple>array length 1- [ * { } new-sequence ] keep <sliced-groups> ] [
[ class ] bi tuple-array boa ; new tuple>array 1 tail
[ <repetition> concat ] [ length ] bi <sliced-groups>
] [ ] bi tuple-array boa ;
M: tuple-array nth M: tuple-array nth
[ seq>> nth ] [ class>> ] bi prefix >tuple ; [ seq>> nth ] [ class>> ] bi prefix >tuple ;
: deconstruct ( tuple -- seq )
tuple>array 1 tail ;
M: tuple-array set-nth ( elt n seq -- ) 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 M: tuple-array new-sequence
class>> new <tuple-array> ; class>> <tuple-array> ;
: >tuple-array ( seq -- tuple-array/seq ) : >tuple-array ( seq -- tuple-array )
dup empty? [ dup empty? [
0 over first <tuple-array> clone-like 0 over first class <tuple-array> clone-like
] unless ; ] unless ;
M: tuple-array like M: tuple-array like