/core/growable/growable.factor

 1! Copyright (C) 2005, 2009 Slava Pestov.
 2! See http://factorcode.org/license.txt for BSD license.
 3USING: accessors kernel math math.private sequences
 4sequences.private ;
 5IN: growable
 6
 7MIXIN: growable
 8
 9SLOT: length
10SLOT: underlying
11
12M: growable length length>> ; inline
13M: growable nth-unsafe underlying>> nth-unsafe ; inline
14M: 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
21GENERIC: contract ( len seq -- )
22
23M: growable contract ( len seq -- )
24    [ length ] keep
25    [ [ 0 ] 2dip set-nth-unsafe ] curry
26    (each-integer) ; inline
27
28M: 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
49M: growable set-nth ensure set-nth-unsafe ; inline
50
51M: growable clone (clone) [ clone ] change-underlying ; inline
52
53M: growable lengthen ( n seq -- )
54    2dup length > [
55        2dup capacity > [ over new-size over expand ] when
56        2dup length<<
57    ] when 2drop ; inline
58
59M: growable shorten ( n seq -- )
60    bounds-check-head
61    2dup length < [
62        2dup contract
63        2dup length<<
64    ] when 2drop ; inline
65
66M: growable new-resizable new-sequence 0 over set-length ; inline
67
68INSTANCE: growable sequence