2005-07-20 18:33:32 -04:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
|
|
|
|
|
|
! Some low-level code used by vectors and string buffers.
|
2005-09-10 18:27:31 -04:00
|
|
|
IN: sequences-internals
|
|
|
|
|
USING: errors kernel kernel-internals math math-internals
|
|
|
|
|
sequences ;
|
2005-07-20 18:33:32 -04:00
|
|
|
|
|
|
|
|
GENERIC: underlying
|
|
|
|
|
GENERIC: set-underlying
|
2005-09-10 00:26:12 -04:00
|
|
|
|
|
|
|
|
! fill pointer mutation. user code should use set-length
|
|
|
|
|
! instead, since it will also resize the underlying sequence.
|
|
|
|
|
GENERIC: set-fill
|
|
|
|
|
|
|
|
|
|
: capacity ( seq -- n ) underlying length ; inline
|
2005-07-20 18:33:32 -04:00
|
|
|
|
|
|
|
|
: expand ( len seq -- )
|
|
|
|
|
[ underlying resize ] keep set-underlying ;
|
|
|
|
|
|
2005-09-10 18:27:31 -04:00
|
|
|
: new-size ( n -- n )
|
2005-09-16 20:49:24 -04:00
|
|
|
3 fixnum* dup 50 fixnum< [ drop 50 ] when ;
|
2005-09-10 18:27:31 -04:00
|
|
|
|
2005-07-20 18:33:32 -04:00
|
|
|
: ensure ( n seq -- )
|
|
|
|
|
#! If n is beyond the sequence's length, increase the length,
|
|
|
|
|
#! growing the underlying storage if necessary, with an
|
|
|
|
|
#! optimistic doubling of its size.
|
|
|
|
|
2dup length fixnum>= [
|
|
|
|
|
>r 1 fixnum+ r>
|
2005-09-10 18:27:31 -04:00
|
|
|
2dup capacity fixnum>
|
|
|
|
|
[ over new-size over expand ] when
|
|
|
|
|
2dup set-fill
|
|
|
|
|
] when 2drop ;
|
2005-07-20 18:33:32 -04:00
|
|
|
|
|
|
|
|
: grow-length ( len seq -- )
|
2005-09-10 00:26:12 -04:00
|
|
|
growable-check 2dup capacity > [ 2dup expand ] when set-fill ;
|
2005-09-07 17:21:11 -04:00
|
|
|
|
2005-09-10 18:27:31 -04:00
|
|
|
: clone-growable ( obj -- obj )
|
|
|
|
|
#! Cloning vectors, sbufs, hashtables.
|
|
|
|
|
(clone) dup underlying clone over set-underlying ;
|