unmaintained/isequences/ops/iota/iota.factor

   1 ! Copyright (C) 2007 Robbert van Dalen.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 IN: isequences.ops.iota
   5 USING: generic kernel math sequences isequences.interface isequences.base ;
   6
   7
   8
   9 ! **** positive iota ****
  10 !
  11
  12 TUPLE: p-iota offset size ;
  13
  14 : <ip-iota> ( offset size -- p-iota )
  15     dup zero? [ nip ] [ dup 1 = [ drop <i> <i> ] [ <p-iota> ] if ] if ; inline
  16
  17 M: p-iota i-length p-iota-size ;
  18 M: p-iota i-at swap p-iota-offset + <i> ;
  19 M: p-iota ileft dup i-length 2/ >r p-iota-offset r> <ip-iota> ;
  20 M: p-iota iright dup i-length 1 + 2/ >r dup p-iota-offset swap ileft i-length + r> <ip-iota> ;
  21 M: p-iota ihead (ihead) ;
  22 M: p-iota itail (itail) ;
  23 M: p-iota $$ dup p-iota-offset swap p-iota-size [ $$ ] 2apply quick-hash ;
  24 M: p-iota ascending? drop t ;
  25 M: p-iota descending? drop f ;
  26
  27
  28 ! **** negative iota ****
  29 !
  30 TUPLE: n-iota offset size ;
  31
  32 : <in-iota> ( offset size -- n-iota )
  33     dup zero? [ nip ] [ dup 1 = [ drop <i> <i> ] [ <n-iota> ] if ] if ; inline
  34
  35 M: n-iota i-length n-iota-size ;
  36 M: n-iota i-at swap n-iota-offset + neg -1 + <i> ;
  37 M: n-iota ileft dup i-length 2/ >r n-iota-offset r> <in-iota> ;
  38 M: n-iota iright dup i-length 1 + 2/ >r dup n-iota-offset swap ileft i-length + r> <in-iota> ;
  39 M: n-iota ihead (ihead) ;
  40 M: n-iota itail (itail) ;
  41 M: n-iota $$ dup n-iota-offset swap n-iota-size [ $$ -- ] 2apply quick-hash ;
  42 M: n-iota ascending? drop f ;
  43 M: n-iota descending? drop t ;
  44
  45 M: object ~~
  46     0 over i-length dup 0 <
  47     [ -- <in-iota> -- swap -- ## -- || ]
  48     [ <ip-iota> swap ## || ]
  49     if ;
  50 M: integer ~~
  51     0 over 0 < [ swap -- <in-iota> -- ] [ swap <ip-iota> ] if ;
  52 M: p-iota ~~ i-length ~~ ;
  53 M: n-iota ~~ i-length ~~ ;