<commit_before>USING: tools.test kernel.private kernel arrays sequences
math.private math generic words quotations alien alien.c-types
alien.data strings sbufs sequences.private slots.private
combinators definitions system layouts vectors
math.partial-dispatch math.order math.functions accessors
hashtables classes assocs io.encodings.utf8 io.encodings.ascii
io.encodings fry slots sorting.private combinators.short-circuit
grouping prettyprint generalizations
compiler.tree
compiler.tree.combinators
compiler.tree.cleanup
compiler.tree.builder
compiler.tree.recursive
compiler.tree.normalization
compiler.tree.propagation
compiler.tree.propagation.info
compiler.tree.checker
compiler.tree.debugger ;
FROM: math => float ;
QUALIFIED-WITH: alien.c-types c
IN: compiler.tree.cleanup.tests

[ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

[ f ] [ [ f [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

[ f ] [ [ { array } declare [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

[ t ] [ [ { sequence } declare [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

: recursive-test ( a -- b ) dup [ not recursive-test ] when ; inline recursive

[ t ] [ [ recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test

[ f ] [ [ f recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test

[ t ] [ [ t recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test

[ f ] [
    [ { integer } declare >fixnum ]
    \ >fixnum inlined?
] unit-test

GENERIC: mynot ( x -- y )

M: f mynot drop t ; inline

M: object mynot drop f ; inline

GENERIC: detect-f ( x -- y )

M: f detect-f ; inline

[ t ] [
    [ dup [ mynot ] [ ] if detect-f ] \ detect-f inlined?
] unit-test

GENERIC: xyz ( n -- n )

M: integer xyz ; inline

M: object xyz ; inline

[ t ] [
    [ { integer } declare xyz ] \ xyz inlined?
] unit-test

[ t ] [
    [ dup fixnum? [ xyz ] [ drop "hi" ] if ]
    \ xyz inlined?
] unit-test

: (fx-repeat) ( i n quot: ( i -- i ) -- )
    2over fixnum>= [
        3drop
    ] [
        [ swap [ call 1 fixnum+fast ] dip ] keep (fx-repeat)
    ] if ; inline recursive

: fx-repeat ( n quot -- )
    0 -rot (fx-repeat) ; inline

! The + should be optimized into fixnum+, if it was not, then
! the type of the loop index was not inferred correctly
[ t ] [
    [ [ dup 2 + drop ] fx-repeat ] \ + inlined?
] unit-test

: (i-repeat) ( i n quot: ( i -- i ) -- )
    2over dup xyz drop >= [
        3drop
    ] [
        [ swap [ call 1 + ] dip ] keep (i-repeat)
    ] if ; inline recursive

: i-repeat ( n quot -- ) [ { integer } declare ] dip 0 -rot (i-repeat) ; inline

[ t ] [
    [ [ dup xyz drop ] i-repeat ] \ xyz inlined?
] unit-test

[ t ] [
    [ { fixnum } declare dup 100 >= [ 1 + ] unless ] \ fixnum+ inlined?
] unit-test

[ t ] [
    [ { fixnum fixnum } declare dupd < [ 1 + 1 + ] when ]
    \ + inlined?
] unit-test

[ t ] [
    [ { fixnum fixnum } declare dupd < [ 1 + 1 + ] when ]
    \ + inlined?
] unit-test

[ t ] [
    [ { fixnum } declare [ ] times ] \ >= inlined?
] unit-test

[ t ] [
    [ { fixnum } declare [ ] times ] \ + inlined?
] unit-test

[ t ] [
    [ { fixnum } declare [ ] times ] \ fixnum+ inlined?
] unit-test

[ t ] [
    [ { integer fixnum } declare dupd < [ 1 + ] when ]
    \ + inlined?
] unit-test

[ f ] [
    [ { integer fixnum } declare dupd < [ 1 + ] when ]
    \ +-integer-fixnum inlined?
] unit-test

[ t ] [
    [
        [ no-cond ] 1
        [ 1array dup quotation? [ >quotation ] unless ] times
    ] \ quotation? inlined?
] unit-test

[ t ] [
    [
        1000000000000000000000000000000000 [ ] times
    ] \ + inlined?
] unit-test
[ f ] [
    [
        1000000000000000000000000000000000 [ ] times
    ] \ +-integer-fixnum inlined?
] unit-test

[ f ] [
    [ { bignum } declare [ ] times ]
    \ +-integer-fixnum inlined?
] unit-test

[ t ] [
    [ { array-capacity } declare 0 < ] \ < inlined?
] unit-test

[ t ] [
    [ { array-capacity } declare 0 < ] \ fixnum< inlined?
] unit-test

[ t ] [
    [ { array-capacity } declare 1 fixnum- ] \ fixnum- inlined?
] unit-test

GENERIC: annotate-entry-test-1 ( x -- )

M: fixnum annotate-entry-test-1 drop ;

: (annotate-entry-test-2) ( from to -- )
    2dup >= [
        2drop
    ] [
        [ dup annotate-entry-test-1 1 + ] dip (annotate-entry-test-2)
    ] if ; inline recursive

: annotate-entry-test-2 ( from to -- obj ) 0 -rot (annotate-entry-test-2) ; inline

[ f ] [
    [ { bignum } declare annotate-entry-test-2 ]
    \ annotate-entry-test-1 inlined?
] unit-test

[ t ] [
    [ { float } declare 10 [ 2.3 * ] times >float ]
    \ >float inlined?
] unit-test

GENERIC: detect-float ( a -- b )

M: float detect-float ;

[ t ] [
    [ { real float } declare + detect-float ]
    \ detect-float inlined?
] unit-test

[ t ] [
    [ { float real } declare + detect-float ]
    \ detect-float inlined?
] unit-test

[ f ] [
    [ { fixnum fixnum } declare 7 bitand neg shift ]
    \ fixnum-shift-fast inlined?
] unit-test

[ t ] [
    [ { fixnum fixnum } declare 7 bitand neg shift ]
    { shift fixnum-shift } inlined?
] unit-test

[ t ] [
    [ { fixnum fixnum } declare 1 swap 7 bitand shift ]
    { shift fixnum-shift } inlined?
] unit-test

[ f ] [
    [ { fixnum fixnum } declare 1 swap 7 bitand shift ]
    { fixnum-shift-fast } inlined?
] unit-test

[ t ] [
    [ 1 swap 7 bitand shift ]
    { shift fixnum-shift } inlined?
] unit-test

cell-bits 32 = [
    [ t ] [
        [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
        \ shift inlined?
    ] unit-test

    [ f ] [
        [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
        \ fixnum-shift inlined?
    ] unit-test
] when

[ t ] [
    [ B{ 1 0 } c:short deref 0 number= ]
    \ number= inlined?
] unit-test

[ t ] [
    [ B{ 1 0 } c:short deref 0 { number number } declare number= ]
    \ number= inlined?
] unit-test

[ t ] [
    [ B{ 1 0 } c:short deref 0 = ]
    \ number= inlined?
] unit-test

[ t ] [
    [ B{ 1 0 } c:short deref dup number? [ 0 number= ] [ drop f ] if ]
    \ number= inlined?
] unit-test

[ t ] [
    [ 0xff bitand 0 0xff between? ]
    \ >= inlined?
] unit-test

[ t ] [
    [ 0xff swap 0xff bitand >= ]
    \ >= inlined?
] unit-test

[ t ] [
    [ { vector } declare nth-unsafe ] \ nth-unsafe inlined?
] unit-test

[ t ] [
    [
        dup integer? [
            dup fixnum? [
                1 +
            ] [
                2 +
            ] if
        ] when
    ] \ + inlined?
] unit-test

: rec ( a -- b )
    dup 0 > [ 1 - rec ] when ; inline recursive

[ t ] [
    [ { fixnum } declare rec 1 + ]
    { > - + } inlined?
] unit-test

: fib ( m -- n )
    dup 2 < [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ; inline recursive

[ t ] [
    [ 27.0 fib ] { < - + } inlined?
] unit-test

[ f ] [
    [ 27.0 fib ] { +-integer-integer } inlined?
] unit-test

[ t ] [
    [ 27 fib ] { < - + } inlined?
] unit-test

[ t ] [
    [ 27 >bignum fib ] { < - + } inlined?
] unit-test

[ f ] [
    [ 27/2 fib ] { < - } inlined?
] unit-test

[ t ] [
    [ { fixnum } declare 10 [ -1 shift ] times ] \ shift inlined?
] unit-test

[ f ] [
    [ { integer } declare 10 [ -1 shift ] times ] \ shift inlined?
] unit-test

[ f ] [
    [ { fixnum } declare 1048575 fixnum-bitand 524288 fixnum- ]
    \ fixnum-bitand inlined?
] unit-test

[ t ] [
    [ { fixnum } declare [ drop ] each-integer ]
    { < <-integer-fixnum +-integer-fixnum + } inlined?
] unit-test

[ t ] [
    [ { fixnum } declare iota [ drop ] each ]
    { < <-integer-fixnum +-integer-fixnum + } inlined?
] unit-test

[ t ] [
    [ { fixnum } declare iota 0 [ + ] reduce ]
    { < <-integer-fixnum nth-unsafe } inlined?
] unit-test

[ f ] [<commit_msg>compiler.tree.cleanup: fix "-1 shift" tests.<commit_after>USING: tools.test kernel.private kernel arrays sequences
math.private math generic words quotations alien alien.c-types
alien.data strings sbufs sequences.private slots.private
combinators definitions system layouts vectors
math.partial-dispatch math.order math.functions accessors
hashtables classes assocs io.encodings.utf8 io.encodings.ascii
io.encodings fry slots sorting.private combinators.short-circuit
grouping prettyprint generalizations
compiler.tree
compiler.tree.combinators
compiler.tree.cleanup
compiler.tree.builder
compiler.tree.recursive
compiler.tree.normalization
compiler.tree.propagation
compiler.tree.propagation.info
compiler.tree.checker
compiler.tree.debugger ;
FROM: math => float ;
QUALIFIED-WITH: alien.c-types c
IN: compiler.tree.cleanup.tests

[ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

[ f ] [ [ f [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

[ f ] [ [ { array } declare [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

[ t ] [ [ { sequence } declare [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

: recursive-test ( a -- b ) dup [ not recursive-test ] when ; inline recursive

[ t ] [ [ recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test

[ f ] [ [ f recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test

[ t ] [ [ t recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test

[ f ] [
    [ { integer } declare >fixnum ]
    \ >fixnum inlined?
] unit-test

GENERIC: mynot ( x -- y )

M: f mynot drop t ; inline

M: object mynot drop f ; inline

GENERIC: detect-f ( x -- y )

M: f detect-f ; inline

[ t ] [
    [ dup [ mynot ] [ ] if detect-f ] \ detect-f inlined?
] unit-test

GENERIC: xyz ( n -- n )

M: integer xyz ; inline

M: object xyz ; inline

[ t ] [
    [ { integer } declare xyz ] \ xyz inlined?
] unit-test

[ t ] [
    [ dup fixnum? [ xyz ] [ drop "hi" ] if ]
    \ xyz inlined?
] unit-test

: (fx-repeat) ( i n quot: ( i -- i ) -- )
    2over fixnum>= [
        3drop
    ] [
        [ swap [ call 1 fixnum+fast ] dip ] keep (fx-repeat)
    ] if ; inline recursive

: fx-repeat ( n quot -- )
    0 -rot (fx-repeat) ; inline

! The + should be optimized into fixnum+, if it was not, then
! the type of the loop index was not inferred correctly
[ t ] [
    [ [ dup 2 + drop ] fx-repeat ] \ + inlined?
] unit-test

: (i-repeat) ( i n quot: ( i -- i ) -- )
    2over dup xyz drop >= [
        3drop
    ] [
        [ swap [ call 1 + ] dip ] keep (i-repeat)
    ] if ; inline recursive

: i-repeat ( n quot -- ) [ { integer } declare ] dip 0 -rot (i-repeat) ; inline

[ t ] [
    [ [ dup xyz drop ] i-repeat ] \ xyz inlined?
] unit-test

[ t ] [
    [ { fixnum } declare dup 100 >= [ 1 + ] unless ] \ fixnum+ inlined?
] unit-test

[ t ] [
    [ { fixnum fixnum } declare dupd < [ 1 + 1 + ] when ]
    \ + inlined?
] unit-test

[ t ] [
    [ { fixnum fixnum } declare dupd < [ 1 + 1 + ] when ]
    \ + inlined?
] unit-test

[ t ] [
    [ { fixnum } declare [ ] times ] \ >= inlined?
] unit-test

[ t ] [
    [ { fixnum } declare [ ] times ] \ + inlined?
] unit-test

[ t ] [
    [ { fixnum } declare [ ] times ] \ fixnum+ inlined?
] unit-test

[ t ] [
    [ { integer fixnum } declare dupd < [ 1 + ] when ]
    \ + inlined?
] unit-test

[ f ] [
    [ { integer fixnum } declare dupd < [ 1 + ] when ]
    \ +-integer-fixnum inlined?
] unit-test

[ t ] [
    [
        [ no-cond ] 1
        [ 1array dup quotation? [ >quotation ] unless ] times
    ] \ quotation? inlined?
] unit-test

[ t ] [
    [
        1000000000000000000000000000000000 [ ] times
    ] \ + inlined?
] unit-test
[ f ] [
    [
        1000000000000000000000000000000000 [ ] times
    ] \ +-integer-fixnum inlined?
] unit-test

[ f ] [
    [ { bignum } declare [ ] times ]
    \ +-integer-fixnum inlined?
] unit-test

[ t ] [
    [ { array-capacity } declare 0 < ] \ < inlined?
] unit-test

[ t ] [
    [ { array-capacity } declare 0 < ] \ fixnum< inlined?
] unit-test

[ t ] [
    [ { array-capacity } declare 1 fixnum- ] \ fixnum- inlined?
] unit-test

GENERIC: annotate-entry-test-1 ( x -- )

M: fixnum annotate-entry-test-1 drop ;

: (annotate-entry-test-2) ( from to -- )
    2dup >= [
        2drop
    ] [
        [ dup annotate-entry-test-1 1 + ] dip (annotate-entry-test-2)
    ] if ; inline recursive

: annotate-entry-test-2 ( from to -- obj ) 0 -rot (annotate-entry-test-2) ; inline

[ f ] [
    [ { bignum } declare annotate-entry-test-2 ]
    \ annotate-entry-test-1 inlined?
] unit-test

[ t ] [
    [ { float } declare 10 [ 2.3 * ] times >float ]
    \ >float inlined?
] unit-test

GENERIC: detect-float ( a -- b )

M: float detect-float ;

[ t ] [
    [ { real float } declare + detect-float ]
    \ detect-float inlined?
] unit-test

[ t ] [
    [ { float real } declare + detect-float ]
    \ detect-float inlined?
] unit-test

[ f ] [
    [ { fixnum fixnum } declare 7 bitand neg shift ]
    \ fixnum-shift-fast inlined?
] unit-test

[ t ] [
    [ { fixnum fixnum } declare 7 bitand neg shift ]
    { shift fixnum-shift } inlined?
] unit-test

[ t ] [
    [ { fixnum fixnum } declare 1 swap 7 bitand shift ]
    { shift fixnum-shift } inlined?
] unit-test

[ f ] [
    [ { fixnum fixnum } declare 1 swap 7 bitand shift ]
    { fixnum-shift-fast } inlined?
] unit-test

[ t ] [
    [ 1 swap 7 bitand shift ]
    { shift fixnum-shift } inlined?
] unit-test

cell-bits 32 = [
    [ t ] [
        [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
        \ shift inlined?
    ] unit-test

    [ f ] [
        [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
        \ fixnum-shift inlined?
    ] unit-test
] when

[ t ] [
    [ B{ 1 0 } c:short deref 0 number= ]
    \ number= inlined?
] unit-test

[ t ] [
    [ B{ 1 0 } c:short deref 0 { number number } declare number= ]
    \ number= inlined?
] unit-test

[ t ] [
    [ B{ 1 0 } c:short deref 0 = ]
    \ number= inlined?
] unit-test

[ t ] [
    [ B{ 1 0 } c:short deref dup number? [ 0 number= ] [ drop f ] if ]
    \ number= inlined?
] unit-test

[ t ] [
    [ 0xff bitand 0 0xff between? ]
    \ >= inlined?
] unit-test

[ t ] [
    [ 0xff swap 0xff bitand >= ]
    \ >= inlined?
] unit-test

[ t ] [
    [ { vector } declare nth-unsafe ] \ nth-unsafe inlined?
] unit-test

[ t ] [
    [
        dup integer? [
            dup fixnum? [
                1 +
            ] [
                2 +
            ] if
        ] when
    ] \ + inlined?
] unit-test

: rec ( a -- b )
    dup 0 > [ 1 - rec ] when ; inline recursive

[ t ] [
    [ { fixnum } declare rec 1 + ]
    { > - + } inlined?
] unit-test

: fib ( m -- n )
    dup 2 < [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ; inline recursive

[ t ] [
    [ 27.0 fib ] { < - + } inlined?
] unit-test

[ f ] [
    [ 27.0 fib ] { +-integer-integer } inlined?
] unit-test

[ t ] [
    [ 27 fib ] { < - + } inlined?
] unit-test

[ t ] [
    [ 27 >bignum fib ] { < - + } inlined?
] unit-test

[ f ] [
    [ 27/2 fib ] { < - } inlined?
] unit-test

[ t ] [
    [ 10 [ -1 shift ] times ] \ shift inlined?
] unit-test

[ f ] [
    [ { fixnum } declare 1048575 fixnum-bitand 524288 fixnum- ]
    \ fixnum-bitand inlined?
] unit-test

[ t ] [
    [ { fixnum } declare [ drop ] each-integer ]
    { < <-integer-fixnum +-integer-fixnum + } inlined?
] unit-test

[ t ] [
    [ { fixnum } declare iota [ drop ] each ]
    { < <-integer-fixnum +-integer-fixnum + } inlined?
] unit-test

[ t ] [
    [ { fixnum } declare iota 0 [ + ] reduce ]
    { < <-integer-fixnum nth-unsafe } inlined?
] unit-test

[ f ] [
{'fraction_non_alphanumeric': 0.15249285899766293, 'fraction_numerical': 0.02492858997662945, 'mean_word_length': 2.0995975855130786, 'pattern_counts': {'":': 0, '<': 41, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 4, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4222367', 'n_tokens_mistral': 6038, 'n_tokens_neox': 5622, 'n_words': 1512}