steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorforge.org/git/littledan

db4
Slava Pestov 2008-07-11 17:40:14 -05:00
parent a277ee0178 1e829b18e5
commit 96d9962a5b
2 changed files with 13 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/tuple-arrays/tuple-arrays-tests.factor
View File

@ -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

31
extra/tuple-arrays/tuple-arrays.factor
View File

@ -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