basis/stack-checker/stack-checker-tests.factor

   1 USING: accessors arrays generic stack-checker
   2 stack-checker.backend stack-checker.errors kernel classes
   3 kernel.private math math.parser math.private namespaces
   4 namespaces.private parser sequences strings vectors words
   5 quotations effects tools.test continuations generic.standard
   6 sorting assocs definitions prettyprint io inspector
   7 classes.tuple classes.union classes.predicate debugger
   8 threads.private io.streams.string io.timeouts io.thread
   9 sequences.private destructors combinators eval locals.backend
  10 system compiler.units shuffle vocabs combinators.smart ;
  11 IN: stack-checker.tests
  12
  13 [ 1234 infer ] must-fail
  14
  15 { 0 2 } [ 2 "Hello" ] must-infer-as
  16 { 1 2 } [ dup ] must-infer-as
  17
  18 { 1 2 } [ [ dup ] call ] must-infer-as
  19 [ [ call ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
  20 [ [ curry call ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
  21 [ [ { } >quotation call ] infer ] [ T{ bad-macro-input f call } = ] must-fail-with
  22 [ [ append curry call ] infer ] [ T{ bad-macro-input f call } = ] must-fail-with
  23
  24 { 2 4 } [ 2dup ] must-infer-as
  25
  26 { 1 0 } [ [ ] [ ] if ] must-infer-as
  27 [ [ if ] infer ] [ T{ unknown-macro-input f if } = ] must-fail-with
  28 [ [ { } >quotation { } >quotation if ] infer ] [ T{ bad-macro-input f if } = ] must-fail-with
  29 [ [ [ ] if ] infer ] [ T{ unknown-macro-input f if } = ] must-fail-with
  30 [ [ [ 2 ] [ ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
  31 { 4 3 } [ [ rot ] [ -rot ] if ] must-infer-as
  32
  33 { 4 3 } [
  34     [
  35         [ swap 3 ] [ nip 5 5 ] if
  36     ] [
  37         -rot
  38     ] if
  39 ] must-infer-as
  40
  41 { 1 1 } [ dup [ ] when ] must-infer-as
  42 { 1 1 } [ dup [ dup fixnum* ] when ] must-infer-as
  43 { 2 1 } [ [ dup fixnum* ] when ] must-infer-as
  44
  45 { 1 0 } [ [ drop ] when* ] must-infer-as
  46 { 1 1 } [ [ { { [ ] } } ] unless* ] must-infer-as
  47
  48 { 0 1 }
  49 [ [ 2 2 fixnum+ ] dup [ ] when call ] must-infer-as
  50
  51 [
  52     [ [ [ 2 2 fixnum+ ] ] [ [ 2 2 fixnum* ] ] if call ] infer
  53 ] [ T{ bad-macro-input f call } = ] must-fail-with
  54
  55 ! Test inference of termination of control flow
  56 : termination-test-1 ( -- * ) "foo" throw ;
  57
  58 : termination-test-2 ( ? -- x ) [ termination-test-1 ] [ 3 ] if ;
  59
  60 { 1 1 } [ termination-test-2 ] must-infer-as
  61
  62 : simple-recursion-1 ( obj -- obj )
  63     dup [ simple-recursion-1 ] [ ] if ;
  64
  65 { 1 1 } [ simple-recursion-1 ] must-infer-as
  66
  67 : simple-recursion-2 ( obj -- obj )
  68     dup [ ] [ simple-recursion-2 ] if ;
  69
  70 { 1 1 } [ simple-recursion-2 ] must-infer-as
  71
  72 : funny-recursion ( obj -- obj )
  73     dup [ funny-recursion 1 ] [ 2 ] if drop ;
  74
  75 { 1 1 } [ funny-recursion ] must-infer-as
  76
  77 ! Simple combinators
  78 { 1 2 } [ [ first ] keep second ] must-infer-as
  79
  80 ! Mutual recursion
  81 DEFER: foe
  82
  83 : fie ( element obj -- ? )
  84     dup array? [ foe ] [ eq? ] if ;
  85
  86 : foe ( element tree -- ? )
  87     dup [
  88         2dup first fie [
  89             nip
  90         ] [
  91             second dup array? [
  92                 foe
  93             ] [
  94                 fie
  95             ] if
  96         ] if
  97     ] [
  98         2drop f
  99     ] if ;
 100
 101 { 2 1 } [ fie ] must-infer-as
 102 { 2 1 } [ foe ] must-infer-as
 103
 104 : nested-when ( -- )
 105     t [
 106         t [
 107             5 drop
 108         ] when
 109     ] when ;
 110
 111 { 0 0 } [ nested-when ] must-infer-as
 112
 113 : nested-when* ( obj -- )
 114     [
 115         [
 116             drop
 117         ] when*
 118     ] when* ;
 119
 120 { 1 0 } [ nested-when* ] must-infer-as
 121
 122 SYMBOL: sym-test
 123
 124 { 0 1 } [ sym-test ] must-infer-as
 125
 126 : terminator-branch ( a -- b )
 127     dup [
 128         length
 129     ] [
 130         "foo" throw
 131     ] if ;
 132
 133 { 1 1 } [ terminator-branch ] must-infer-as
 134
 135 : recursive-terminator ( obj -- )
 136     dup [
 137         recursive-terminator
 138     ] [
 139         "Hi" throw
 140     ] if ;
 141
 142 { 1 0 } [ recursive-terminator ] must-infer-as
 143
 144 GENERIC: potential-hang ( obj -- obj )
 145 M: fixnum potential-hang dup [ potential-hang ] when ;
 146
 147 [ ] [ [ 5 potential-hang ] infer drop ] unit-test
 148
 149 TUPLE: funny-cons car cdr ;
 150 GENERIC: iterate ( obj -- )
 151 M: funny-cons iterate cdr>> iterate ;
 152 M: f iterate drop ;
 153 M: real iterate drop ;
 154
 155 { 1 0 } [ iterate ] must-infer-as
 156
 157 ! Regression
 158 : cat ( obj -- * ) dup [ throw ] [ throw ] if ;
 159 : dog ( a b c -- ) dup [ cat ] [ 3drop ] if ;
 160 { 3 0 } [ dog ] must-infer-as
 161
 162 ! Regression
 163 DEFER: monkey
 164 : friend ( a b c -- ) dup [ friend ] [ monkey ] if ;
 165 : monkey ( a b c -- ) dup [ 3drop ] [ friend ] if ;
 166 { 3 0 } [ friend ] must-infer-as
 167
 168 ! Regression -- same as above but we infer the second word first
 169 DEFER: blah2
 170 : blah ( a b c -- ) dup [ blah ] [ blah2 ] if ;
 171 : blah2 ( a b c -- ) dup [ blah ] [ 3drop ] if ;
 172 { 3 0 } [ blah2 ] must-infer-as
 173
 174 ! Regression
 175 DEFER: blah4
 176 : blah3 ( a b c -- )
 177     dup [ blah3 ] [ dup [ blah4 ] [ blah3 ] if ] if ;
 178 : blah4 ( a b c -- )
 179     dup [ blah4 ] [ dup [ 3drop ] [ blah3 ] if ] if ;
 180 { 3 0 } [ blah4 ] must-infer-as
 181
 182 ! Regression
 183 : bad-combinator ( obj quot: ( -- ) -- )
 184     over [
 185         2drop
 186     ] [
 187         [ dip ] keep swap bad-combinator
 188     ] if ; inline recursive
 189
 190 [ [ [ 1 ] [ ] bad-combinator ] infer ] must-fail
 191
 192 ! Regression
 193 { 2 2 } [
 194     dup string? [ 2array throw ] unless
 195     over string? [ 2array throw ] unless
 196 ] must-infer-as
 197
 198 ! Regression
 199 : too-deep ( a b -- c )
 200     dup [ drop ] [ 2dup too-deep too-deep * ] if ; inline recursive
 201 { 2 1 } [ too-deep ] must-infer-as
 202
 203 ! This used to hang
 204 [ [ [ dup call ] dup call ] infer ]
 205 [ recursive-quotation-error? ] must-fail-with
 206
 207 : m ( q -- ) dup call ; inline
 208
 209 [ [ [ m ] m ] infer ] [ recursive-quotation-error? ] must-fail-with
 210
 211 : m' ( quot -- ) dup curry call ; inline
 212
 213 [ [ [ m' ] m' ] infer ] [ recursive-quotation-error? ] must-fail-with
 214
 215 : m'' ( -- q ) [ dup curry ] ; inline
 216
 217 : m''' ( -- ) m'' call call ; inline
 218
 219 [ [ [ m''' ] m''' ] infer ] [ recursive-quotation-error? ] must-fail-with
 220
 221 : m-if ( a b c -- ) t over when ; inline
 222
 223 [ [ [ m-if ] m-if ] infer ] [ recursive-quotation-error? ] must-fail-with
 224
 225 ! This doesn't hang but it's also an example of the
 226 ! undedicable case
 227 [ [ [ [ drop 3 ] swap call ] dup call ] infer ]
 228 [ recursive-quotation-error? ] must-fail-with
 229
 230 [ [ 1 drop-locals ] infer ] [ too-many-r>? ] must-fail-with
 231
 232 ! Regression
 233 [ [ cleave ] infer ] [ T{ unknown-macro-input f cleave } = ] must-fail-with
 234
 235 ! Test some curry stuff
 236 { 1 1 } [ 3 [ ] curry 4 [ ] curry if ] must-infer-as
 237 { 3 1 } [ [ ] curry [ [ ] curry ] dip if ] must-infer-as
 238
 239 { 2 1 } [ [ ] curry 4 [ ] curry if ] must-infer-as
 240
 241 [ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] [ unbalanced-branches-error? ] must-fail-with
 242 [ [ [ ] curry [ [ ] 2curry ] dip if ] infer ] [ unbalanced-branches-error? ] must-fail-with
 243
 244 { 1 3 } [ [ 2drop f ] assoc-find ] must-infer-as
 245
 246 ! Test words with continuations
 247 { 0 0 } [ [ drop ] callcc0 ] must-infer-as
 248 { 0 1 } [ [ 4 swap continue-with ] callcc1 ] must-infer-as
 249 { 2 1 } [ [ + ] [ ] [ ] cleanup ] must-infer-as
 250 { 2 1 } [ [ + ] [ 3drop 0 ] recover ] must-infer-as
 251
 252 ! A typo
 253 { 1 0 } [ { [ ] } dispatch ] must-infer-as
 254
 255 ! Make sure the error is correct
 256 [
 257     [ { [ drop ] [ dup ] } dispatch ] infer
 258 ] [ word>> \ dispatch eq? ] must-fail-with
 259
 260 DEFER: inline-recursive-2
 261 : inline-recursive-1 ( -- ) inline-recursive-2 ;
 262 : inline-recursive-2 ( -- ) inline-recursive-1 ;
 263
 264 { 0 0 } [ inline-recursive-1 ] must-infer-as
 265
 266 ! Hooks
 267 SYMBOL: my-var
 268 HOOK: my-hook my-var ( -- x )
 269
 270 M: integer my-hook "an integer" ;
 271 M: string my-hook "a string" ;
 272
 273 { 0 1 } [ my-hook ] must-infer-as
 274
 275 DEFER: deferred-word
 276
 277 { 1 1 } [ [ deferred-word ] [ 3 ] if ] must-infer-as
 278
 279 DEFER: an-inline-word
 280
 281 : normal-word-3 ( -- )
 282     3 [ [ 2 + ] curry ] an-inline-word call drop ;
 283
 284 : normal-word-2 ( -- )
 285     normal-word-3 ;
 286
 287 : normal-word ( x -- x )
 288     dup [ normal-word-2 ] when ;
 289
 290 : an-inline-word ( obj quot -- )
 291     [ normal-word ] dip call ; inline
 292
 293 { 1 1 } [ [ 3 * ] an-inline-word ] must-infer-as
 294
 295 { 0 1 } [ [ 2 ] [ 2 ] [ + ] compose compose call ] must-infer-as
 296
 297 ERROR: custom-error ;
 298
 299 [ T{ effect f { } { } t } ] [
 300     [ custom-error ] infer
 301 ] unit-test
 302
 303 : funny-throw ( a -- * ) throw ; inline
 304
 305 [ T{ effect f { } { } t } ] [
 306     [ 3 funny-throw ] infer
 307 ] unit-test
 308
 309 [ T{ effect f { } { } t } ] [
 310     [ custom-error inference-error ] infer
 311 ] unit-test
 312
 313 [ T{ effect f { "x" } { "x" "x" } t } ] [
 314     [ dup [ 3 throw ] dip ] infer
 315 ] unit-test
 316
 317 ! Regression
 318 [ [ 1 load-locals ] infer ] [ too-many->r? ] must-fail-with
 319
 320 ! Corner case
 321 [ [ [ f dup ] [ dup ] produce ] infer ] must-fail
 322
 323 [ [ [ f dup ] [ ] while ] infer ] must-fail
 324
 325 : erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline recursive
 326 [ [ erg's-inference-bug ] infer ] must-fail
 327 FORGET: erg's-inference-bug
 328
 329 : bad-recursion-3 ( -- ) dup [ [ bad-recursion-3 ] dip ] when ; inline recursive
 330 [ [ bad-recursion-3 ] infer ] must-fail
 331 FORGET: bad-recursion-3
 332
 333 : bad-recursion-4 ( -- ) 4 [ dup call [ rot ] dip swap ] times ; inline recursive
 334 [ [ [ ] [ 1 2 3 ] over dup bad-recursion-4 ] infer ] must-fail
 335
 336 : bad-recursion-5 ( obj quot: ( -- ) -- ) dup call swap bad-recursion-5 ; inline recursive
 337 [ [ f [ ] bad-recursion-5 ] infer ] must-fail
 338
 339 : bad-recursion-6 ( quot: ( -- ) -- )
 340     dup bad-recursion-6 call ; inline recursive
 341 [ [ [ drop f ] bad-recursion-6 ] infer ] must-fail
 342
 343 [ ] [ [ \ bad-recursion-6 forget ] with-compilation-unit ] unit-test
 344
 345 { 3 0 } [ [ 2drop "A" throw ] [ ] if 2drop ] must-infer-as
 346 { 2 0 } [ drop f f [ 2drop "A" throw ] [ ] if 2drop ] must-infer-as
 347
 348 : unbalanced-retain-usage ( a b -- )
 349     dup 10 < [ 2drop 5 1 + unbalanced-retain-usage ] [ 2drop ] if ;
 350     inline recursive
 351
 352 [ [ unbalanced-retain-usage ] infer ] [ inference-error? ] must-fail-with
 353
 354 FORGET: unbalanced-retain-usage
 355
 356 DEFER: eee'
 357 : ddd' ( ? -- ) [ f eee' ] when ; inline recursive
 358 : eee' ( ? -- ) [ swap [ ] ] dip ddd' call ; inline recursive
 359
 360 [ [ eee' ] infer ] [ inference-error? ] must-fail-with
 361
 362 [ ] [ [ \ ddd' forget ] with-compilation-unit ] unit-test
 363 [ ] [ [ \ eee' forget ] with-compilation-unit ] unit-test
 364
 365 : bogus-error ( x -- )
 366     dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive
 367
 368 [ bogus-error ] must-infer
 369
 370 [ [ clear ] infer. ] [ inference-error? ] must-fail-with
 371
 372 : debugging-curry-folding ( quot -- )
 373     [ debugging-curry-folding ] curry call ; inline recursive
 374
 375 [ [ ] debugging-curry-folding ] must-infer
 376
 377 [ [ exit ] [ 1 2 3 ] if ] must-infer
 378
 379 ! Stack effects are required now but FORGET: clears them...
 380 : forget-test ( -- ) ;
 381
 382 [ forget-test ] must-infer
 383 [ ] [ [ \ forget-test forget ] with-compilation-unit ] unit-test
 384 [ forget-test ] must-infer
 385
 386 [ [ cond ] infer ] [ T{ unknown-macro-input f cond } = ] must-fail-with
 387 [ [ call ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
 388 [ [ dip ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
 389
 390 [ [ each ] infer ] [ T{ unknown-macro-input f each } = ] must-fail-with
 391 [ [ if* ] infer ] [ T{ unknown-macro-input f if* } = ] must-fail-with
 392 [ [ [ "derp" ] if* ] infer ] [ T{ unknown-macro-input f if* } = ] must-fail-with
 393
 394 [ [ [ "OOPS" throw ] dip ] [ drop ] if ] must-infer
 395
 396 ! Found during code review
 397 [ [ [ drop [ ] ] when call ] infer ] must-fail
 398 [ swap [ [ drop [ ] ] when call ] infer ] must-fail
 399
 400 { 3 1 } [ call( a b -- c ) ] must-infer-as
 401 { 3 1 } [ execute( a b -- c ) ] must-infer-as
 402
 403 [ [ call-effect ] infer ] [ T{ unknown-macro-input f call-effect } = ] must-fail-with
 404 [ [ execute-effect ] infer ] [ T{ unknown-macro-input f execute-effect } = ] must-fail-with
 405
 406 [ \ set-datastack def>> infer ] [ T{ do-not-compile f do-primitive } = ] must-fail-with
 407 [ ] [ [ \ set-datastack def>> infer ] try ] unit-test
 408
 409 ! Make sure all primitives are covered
 410 [ { } ] [
 411     all-words [ primitive? ] filter
 412     [ "default-output-classes" word-prop not ] filter
 413     [ "special" word-prop not ] filter
 414     [ "shuffle" word-prop not ] filter
 415 ] unit-test
 416
 417 { 1 0 } [ [ drop       ] each ] must-infer-as
 418 { 2 1 } [ [ append     ] each ] must-infer-as
 419 { 1 1 } [ [            ] map  ] must-infer-as
 420 { 1 1 } [ [ reverse    ] map  ] must-infer-as
 421 { 2 2 } [ [ append dup ] map  ] must-infer-as
 422 { 2 2 } [ [ swap nth suffix dup ] map-index ] must-infer-as
 423
 424 { 4 1 } [ [ 2drop ] [ 2nip    ] if ] must-infer-as
 425 { 3 3 } [ [ dup   ] [ over    ] if ] must-infer-as
 426 { 1 1 } [ [ 1     ] [ 0       ] if ] must-infer-as
 427 { 2 2 } [ [ t     ] [ 1 + f   ] if ] must-infer-as
 428
 429 { 1 0 } [ [ write     ] [ "(f)" write ] if* ] must-infer-as
 430 { 1 1 } [ [           ] [ f           ] if* ] must-infer-as
 431 { 2 1 } [ [ nip       ] [ drop f      ] if* ] must-infer-as
 432 { 2 1 } [ [ nip       ] [             ] if* ] must-infer-as
 433 { 3 2 } [ [ 3append f ] [             ] if* ] must-infer-as
 434 { 1 0 } [ [ drop      ] [             ] if* ] must-infer-as
 435
 436 { 1 1 } [ [ 1 +       ] [ "oops" throw ] if* ] must-infer-as
 437
 438 : strict-each ( seq quot: ( x -- ) -- )
 439     each ; inline
 440 : strict-map ( seq quot: ( x -- x' ) -- seq' )
 441     map ; inline
 442 : strict-2map ( xs ys quot: ( x y -- z ) -- zs )
 443     2map ; inline
 444
 445 { 1 0 } [ [ drop ] strict-each ] must-infer-as
 446 { 1 1 } [ [ 1 + ] strict-map ] must-infer-as
 447 { 1 1 } [ [  ] strict-map ] must-infer-as
 448 { 2 1 } [ [ + ] strict-2map ] must-infer-as
 449 { 2 1 } [ [ drop ] strict-2map ] must-infer-as
 450 [ [ [ append ] strict-each ] infer ] [ unbalanced-branches-error? ] must-fail-with
 451 [ [ [ 1 + ] strict-2map ] infer ] [ unbalanced-branches-error? ] must-fail-with
 452
 453 ! ensure that polymorphic checking works on recursive combinators
 454 : (recursive-reduce) ( identity i seq quot: ( prev elt -- next ) n -- result )
 455     [ pick ] dip swap over < [
 456         [ [ [ nth-unsafe ] dip call ] 3keep [ 1 + ] 2dip ] dip
 457         (recursive-reduce)
 458     ] [ 4drop ] if ; inline recursive
 459 : recursive-reduce ( seq i quot: ( prev elt -- next ) -- result )
 460     swapd [ 0 ] 2dip over length (recursive-reduce) ; inline
 461 { 24995000 } [ 10000 iota 0 [ dup even? [ + ] [ drop ] if ] recursive-reduce ] unit-test
 462 { 3 1 } [ [ member? [ 1 + ] when ] curry recursive-reduce ] must-infer-as
 463
 464 [ [ [ write write ] each      ] infer ] [ unbalanced-branches-error? ] must-fail-with
 465
 466 [ [ [             ] each      ] infer ] [ unbalanced-branches-error? ] must-fail-with
 467 [ [ [ dup         ] map       ] infer ] [ unbalanced-branches-error? ] must-fail-with
 468 [ [ [ drop        ] map       ] infer ] [ unbalanced-branches-error? ] must-fail-with
 469 [ [ [ 1 +         ] map-index ] infer ] [ unbalanced-branches-error? ] must-fail-with
 470
 471 [ [ [ dup  ] [      ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
 472 [ [ [ 2dup ] [ over ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
 473 [ [ [ drop ] [      ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
 474
 475 [ [ [      ] [       ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
 476 [ [ [ dup  ] [       ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
 477 [ [ [ drop ] [ drop  ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
 478 [ [ [      ] [ drop  ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
 479 [ [ [      ] [ 2dup  ] if* ] infer ] [ unbalanced-branches-error? ] must-fail-with
 480
 481 ! M\ declared-effect infer-call* didn't properly unify branches
 482 { 1 0 } [ [ 1 [ drop ] [ drop ] if ] each ] must-infer-as
 483
 484 ! Make sure alien-callback effects are checked properly
 485 USING: alien.c-types alien ;
 486
 487 [ void { } cdecl [ ] alien-callback ] must-infer
 488
 489 [ [ void { } cdecl [ f [ drop ] unless ] alien-callback ] infer ] [ unbalanced-branches-error? ] must-fail-with
 490
 491 [ [ void { } cdecl [ drop ] alien-callback ] infer ] [ effect-error? ] must-fail-with
 492
 493 [ [ int { } cdecl [ ] alien-callback ] infer ] [ effect-error? ] must-fail-with
 494
 495 [ int { } cdecl [ 5 ] alien-callback ] must-infer
 496
 497 [ int { int } cdecl [ ] alien-callback ] must-infer
 498
 499 [ int { int } cdecl [ 1 + ] alien-callback ] must-infer
 500
 501 [ void { int } cdecl [ . ] alien-callback ] must-infer
 502
 503 : recursive-callback-1 ( -- x )
 504     void { } cdecl [ recursive-callback-1 drop ] alien-callback ;
 505
 506 \ recursive-callback-1 def>> must-infer
 507
 508 : recursive-callback-2 ( -- x )
 509     void { } cdecl [ recursive-callback-2 drop ] alien-callback ; inline recursive
 510
 511 [ recursive-callback-2 ] must-infer
 512
 513 ! test one-sided row polymorphism
 514
 515 : poly-output ( x a: ( x -- ..a ) -- ..a ) call ; inline
 516
 517 [ [ ] poly-output ] must-infer
 518 [ [ f f f ] poly-output ] must-infer
 519
 520 : poly-input ( ..a a: ( ..a -- x ) -- x ) call ; inline
 521
 522 [ [ ] poly-input ] must-infer
 523 [ [ drop drop drop ] poly-input ] must-infer
 524
 525 : poly-output-input ( x a: ( x -- ..a ) b: ( ..a -- y ) -- y ) [ call ] bi@ ; inline
 526
 527 [ [ ] [ ] poly-output-input ] must-infer
 528 [ [ f f f ] [ drop drop drop ] poly-output-input ] must-infer
 529 [ [ [ f f ] [ drop drop drop ] poly-output-input ] infer ] [ unbalanced-branches-error? ] must-fail-with
 530 [ [ [ f f f ] [ drop drop ] poly-output-input ] infer ] [ unbalanced-branches-error? ] must-fail-with
 531
 532 : poly-input-output ( ..a a: ( ..a -- x ) b: ( x -- ..b ) -- ..b ) [ call ] bi@ ; inline
 533
 534 [ [ ] [ ] poly-input-output ] must-infer
 535 [ [ drop drop drop ] [ f f f ] poly-input-output ] must-infer
 536 [ [ drop drop ] [ f f f ] poly-input-output ] must-infer
 537 [ [ drop drop drop ] [ f f ] poly-input-output ] must-infer
 538
 539 ! Check that 'inputs' and 'outputs' work at compile-time
 540
 541 : inputs-test0 ( -- n )
 542     [ 5 + ] inputs ;
 543
 544 : inputs-test1 ( x -- n )
 545     [ + ] curry inputs ;
 546
 547 [ 1 ] [ inputs-test0 ] unit-test
 548 [ 1 ] [ 10 inputs-test1 ] unit-test