factor/core/growable/growable.factor

63 lines
1.5 KiB
Factor
Raw Normal View History

! Copyright (C) 2005, 2008 Slava Pestov.
2007-09-20 18:09:08 -04:00
! See http://factorcode.org/license.txt for BSD license.
! Some low-level code used by vectors and string buffers.
USING: accessors kernel kernel.private math math.private
2007-09-20 18:09:08 -04:00
sequences sequences.private ;
IN: growable
MIXIN: growable
SLOT: length
SLOT: underlying
2007-09-20 18:09:08 -04:00
M: growable length length>> ;
M: growable nth-unsafe underlying>> nth-unsafe ;
M: growable set-nth-unsafe underlying>> set-nth-unsafe ;
2007-09-20 18:09:08 -04:00
: capacity ( seq -- n ) underlying>> length ; inline
2007-09-20 18:09:08 -04:00
: expand ( len seq -- )
[ resize ] change-underlying drop ; inline
2007-09-20 18:09:08 -04:00
: contract ( len seq -- )
[ length ] keep
[ 0 -rot set-nth-unsafe ] curry
(each-integer) ; inline
: growable-check ( n seq -- n seq )
over 0 < [ bounds-error ] when ; inline
M: growable set-length ( n seq -- )
growable-check
2dup length < [
2dup contract
] [
2dup capacity > [ 2dup expand ] when
] if
(>>length) ;
2007-09-20 18:09:08 -04:00
: new-size ( old -- new ) 1+ 3 * ; inline
: ensure ( n seq -- n seq )
growable-check
2dup length >= [
2dup capacity >= [ over new-size over expand ] when
>r >fixnum r>
over 1 fixnum+fast over (>>length)
2007-09-20 18:09:08 -04:00
] [
>r >fixnum r>
] if ; inline
M: growable set-nth ensure set-nth-unsafe ;
M: growable clone (clone) [ clone ] change-underlying ;
2007-09-20 18:09:08 -04:00
M: growable lengthen ( n seq -- )
2dup length > [
2dup capacity > [ over new-size over expand ] when
2dup (>>length)
2007-09-20 18:09:08 -04:00
] when 2drop ;
INSTANCE: growable sequence