2006-10-22 18:08:49 -04:00
|
|
|
! Copyright (C) 2005, 2006 Slava Pestov.
|
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2005-08-04 19:11:29 -04:00
|
|
|
IN: sequences
|
2005-09-11 20:46:55 -04:00
|
|
|
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-08-16 21:55:53 -04:00
|
|
|
: reversed@ ( m reversed -- n seq )
|
|
|
|
|
reversed-seq [ length swap - 1- ] keep ; inline
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: reversed length reversed-seq length ;
|
2006-06-04 16:20:40 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: reversed nth reversed@ nth ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: reversed nth-unsafe reversed@ nth-unsafe ;
|
2005-09-10 18:27:31 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: reversed set-nth reversed@ set-nth ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: reversed set-nth-unsafe
|
2005-09-10 18:27:31 -04:00
|
|
|
reversed@ set-nth-unsafe ;
|
|
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: reversed like reversed-seq like ;
|
2006-01-02 00:51:03 -05:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: reversed thaw reversed-seq thaw ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: reverse ( seq -- newseq ) [ <reversed> ] keep like ;
|
2006-05-14 23:25:34 -04:00
|
|
|
|
2005-08-14 17:33:45 -04:00
|
|
|
! A slice of another sequence.
|
2005-09-11 20:46:55 -04:00
|
|
|
TUPLE: slice seq from to ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2005-08-15 23:09:44 -04:00
|
|
|
: collapse-slice ( from to slice -- from to seq )
|
|
|
|
|
dup slice-from swap slice-seq >r tuck + >r + r> r> ;
|
|
|
|
|
|
2006-08-01 04:45:05 -04:00
|
|
|
TUPLE: slice-error reason ;
|
2006-08-15 03:01:24 -04:00
|
|
|
: slice-error ( str -- * ) <slice-error> throw ;
|
2006-08-01 04:45:05 -04:00
|
|
|
|
2005-09-11 20:46:55 -04:00
|
|
|
: check-slice ( from to seq -- )
|
2006-08-01 04:45:05 -04:00
|
|
|
pick 0 < [ "start < 0" slice-error ] when
|
|
|
|
|
length over < [ "end > sequence" slice-error ] when
|
|
|
|
|
> [ "start > end" slice-error ] when ;
|
2005-09-11 20:46:55 -04:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
C: slice ( m n seq -- slice )
|
2005-08-15 23:09:44 -04:00
|
|
|
#! A slice of a slice collapses.
|
|
|
|
|
>r dup slice? [ collapse-slice ] when r>
|
2005-09-11 20:46:55 -04:00
|
|
|
>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
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: slice length
|
2005-09-11 20:46:55 -04:00
|
|
|
dup slice-to swap slice-from - ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: slice@ ( m slice -- n seq )
|
2005-09-11 20:46:55 -04:00
|
|
|
[ slice-from + ] keep slice-seq ; inline
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: slice nth slice@ nth ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: slice nth-unsafe slice@ nth-unsafe ;
|
2005-09-10 18:27:31 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: slice set-nth slice@ set-nth ;
|
2005-08-04 19:11:29 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: slice set-nth-unsafe slice@ set-nth-unsafe ;
|
2005-09-10 18:27:31 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: slice like slice-seq like ;
|
2005-12-31 20:51:58 -05:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: slice thaw slice-seq thaw ;
|
2006-10-21 16:51:38 -04:00
|
|
|
|
2006-10-22 18:08:49 -04:00
|
|
|
TUPLE: column seq col ;
|
2006-10-21 16:51:38 -04:00
|
|
|
|
2006-10-22 18:08:49 -04:00
|
|
|
: column@ ( m column -- n seq )
|
2006-10-21 16:51:38 -04:00
|
|
|
dup column-col -rot column-seq nth ;
|
|
|
|
|
|
|
|
|
|
M: column length column-seq length ;
|
|
|
|
|
|
|
|
|
|
M: column nth column@ nth ;
|
|
|
|
|
|
|
|
|
|
M: column set-nth column@ set-nth ;
|
|
|
|
|
|
|
|
|
|
M: column like column-seq like ;
|
|
|
|
|
|
|
|
|
|
M: column thaw column-seq thaw ;
|