1 IN: inference.class.tests
2 USING: arrays math.private kernel math compiler inference
3 inference.dataflow optimizer tools.test kernel.private generic
4 sequences words inference.class quotations alien
5 alien.c-types strings sbufs sequences.private
6 slots.private combinators definitions compiler.units
7 system layouts vectors optimizer.math.partial
8 optimizer.inlining optimizer.backend math.order math.functions
9 accessors hashtables classes assocs io.encodings.utf8
10 io.encodings.ascii io.encodings ;
12 [ t ] [ T{ literal-constraint f 1 2 } T{ literal-constraint f 1 2 } equal? ] unit-test
14 [ f ] [ T{ literal-constraint f 1 3 } T{ literal-constraint f 1 2 } equal? ] unit-test
16 ! Make sure these compile even though this is invalid code
17 [ ] [ [ 10 mod 3.0 /i ] dataflow optimize drop ] unit-test
18 [ ] [ [ 10 mod 3.0 shift ] dataflow optimize drop ] unit-test
20 ! Ensure type inference works as it is supposed to by checking
21 ! if various methods get inlined
23 : inlined? ( quot seq/word -- ? )
24 dup word? [ 1array ] when
25 swap dataflow optimize
26 [ node-param swap member? ] with node-exists? not ;
29 [ { integer } declare >fixnum ]
33 GENERIC: mynot ( x -- y )
37 M: object mynot drop f ;
39 GENERIC: detect-f ( x -- y )
44 [ dup [ mynot ] [ ] if detect-f ] \ detect-f inlined?
47 [ ] [ [ fixnum< ] dataflow optimize drop ] unit-test
49 [ ] [ [ fixnum< [ ] [ ] if ] dataflow optimize drop ] unit-test
51 GENERIC: xyz ( n -- n )
58 [ { integer } declare xyz ] \ xyz inlined?
62 [ dup fixnum? [ xyz ] [ drop "hi" ] if ]
66 : (fx-repeat) ( i n quot -- )
70 [ swap >r call 1 fixnum+fast r> ] keep (fx-repeat)
73 : fx-repeat ( n quot -- )
74 0 -rot (fx-repeat) ; inline
76 ! The + should be optimized into fixnum+, if it was not, then
77 ! the type of the loop index was not inferred correctly
79 [ [ dup 2 + drop ] fx-repeat ] \ + inlined?
82 : (i-repeat) ( i n quot -- )
83 2over dup xyz drop >= [
86 [ swap >r call 1+ r> ] keep (i-repeat)
89 : i-repeat >r { integer } declare r> 0 -rot (i-repeat) ; inline
92 [ [ dup xyz drop ] i-repeat ] \ xyz inlined?
96 [ { fixnum } declare dup 100 >= [ 1 + ] unless ] \ fixnum+ inlined?
100 [ { fixnum fixnum } declare dupd < [ 1 + 1 + ] when ]
105 [ { fixnum fixnum } declare dupd < [ 1 + 1 + ] when ]
110 [ { fixnum } declare [ ] times ] \ >= inlined?
114 [ { fixnum } declare [ ] times ] \ 1+ inlined?
118 [ { fixnum } declare [ ] times ] \ + inlined?
122 [ { fixnum } declare [ ] times ] \ fixnum+ inlined?
126 [ { integer fixnum } declare dupd < [ 1 + ] when ]
131 [ { integer fixnum } declare dupd < [ 1 + ] when ]
132 \ +-integer-fixnum inlined?
135 [ f ] [ [ dup 0 < [ neg ] when ] \ - inlined? ] unit-test
140 [ 1array dup quotation? [ >quotation ] unless ] times
141 ] \ quotation? inlined?
144 [ f ] [ [ <reversed> length ] \ slot inlined? ] unit-test
146 ! We don't want to use = to compare literals
147 : foo ( seq -- seq' ) reverse ;
151 fixnum 0 `output class,
152 V{ } dup dup push 0 `input literal,
154 ] "constraints" set-word-prop
161 [ dup V{ } eq? [ foo ] when ] dup second dup push define
162 ] with-compilation-unit
164 \ blah def>> dataflow optimize drop
167 GENERIC: detect-fx ( n -- n )
169 M: fixnum detect-fx ;
173 [ uchar-nth ] 2keep [ uchar-nth ] 2keep uchar-nth
174 >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift
175 255 min 0 max detect-fx
176 ] \ detect-fx inlined?
181 1000000000000000000000000000000000 [ ] times
186 1000000000000000000000000000000000 [ ] times
187 ] \ +-integer-fixnum inlined?
191 [ { bignum } declare [ ] times ]
192 \ +-integer-fixnum inlined?
197 [ { string sbuf } declare ] \ push-all def>> append \ + inlined?
201 [ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined?
205 [ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined?
209 [ { array-capacity } declare 0 < ] \ < inlined?
213 [ { array-capacity } declare 0 < ] \ fixnum< inlined?
217 [ { array-capacity } declare 1 fixnum- ] \ fixnum- inlined?
221 [ 5000 [ 5000 [ ] times ] times ] \ 1+ inlined?
225 [ 5000 [ [ ] times ] each ] \ 1+ inlined?
229 [ 5000 0 [ dup 2 - swap [ 2drop ] curry each ] reduce ]
233 GENERIC: annotate-entry-test-1 ( x -- )
235 M: fixnum annotate-entry-test-1 drop ;
237 : (annotate-entry-test-2) ( from to quot -- )
241 [ swap >r call dup annotate-entry-test-1 1+ r> ] keep (annotate-entry-test-2)
244 : annotate-entry-test-2 0 -rot (annotate-entry-test-2) ; inline
247 [ { bignum } declare [ ] annotate-entry-test-2 ]
248 \ annotate-entry-test-1 inlined?
252 [ { float } declare 10 [ 2.3 * ] times >float ]
256 GENERIC: detect-float ( a -- b )
258 M: float detect-float ;
261 [ { real float } declare + detect-float ]
262 \ detect-float inlined?
266 [ { float real } declare + detect-float ]
267 \ detect-float inlined?
271 [ 3 + = ] \ equal? inlined?
275 [ { fixnum fixnum } declare 7 bitand neg shift ]
276 \ fixnum-shift-fast inlined?
280 [ { fixnum fixnum } declare 7 bitand neg shift ]
281 { shift fixnum-shift } inlined?
285 [ { fixnum fixnum } declare 1 swap 7 bitand shift ]
286 { shift fixnum-shift } inlined?
290 [ { fixnum fixnum } declare 1 swap 7 bitand shift ]
291 { fixnum-shift-fast } inlined?
296 [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
301 [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
302 \ fixnum-shift inlined?
307 [ { integer } declare -63 shift 4095 bitand ]
312 [ B{ 1 0 } *short 0 number= ]
317 [ B{ 1 0 } *short 0 { number number } declare number= ]
322 [ B{ 1 0 } *short 0 = ]
327 [ B{ 1 0 } *short dup number? [ 0 number= ] [ drop f ] if ]
332 [ HEX: ff bitand 0 HEX: ff between? ]
337 [ HEX: ff swap HEX: ff bitand >= ]
342 [ { vector } declare nth-unsafe ] \ nth-unsafe inlined?
360 ] { mod fixnum-mod } inlined?
365 dup 0 >= [ 256 mod ] when
366 ] { mod fixnum-mod } inlined?
371 { integer } declare dup 0 >= [ 256 mod ] when
372 ] { mod fixnum-mod } inlined?
377 { integer } declare 256 rem
378 ] { mod fixnum-mod } inlined?
383 { integer } declare [ 256 rem ] map
384 ] { mod fixnum-mod rem } inlined?
388 [ 1000 [ 1+ ] map ] { 1+ fixnum+ } inlined?
392 dup 0 > [ 1 - rec ] when ; inline
395 [ { fixnum } declare rec 1 + ]
400 dup 2 < [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ; inline
403 [ 27.0 fib ] { < - + } inlined?
407 [ 27.0 fib ] { +-integer-integer } inlined?
411 [ 27 fib ] { < - + } inlined?
415 [ 27 >bignum fib ] { < - + } inlined?
419 [ 27/2 fib ] { < - } inlined?
422 : hang-regression ( m n -- x )
427 drop 1 hang-regression
429 dupd hang-regression hang-regression
434 [ dup fixnum? [ 3 over hang-regression ] [ 3 over hang-regression ] if
435 ] { } inlined? ] unit-test
437 : detect-null ( a -- b ) dup drop ;
440 { [ dup dup in-d>> first node-class null eq? ] [ [ ] f splice-quot ] }
444 [ { null } declare detect-null ] \ detect-null inlined?
448 [ { null null } declare + detect-null ] \ detect-null inlined?
452 [ { null fixnum } declare + detect-null ] \ detect-null inlined?
455 GENERIC: detect-integer ( a -- b )
457 M: integer detect-integer ;
460 [ { null fixnum } declare + detect-integer ] \ detect-integer inlined?
464 [ { fixnum } declare 10 [ -1 shift ] times ] \ shift inlined?
468 [ { integer } declare 10 [ -1 shift ] times ] \ shift inlined?
472 [ { fixnum } declare 1048575 fixnum-bitand 524288 fixnum- ]
473 \ fixnum-bitand inlined?
477 [ { integer } declare 127 bitand 3 + ]
478 { + +-integer-fixnum +-integer-fixnum-fast bitand } inlined?
482 [ { integer } declare 127 bitand 3 + ]
487 [ { fixnum } declare [ drop ] each-integer ]
488 { < <-integer-fixnum +-integer-fixnum + } inlined?
492 [ { fixnum } declare length [ drop ] each-integer ]
493 { < <-integer-fixnum +-integer-fixnum + } inlined?
497 [ { fixnum } declare [ drop ] each ]
498 { < <-integer-fixnum +-integer-fixnum + } inlined?
502 [ { fixnum } declare 0 [ + ] reduce ]
503 { < <-integer-fixnum } inlined?
507 [ { fixnum } declare 0 [ + ] reduce ]
508 \ +-integer-fixnum inlined?
515 615949 * 797807 + 20 2^ mod dup 19 2^ -
517 ] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
523 615949 * 797807 + 20 2^ mod dup 19 2^ -
524 ] { >fixnum } inlined?
529 { integer } declare [ ] map
535 { integer } declare { } set-nth-unsafe
541 { integer } declare 1 + { } set-nth-unsafe
547 { integer } declare 0 swap
549 drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
551 ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
556 { fixnum } declare 0 swap
558 drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
560 ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
564 [ { integer } declare bitnot detect-integer ]
565 \ detect-integer inlined?
569 [ hashtable new ] \ new inlined?
573 [ dup hashtable eq? [ new ] when ] \ new inlined?
577 [ { hashtable } declare hashtable instance? ] \ instance? inlined?
581 [ { vector } declare hashtable instance? ] \ instance? inlined?
585 [ { assoc } declare hashtable instance? ] \ instance? inlined?
588 TUPLE: declared-fixnum { x fixnum } ;
591 [ { declared-fixnum } declare [ 1 + ] change-x ]
592 { + fixnum+ >fixnum } inlined?
596 [ { declared-fixnum } declare x>> drop ]
602 { array } declare length
603 1 + dup 100 fixnum> [ 1 fixnum+ ] when
608 [ [ resize-array ] keep length ] \ length inlined?
612 [ dup 0 > [ sqrt ] when ] \ sqrt inlined?
616 [ { utf8 } declare decode-char ] \ decode-char inlined?
620 [ { ascii } declare decode-char ] \ decode-char inlined?
623 [ t ] [ [ { 1 2 } length ] { length length>> slot } inlined? ] unit-test
629 ! { integer } declare [ 256 mod ] map
630 ! ] { mod fixnum-mod } inlined?
635 ! { integer } declare [ 0 >= ] map
636 ! ] { >= fixnum>= } inlined?