1 ! Copyright (C) 2004, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.accessors arrays bit-arrays byte-arrays
4 classes sequences.private continuations.private effects
5 float-arrays generic hashtables hashtables.private
6 inference.state inference.backend inference.dataflow io
7 io.backend io.files io.files.private io.streams.c kernel
8 kernel.private math math.private memory namespaces
9 namespaces.private parser prettyprint quotations
10 quotations.private sbufs sbufs.private sequences
11 sequences.private slots.private strings strings.private system
12 threads.private classes.tuple classes.tuple.private vectors
13 vectors.private words words.private assocs inspector
14 compiler.units system.private ;
15 IN: inference.known-words
18 : infer-shuffle-inputs ( shuffle node -- )
19 >r effect-in length 0 r> node-inputs ;
21 : shuffle-stacks ( shuffle -- )
22 meta-d [ swap shuffle ] change ;
24 : infer-shuffle-outputs ( shuffle node -- )
25 >r effect-out length 0 r> node-outputs ;
27 : infer-shuffle ( shuffle -- )
28 dup effect-in ensure-values
30 2dup infer-shuffle-inputs
32 2dup infer-shuffle-outputs
35 : define-shuffle ( word shuffle -- )
36 [ infer-shuffle ] curry "infer" set-word-prop ;
39 { drop T{ effect f 1 { } } }
40 { 2drop T{ effect f 2 { } } }
41 { 3drop T{ effect f 3 { } } }
42 { dup T{ effect f 1 { 0 0 } } }
43 { 2dup T{ effect f 2 { 0 1 0 1 } } }
44 { 3dup T{ effect f 3 { 0 1 2 0 1 2 } } }
45 { rot T{ effect f 3 { 1 2 0 } } }
46 { -rot T{ effect f 3 { 2 0 1 } } }
47 { dupd T{ effect f 2 { 0 0 1 } } }
48 { swapd T{ effect f 3 { 1 0 2 } } }
49 { nip T{ effect f 2 { 1 } } }
50 { 2nip T{ effect f 3 { 2 } } }
51 { tuck T{ effect f 2 { 1 0 1 } } }
52 { over T{ effect f 2 { 0 1 0 } } }
53 { pick T{ effect f 3 { 0 1 2 0 } } }
54 { swap T{ effect f 2 { 1 0 } } }
55 } [ define-shuffle ] assoc-each
57 \ >r [ 1 infer->r ] "infer" set-word-prop
59 \ r> [ 1 infer-r> ] "infer" set-word-prop
67 [ 2dup set-node-in-d set-node-out-d ] keep
69 ] "infer" set-word-prop
71 ! Primitive combinators
72 GENERIC: infer-call ( value -- )
77 pop-d infer-quot-value ;
80 infer-uncurry peek-d infer-call ;
82 M: composed infer-call
84 1 infer->r peek-d infer-call
85 terminated? get [ 1 infer-r> peek-d infer-call ] unless ;
88 \ literal-expected inference-warning ;
93 ] "infer" set-word-prop
95 \ call t "no-compile" set-word-prop
104 "execute must be given a word" time-bomb
106 ] "infer" set-word-prop
110 2 d-tail [ special? ] contains? [
111 [ rot [ drop call ] [ nip call ] if ]
112 recursive-state get infer-quot
115 2 #drop node, pop-d pop-d swap 2array
116 [ #if ] infer-branches
118 ] "infer" set-word-prop
123 pop-literal nip [ <value> ] map
124 [ #dispatch ] infer-branches
125 ] "infer" set-word-prop
129 pop-d pop-d swap <curried> push-d
130 ] "infer" set-word-prop
134 pop-d pop-d swap <composed> push-d
135 ] "infer" set-word-prop
137 ! Variadic tuple constructor
140 peek-d value-literal layout-size { tuple } <effect>
142 ] "infer" set-word-prop
144 ! Non-standard control flow
147 peek-d value-literal 2 + { } <effect>
148 t over set-effect-terminated?
150 ] "infer" set-word-prop
152 : set-primitive-effect ( word effect -- )
153 2dup effect-out "default-output-classes" set-word-prop
154 dupd [ make-call-node ] 2curry "infer" set-word-prop ;
156 ! Stack effects for all primitives
157 \ fixnum< { fixnum fixnum } { object } <effect> set-primitive-effect
158 \ fixnum< make-foldable
160 \ fixnum<= { fixnum fixnum } { object } <effect> set-primitive-effect
161 \ fixnum<= make-foldable
163 \ fixnum> { fixnum fixnum } { object } <effect> set-primitive-effect
164 \ fixnum> make-foldable
166 \ fixnum>= { fixnum fixnum } { object } <effect> set-primitive-effect
167 \ fixnum>= make-foldable
169 \ eq? { object object } { object } <effect> set-primitive-effect
172 \ rehash-string { string } { } <effect> set-primitive-effect
174 \ bignum>fixnum { bignum } { fixnum } <effect> set-primitive-effect
175 \ bignum>fixnum make-foldable
177 \ float>fixnum { float } { fixnum } <effect> set-primitive-effect
178 \ bignum>fixnum make-foldable
180 \ fixnum>bignum { fixnum } { bignum } <effect> set-primitive-effect
181 \ fixnum>bignum make-foldable
183 \ float>bignum { float } { bignum } <effect> set-primitive-effect
184 \ float>bignum make-foldable
186 \ fixnum>float { fixnum } { float } <effect> set-primitive-effect
187 \ fixnum>float make-foldable
189 \ bignum>float { bignum } { float } <effect> set-primitive-effect
190 \ bignum>float make-foldable
192 \ <ratio> { integer integer } { ratio } <effect> set-primitive-effect
193 \ <ratio> make-foldable
195 \ string>float { string } { float } <effect> set-primitive-effect
196 \ string>float make-foldable
198 \ float>string { float } { string } <effect> set-primitive-effect
199 \ float>string make-foldable
201 \ float>bits { real } { integer } <effect> set-primitive-effect
202 \ float>bits make-foldable
204 \ double>bits { real } { integer } <effect> set-primitive-effect
205 \ double>bits make-foldable
207 \ bits>float { integer } { float } <effect> set-primitive-effect
208 \ bits>float make-foldable
210 \ bits>double { integer } { float } <effect> set-primitive-effect
211 \ bits>double make-foldable
213 \ <complex> { real real } { complex } <effect> set-primitive-effect
214 \ <complex> make-foldable
216 \ fixnum+ { fixnum fixnum } { integer } <effect> set-primitive-effect
217 \ fixnum+ make-foldable
219 \ fixnum+fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
220 \ fixnum+fast make-foldable
222 \ fixnum- { fixnum fixnum } { integer } <effect> set-primitive-effect
223 \ fixnum- make-foldable
225 \ fixnum-fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
226 \ fixnum-fast make-foldable
228 \ fixnum* { fixnum fixnum } { integer } <effect> set-primitive-effect
229 \ fixnum* make-foldable
231 \ fixnum*fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
232 \ fixnum*fast make-foldable
234 \ fixnum/i { fixnum fixnum } { integer } <effect> set-primitive-effect
235 \ fixnum/i make-foldable
237 \ fixnum-mod { fixnum fixnum } { fixnum } <effect> set-primitive-effect
238 \ fixnum-mod make-foldable
240 \ fixnum/mod { fixnum fixnum } { integer fixnum } <effect> set-primitive-effect
241 \ fixnum/mod make-foldable
243 \ fixnum-bitand { fixnum fixnum } { fixnum } <effect> set-primitive-effect
244 \ fixnum-bitand make-foldable
246 \ fixnum-bitor { fixnum fixnum } { fixnum } <effect> set-primitive-effect
247 \ fixnum-bitor make-foldable
249 \ fixnum-bitxor { fixnum fixnum } { fixnum } <effect> set-primitive-effect
250 \ fixnum-bitxor make-foldable
252 \ fixnum-bitnot { fixnum } { fixnum } <effect> set-primitive-effect
253 \ fixnum-bitnot make-foldable
255 \ fixnum-shift { fixnum fixnum } { integer } <effect> set-primitive-effect
256 \ fixnum-shift make-foldable
258 \ fixnum-shift-fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
259 \ fixnum-shift-fast make-foldable
261 \ bignum= { bignum bignum } { object } <effect> set-primitive-effect
262 \ bignum= make-foldable
264 \ bignum+ { bignum bignum } { bignum } <effect> set-primitive-effect
265 \ bignum+ make-foldable
267 \ bignum- { bignum bignum } { bignum } <effect> set-primitive-effect
268 \ bignum- make-foldable
270 \ bignum* { bignum bignum } { bignum } <effect> set-primitive-effect
271 \ bignum* make-foldable
273 \ bignum/i { bignum bignum } { bignum } <effect> set-primitive-effect
274 \ bignum/i make-foldable
276 \ bignum-mod { bignum bignum } { bignum } <effect> set-primitive-effect
277 \ bignum-mod make-foldable
279 \ bignum/mod { bignum bignum } { bignum bignum } <effect> set-primitive-effect
280 \ bignum/mod make-foldable
282 \ bignum-bitand { bignum bignum } { bignum } <effect> set-primitive-effect
283 \ bignum-bitand make-foldable
285 \ bignum-bitor { bignum bignum } { bignum } <effect> set-primitive-effect
286 \ bignum-bitor make-foldable
288 \ bignum-bitxor { bignum bignum } { bignum } <effect> set-primitive-effect
289 \ bignum-bitxor make-foldable
291 \ bignum-bitnot { bignum } { bignum } <effect> set-primitive-effect
292 \ bignum-bitnot make-foldable
294 \ bignum-shift { bignum bignum } { bignum } <effect> set-primitive-effect
295 \ bignum-shift make-foldable
297 \ bignum< { bignum bignum } { object } <effect> set-primitive-effect
298 \ bignum< make-foldable
300 \ bignum<= { bignum bignum } { object } <effect> set-primitive-effect
301 \ bignum<= make-foldable
303 \ bignum> { bignum bignum } { object } <effect> set-primitive-effect
304 \ bignum> make-foldable
306 \ bignum>= { bignum bignum } { object } <effect> set-primitive-effect
307 \ bignum>= make-foldable
309 \ bignum-bit? { bignum integer } { object } <effect> set-primitive-effect
310 \ bignum-bit? make-foldable
312 \ bignum-log2 { bignum } { bignum } <effect> set-primitive-effect
313 \ bignum-log2 make-foldable
315 \ byte-array>bignum { byte-array } { bignum } <effect> set-primitive-effect
316 \ byte-array>bignum make-foldable
318 \ float= { float float } { object } <effect> set-primitive-effect
319 \ float= make-foldable
321 \ float+ { float float } { float } <effect> set-primitive-effect
322 \ float+ make-foldable
324 \ float- { float float } { float } <effect> set-primitive-effect
325 \ float- make-foldable
327 \ float* { float float } { float } <effect> set-primitive-effect
328 \ float* make-foldable
330 \ float/f { float float } { float } <effect> set-primitive-effect
331 \ float/f make-foldable
333 \ float< { float float } { object } <effect> set-primitive-effect
334 \ float< make-foldable
336 \ float-mod { float float } { float } <effect> set-primitive-effect
337 \ float-mod make-foldable
339 \ float<= { float float } { object } <effect> set-primitive-effect
340 \ float<= make-foldable
342 \ float> { float float } { object } <effect> set-primitive-effect
343 \ float> make-foldable
345 \ float>= { float float } { object } <effect> set-primitive-effect
346 \ float>= make-foldable
348 \ <word> { object object } { word } <effect> set-primitive-effect
349 \ <word> make-flushable
351 \ word-xt { word } { integer integer } <effect> set-primitive-effect
352 \ word-xt make-flushable
354 \ getenv { fixnum } { object } <effect> set-primitive-effect
355 \ getenv make-flushable
357 \ setenv { object fixnum } { } <effect> set-primitive-effect
359 \ (exists?) { string } { object } <effect> set-primitive-effect
361 \ (directory) { string } { array } <effect> set-primitive-effect
363 \ gc { } { } <effect> set-primitive-effect
365 \ gc-stats { } { array } <effect> set-primitive-effect
367 \ save-image { string } { } <effect> set-primitive-effect
369 \ save-image-and-exit { string } { } <effect> set-primitive-effect
371 \ exit { integer } { } <effect>
372 t over set-effect-terminated?
375 \ data-room { } { integer integer array } <effect> set-primitive-effect
376 \ data-room make-flushable
378 \ code-room { } { integer integer integer integer } <effect> set-primitive-effect
379 \ code-room make-flushable
381 \ os-env { string } { object } <effect> set-primitive-effect
383 \ millis { } { integer } <effect> set-primitive-effect
384 \ millis make-flushable
386 \ tag { object } { fixnum } <effect> set-primitive-effect
389 \ cwd { } { string } <effect> set-primitive-effect
391 \ cd { string } { } <effect> set-primitive-effect
393 \ dlopen { string } { dll } <effect> set-primitive-effect
395 \ dlsym { string object } { c-ptr } <effect> set-primitive-effect
397 \ dlclose { dll } { } <effect> set-primitive-effect
399 \ <byte-array> { integer } { byte-array } <effect> set-primitive-effect
400 \ <byte-array> make-flushable
402 \ <bit-array> { integer } { bit-array } <effect> set-primitive-effect
403 \ <bit-array> make-flushable
405 \ <float-array> { integer float } { float-array } <effect> set-primitive-effect
406 \ <float-array> make-flushable
408 \ <displaced-alien> { integer c-ptr } { c-ptr } <effect> set-primitive-effect
409 \ <displaced-alien> make-flushable
411 \ alien-signed-cell { c-ptr integer } { integer } <effect> set-primitive-effect
412 \ alien-signed-cell make-flushable
414 \ set-alien-signed-cell { integer c-ptr integer } { } <effect> set-primitive-effect
416 \ alien-unsigned-cell { c-ptr integer } { integer } <effect> set-primitive-effect
417 \ alien-unsigned-cell make-flushable
419 \ set-alien-unsigned-cell { integer c-ptr integer } { } <effect> set-primitive-effect
421 \ alien-signed-8 { c-ptr integer } { integer } <effect> set-primitive-effect
422 \ alien-signed-8 make-flushable
424 \ set-alien-signed-8 { integer c-ptr integer } { } <effect> set-primitive-effect
426 \ alien-unsigned-8 { c-ptr integer } { integer } <effect> set-primitive-effect
427 \ alien-unsigned-8 make-flushable
429 \ set-alien-unsigned-8 { integer c-ptr integer } { } <effect> set-primitive-effect
431 \ alien-signed-4 { c-ptr integer } { integer } <effect> set-primitive-effect
432 \ alien-signed-4 make-flushable
434 \ set-alien-signed-4 { integer c-ptr integer } { } <effect> set-primitive-effect
436 \ alien-unsigned-4 { c-ptr integer } { integer } <effect> set-primitive-effect
437 \ alien-unsigned-4 make-flushable
439 \ set-alien-unsigned-4 { integer c-ptr integer } { } <effect> set-primitive-effect
441 \ alien-signed-2 { c-ptr integer } { fixnum } <effect> set-primitive-effect
442 \ alien-signed-2 make-flushable
444 \ set-alien-signed-2 { integer c-ptr integer } { } <effect> set-primitive-effect
446 \ alien-unsigned-2 { c-ptr integer } { fixnum } <effect> set-primitive-effect
447 \ alien-unsigned-2 make-flushable
449 \ set-alien-unsigned-2 { integer c-ptr integer } { } <effect> set-primitive-effect
451 \ alien-signed-1 { c-ptr integer } { fixnum } <effect> set-primitive-effect
452 \ alien-signed-1 make-flushable
454 \ set-alien-signed-1 { integer c-ptr integer } { } <effect> set-primitive-effect
456 \ alien-unsigned-1 { c-ptr integer } { fixnum } <effect> set-primitive-effect
457 \ alien-unsigned-1 make-flushable
459 \ set-alien-unsigned-1 { integer c-ptr integer } { } <effect> set-primitive-effect
461 \ alien-float { c-ptr integer } { float } <effect> set-primitive-effect
462 \ alien-float make-flushable
464 \ set-alien-float { float c-ptr integer } { } <effect> set-primitive-effect
466 \ alien-double { c-ptr integer } { float } <effect> set-primitive-effect
467 \ alien-double make-flushable
469 \ set-alien-double { float c-ptr integer } { } <effect> set-primitive-effect
471 \ alien-cell { c-ptr integer } { simple-c-ptr } <effect> set-primitive-effect
472 \ alien-cell make-flushable
474 \ set-alien-cell { c-ptr c-ptr integer } { } <effect> set-primitive-effect
476 \ alien-address { alien } { integer } <effect> set-primitive-effect
477 \ alien-address make-flushable
479 \ slot { object fixnum } { object } <effect> set-primitive-effect
480 \ slot make-flushable
482 \ set-slot { object object fixnum } { } <effect> set-primitive-effect
484 \ string-nth { fixnum string } { fixnum } <effect> set-primitive-effect
485 \ string-nth make-flushable
487 \ set-string-nth { fixnum fixnum string } { } <effect> set-primitive-effect
489 \ resize-array { integer array } { array } <effect> set-primitive-effect
490 \ resize-array make-flushable
492 \ resize-byte-array { integer byte-array } { byte-array } <effect> set-primitive-effect
493 \ resize-byte-array make-flushable
495 \ resize-bit-array { integer bit-array } { bit-array } <effect> set-primitive-effect
496 \ resize-bit-array make-flushable
498 \ resize-float-array { integer float-array } { float-array } <effect> set-primitive-effect
499 \ resize-float-array make-flushable
501 \ resize-string { integer string } { string } <effect> set-primitive-effect
502 \ resize-string make-flushable
504 \ <array> { integer object } { array } <effect> set-primitive-effect
505 \ <array> make-flushable
507 \ begin-scan { } { } <effect> set-primitive-effect
509 \ next-object { } { object } <effect> set-primitive-effect
511 \ end-scan { } { } <effect> set-primitive-effect
513 \ size { object } { fixnum } <effect> set-primitive-effect
514 \ size make-flushable
516 \ die { } { } <effect> set-primitive-effect
518 \ fopen { string string } { alien } <effect> set-primitive-effect
520 \ fgetc { alien } { object } <effect> set-primitive-effect
522 \ fwrite { string alien } { } <effect> set-primitive-effect
524 \ fputc { object alien } { } <effect> set-primitive-effect
526 \ fread { integer string } { object } <effect> set-primitive-effect
528 \ fflush { alien } { } <effect> set-primitive-effect
530 \ fclose { alien } { } <effect> set-primitive-effect
532 \ expired? { object } { object } <effect> set-primitive-effect
533 \ expired? make-flushable
535 \ <wrapper> { object } { wrapper } <effect> set-primitive-effect
536 \ <wrapper> make-foldable
538 \ (clone) { object } { object } <effect> set-primitive-effect
539 \ (clone) make-flushable
541 \ <string> { integer integer } { string } <effect> set-primitive-effect
542 \ <string> make-flushable
544 \ array>quotation { array } { quotation } <effect> set-primitive-effect
545 \ array>quotation make-flushable
547 \ quotation-xt { quotation } { integer } <effect> set-primitive-effect
548 \ quotation-xt make-flushable
550 \ <tuple> { tuple-layout } { tuple } <effect> set-primitive-effect
551 \ <tuple> make-flushable
553 \ <tuple-layout> { word fixnum array fixnum } { tuple-layout } <effect> set-primitive-effect
554 \ <tuple-layout> make-foldable
556 \ datastack { } { array } <effect> set-primitive-effect
557 \ datastack make-flushable
559 \ retainstack { } { array } <effect> set-primitive-effect
560 \ retainstack make-flushable
562 \ callstack { } { callstack } <effect> set-primitive-effect
563 \ callstack make-flushable
565 \ callstack>array { callstack } { array } <effect> set-primitive-effect
566 \ callstack>array make-flushable
568 \ (sleep) { integer } { } <effect> set-primitive-effect
570 \ become { array array } { } <effect> set-primitive-effect
572 \ innermost-frame-quot { callstack } { quotation } <effect> set-primitive-effect
574 \ innermost-frame-scan { callstack } { fixnum } <effect> set-primitive-effect
576 \ set-innermost-frame-quot { quotation callstack } { } <effect> set-primitive-effect
578 \ (os-envs) { } { array } <effect> set-primitive-effect
580 \ set-os-env { string string } { } <effect> set-primitive-effect
582 \ unset-os-env { string } { } <effect> set-primitive-effect
584 \ (set-os-envs) { array } { } <effect> set-primitive-effect
586 \ do-primitive [ \ do-primitive cannot-infer-effect ] "infer" set-word-prop
588 \ dll-valid? { object } { object } <effect> set-primitive-effect
590 \ modify-code-heap { array object } { } <effect> set-primitive-effect
592 \ unimplemented { } { } <effect> set-primitive-effect