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 accessors
8 optimizer.inlining math.order hashtables classes ;
10 [ t ] [ T{ literal-constraint f 1 2 } T{ literal-constraint f 1 2 } equal? ] unit-test
12 [ f ] [ T{ literal-constraint f 1 3 } T{ literal-constraint f 1 2 } equal? ] unit-test
14 ! Make sure these compile even though this is invalid code
15 [ ] [ [ 10 mod 3.0 /i ] dataflow optimize drop ] unit-test
16 [ ] [ [ 10 mod 3.0 shift ] dataflow optimize drop ] unit-test
18 ! Ensure type inference works as it is supposed to by checking
19 ! if various methods get inlined
21 : inlined? ( quot seq/word -- ? )
22 dup word? [ 1array ] when
23 swap dataflow optimize
24 [ node-param swap member? ] with node-exists? not ;
27 [ { integer } declare >fixnum ]
31 GENERIC: mynot ( x -- y )
35 M: object mynot drop f ;
37 GENERIC: detect-f ( x -- y )
42 [ dup [ mynot ] [ ] if detect-f ] \ detect-f inlined?
45 [ ] [ [ fixnum< ] dataflow optimize drop ] unit-test
47 [ ] [ [ fixnum< [ ] [ ] if ] dataflow optimize drop ] unit-test
49 GENERIC: xyz ( n -- n )
56 [ { integer } declare xyz ] \ xyz inlined?
60 [ dup fixnum? [ xyz ] [ drop "hi" ] if ]
64 : (fx-repeat) ( i n quot -- )
68 [ swap >r call 1 fixnum+fast r> ] keep (fx-repeat)
71 : fx-repeat ( n quot -- )
72 0 -rot (fx-repeat) ; inline
74 ! The + should be optimized into fixnum+, if it was not, then
75 ! the type of the loop index was not inferred correctly
77 [ [ dup 2 + drop ] fx-repeat ] \ + inlined?
80 : (i-repeat) ( i n quot -- )
81 2over dup xyz drop >= [
84 [ swap >r call 1+ r> ] keep (i-repeat)
87 : i-repeat >r { integer } declare r> 0 -rot (i-repeat) ; inline
90 [ [ dup xyz drop ] i-repeat ] \ xyz inlined?
94 [ { fixnum } declare dup 100 >= [ 1 + ] unless ] \ fixnum+ inlined?
98 [ { fixnum fixnum } declare dupd < [ 1 + 1 + ] when ]
103 [ { fixnum fixnum } declare dupd < [ 1 + 1 + ] when ]
108 [ { fixnum } declare [ ] times ] \ >= inlined?
112 [ { fixnum } declare [ ] times ] \ 1+ inlined?
116 [ { fixnum } declare [ ] times ] \ + inlined?
120 [ { fixnum } declare [ ] times ] \ fixnum+ inlined?
124 [ { integer fixnum } declare dupd < [ 1 + ] when ]
129 [ { integer fixnum } declare dupd < [ 1 + ] when ]
130 \ +-integer-fixnum inlined?
133 [ f ] [ [ dup 0 < [ neg ] when ] \ - inlined? ] unit-test
138 [ 1array dup quotation? [ >quotation ] unless ] times
139 ] \ quotation? inlined?
142 [ f ] [ [ <reversed> length ] \ slot inlined? ] unit-test
144 ! We don't want to use = to compare literals
145 : foo ( seq -- seq' ) reverse ;
149 fixnum 0 `output class,
150 V{ } dup dup push 0 `input literal,
152 ] "constraints" set-word-prop
159 [ dup V{ } eq? [ foo ] when ] dup second dup push define
160 ] with-compilation-unit
162 \ blah def>> dataflow optimize drop
165 GENERIC: detect-fx ( n -- n )
167 M: fixnum detect-fx ;
171 [ uchar-nth ] 2keep [ uchar-nth ] 2keep uchar-nth
172 >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift
173 255 min 0 max detect-fx
174 ] \ detect-fx inlined?
179 1000000000000000000000000000000000 [ ] times
184 1000000000000000000000000000000000 [ ] times
185 ] \ +-integer-fixnum inlined?
189 [ { bignum } declare [ ] times ]
190 \ +-integer-fixnum inlined?
195 [ { string sbuf } declare push-all ] \ push-all inlined?
199 [ { string sbuf } declare push-all ] \ + inlined?
203 [ { string sbuf } declare push-all ] \ fixnum+ inlined?
207 [ { string sbuf } declare push-all ] \ >fixnum inlined?
211 [ { array-capacity } declare 0 < ] \ < inlined?
215 [ { array-capacity } declare 0 < ] \ fixnum< inlined?
219 [ { array-capacity } declare 1 fixnum- ] \ fixnum- inlined?
223 [ 5000 [ 5000 [ ] times ] times ] \ 1+ inlined?
227 [ 5000 [ [ ] times ] each ] \ 1+ inlined?
231 [ 5000 0 [ dup 2 - swap [ 2drop ] curry each ] reduce ]
235 GENERIC: annotate-entry-test-1 ( x -- )
237 M: fixnum annotate-entry-test-1 drop ;
239 : (annotate-entry-test-2) ( from to quot -- )
243 [ swap >r call dup annotate-entry-test-1 1+ r> ] keep (annotate-entry-test-2)
246 : annotate-entry-test-2 0 -rot (annotate-entry-test-2) ; inline
249 [ { bignum } declare [ ] annotate-entry-test-2 ]
250 \ annotate-entry-test-1 inlined?
254 [ { float } declare 10 [ 2.3 * ] times >float ]
258 GENERIC: detect-float ( a -- b )
260 M: float detect-float ;
263 [ { real float } declare + detect-float ]
264 \ detect-float inlined?
268 [ { float real } declare + detect-float ]
269 \ detect-float inlined?
273 [ 3 + = ] \ equal? inlined?
277 [ { fixnum fixnum } declare 7 bitand neg shift ]
278 \ fixnum-shift-fast inlined?
282 [ { fixnum fixnum } declare 7 bitand neg shift ]
283 { shift fixnum-shift } inlined?
287 [ { fixnum fixnum } declare 1 swap 7 bitand shift ]
288 { shift fixnum-shift } inlined?
292 [ { fixnum fixnum } declare 1 swap 7 bitand shift ]
293 { fixnum-shift-fast } inlined?
298 [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
303 [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
304 \ fixnum-shift inlined?
309 [ { integer } declare -63 shift 4095 bitand ]
314 [ B{ 1 0 } *short 0 number= ]
319 [ B{ 1 0 } *short 0 { number number } declare number= ]
324 [ B{ 1 0 } *short 0 = ]
329 [ B{ 1 0 } *short dup number? [ 0 number= ] [ drop f ] if ]
334 [ HEX: ff bitand 0 HEX: ff between? ]
339 [ HEX: ff swap HEX: ff bitand >= ]
344 [ { vector } declare nth-unsafe ] \ nth-unsafe inlined?
362 ] { mod fixnum-mod } inlined?
367 dup 0 >= [ 256 mod ] when
368 ] { mod fixnum-mod } inlined?
373 { integer } declare dup 0 >= [ 256 mod ] when
374 ] { mod fixnum-mod } inlined?
379 { integer } declare 256 rem
380 ] { mod fixnum-mod } inlined?
385 { integer } declare [ 256 rem ] map
386 ] { mod fixnum-mod rem } inlined?
390 [ 1000 [ 1+ ] map ] { 1+ fixnum+ } inlined?
394 dup 0 > [ 1 - rec ] when ; inline
397 [ { fixnum } declare rec 1 + ]
402 dup 2 < [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ; inline
405 [ 27.0 fib ] { < - + } inlined?
409 [ 27.0 fib ] { +-integer-integer } inlined?
413 [ 27 fib ] { < - + } inlined?
417 [ 27 >bignum fib ] { < - + } inlined?
421 [ 27/2 fib ] { < - } inlined?
424 : hang-regression ( m n -- x )
429 drop 1 hang-regression
431 dupd hang-regression hang-regression
436 [ dup fixnum? [ 3 over hang-regression ] [ 3 over hang-regression ] if
437 ] { } inlined? ] unit-test
439 : detect-null ( a -- b ) dup drop ;
442 { [ dup dup in-d>> first node-class null eq? ] [ [ ] f splice-quot ] }
446 [ { null } declare detect-null ] \ detect-null inlined?
450 [ { null null } declare + detect-null ] \ detect-null inlined?
454 [ { null fixnum } declare + detect-null ] \ detect-null inlined?
457 GENERIC: detect-integer ( a -- b )
459 M: integer detect-integer ;
462 [ { null fixnum } declare + detect-integer ] \ detect-integer inlined?
466 [ { fixnum } declare 10 [ -1 shift ] times ] \ shift inlined?
470 [ { integer } declare 10 [ -1 shift ] times ] \ shift inlined?
474 [ { fixnum } declare 1048575 fixnum-bitand 524288 fixnum- ]
475 \ fixnum-bitand inlined?
479 [ { integer } declare 127 bitand 3 + ]
480 { + +-integer-fixnum +-integer-fixnum-fast bitand } inlined?
484 [ { integer } declare 127 bitand 3 + ]
489 [ { fixnum } declare [ drop ] each-integer ]
490 { < <-integer-fixnum +-integer-fixnum + } inlined?
494 [ { fixnum } declare length [ drop ] each-integer ]
495 { < <-integer-fixnum +-integer-fixnum + } inlined?
499 [ { fixnum } declare [ drop ] each ]
500 { < <-integer-fixnum +-integer-fixnum + } inlined?
504 [ { fixnum } declare 0 [ + ] reduce ]
505 { < <-integer-fixnum } inlined?
509 [ { fixnum } declare 0 [ + ] reduce ]
510 \ +-integer-fixnum inlined?
517 615949 * 797807 + 20 2^ mod dup 19 2^ -
519 ] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
525 615949 * 797807 + 20 2^ mod dup 19 2^ -
526 ] { >fixnum } inlined?
531 { integer } declare [ ] map
537 { integer } declare { } set-nth-unsafe
543 { integer } declare 1 + { } set-nth-unsafe
549 { integer } declare 0 swap
551 drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
553 ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
558 { fixnum } declare 0 swap
560 drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
562 ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
566 [ { integer } declare bitnot detect-integer ]
567 \ detect-integer inlined?
571 [ hashtable new ] \ new inlined?
575 [ dup hashtable eq? [ new ] when ] \ new inlined?
579 [ hashtable instance? ] \ instance? inlined?
582 TUPLE: declared-fixnum { x fixnum } ;
585 [ { declared-fixnum } declare [ 1 + ] change-x ]
586 { + fixnum+ >fixnum } inlined?
590 [ { declared-fixnum } declare x>> drop ]
598 ! { integer } declare [ 256 mod ] map
599 ! ] { mod fixnum-mod } inlined?
604 ! { integer } declare [ 0 >= ] map
605 ! ] { >= fixnum>= } inlined?