2005-07-20 18:33:32 -04:00
|
|
|
! Copyright (C) 2005 Slava Pestov.
|
2005-12-31 04:20:07 -05:00
|
|
|
! See http://factorcode.org/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
|
|
|
|
2006-08-15 16:29:35 -04:00
|
|
|
GENERIC: underlying ( seq -- underlying )
|
|
|
|
|
GENERIC: set-underlying ( underlying seq -- )
|
|
|
|
|
GENERIC: set-fill ( n seq -- )
|
2005-09-10 00:26:12 -04:00
|
|
|
|
2005-12-31 04:20:07 -05:00
|
|
|
: capacity ( seq -- n ) underlying length ; inline
|
|
|
|
|
|
|
|
|
|
: expand ( len seq -- )
|
2006-05-02 06:05:58 -04:00
|
|
|
[ underlying resize ] keep set-underlying ; inline
|
2005-12-31 04:20:07 -05:00
|
|
|
|
2006-07-28 17:57:24 -04:00
|
|
|
: contract ( len seq -- )
|
|
|
|
|
dup length pick - [
|
|
|
|
|
[ swap >r + 0 swap r> set-nth-unsafe ] 3keep
|
|
|
|
|
] repeat 2drop ;
|
|
|
|
|
|
2006-08-15 21:23:05 -04:00
|
|
|
: new-size ( old -- new ) 1+ 3 * ; inline
|
2005-12-31 04:20:07 -05:00
|
|
|
|
|
|
|
|
: ensure ( n seq -- )
|
2005-09-24 16:34:10 -04:00
|
|
|
2dup length >= [
|
|
|
|
|
>r 1+ r>
|
|
|
|
|
2dup capacity > [ over new-size over expand ] when
|
2005-09-10 18:27:31 -04:00
|
|
|
2dup set-fill
|
2006-05-02 06:05:58 -04:00
|
|
|
] when 2drop ; inline
|
2005-12-31 04:20:07 -05:00
|
|
|
|
2005-09-24 16:34:10 -04:00
|
|
|
TUPLE: bounds-error index seq ;
|
2005-12-31 04:20:07 -05:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
: bounds-error ( n seq -- * ) <bounds-error> throw ;
|
2005-12-31 04:20:07 -05:00
|
|
|
|
|
|
|
|
: growable-check ( n seq -- n seq )
|
|
|
|
|
over 0 < [ bounds-error ] when ; inline
|
|
|
|
|
|
|
|
|
|
: bounds-check ( n seq -- n seq )
|
2005-10-01 01:44:49 -04:00
|
|
|
2dup bounds-check? [ bounds-error ] unless ; inline
|
2005-12-31 04:20:07 -05:00
|
|
|
|
2006-08-15 21:23:05 -04:00
|
|
|
: grow-length ( n seq -- )
|
2006-07-28 17:57:24 -04:00
|
|
|
growable-check
|
|
|
|
|
2dup length < [ 2dup contract ] when
|
|
|
|
|
2dup capacity > [ 2dup expand ] when
|
|
|
|
|
set-fill ; inline
|
2005-12-31 04:20:07 -05:00
|
|
|
|
2006-09-01 01:10:30 -04:00
|
|
|
: clone-resizable ( seq -- newseq )
|
2006-05-02 06:05:58 -04:00
|
|
|
(clone) dup underlying clone over set-underlying ; inline
|