core/collections/growable.factor

   1 ! Copyright (C) 2005 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 ! Some low-level code used by vectors and string buffers.
   5 IN: sequences-internals
   6 USING: errors kernel kernel-internals math math-internals
   7 sequences ;
   8
   9 GENERIC: underlying ( seq -- underlying )
  10 GENERIC: set-underlying ( underlying seq -- )
  11 GENERIC: set-fill ( n seq -- )
  12
  13 : capacity ( seq -- n ) underlying length ; inline
  14
  15 : expand ( len seq -- )
  16     [ underlying resize ] keep set-underlying ; inline
  17
  18 : contract ( len seq -- )
  19     dup length pick - [
  20         [ swap >r + 0 swap r> set-nth-unsafe ] 3keep
  21     ] repeat 2drop ;
  22
  23 : new-size ( old -- new ) 1+ 3 * ; inline
  24
  25 : ensure ( n seq -- )
  26     2dup length >= [
  27         >r 1+ r>
  28         2dup capacity > [ over new-size over expand ] when
  29         2dup set-fill
  30     ] when 2drop ; inline
  31
  32 TUPLE: bounds-error index seq ;
  33
  34 : bounds-error ( n seq -- * ) <bounds-error> throw ;
  35
  36 : growable-check ( n seq -- n seq )
  37     over 0 < [ bounds-error ] when ; inline
  38
  39 : bounds-check ( n seq -- n seq )
  40     2dup bounds-check? [ bounds-error ] unless ; inline
  41
  42 : grow-length ( n seq -- )
  43     growable-check
  44     2dup length < [ 2dup contract ] when
  45     2dup capacity > [ 2dup expand ] when
  46     set-fill ; inline
  47
  48 : clone-resizable ( seq -- newseq )
  49     (clone) dup underlying clone over set-underlying ; inline