1 ! Copyright (C) 2005, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel math math.private sequences
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
18 : push-unsafe ( elt seq -- )
19 [ length integer>fixnum ] keep
20 [ set-nth-unsafe ] [ [ 1 fixnum+fast ] dip length<< ] 2bi ; inline
22 : push-all-unsafe ( from to src dst -- )
23 [ over - swap ] 2dip pickd [ length integer>fixnum ] keep
24 [ [ fixnum+fast ] dip length<< ] 2keep <copy> (copy) drop ; inline
28 : capacity ( seq -- n ) underlying>> length ; inline
30 : expand ( len seq -- )
31 [ resize ] change-underlying drop ; inline
33 GENERIC: contract ( len seq -- )
35 M: growable contract ( len seq -- )
37 [ [ 0 ] 2dip set-nth-unsafe ] curry
38 (each-integer) ; inline
40 M: growable set-length ( n seq -- )
45 2dup capacity > [ 2dup expand ] when
49 : new-size ( old -- new ) 1 + 2 * ; inline
51 : ensure ( n seq -- n seq )
54 2dup capacity >= [ over new-size over expand ] when
55 [ integer>fixnum ] dip
56 over 1 fixnum+fast >>length
58 [ integer>fixnum ] dip
61 M: growable set-nth ensure set-nth-unsafe ; inline
63 M: growable clone (clone) [ clone ] change-underlying ; inline
65 M: growable lengthen ( n seq -- )
67 2dup capacity > [ over new-size over expand ] when
71 M: growable shorten ( n seq -- )
78 M: growable new-resizable new-sequence 0 over set-length ; inline
80 INSTANCE: growable sequence