core/compiler/inference/known-words.factor

   1 ! Copyright (C) 2004, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: inference
   4 USING: arrays alien assembler errors generic hashtables
   5 hashtables-internals io io-internals kernel
   6 kernel-internals math math-internals memory parser
   7 sequences strings vectors words prettyprint namespaces ;
   8
   9 \ declare [
  10     pop-literal nip
  11     dup ensure-values
  12     dup length d-tail
  13     swap #declare
  14     [ 2dup set-node-in-d set-node-out-d ] keep
  15     node,
  16 ] "infer" set-word-prop
  17 \ declare { object } { } <effect> "inferred-effect" set-word-prop
  18
  19 \ fixnum< { fixnum fixnum } { object } <effect> "inferred-effect" set-word-prop
  20 \ fixnum< t "foldable" set-word-prop
  21
  22 \ fixnum<= { fixnum fixnum } { object } <effect> "inferred-effect" set-word-prop
  23 \ fixnum<= t "foldable" set-word-prop
  24
  25 \ fixnum> { fixnum fixnum } { object } <effect> "inferred-effect" set-word-prop
  26 \ fixnum> t "foldable" set-word-prop
  27
  28 \ fixnum>= { fixnum fixnum } { object } <effect> "inferred-effect" set-word-prop
  29 \ fixnum>= t "foldable" set-word-prop
  30
  31 \ eq? { object object } { object } <effect> "inferred-effect" set-word-prop
  32 \ eq? t "foldable" set-word-prop
  33
  34 ! Primitive combinators
  35 \ call { object } { } <effect> "inferred-effect" set-word-prop
  36
  37 \ call [ pop-literal infer-quot-value ] "infer" set-word-prop
  38
  39 \ execute { word } { } <effect> "inferred-effect" set-word-prop
  40
  41 \ execute [ pop-literal nip apply-word ] "infer" set-word-prop
  42
  43 \ if { object object object } { } <effect> "inferred-effect" set-word-prop
  44
  45 \ if [
  46     2 #drop node, pop-d pop-d swap 2array
  47     #if pop-d drop infer-branches
  48 ] "infer" set-word-prop
  49
  50 \ cond { object } { } <effect> "inferred-effect" set-word-prop
  51
  52 \ cond [
  53     pop-literal <reversed>
  54     [ no-cond ] swap alist>quot infer-quot-value
  55 ] "infer" set-word-prop
  56
  57 \ dispatch { fixnum array } { } <effect> "inferred-effect" set-word-prop
  58
  59 \ dispatch [
  60     pop-literal nip [ <value> ] map
  61     #dispatch pop-d drop infer-branches
  62 ] "infer" set-word-prop
  63
  64 ! Non-standard control flow
  65 \ throw { object } { } <effect>
  66 t over set-effect-terminated?
  67 "inferred-effect" set-word-prop
  68
  69 ! Stack effects for all primitives
  70 \ rehash-string { string } { } <effect> "inferred-effect" set-word-prop
  71
  72 \ string>sbuf { string } { sbuf } <effect> "inferred-effect" set-word-prop
  73
  74 \ bignum>fixnum { bignum } { fixnum } <effect> "inferred-effect" set-word-prop
  75 \ bignum>fixnum t "foldable" set-word-prop
  76
  77 \ float>fixnum { float } { fixnum } <effect> "inferred-effect" set-word-prop
  78 \ bignum>fixnum t "foldable" set-word-prop
  79
  80 \ fixnum>bignum { fixnum } { bignum } <effect> "inferred-effect" set-word-prop
  81 \ fixnum>bignum t "foldable" set-word-prop
  82
  83 \ float>bignum { float } { bignum } <effect> "inferred-effect" set-word-prop
  84 \ float>bignum t "foldable" set-word-prop
  85
  86 \ fixnum>float { fixnum } { float } <effect> "inferred-effect" set-word-prop
  87 \ fixnum>float t "foldable" set-word-prop
  88
  89 \ bignum>float { bignum } { float } <effect> "inferred-effect" set-word-prop
  90 \ bignum>float t "foldable" set-word-prop
  91
  92 \ (fraction>) { integer integer } { rational } <effect> "inferred-effect" set-word-prop
  93 \ (fraction>) t "foldable" set-word-prop
  94
  95 \ string>float { string } { float } <effect> "inferred-effect" set-word-prop
  96 \ string>float t "foldable" set-word-prop
  97
  98 \ float>string { float } { string } <effect> "inferred-effect" set-word-prop
  99 \ float>string t "foldable" set-word-prop
 100
 101 \ float>bits { real } { integer } <effect> "inferred-effect" set-word-prop
 102 \ float>bits t "foldable" set-word-prop
 103
 104 \ double>bits { real } { integer } <effect> "inferred-effect" set-word-prop
 105 \ double>bits t "foldable" set-word-prop
 106
 107 \ bits>float { integer } { float } <effect> "inferred-effect" set-word-prop
 108 \ bits>float t "foldable" set-word-prop
 109
 110 \ bits>double { integer } { float } <effect> "inferred-effect" set-word-prop
 111 \ bits>double t "foldable" set-word-prop
 112
 113 \ <complex> { real real } { number } <effect> "inferred-effect" set-word-prop
 114 \ <complex> t "foldable" set-word-prop
 115
 116 \ fixnum+ { fixnum fixnum } { integer } <effect> "inferred-effect" set-word-prop
 117 \ fixnum+ t "foldable" set-word-prop
 118
 119 \ fixnum+fast { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
 120 \ fixnum+fast t "foldable" set-word-prop
 121
 122 \ fixnum- { fixnum fixnum } { integer } <effect> "inferred-effect" set-word-prop
 123 \ fixnum- t "foldable" set-word-prop
 124
 125 \ fixnum-fast { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
 126 \ fixnum-fast t "foldable" set-word-prop
 127
 128 \ fixnum* { fixnum fixnum } { integer } <effect> "inferred-effect" set-word-prop
 129 \ fixnum* t "foldable" set-word-prop
 130
 131 \ fixnum/i { fixnum fixnum } { integer } <effect> "inferred-effect" set-word-prop
 132 \ fixnum/i t "foldable" set-word-prop
 133
 134 \ fixnum-mod { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
 135 \ fixnum-mod t "foldable" set-word-prop
 136
 137 \ fixnum/mod { fixnum fixnum } { integer fixnum } <effect> "inferred-effect" set-word-prop
 138 \ fixnum/mod t "foldable" set-word-prop
 139
 140 \ fixnum-bitand { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
 141 \ fixnum-bitand t "foldable" set-word-prop
 142
 143 \ fixnum-bitor { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
 144 \ fixnum-bitor t "foldable" set-word-prop
 145
 146 \ fixnum-bitxor { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
 147 \ fixnum-bitxor t "foldable" set-word-prop
 148
 149 \ fixnum-bitnot { fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
 150 \ fixnum-bitnot t "foldable" set-word-prop
 151
 152 \ fixnum-shift { fixnum fixnum } { integer } <effect> "inferred-effect" set-word-prop
 153 \ fixnum-shift t "foldable" set-word-prop
 154
 155 \ bignum= { bignum bignum } { object } <effect> "inferred-effect" set-word-prop
 156 \ bignum= t "foldable" set-word-prop
 157
 158 \ bignum+ { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
 159 \ bignum+ t "foldable" set-word-prop
 160
 161 \ bignum- { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
 162 \ bignum- t "foldable" set-word-prop
 163
 164 \ bignum* { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
 165 \ bignum* t "foldable" set-word-prop
 166
 167 \ bignum/i { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
 168 \ bignum/i t "foldable" set-word-prop
 169
 170 \ bignum-mod { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
 171 \ bignum-mod t "foldable" set-word-prop
 172
 173 \ bignum/mod { bignum bignum } { bignum bignum } <effect> "inferred-effect" set-word-prop
 174 \ bignum/mod t "foldable" set-word-prop
 175
 176 \ bignum-bitand { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
 177 \ bignum-bitand t "foldable" set-word-prop
 178
 179 \ bignum-bitor { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
 180 \ bignum-bitor t "foldable" set-word-prop
 181
 182 \ bignum-bitxor { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
 183 \ bignum-bitxor t "foldable" set-word-prop
 184
 185 \ bignum-bitnot { bignum } { bignum } <effect> "inferred-effect" set-word-prop
 186 \ bignum-bitnot t "foldable" set-word-prop
 187
 188 \ bignum-shift { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
 189 \ bignum-shift t "foldable" set-word-prop
 190
 191 \ bignum< { bignum bignum } { object } <effect> "inferred-effect" set-word-prop
 192 \ bignum< t "foldable" set-word-prop
 193
 194 \ bignum<= { bignum bignum } { object } <effect> "inferred-effect" set-word-prop
 195 \ bignum<= t "foldable" set-word-prop
 196
 197 \ bignum> { bignum bignum } { object } <effect> "inferred-effect" set-word-prop
 198 \ bignum> t "foldable" set-word-prop
 199
 200 \ bignum>= { bignum bignum } { object } <effect> "inferred-effect" set-word-prop
 201 \ bignum>= t "foldable" set-word-prop
 202
 203 \ float+ { float float } { float } <effect> "inferred-effect" set-word-prop
 204 \ float+ t "foldable" set-word-prop
 205
 206 \ float- { float float } { float } <effect> "inferred-effect" set-word-prop
 207 \ float- t "foldable" set-word-prop
 208
 209 \ float* { float float } { float } <effect> "inferred-effect" set-word-prop
 210 \ float* t "foldable" set-word-prop
 211
 212 \ float/f { float float } { float } <effect> "inferred-effect" set-word-prop
 213 \ float/f t "foldable" set-word-prop
 214
 215 \ float< { float float } { object } <effect> "inferred-effect" set-word-prop
 216 \ float< t "foldable" set-word-prop
 217
 218 \ float-mod { float float } { float } <effect> "inferred-effect" set-word-prop
 219 \ float-mod t "foldable" set-word-prop
 220
 221 \ float<= { float float } { object } <effect> "inferred-effect" set-word-prop
 222 \ float<= t "foldable" set-word-prop
 223
 224 \ float> { float float } { object } <effect> "inferred-effect" set-word-prop
 225 \ float> t "foldable" set-word-prop
 226
 227 \ float>= { float float } { object } <effect> "inferred-effect" set-word-prop
 228 \ float>= t "foldable" set-word-prop
 229
 230 \ (word) { object object } { word } <effect> "inferred-effect" set-word-prop
 231
 232 \ update-xt { word } { } <effect> "inferred-effect" set-word-prop
 233
 234 \ word-xt { word } { integer } <effect> "inferred-effect" set-word-prop
 235
 236 \ getenv { fixnum } { object } <effect> "inferred-effect" set-word-prop
 237 \ setenv { object fixnum } { } <effect> "inferred-effect" set-word-prop
 238 \ stat { string } { object object object object } <effect> "inferred-effect" set-word-prop
 239 \ (directory) { string } { array } <effect> "inferred-effect" set-word-prop
 240 \ data-gc { integer } { } <effect> "inferred-effect" set-word-prop
 241
 242 ! code-gc does not declare a stack effect since it might be
 243 ! called from a compiled word which becomes unreachable during
 244 ! the course of its execution, resulting in a crash
 245
 246 \ gc-time { } { integer } <effect> "inferred-effect" set-word-prop
 247 \ save-image { string } { } <effect> "inferred-effect" set-word-prop
 248 \ exit { integer } { } <effect> "inferred-effect" set-word-prop
 249 \ data-room { } { integer integer array } <effect> "inferred-effect" set-word-prop
 250 \ code-room { } { integer integer } <effect> "inferred-effect" set-word-prop
 251 \ os-env { string } { object } <effect> "inferred-effect" set-word-prop
 252 \ millis { } { integer } <effect> "inferred-effect" set-word-prop
 253
 254 \ type { object } { fixnum } <effect> "inferred-effect" set-word-prop
 255 \ type t "foldable" set-word-prop
 256
 257 \ tag { object } { fixnum } <effect> "inferred-effect" set-word-prop
 258 \ tag t "foldable" set-word-prop
 259
 260 \ cwd { } { string } <effect> "inferred-effect" set-word-prop
 261 \ cd { string } { } <effect> "inferred-effect" set-word-prop
 262
 263 \ dlopen { string } { dll } <effect> "inferred-effect" set-word-prop
 264 \ dlsym { string object } { integer } <effect> "inferred-effect" set-word-prop
 265 \ dlclose { dll } { } <effect> "inferred-effect" set-word-prop
 266
 267 \ <byte-array> { integer } { byte-array } <effect> "inferred-effect" set-word-prop
 268
 269 \ <displaced-alien> { integer c-ptr } { c-ptr } <effect> "inferred-effect" set-word-prop
 270
 271 \ alien-signed-cell { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
 272
 273 \ set-alien-signed-cell { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 274 \ alien-unsigned-cell { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
 275
 276 \ set-alien-unsigned-cell { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 277 \ alien-signed-8 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
 278
 279 \ set-alien-signed-8 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 280 \ alien-unsigned-8 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
 281
 282 \ set-alien-unsigned-8 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 283 \ alien-signed-4 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
 284
 285 \ set-alien-signed-4 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 286 \ alien-unsigned-4 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
 287
 288 \ set-alien-unsigned-4 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 289 \ alien-signed-2 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
 290
 291 \ set-alien-signed-2 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 292 \ alien-unsigned-2 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
 293
 294 \ set-alien-unsigned-2 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 295 \ alien-signed-1 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
 296
 297 \ set-alien-signed-1 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 298 \ alien-unsigned-1 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
 299
 300 \ set-alien-unsigned-1 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 301 \ alien-float { c-ptr integer } { float } <effect> "inferred-effect" set-word-prop
 302
 303 \ set-alien-float { float c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 304 \ alien-float { c-ptr integer } { float } <effect> "inferred-effect" set-word-prop
 305
 306 \ set-alien-double { float c-ptr integer } { } <effect> "inferred-effect" set-word-prop
 307 \ alien-double { c-ptr integer } { float } <effect> "inferred-effect" set-word-prop
 308
 309 \ alien>char-string { c-ptr } { string } <effect> "inferred-effect" set-word-prop
 310
 311 \ string>char-alien { string } { byte-array } <effect> "inferred-effect" set-word-prop
 312
 313 \ alien>u16-string { c-ptr } { string } <effect> "inferred-effect" set-word-prop
 314
 315 \ string>u16-alien { string } { byte-array } <effect> "inferred-effect" set-word-prop
 316
 317 \ string>memory { string integer } { } <effect> "inferred-effect" set-word-prop
 318 \ memory>string { integer integer } { string } <effect> "inferred-effect" set-word-prop
 319
 320 \ alien-address { alien } { integer } <effect> "inferred-effect" set-word-prop
 321
 322 \ slot { object fixnum } { object } <effect> "inferred-effect" set-word-prop
 323
 324 \ set-slot { object object fixnum } { } <effect> "inferred-effect" set-word-prop
 325
 326 \ char-slot { fixnum object } { fixnum } <effect> "inferred-effect" set-word-prop
 327
 328 \ set-char-slot { fixnum fixnum object } { } <effect> "inferred-effect" set-word-prop
 329 \ resize-array { integer array } { array } <effect> "inferred-effect" set-word-prop
 330 \ resize-string { integer string } { string } <effect> "inferred-effect" set-word-prop
 331
 332 \ (hashtable) { } { hashtable } <effect> "inferred-effect" set-word-prop
 333
 334 \ <array> { integer object } { array } <effect> "inferred-effect" set-word-prop
 335
 336 \ begin-scan { } { } <effect> "inferred-effect" set-word-prop
 337 \ next-object { } { object } <effect> "inferred-effect" set-word-prop
 338 \ end-scan { } { } <effect> "inferred-effect" set-word-prop
 339
 340 \ size { object } { fixnum } <effect> "inferred-effect" set-word-prop
 341
 342 \ die { } { } <effect> "inferred-effect" set-word-prop
 343 \ fopen { string string } { alien } <effect> "inferred-effect" set-word-prop
 344 \ fgetc { alien } { object } <effect> "inferred-effect" set-word-prop
 345 \ fwrite { string alien } { } <effect> "inferred-effect" set-word-prop
 346 \ fflush { alien } { } <effect> "inferred-effect" set-word-prop
 347 \ fclose { alien } { } <effect> "inferred-effect" set-word-prop
 348 \ expired? { object } { object } <effect> "inferred-effect" set-word-prop
 349
 350 \ <wrapper> { object } { wrapper } <effect> "inferred-effect" set-word-prop
 351 \ <wrapper> t "foldable" set-word-prop
 352
 353 \ (clone) { object } { object } <effect> "inferred-effect" set-word-prop
 354
 355 \ become { object fixnum } { object } <effect> "inferred-effect" set-word-prop
 356
 357 \ array>vector { array } { vector } <effect> "inferred-effect" set-word-prop
 358
 359 \ finalize-compile { array } { } <effect> "inferred-effect" set-word-prop
 360
 361 \ <string> { integer integer } { string } <effect> "inferred-effect" set-word-prop
 362
 363 \ <quotation> { integer } { quotation } <effect> "inferred-effect" set-word-prop
 364
 365 \ xt-map { } { array } <effect> "inferred-effect" set-word-prop
 366
 367 ! Dynamic scope inference
 368 : if-tos-literal ( quot -- )
 369     peek-d dup value? [ value-literal swap call ] [ 2drop ] if ;
 370     inline
 371
 372 \ >n [ H{ } clone push-n ] "infer-vars" set-word-prop
 373
 374 \ >n { object } { } <effect> "inferred-effect" set-word-prop
 375
 376 TUPLE: too-many-n> ;
 377
 378 : apply-n> ( -- )
 379     meta-n get empty? [
 380         <too-many-n>> inference-error
 381     ] [
 382         pop-n drop
 383     ] if ;
 384
 385 \ n> [ apply-n> ] "infer-vars" set-word-prop
 386
 387 \ n> { } { object } <effect> "inferred-effect" set-word-prop
 388
 389 \ ndrop [ apply-n> ] "infer-vars" set-word-prop
 390
 391 \ ndrop { } { } <effect> "inferred-effect" set-word-prop
 392
 393 \ get [
 394     [ apply-var-read ] if-tos-literal
 395 ] "infer-vars" set-word-prop
 396
 397 \ get { object } { object } <effect> "inferred-effect" set-word-prop
 398
 399 \ set [
 400     [ apply-var-write ] if-tos-literal
 401 ] "infer-vars" set-word-prop
 402
 403 \ set { object object } { } <effect> "inferred-effect" set-word-prop
 404
 405 \ get-global [
 406     [ apply-global-read ]
 407     if-tos-literal
 408 ] "infer-vars" set-word-prop
 409
 410 \ get-global { object } { object } <effect> "inferred-effect" set-word-prop
 411
 412 \ set-global [
 413     [ apply-global-write ]
 414     if-tos-literal
 415 ] "infer-vars" set-word-prop
 416
 417 \ set-global { object object } { } <effect> "inferred-effect" set-word-prop