core/growable/growable.factor

   1 ! Copyright (C) 2005, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel kernel.private math math.private
   4 sequences sequences.private ;
   5 IN: growable
   6
   7 MIXIN: growable
   8
   9 SLOT: length
  10 SLOT: underlying
  11
  12 M: growable length length>> ;
  13 M: growable nth-unsafe underlying>> nth-unsafe ;
  14 M: growable set-nth-unsafe underlying>> set-nth-unsafe ;
  15
  16 : capacity ( seq -- n ) underlying>> length ; inline
  17
  18 : expand ( len seq -- )
  19     [ resize ] change-underlying drop ; inline
  20
  21 : contract ( len seq -- )
  22     [ length ] keep
  23     [ [ 0 ] 2dip set-nth-unsafe ] curry
  24     (each-integer) ; inline
  25
  26 : growable-check ( n seq -- n seq )
  27     over 0 < [ bounds-error ] when ; inline
  28
  29 M: growable set-length ( n seq -- )
  30     growable-check
  31     2dup length < [
  32         2dup contract
  33     ] [
  34         2dup capacity > [ 2dup expand ] when
  35     ] if
  36     (>>length) ;
  37
  38 : new-size ( old -- new ) 1+ 3 * ; inline
  39
  40 : ensure ( n seq -- n seq )
  41     growable-check
  42     2dup length >= [
  43         2dup capacity >= [ over new-size over expand ] when
  44         [ >fixnum ] dip
  45         over 1 fixnum+fast over (>>length)
  46     ] [
  47         [ >fixnum ] dip
  48     ] if ; inline
  49
  50 M: growable set-nth ensure set-nth-unsafe ;
  51
  52 M: growable clone (clone) [ clone ] change-underlying ;
  53
  54 M: growable lengthen ( n seq -- )
  55     2dup length > [
  56         2dup capacity > [ over new-size over expand ] when
  57         2dup (>>length)
  58     ] when 2drop ;
  59
  60 M: growable shorten ( n seq -- )
  61     growable-check
  62     2dup length < [
  63         2dup contract
  64         2dup (>>length)
  65     ] when 2drop ;
  66
  67 INSTANCE: growable sequence