2005-08-04 19:11:29 -04:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
|
IN: sequences
|
|
|
|
|
USING: generic kernel math vectors ;
|
|
|
|
|
|
|
|
|
|
! A repeated sequence is the same element n times.
|
|
|
|
|
TUPLE: repeated length object ;
|
|
|
|
|
|
|
|
|
|
M: repeated length repeated-length ;
|
|
|
|
|
|
|
|
|
|
M: repeated nth nip repeated-object ;
|
|
|
|
|
|
|
|
|
|
! A reversal of an underlying sequence.
|
|
|
|
|
TUPLE: reversed ;
|
|
|
|
|
|
|
|
|
|
C: reversed [ set-delegate ] keep ;
|
|
|
|
|
|
|
|
|
|
: reversed@ delegate [ length swap - 1 - ] keep ;
|
|
|
|
|
|
|
|
|
|
M: reversed nth ( n seq -- elt ) reversed@ nth ;
|
|
|
|
|
|
|
|
|
|
M: reversed set-nth ( elt n seq -- ) reversed@ set-nth ;
|
|
|
|
|
|
|
|
|
|
M: reversed thaw ( seq -- seq ) delegate reverse ;
|
|
|
|
|
|
2005-08-14 17:33:45 -04:00
|
|
|
! A slice of another sequence.
|
|
|
|
|
TUPLE: slice seq from to step ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2005-08-14 17:33:45 -04:00
|
|
|
C: slice ( from to seq -- seq )
|
|
|
|
|
[ set-slice-seq ] keep
|
2005-08-04 19:11:29 -04:00
|
|
|
>r 2dup > -1 1 ? r>
|
2005-08-14 17:33:45 -04:00
|
|
|
[ set-slice-step ] keep
|
|
|
|
|
[ set-slice-to ] keep
|
|
|
|
|
[ set-slice-from ] keep ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2005-08-14 17:33:45 -04:00
|
|
|
: <range> ( from to -- seq ) 0 <slice> ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2005-08-14 17:33:45 -04:00
|
|
|
M: slice length ( range -- n )
|
|
|
|
|
dup slice-to swap slice-from - abs ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2005-08-14 17:33:45 -04:00
|
|
|
: slice@ ( n slice -- n seq )
|
|
|
|
|
[ [ slice-step * ] keep slice-from + ] keep slice-seq ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2005-08-14 17:33:45 -04:00
|
|
|
M: slice nth ( n slice -- obj ) slice@ nth ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2005-08-14 17:33:45 -04:00
|
|
|
M: slice set-nth ( obj n slice -- ) slice@ set-nth ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2005-08-14 17:33:45 -04:00
|
|
|
M: slice like ( seq slice -- seq ) slice-seq like ;
|