core/growable/growable.factor

   1 ! Copyright (C) 2005, 2007 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 USING: kernel kernel.private math math.private
   6 sequences sequences.private ;
   7 IN: growable
   8
   9 MIXIN: growable
  10 GENERIC: underlying ( seq -- underlying )
  11 GENERIC: set-underlying ( underlying seq -- )
  12 GENERIC: set-fill ( n seq -- )
  13
  14 M: growable nth-unsafe underlying nth-unsafe ;
  15
  16 M: growable set-nth-unsafe underlying set-nth-unsafe ;
  17
  18 : capacity ( seq -- n ) underlying length ; inline
  19
  20 : expand ( len seq -- )
  21     [ underlying resize ] keep set-underlying ; inline
  22
  23 : contract ( len seq -- )
  24     [ length ] keep
  25     [ 0 -rot set-nth-unsafe ] curry
  26     (each-integer) ; inline
  27
  28 : growable-check ( n seq -- n seq )
  29     over 0 < [ bounds-error ] when ; inline
  30
  31 M: growable set-length ( n seq -- )
  32     growable-check
  33     2dup length < [
  34         2dup contract
  35     ] [
  36         2dup capacity > [ 2dup expand ] when
  37     ] if
  38     >r >fixnum r> set-fill ;
  39
  40 : new-size ( old -- new ) 1+ 3 * ; inline
  41
  42 : ensure ( n seq -- n seq )
  43     growable-check
  44     2dup length >= [
  45         2dup capacity >= [ over new-size over expand ] when
  46         >r >fixnum r>
  47         2dup >r 1 fixnum+fast r> set-fill
  48     ] [
  49         >r >fixnum r>
  50     ] if ; inline
  51
  52 M: growable set-nth ensure set-nth-unsafe ;
  53
  54 M: growable clone ( seq -- newseq )
  55     (clone) dup underlying clone over set-underlying ;
  56
  57 M: growable lengthen ( n seq -- )
  58     2dup length > [
  59         2dup capacity > [ over new-size over expand ] when
  60         2dup >r >fixnum r> set-fill
  61     ] when 2drop ;
  62
  63 INSTANCE: growable sequence