core/growable/growable.factor

   1 ! Copyright (C) 2005, 2009 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>> ; inline
  13 M: growable nth-unsafe underlying>> nth-unsafe ; inline
  14 M: growable set-nth-unsafe underlying>> set-nth-unsafe ; inline
  15
  16 : capacity ( seq -- n ) underlying>> length ; inline
  17
  18 : expand ( len seq -- )
  19     [ resize ] change-underlying drop ; inline
  20
  21 GENERIC: contract ( len seq -- )
  22
  23 M: growable contract ( len seq -- )
  24     [ length ] keep
  25     [ [ 0 ] 2dip set-nth-unsafe ] curry
  26     (each-integer) ; inline
  27
  28 M: growable set-length ( n seq -- )
  29     bounds-check-head
  30     2dup length < [
  31         2dup contract
  32     ] [
  33         2dup capacity > [ 2dup expand ] when
  34     ] if
  35     length<< ;
  36
  37 : new-size ( old -- new ) 1 + 3 * ; inline
  38
  39 : ensure ( n seq -- n seq )
  40     bounds-check-head
  41     2dup length >= [
  42         2dup capacity >= [ over new-size over expand ] when
  43         [ >fixnum ] dip
  44         over 1 fixnum+fast over length<<
  45     ] [
  46         [ >fixnum ] dip
  47     ] if ; inline
  48
  49 M: growable set-nth ensure set-nth-unsafe ; inline
  50
  51 M: growable clone (clone) [ clone ] change-underlying ; inline
  52
  53 M: growable lengthen ( n seq -- )
  54     2dup length > [
  55         2dup capacity > [ over new-size over expand ] when
  56         2dup length<<
  57     ] when 2drop ; inline
  58
  59 M: growable shorten ( n seq -- )
  60     bounds-check-head
  61     2dup length < [
  62         2dup contract
  63         2dup length<<
  64     ] when 2drop ; inline
  65
  66 M: growable new-resizable new-sequence 0 over set-length ; inline
  67
  68 INSTANCE: growable sequence