factor/library/collections/virtual-sequences.factor

64 lines
1.8 KiB
Factor
Raw Normal View History

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: errors generic kernel math sequences-internals vectors ;
2005-08-04 19:11:29 -04:00
! A reversal of an underlying sequence.
2006-06-04 03:46:06 -04:00
TUPLE: reversed seq ;
2005-08-04 19:11:29 -04:00
2006-06-04 03:46:06 -04:00
: reversed@ reversed-seq [ length swap - 1- ] keep ; inline
2005-08-04 19:11:29 -04:00
2006-06-04 16:20:40 -04:00
M: reversed length ( seq -- n ) reversed-seq length ;
2005-08-04 19:11:29 -04:00
M: reversed nth ( n seq -- elt ) reversed@ nth ;
M: reversed nth-unsafe ( n seq -- elt ) reversed@ nth-unsafe ;
2005-08-04 19:11:29 -04:00
M: reversed set-nth ( elt n seq -- ) reversed@ set-nth ;
M: reversed set-nth-unsafe ( elt n seq -- )
reversed@ set-nth-unsafe ;
2006-06-04 03:46:06 -04:00
M: reversed like ( seq reversed -- seq ) reversed-seq like ;
2006-01-02 00:51:03 -05:00
2006-06-04 03:46:06 -04:00
M: reversed thaw ( seq -- seq ) reversed-seq thaw ;
2005-08-04 19:11:29 -04:00
2006-05-14 23:25:34 -04:00
: reverse ( seq -- seq ) [ <reversed> ] keep like ;
2005-08-14 17:33:45 -04:00
! A slice of another sequence.
TUPLE: slice seq from to ;
2005-08-04 19:11:29 -04:00
: collapse-slice ( from to slice -- from to seq )
dup slice-from swap slice-seq >r tuck + >r + r> r> ;
: check-slice ( from to seq -- )
2005-10-09 21:27:14 -04:00
pick 0 < [ "Slice begins before 0" throw ] when
length over < [ "Slice longer than sequence" throw ] when
> [ "Slice start is after slice end" throw ] when ;
2005-08-14 17:33:45 -04:00
C: slice ( from to seq -- seq )
#! A slice of a slice collapses.
>r dup slice? [ collapse-slice ] when r>
>r 3dup check-slice r>
2005-08-14 17:33:45 -04:00
[ set-slice-seq ] keep
[ set-slice-to ] keep
2005-12-12 20:53:55 -05:00
[ set-slice-from ] keep ;
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 - ;
2005-08-04 19:11:29 -04:00
2005-08-14 17:33:45 -04:00
: slice@ ( n slice -- n seq )
[ slice-from + ] keep slice-seq ; inline
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
M: slice nth-unsafe ( n slice -- obj ) slice@ nth-unsafe ;
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
M: slice set-nth-unsafe ( n slice -- obj ) slice@ set-nth-unsafe ;
2005-08-14 17:33:45 -04:00
M: slice like ( seq slice -- seq ) slice-seq like ;
2005-12-31 20:51:58 -05:00
2006-01-02 00:51:03 -05:00
M: slice thaw ( seq -- seq ) slice-seq thaw ;