basis/circular/circular.factor

   1 ! Copyright (C) 2005, 2006 Alex Chapman, Daniel Ehrenberg
   2 ! See http;//factorcode.org/license.txt for BSD license
   3 USING: kernel sequences math sequences.private strings
   4 accessors ;
   5 IN: circular
   6
   7 ! a circular sequence wraps another sequence, but begins at an
   8 ! arbitrary element in the underlying sequence.
   9 TUPLE: circular seq start ;
  10
  11 : <circular> ( seq -- circular )
  12     0 circular boa ;
  13
  14 <PRIVATE
  15 : circular-wrap ( n circular -- n circular )
  16     [ start>> + ] keep
  17     [ seq>> length rem ] keep ; inline
  18 PRIVATE>
  19
  20 M: circular length seq>> length ;
  21
  22 M: circular virtual@ circular-wrap seq>> ;
  23
  24 M: circular virtual-seq seq>> ;
  25
  26 : change-circular-start ( n circular -- )
  27     #! change start to (start + n) mod length
  28     circular-wrap (>>start) ;
  29
  30 : rotate-circular ( circular -- )
  31     [ start>> 1 + ] keep circular-wrap (>>start) ;
  32
  33 : push-circular ( elt circular -- )
  34     [ set-first ] [ 1 swap change-circular-start ] bi ;
  35
  36 : <circular-string> ( n -- circular )
  37     0 <string> <circular> ;
  38
  39 INSTANCE: circular virtual-sequence
  40
  41 TUPLE: growing-circular < circular length ;
  42
  43 M: growing-circular length length>> ;
  44
  45 <PRIVATE
  46 : full? ( circular -- ? )
  47     [ length ] [ seq>> length ] bi = ;
  48
  49 : set-peek ( elt seq -- )
  50     [ length 1- ] keep set-nth ;
  51 PRIVATE>
  52
  53 : push-growing-circular ( elt circular -- )
  54     dup full? [ push-circular ]
  55     [ [ 1+ ] change-length set-peek ] if ;
  56
  57 : <growing-circular> ( capacity -- growing-circular )
  58     { } new-sequence 0 0 growing-circular boa ;