diff --git a/extra/tuple-arrays/tuple-arrays-tests.factor b/extra/tuple-arrays/tuple-arrays-tests.factor index dd9510405f..132a11f4a6 100755 --- a/extra/tuple-arrays/tuple-arrays-tests.factor +++ b/extra/tuple-arrays/tuple-arrays-tests.factor @@ -6,7 +6,7 @@ TUPLE: foo bar ; C: <foo> foo [ 2 ] [ 2 T{ foo } <tuple-array> dup mat set length ] unit-test [ T{ foo } ] [ mat get first ] unit-test -[ T{ foo f 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{ foo f 3 } t ] [ mat get [ foo-bar 2 + <foo> ] map [ first ] keep tuple-array? ] unit-test diff --git a/extra/tuple-arrays/tuple-arrays.factor b/extra/tuple-arrays/tuple-arrays.factor index 6a31dac808..63e7541c95 100644 --- a/extra/tuple-arrays/tuple-arrays.factor +++ b/extra/tuple-arrays/tuple-arrays.factor @@ -1,35 +1,26 @@ ! Copyright (C) 2007 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: splitting grouping classes.tuple classes math kernel -sequences arrays ; +sequences arrays accessors ; IN: tuple-arrays -TUPLE: tuple-array example ; - -: prepare-example ( tuple -- seq n ) - dup class over delegate [ 1array ] [ f 2array ] if - swap tuple>array length over length - ; +TUPLE: tuple-array seq class ; : <tuple-array> ( length example -- tuple-array ) - prepare-example [ rot * { } new-sequence ] keep - <sliced-groups> tuple-array construct-delegate - [ set-tuple-array-example ] keep ; - -: reconstruct ( seq example -- tuple ) - prepend >tuple ; + [ tuple>array length 1- [ * { } new-sequence ] keep <sliced-groups> ] + [ class ] bi tuple-array boa ; M: tuple-array nth - [ delegate nth ] keep - tuple-array-example reconstruct ; + [ seq>> nth ] [ class>> ] bi prefix >tuple ; -: deconstruct ( tuple example -- seq ) - >r tuple>array r> length tail-slice ; +: deconstruct ( tuple -- seq ) + tuple>array 1 tail ; M: tuple-array set-nth ( elt n seq -- ) - tuck >r >r tuple-array-example deconstruct r> r> - delegate set-nth ; + >r >r deconstruct r> r> seq>> set-nth ; -M: tuple-array new-sequence tuple-array-example >tuple <tuple-array> ; +M: tuple-array new-sequence + class>> new <tuple-array> ; : >tuple-array ( seq -- tuple-array/seq ) dup empty? [ @@ -39,4 +30,6 @@ M: tuple-array new-sequence tuple-array-example >tuple <tuple-array> ; M: tuple-array like drop dup tuple-array? [ >tuple-array ] unless ; +M: tuple-array length seq>> length ; + INSTANCE: tuple-array sequence