core/collections/virtual-sequences.factor

   1 ! Copyright (C) 2005, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: sequences
   4 USING: errors generic kernel math sequences-internals vectors ;
   5
   6 ! A reversal of an underlying sequence.
   7 TUPLE: reversed seq ;
   8
   9 : reversed@ ( m reversed -- n seq )
  10     reversed-seq [ length swap - 1- ] keep ; inline
  11
  12 M: reversed length reversed-seq length ;
  13
  14 M: reversed nth reversed@ nth ;
  15
  16 M: reversed nth-unsafe reversed@ nth-unsafe ;
  17
  18 M: reversed set-nth reversed@ set-nth ;
  19
  20 M: reversed set-nth-unsafe
  21     reversed@ set-nth-unsafe ;
  22
  23 M: reversed like reversed-seq like ;
  24
  25 M: reversed new reversed-seq new ;
  26
  27 : reverse ( seq -- newseq ) [ <reversed> ] keep like ;
  28
  29 ! A slice of another sequence.
  30 TUPLE: slice seq from to ;
  31
  32 : collapse-slice ( from to slice -- from to seq )
  33     dup slice-from swap slice-seq >r tuck + >r + r> r> ;
  34
  35 TUPLE: slice-error reason ;
  36 : slice-error ( str -- * ) <slice-error> throw ;
  37
  38 : check-slice ( from to seq -- )
  39     pick 0 < [ "start < 0" slice-error ] when
  40     length over < [ "end > sequence" slice-error ] when
  41     > [ "start > end" slice-error ] when ;
  42
  43 C: slice ( m n seq -- slice )
  44     #! A slice of a slice collapses.
  45     >r dup slice? [ collapse-slice ] when r>
  46     >r 3dup check-slice r>
  47     [ set-slice-seq ] keep
  48     [ set-slice-to ] keep
  49     [ set-slice-from ] keep ;
  50
  51 M: slice length
  52     dup slice-to swap slice-from - ;
  53
  54 : slice@ ( m slice -- n seq )
  55     [ slice-from + ] keep slice-seq ; inline
  56
  57 M: slice nth slice@ nth ;
  58
  59 M: slice nth-unsafe slice@ nth-unsafe ;
  60
  61 M: slice set-nth slice@ set-nth ;
  62
  63 M: slice set-nth-unsafe slice@ set-nth-unsafe ;
  64
  65 M: slice like slice-seq like ;
  66
  67 M: slice new slice-seq new ;
  68
  69 TUPLE: column seq col ;
  70
  71 : column@ ( m column -- n seq )
  72     dup column-col -rot column-seq nth ;
  73
  74 M: column length column-seq length ;
  75
  76 M: column nth column@ nth ;
  77
  78 M: column set-nth column@ set-nth ;
  79
  80 M: column like column-seq like ;
  81
  82 M: column new column-seq new ;