<commit_before>! Copyright (C) 2005, 2009 <NAME>, <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel kernel.private slots.private math
math.private math.order ;
IN: sequences

MIXIN: sequence

GENERIC: length ( seq -- n ) flushable
GENERIC: set-length ( n seq -- )
GENERIC: nth ( n seq -- elt ) flushable
GENERIC: set-nth ( elt n seq -- )
GENERIC: new-sequence ( len seq -- newseq ) flushable
GENERIC: new-resizable ( len seq -- newseq ) flushable
GENERIC: like ( seq exemplar -- newseq ) flushable
GENERIC: clone-like ( seq exemplar -- newseq ) flushable

: new-like ( len exemplar quot -- seq )
    over [ [ new-sequence ] dip call ] dip like ; inline

M: sequence like drop ; inline

GENERIC: lengthen ( n seq -- )
GENERIC: shorten ( n seq -- )

M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; inline

M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; inline

: empty? ( seq -- ? ) length 0 = ; inline

: if-empty ( seq quot1 quot2 -- )
    [ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline

: when-empty ( seq quot -- ) [ ] if-empty ; inline

: unless-empty ( seq quot -- ) [ ] swap if-empty ; inline

: delete-all ( seq -- ) 0 swap set-length ;

: first ( seq -- first ) 0 swap nth ; inline
: second ( seq -- second ) 1 swap nth ; inline
: third ( seq -- third ) 2 swap nth ; inline
: fourth ( seq -- fourth ) 3 swap nth ; inline

: set-first ( first seq -- ) 0 swap set-nth ; inline
: set-second ( second seq -- ) 1 swap set-nth ; inline
: set-third ( third seq -- ) 2 swap set-nth ; inline
: set-fourth  ( fourth seq -- ) 3 swap set-nth ; inline

: push ( elt seq -- ) [ length ] [ set-nth ] bi ;

: bounds-check? ( n seq -- ? )
    dupd length < [ 0 >= ] [ drop f ] if ; inline

ERROR: bounds-error index seq ;

: bounds-check ( n seq -- n seq )
    2dup bounds-check? [ bounds-error ] unless ; inline

MIXIN: immutable-sequence

ERROR: immutable seq ;

M: immutable-sequence set-nth immutable ;

INSTANCE: immutable-sequence sequence

<PRIVATE

: array-nth ( n array -- elt )
    swap 2 fixnum+fast slot ; inline

: set-array-nth ( elt n array -- )
    swap 2 fixnum+fast set-slot ; inline

: dispatch ( n array -- ) array-nth call ;

GENERIC: resize ( n seq -- newseq ) flushable

! Unsafe sequence protocol for inner loops
GENERIC: nth-unsafe ( n seq -- elt ) flushable
GENERIC: set-nth-unsafe ( elt n seq -- )

M: sequence nth bounds-check nth-unsafe ; inline
M: sequence set-nth bounds-check set-nth-unsafe ; inline

M: sequence nth-unsafe nth ; inline
M: sequence set-nth-unsafe set-nth ; inline

: change-nth-unsafe ( i seq quot -- )
    [ [ nth-unsafe ] dip call ] 3keep drop set-nth-unsafe ; inline

! The f object supports the sequence protocol trivially
M: f length drop 0 ; inline
M: f nth-unsafe nip ; inline
M: f like drop [ f ] when-empty ; inline

INSTANCE: f immutable-sequence

! Integers support the sequence protocol
M: integer length ; inline
M: integer nth-unsafe drop ; inline

INSTANCE: integer immutable-sequence

PRIVATE>

! In the future, this will replace integer sequences
TUPLE: iota { n integer read-only } ;

: iota ( n -- iota ) \ iota boa ; inline

<PRIVATE

M: iota length n>> ; inline
M: iota nth-unsafe drop ; inline

INSTANCE: iota immutable-sequence

: first-unsafe ( seq -- first )
    0 swap nth-unsafe ; inline

: first2-unsafe ( seq -- first second )
    [ first-unsafe ] [ 1 swap nth-unsafe ] bi ; inline

: first3-unsafe ( seq -- first second third )
    [ first2-unsafe ] [ 2 swap nth-unsafe ] bi ; inline

: first4-unsafe ( seq -- first second third fourth )
    [ first3-unsafe ] [ 3 swap nth-unsafe ] bi ; inline

: exchange-unsafe ( m n seq -- )<commit_msg>mark integer sequence methods as deprecated<commit_after>! Copyright (C) 2005, 2009 <NAME>, <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel kernel.private slots.private math
math.private math.order ;
IN: sequences

MIXIN: sequence

GENERIC: length ( seq -- n ) flushable
GENERIC: set-length ( n seq -- )
GENERIC: nth ( n seq -- elt ) flushable
GENERIC: set-nth ( elt n seq -- )
GENERIC: new-sequence ( len seq -- newseq ) flushable
GENERIC: new-resizable ( len seq -- newseq ) flushable
GENERIC: like ( seq exemplar -- newseq ) flushable
GENERIC: clone-like ( seq exemplar -- newseq ) flushable

: new-like ( len exemplar quot -- seq )
    over [ [ new-sequence ] dip call ] dip like ; inline

M: sequence like drop ; inline

GENERIC: lengthen ( n seq -- )
GENERIC: shorten ( n seq -- )

M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; inline

M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; inline

: empty? ( seq -- ? ) length 0 = ; inline

: if-empty ( seq quot1 quot2 -- )
    [ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline

: when-empty ( seq quot -- ) [ ] if-empty ; inline

: unless-empty ( seq quot -- ) [ ] swap if-empty ; inline

: delete-all ( seq -- ) 0 swap set-length ;

: first ( seq -- first ) 0 swap nth ; inline
: second ( seq -- second ) 1 swap nth ; inline
: third ( seq -- third ) 2 swap nth ; inline
: fourth ( seq -- fourth ) 3 swap nth ; inline

: set-first ( first seq -- ) 0 swap set-nth ; inline
: set-second ( second seq -- ) 1 swap set-nth ; inline
: set-third ( third seq -- ) 2 swap set-nth ; inline
: set-fourth  ( fourth seq -- ) 3 swap set-nth ; inline

: push ( elt seq -- ) [ length ] [ set-nth ] bi ;

: bounds-check? ( n seq -- ? )
    dupd length < [ 0 >= ] [ drop f ] if ; inline

ERROR: bounds-error index seq ;

: bounds-check ( n seq -- n seq )
    2dup bounds-check? [ bounds-error ] unless ; inline

MIXIN: immutable-sequence

ERROR: immutable seq ;

M: immutable-sequence set-nth immutable ;

INSTANCE: immutable-sequence sequence

<PRIVATE

: array-nth ( n array -- elt )
    swap 2 fixnum+fast slot ; inline

: set-array-nth ( elt n array -- )
    swap 2 fixnum+fast set-slot ; inline

: dispatch ( n array -- ) array-nth call ;

GENERIC: resize ( n seq -- newseq ) flushable

! Unsafe sequence protocol for inner loops
GENERIC: nth-unsafe ( n seq -- elt ) flushable
GENERIC: set-nth-unsafe ( elt n seq -- )

M: sequence nth bounds-check nth-unsafe ; inline
M: sequence set-nth bounds-check set-nth-unsafe ; inline

M: sequence nth-unsafe nth ; inline
M: sequence set-nth-unsafe set-nth ; inline

: change-nth-unsafe ( i seq quot -- )
    [ [ nth-unsafe ] dip call ] 3keep drop set-nth-unsafe ; inline

! The f object supports the sequence protocol trivially
M: f length drop 0 ; inline
M: f nth-unsafe nip ; inline
M: f like drop [ f ] when-empty ; inline

INSTANCE: f immutable-sequence

! Integers used to support the sequence protocol
M: integer length ; inline deprecated
M: integer nth-unsafe drop ; inline deprecated

INSTANCE: integer immutable-sequence

PRIVATE>

! In the future, this will replace integer sequences
TUPLE: iota { n integer read-only } ;

: iota ( n -- iota ) \ iota boa ; inline

<PRIVATE

M: iota length n>> ; inline
M: iota nth-unsafe drop ; inline

INSTANCE: iota immutable-sequence

: first-unsafe ( seq -- first )
    0 swap nth-unsafe ; inline

: first2-unsafe ( seq -- first second )
    [ first-unsafe ] [ 1 swap nth-unsafe ] bi ; inline

: first3-unsafe ( seq -- first second third )
    [ first2-unsafe ] [ 2 swap nth-unsafe ] bi ; inline

: first4-unsafe ( seq -- first second third fourth )
    [ first3-unsafe ] [ 3 swap nth-unsafe ] bi ; inline

: exchange-unsafe ( m n seq -- )
{'fraction_non_alphanumeric': 0.12174146734748724, 'fraction_numerical': 0.010481053480247245, 'mean_word_length': 2.84452479338843, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 17, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5978240', 'n_tokens_mistral': 2557, 'n_tokens_neox': 2433, 'n_words': 899}