1 /* j/6/ap.c 2 ** 3 */ 4 #include "all.h" 5 6 7 /** forward declares 8 **/ 9 u3_noun u3wfp_rake(u3_noun); 10 u3_noun u3wfp_open(u3_noun); 11 u3_noun u3wfp_hack(u3_noun); 12 13 static u3_noun 14 _ap_open_l(u3_noun, u3_noun); 15 16 // make sure these match the array below! 17 // 18 # define _ap_jet_open 0 19 # define _ap_jet_rake 1 20 # define _ap_jet_hack 2 21 22 #if 0 23 static u3_noun 24 _open_in(u3_noun ter, u3_noun gen); 25 /* ~(. al gen) 26 */ 27 static u3_noun 28 _al_bore(u3_noun ter, 29 u3_noun gen) 30 { 31 u3_noun gat = u3j_hook(u3k(ter), "al"); 32 33 return u3i_molt(gat, u3x_sam, u3nc(c3__herb, u3k(gen)), 0); 34 } 35 /* ~(. al gen) 36 */ 37 static u3_noun 38 _al_core(u3_noun ter, 39 u3_noun gen) 40 { 41 u3_noun gat = u3j_hook(u3k(ter), "al"); 42 43 return u3i_molt(gat, u3x_sam, u3k(gen), 0); 44 } 45 46 /* van is transferred, gen is retained 47 */ 48 static u3_noun 49 _ap_bunt(u3_noun van, 50 u3_noun gen) 51 { 52 u3_noun pro = u3qfl_bunt(van, gen); 53 54 u3z(van); 55 return pro; 56 } 57 58 /** open cases 59 **/ 60 61 #define _open_do_p(stem) \ 62 static u3_noun _open_in_##stem \ 63 ( u3_noun ter, u3_noun p_gen) 64 65 #define _open_do_pq(stem) \ 66 static u3_noun _open_in_##stem \ 67 ( u3_noun ter, u3_noun p_gen, u3_noun q_gen) 68 69 #define _open_do_pqr(stem) \ 70 static u3_noun _open_in_##stem \ 71 ( u3_noun ter, u3_noun p_gen, u3_noun q_gen, u3_noun r_gen) 72 73 #define _open_do_pqrs(stem) \ 74 static u3_noun _open_in_##stem \ 75 ( u3_noun ter, u3_noun p_gen, u3_noun q_gen, u3_noun r_gen, \ 76 u3_noun s_gen) 77 78 /*** 79 **** 80 ***/ 81 _open_do_pq(tsbr) // =: 82 { 83 return u3nt(c3__tsls, 84 _ap_bunt(_al_core(ter, p_gen), p_gen), 85 u3k(q_gen)); 86 } 87 _open_do_pq(tscl) // =: 88 { 89 return u3nt(c3__tsgr, 90 u3nt(c3__cncb, 91 u3nc(u3nc(u3_nul, 1), 92 u3_nul), 93 u3k(p_gen)), 94 u3k(q_gen)); 95 } 96 _open_do_pqr(tsdt) // =. 97 { 98 return u3nt(c3__tsgr, 99 u3nt(c3__cncb, 100 u3nc(u3nc(u3_nul, 1), 101 u3_nul), 102 u3nc(u3nc(u3k(p_gen), 103 u3k(q_gen)), 104 u3_nul)), 105 u3k(r_gen)); 106 } 107 _open_do_pq(tsgl) // =< 108 { 109 return u3nt(c3__tsgr, 110 u3k(q_gen), 111 u3k(p_gen)); 112 } 113 _open_do_pq(tshp) // =- 114 { 115 return u3nt(c3__tsls, 116 u3k(q_gen), 117 u3k(p_gen)); 118 } 119 _open_do_pq(tsls) // =+ 120 { 121 return u3nt(c3__tsgr, 122 u3nc(u3k(p_gen), 123 u3nc(u3_nul, 1)), 124 u3k(q_gen)); 125 } 126 _open_do_p(tssg) // =~ 127 { 128 if ( !_(u3du(p_gen)) ) { 129 return u3nc(0, 1); 130 } else { 131 u3_noun tp_gen = u3t(p_gen); 132 u3_noun ip_gen = u3h(p_gen); 133 134 if ( (u3_nul == p_gen) ) { 135 return u3nc(u3_blip, 1); 136 } 137 else if ( (u3_nul == tp_gen) ) { 138 return u3k(ip_gen); 139 } 140 else { 141 return u3nt(c3__tsgr, 142 u3k(ip_gen), 143 _open_in_tssg(ter, tp_gen)); 144 } 145 } 146 } 147 /*** 148 **** 149 ***/ 150 _open_do_p(bccb) // $_ 151 { 152 return _ap_bunt(_al_core(ter, p_gen), p_gen); 153 } 154 _open_do_p(bctr) // $* 155 { 156 return 157 u3nc(c3__ktsg, 158 _ap_bunt(_al_core(ter, p_gen), 159 p_gen)); 160 } 161 _open_do_p(bczp) // $! 162 { 163 return u3nt(c3__bccb, 164 c3__axil, 165 u3k(p_gen)); 166 } 167 /*** 168 **** 169 ***/ 170 _open_do_p(brhp) // |- 171 { 172 return u3nt(c3__tsgl, 173 u3nc(c3__cnzy, u3_blip), 174 u3nc(c3__brdt, u3k(p_gen))); 175 } 176 _open_do_p(brdt) // |. 177 { 178 return u3nc(c3__brcn, 179 u3nt(u3nt(u3_blip, c3__ash, u3k(p_gen)), 180 u3_nul, 181 u3_nul)); 182 } 183 184 /*** 185 **** 186 ***/ 187 _open_do_p(wtbr) // ?| 188 { 189 if ( (u3_nul == p_gen) ) { 190 return u3nt(c3__dtzz, 'f', c3n); 191 } 192 else { 193 u3_noun ip_gen = u3h(p_gen); 194 u3_noun tp_gen = u3t(p_gen); 195 196 return u3nq(c3__wtcl, 197 u3k(ip_gen), 198 u3nt(c3__dtzz, 'f', c3y), 199 _open_in_wtbr(ter, tp_gen)); 200 } 201 } 202 _open_do_pqr(wtkt) // ?^ 203 { 204 return u3nq(c3__wtcl, 205 u3nt(c3__wtts, 206 u3nt(c3__axil, c3__atom, u3_blip), 207 u3k(p_gen)), 208 u3k(r_gen), 209 u3k(q_gen)); 210 } 211 _open_do_pq(wtgl) // ?< 212 { 213 return u3nq(c3__wtcl, 214 u3k(p_gen), 215 u3nc(c3__zpzp, u3_nul), 216 u3k(q_gen)); 217 } 218 _open_do_pqr(wtdt) // ?. 219 { 220 return u3nq(c3__wtcl, 221 u3k(p_gen), 222 u3k(r_gen), 223 u3k(q_gen)); 224 } 225 _open_do_pq(wtgr) // ?> 226 { 227 return u3nq(c3__wtcl, 228 u3k(p_gen), 229 u3k(q_gen), 230 u3nc(c3__zpzp, u3_nul)); 231 } 232 _open_do_pq(wthp) // ?- 233 { 234 if ( (u3_nul == q_gen) ) { 235 return u3nc(c3__zpfs, 236 u3nc(c3__cnzz, 237 u3k(p_gen))); 238 } 239 else { 240 u3_noun iq_gen = u3h(q_gen); 241 u3_noun tq_gen = u3t(q_gen); 242 u3_noun piq_gen = u3h(iq_gen); 243 u3_noun qiq_gen = u3t(iq_gen); 244 245 return u3nq(c3__wtcl, 246 u3nt(c3__wtts, 247 u3k(piq_gen), 248 u3k(p_gen)), 249 u3k(qiq_gen), 250 _open_in_wthp(ter, p_gen, tq_gen)); 251 } 252 } 253 _open_do_p(wtpm) // ?& 254 { 255 if ( (u3_nul == p_gen) ) { 256 return u3nt(c3__dtzz, 'f', c3y); 257 } 258 else { 259 u3_noun ip_gen = u3h(p_gen); 260 u3_noun tp_gen = u3t(p_gen); 261 262 return u3nq(c3__wtcl, 263 u3k(ip_gen), 264 _open_in_wtpm(ter, tp_gen), 265 u3nt(c3__dtzz, 'f', c3n)); 266 } 267 } 268 _open_do_pqr(wtls) // ?+ 269 { u3_noun tul = u3nc(u3nc(u3nc(c3__axil, c3__noun), 270 u3k(q_gen)), 271 u3_nul); 272 u3_noun zal = u3qb_weld(r_gen, tul); 273 u3_noun ret = u3nt(c3__wthp, u3k(p_gen), zal); 274 275 u3z(tul); 276 return ret; 277 278 } 279 _open_do_pqr(wtpt) // ?@ 280 { 281 return u3nq(c3__wtcl, 282 u3nt(c3__wtts, 283 u3nt(c3__axil, 284 c3__atom, 285 u3_blip), 286 u3k(p_gen)), 287 u3k(q_gen), 288 u3k(r_gen)); 289 } 290 _open_do_pqr(wtsg) // ?~ 291 { 292 return u3nq(c3__wtcl, 293 u3nt(c3__wtts, 294 u3nc(c3__axil, c3__null), 295 u3k(p_gen)), 296 u3k(q_gen), 297 u3k(r_gen)); 298 } 299 _open_do_p(wtzp) // ?! 300 { 301 return u3nq(c3__wtcl, 302 u3k(p_gen), 303 u3nt(c3__dtzz, 'f', c3n), 304 u3nt(c3__dtzz, 'f', c3y)); 305 } 306 /*** 307 **** 308 ***/ 309 _open_do_pq(zpcb) // !_ 310 { 311 return u3k(q_gen); 312 } 313 _open_do_p(zpgr) // !> 314 { 315 return u3nq(c3__cnhp, 316 u3nc(c3__cnzy, c3__onan), 317 u3nt(c3__zpsm, 318 u3nc(c3__bctr, 319 u3nc(c3__herb, 320 u3nc(c3__cnzy, 321 c3__abel))), 322 u3k(p_gen)), 323 u3_nul); 324 } 325 /*** 326 **** 327 ***/ 328 _open_do_pq(clhp) // :- 329 { 330 return u3nc(u3k(p_gen), 331 u3k(q_gen)); 332 } 333 _open_do_pq(clcb) // :_ 334 { 335 return u3nc(u3k(q_gen), 336 u3k(p_gen)); 337 } 338 _open_do_p(clcn) // :% 339 { 340 return u3nc(u3nc(c3__clsg, 341 u3k(p_gen)), 342 u3nc(c3__bczp, c3__null)); 343 } 344 _open_do_pqrs(clkt) // :^ 345 { 346 return u3nq(u3k(p_gen), 347 u3k(q_gen), 348 u3k(r_gen), 349 u3k(s_gen)); 350 } 351 _open_do_pqr(clls) // :+ 352 { 353 return u3nt(u3k(p_gen), 354 u3k(q_gen), 355 u3k(r_gen)); 356 } 357 _open_do_p(clsg) // :~ 358 { 359 if ( (u3_nul == p_gen) ) { 360 return u3nt(c3__dtzz, 'n', u3_nul); 361 } 362 else { 363 u3_noun ip_gen = u3h(p_gen); 364 u3_noun tp_gen = u3t(p_gen); 365 366 return u3nc(u3k(ip_gen), 367 _open_in_clsg(ter, tp_gen)); 368 } 369 } 370 _open_do_p(cltr) // :* 371 { 372 if ( (u3_nul == p_gen) ) { 373 return u3nc(c3__zpzp, u3_nul); 374 } 375 else { 376 u3_noun ip_gen = u3h(p_gen); 377 u3_noun tp_gen = u3t(p_gen); 378 379 if ( (u3_nul == tp_gen) ) { 380 return u3k(ip_gen); 381 } else { 382 return u3nc(u3k(ip_gen), 383 _open_in_cltr(ter, tp_gen)); 384 } 385 } 386 } 387 /*** 388 **** 389 ***/ 390 _open_do_pq(cncb) // %_ 391 { 392 return u3nc(c3__ktls, 393 u3nq(u3nc(c3__cnzz, u3k(p_gen)), 394 c3__cnts, 395 u3k(p_gen), 396 u3k(q_gen))); 397 } 398 #if 0 399 _open_do_pq(cncl) // %: 400 { 401 return u3nq 402 (c3__cnsg, 403 u3nc(u3_blip, u3_nul), 404 u3k(p_gen), 405 u3k(q_gen)); 406 } 407 #endif 408 _open_do_pq(cndt) // %. 409 { 410 return u3nt(c3__cnhp, 411 u3k(q_gen), 412 u3nc(u3k(p_gen), u3_nul)); 413 } 414 _open_do_pqrs(cnkt) // %^ 415 { 416 return u3nq(c3__cnhp, 417 u3k(p_gen), 418 u3k(q_gen), 419 u3nt(u3k(r_gen), 420 u3k(s_gen), 421 u3_nul)); 422 } 423 _open_do_pq(cnhp) // %- 424 { 425 if ( (u3_nul == q_gen) ) { 426 return u3nt(c3__tsgr, 427 u3k(p_gen), 428 u3nc(c3__cnzy, u3_blip)); 429 } else { 430 return u3nq(c3__cncl, 431 u3k(p_gen), 432 c3__cltr, 433 u3k(q_gen)); 434 } 435 } 436 _open_do_pqr(cnls) // %+ 437 { 438 return u3nc(c3__cnhp, 439 u3nq(u3k(p_gen), 440 u3k(q_gen), 441 u3k(r_gen), 442 u3_nul)); 443 } 444 _open_do_pqr(cnsg) // %~ 445 { 446 return u3nq(c3__cntr, 447 u3k(p_gen), 448 u3k(q_gen), 449 u3nc(u3nc(u3nc(u3nc(u3_nul, 6), 0), u3k(r_gen)), 0)); 450 } 451 _open_do_p(cnzy) // %cnzy 452 { 453 return u3nt(c3__cnts, 454 u3nc(u3k(p_gen), u3_nul), 455 u3_nul); 456 } 457 _open_do_p(cnzz) // %cnzz 458 { 459 return u3nt(c3__cnts, u3k(p_gen), u3_nul); 460 } 461 /*** 462 **** 463 ***/ 464 _open_do_p(hxgl) // #< 465 { 466 return u3nq(c3__cnhp, 467 u3nc(c3__cnzy, c3__noah), 468 u3nc(c3__zpgr, 469 u3nc(c3__cltr, u3k(p_gen))), 470 u3_nul); 471 } 472 _open_do_p(hxgr) // #> 473 { 474 return u3nq(c3__cnhp, 475 u3nc(c3__cnzy, c3__cain), 476 u3nc(c3__zpgr, 477 u3nc(c3__cltr, u3k(p_gen))), 478 u3_nul); 479 } 480 /*** 481 **** 482 ***/ 483 _open_do_pq(ktdt) // ^. 484 { 485 return u3nt(c3__ktls, 486 u3nq(c3__cnhp, u3k(p_gen), u3k(q_gen), u3_nul), 487 u3k(q_gen)); 488 } 489 #if 0 490 _open_do_pq(kthp) // ^- 491 { 492 return u3nt(c3__ktls, 493 _ap_bunt(_al_bore(ter, p_gen), p_gen), 494 u3k(q_gen)); 495 } 496 #endif 497 /*** 498 **** 499 ***/ 500 _open_do_pq(brcb) // |_ 501 { 502 return u3nt(c3__tsls, 503 u3nc(c3__bctr, u3k(p_gen)), 504 u3nc(c3__brcn, u3k(q_gen))); 505 } 506 _open_do_pq(brkt) // |^ 507 { 508 u3_noun diz = u3nc(c3__ash, u3k(p_gen)); 509 u3_noun ret = u3nt(c3__tsgr, 510 u3nc(c3__brcn, 511 u3qdb_put(q_gen, u3_blip, diz)), 512 u3nc(c3__cnzy, u3_blip)); 513 514 u3z(diz); 515 return ret; 516 } 517 _open_do_pq(brls) // |+ 518 { 519 return u3nc(c3__ktbr, 520 u3nt(c3__brts, 521 u3k(p_gen), 522 u3k(q_gen))); 523 } 524 _open_do_p(brwt) // |? 525 { 526 return u3nt(c3__ktwt, 527 c3__brdt, 528 u3k(p_gen)); 529 } 530 /*** 531 **** 532 ***/ 533 _open_do_pq(sgts) // ~= 534 { 535 return u3nt(c3__sggr, 536 u3nc(c3__germ, u3k(p_gen)), 537 u3k(q_gen)); 538 } 539 #if 0 540 _open_do_pq(sgbr) // ~| 541 { 542 return u3nt 543 (c3__sggr, 544 u3nc(c3__mean, u3k(p_gen)), 545 u3k(q_gen)); 546 } 547 #endif 548 _open_do_pq(sggl) // ~> 549 { 550 return u3nt(c3__tsgl, 551 u3nq(c3__sggr, u3k(p_gen), u3_nul, 1), 552 u3k(q_gen)); 553 } 554 _open_do_pq(sgbc) // ~$ 555 { 556 return u3nt(c3__sggr, 557 u3nq(c3__live, 558 c3__dtzz, 559 u3_blip, 560 u3k(p_gen)), 561 u3k(q_gen)); 562 } 563 _open_do_pq(sgcb) // ~_ 564 { 565 return u3nt(c3__sggr, 566 u3nc(c3__mean, 567 u3nc(c3__brdt, 568 u3k(p_gen))), 569 u3k(q_gen)); 570 } 571 static u3_noun 572 _sgcn_a(u3_noun r_gen, 573 u3_noun nob) 574 { 575 if ( c3n == u3du(r_gen) ) { 576 return u3k(nob); 577 } else { 578 u3_noun ir_gen = u3h(r_gen); 579 u3_noun tr_gen = u3t(r_gen); 580 u3_noun pir_gen, qir_gen; 581 582 u3x_cell(ir_gen, &pir_gen, &qir_gen); 583 584 return u3nc(u3nc(u3nt(c3__dtzz, u3_blip, u3k(pir_gen)), 585 u3nc(c3__zpts, u3k(qir_gen))), 586 _sgcn_a(tr_gen, nob)); 587 } 588 } 589 _open_do_pqrs(sgcn) // ~% 590 { 591 return u3nt(c3__sggl, 592 u3nq(c3__sgcn, 593 c3__clls, 594 u3nt(c3__dtzz, u3_blip, u3k(p_gen)), 595 u3nt(u3nc(c3__zpts, u3k(q_gen)), 596 c3__clsg, 597 _sgcn_a(r_gen, u3_nul))), 598 u3k(s_gen)); 599 } 600 _open_do_pq(sgfs) // ~/ 601 { 602 return u3nc(c3__sgcn, 603 u3nq(u3k(p_gen), 604 u3nc(u3_nul, 7), 605 u3_nul, 606 u3k(q_gen))); 607 } 608 _open_do_pq(sgls) // ~+ 609 { 610 return u3nt(c3__sggr, 611 u3nq(c3__sgls, c3__dtzz, u3_blip, u3k(p_gen)), 612 u3k(q_gen)); 613 } 614 _open_do_pqr(sgpm) // ~& 615 { 616 return u3nt(c3__sggr, 617 u3nt(c3__slog, 618 u3nt(c3__dtzy, u3_blip, u3k(p_gen)), 619 u3nq(c3__cnhp, u3nc(c3__cnzy, c3__cain), 620 u3nc(c3__zpgr, u3k(q_gen)), u3_nul)), 621 u3k(r_gen)); 622 } 623 _open_do_pqrs(sgwt) // ~? 624 { 625 return u3nt(c3__tsls, 626 u3nq(c3__wtdt, 627 u3k(q_gen), 628 u3nc(c3__bczp, c3__null), 629 u3nc(u3nc(c3__bczp, c3__null), u3k(r_gen))), 630 u3nq(c3__wtsg, 631 u3nc(u3nc(u3_nul, 2),u3_nul), 632 u3nt(c3__tsgr, 633 u3nc(u3_nul, 3), 634 u3k(s_gen)), 635 u3nq(c3__sgpm, 636 u3k(p_gen), 637 u3nc(u3_nul, 5), 638 u3nt(c3__tsgr, 639 u3nc(u3_nul, 3), 640 u3k(s_gen))))); 641 } 642 /*** 643 **** 644 ***/ 645 static u3_noun 646 _smcl_in(u3_noun q_gen) 647 { 648 u3_noun hq_gen = u3h(q_gen); 649 u3_noun tq_gen = u3t(q_gen); 650 651 if ( c3n == u3du(tq_gen) ) { 652 return u3nt(c3__tsgr, 653 u3nc(u3_nul, 3), 654 u3k(hq_gen)); 655 } else { 656 return u3nc(c3__cnhp, 657 u3nq(u3nc(u3_nul, 2), 658 u3nt(c3__tsgr, 659 u3nc(u3_nul, 3), 660 u3k(hq_gen)), 661 _smcl_in(tq_gen), 662 u3_nul)); 663 } 664 } 665 _open_do_pq(smcl) 666 { 667 if ( c3n == u3du(q_gen) ) { 668 return u3nc(c3__zpzp, u3_nul); 669 } 670 else if ( u3_nul == u3t(q_gen) ) { 671 return u3k(u3h(q_gen)); 672 } 673 else { 674 return u3nt(c3__tsls, 675 u3k(p_gen), 676 _smcl_in(q_gen)); 677 } 678 } 679 #if 0 680 _open_do_pq(smsm) 681 { 682 return 683 u3nt(c3__tsgr, u3nq(c3__ktts, c3__v, u3_nul, 1), 684 u3nt(c3__tsls, 685 u3nt(c3__ktts, c3__a, 686 u3nt(c3__tsgr, u3nc(c3__cnzy, c3__v), 687 u3k(p_gen))), 688 u3nt(c3__tsls, 689 u3nt(c3__ktts, c3__b, 690 u3nt(c3__tsgr, 691 u3nc(c3__cnzy, c3__v), 692 u3k(q_gen))), 693 u3nt(c3__tsls, 694 u3nt(c3__ktts, c3__c, 695 u3nq(c3__cnhp, 696 u3nc(c3__cnzy, c3__a), 697 u3nc(c3__cnzy, c3__b), 698 u3_nul)), 699 u3nt(c3__wtgr, 700 u3nt(c3__dtts, 701 u3nc(c3__cnzy, c3__c), 702 u3nc(c3__cnzy, c3__b)), 703 u3nc(c3__cnzy, c3__c)))))); 704 } 705 #endif 706 707 /* functions 708 */ 709 /** open 710 **/ 711 static u3_noun 712 _open_in(u3_noun ter, 713 u3_noun gen) 714 { 715 u3_noun p_gen, q_gen, r_gen, s_gen; 716 717 return u3_none; 718 719 if ( c3y == u3ud(gen) ) { 720 // printf("studly\n"); 721 // u3_err("stud m", gen); 722 return u3m_bail(c3__exit); 723 724 return u3nt(c3__cnts, 725 u3nc(u3k(gen), u3_nul), 726 u3_nul); 727 } 728 else switch ( u3h(gen) ) { 729 default: return u3_none; 730 731 case u3_nul: { 732 return u3nt(c3__cnts, 733 u3nc(u3k(gen), u3_nul), 734 u3_nul); 735 } 736 737 # define _open_p(stem) \ 738 case c3__##stem: \ 739 return _open_in_##stem(ter, u3t(gen)); \ 740 741 # define _open_pq(stem) \ 742 case c3__##stem: \ 743 if ( c3n == u3r_cell(u3t(gen), &p_gen, &q_gen) ) { \ 744 return u3m_bail(c3__fail); \ 745 } else return _open_in_##stem(ter, p_gen, q_gen); 746 747 # define _open_pqr(stem) \ 748 case c3__##stem: \ 749 if ( c3n == u3r_trel(u3t(gen), &p_gen, &q_gen, &r_gen) ) { \ 750 return u3m_bail(c3__fail); \ 751 } else return _open_in_##stem(ter, p_gen, q_gen, r_gen); 752 753 # define _open_pqrs(stem) \ 754 case c3__##stem: \ 755 if ( c3n == u3r_qual\ 756 (u3t(gen), &p_gen, &q_gen, &r_gen, &s_gen) )\ 757 { \ 758 return u3m_bail(c3__fail); \ 759 } else return _open_in_##stem(ter, p_gen, q_gen, r_gen, s_gen); 760 761 _open_p (bccb); 762 _open_p (bctr); 763 _open_p (bczp); 764 765 _open_p (brdt); 766 _open_pq (brcb); 767 _open_p (brhp); 768 _open_pq (brkt); 769 _open_pq (brls); 770 _open_p (brwt); 771 772 _open_pq (clcb); 773 _open_p (clcn); 774 _open_pq (clhp); 775 _open_pqrs(clkt); 776 _open_pqr (clls); 777 _open_p (cltr); 778 _open_p (clsg); 779 _open_pq (cncb); 780 // _open_pq (cncl); 781 _open_pq (cndt); 782 _open_pqrs(cnkt); 783 _open_pq (cnhp); 784 _open_pqr (cnls); 785 _open_pqr (cnsg); 786 _open_p (cnzy); 787 _open_p (cnzz); 788 789 _open_p (hxgl); 790 _open_p (hxgr); 791 792 _open_pq (ktdt); 793 // _open_pq (kthp); 794 795 _open_pq (sgts); 796 // _open_pq (sgbr); 797 _open_pq (sggl); 798 _open_pq (sgbc); 799 _open_pq (sgcb); 800 _open_pqrs(sgcn); 801 _open_pq (sgfs); 802 _open_pq (sgls); 803 _open_pqr (sgpm); 804 _open_pqrs(sgwt); 805 806 _open_pq (smcl); 807 // _open_pq (smsm); 808 809 _open_pq (tsbr); 810 _open_pq (tscl); 811 _open_pqr (tsdt); 812 _open_pq (tsgl); 813 _open_pq (tshp); 814 _open_pq (tsls); 815 _open_p (tssg); 816 817 _open_pqr (wtdt); 818 _open_pq (wtgl); 819 _open_pqr (wtpt); 820 _open_pqr (wtsg); 821 _open_p (wtzp); 822 _open_p (wtbr); 823 _open_pq (wthp); 824 _open_pq (wtgr); 825 _open_pqr (wtls); 826 _open_pqr (wtkt); 827 _open_p (wtpm); 828 829 _open_pq (zpcb); 830 _open_p (zpgr); 831 } 832 } 833 834 /** rake 835 **/ 836 u3_noun 837 u3qfp_rake(u3_noun gen) 838 { 839 u3_noun p_gen, q_gen; 840 841 if ( c3y == u3ud(gen) ) { 842 return u3nc(u3k(gen), u3_nul); 843 } 844 else switch ( u3h(gen) ) { 845 default: return u3m_error("rake-twig"); 846 847 case u3_nul: return u3nc(u3k(gen), u3_nul); 848 849 case c3__cnzy: { 850 return u3nc(u3k(u3t(gen)), u3_nul); 851 } 852 case c3__cnzz: { 853 return u3k(u3t(gen)); 854 } 855 case c3__cnts: { 856 if ( c3n == u3r_cell(u3t(gen), &p_gen, &q_gen) ) { 857 return u3m_bail(c3__fail); 858 } 859 else { 860 if ( u3_nul != q_gen ) { 861 return u3m_bail(c3__fail); 862 } 863 else { 864 return u3k(p_gen); 865 } 866 } 867 } 868 case c3__zpcb: { 869 if ( c3n == u3r_cell(u3t(gen), &p_gen, &q_gen) ) { 870 return u3m_bail(c3__fail); 871 } 872 else return u3qfp_rake(q_gen); 873 } 874 } 875 } 876 u3_noun 877 u3wfp_rake(u3_noun cor) 878 { 879 u3_noun gen; 880 881 if ( u3_none == (gen = u3r_at(u3x_sam, cor)) ) { 882 return u3m_bail(c3__fail); 883 } else { 884 return u3qfp_rake(gen); 885 } 886 } 887 888 /** hack 889 **/ 890 u3_noun 891 u3qfp_hack(u3_noun ter, 892 u3_noun gen) 893 { 894 u3_noun p_gen, q_gen; 895 u3_noun ret; 896 897 if ( c3y == u3du(u3h(gen)) ) { 898 return u3nt(c3y, 899 u3k(u3h(gen)), 900 u3k(u3t(gen))); 901 } 902 else switch ( u3h(gen) ) { 903 case c3__tsgr: u3x_cell(u3t(gen), &p_gen, &q_gen); 904 { 905 if ( (c3n == u3du(p_gen)) || (u3_nul != u3h(p_gen)) ) { 906 return u3nc(c3n, u3k(gen)); 907 } 908 else { 909 u3_noun pyr = u3qfp_hack(ter, q_gen); 910 911 if ( c3y == u3h(pyr) ) { 912 ret = u3nt(c3y, 913 u3nt(c3__tsgr, 914 u3k(p_gen), 915 u3k(u3h(u3t(pyr)))), 916 u3nt(c3__tsgr, 917 u3k(p_gen), 918 u3k(u3t(u3t(pyr))))); 919 } 920 else { 921 ret = u3nc(c3n, 922 u3nt(c3__tsgr, 923 u3k(p_gen), 924 u3k(u3t(pyr)))); 925 } 926 u3z(pyr); 927 return ret; 928 } 929 } 930 case c3__zpcb: u3x_cell(u3t(gen), &p_gen, &q_gen); 931 { 932 u3_noun pyr = u3qfp_hack(ter, q_gen); 933 934 if ( c3y == u3h(pyr) ) { 935 ret = u3nt(c3y, 936 u3nt(c3__zpcb, 937 u3k(p_gen), 938 u3k(u3h(u3t(pyr)))), 939 u3nt(c3__zpcb, 940 u3k(p_gen), 941 u3k(u3t(u3t(pyr))))); 942 } 943 else { 944 ret = u3nc(c3n, 945 u3nt(c3__zpcb, 946 u3k(p_gen), 947 u3k(u3t(pyr)))); 948 } 949 u3z(pyr); 950 return ret; 951 } 952 default: break; 953 } 954 955 { 956 u3_noun voq = _ap_open_l(ter, gen); 957 958 if ( u3_none == voq ) { 959 return u3nc(c3n, u3k(gen)); 960 } 961 else if ( c3y == u3r_sing(voq, gen) ) { 962 return u3nc(c3n, voq); 963 } 964 else { 965 ret = u3qfp_hack(ter, voq); 966 967 u3z(voq); 968 return ret; 969 } 970 } 971 } 972 973 u3_noun 974 u3wfp_hack(u3_noun cor) 975 { 976 u3_noun gen; 977 978 if ( u3_none == (gen = u3r_at(u3x_sam, cor)) ) { 979 return u3m_bail(c3__fail); 980 } else { 981 u3_noun ter = u3r_at(u3x_con, cor); 982 983 return u3qfp_hack(ter, gen); 984 } 985 } 986 #endif 987 988 /* boilerplate 989 */ 990 static u3_noun _ap_core(u3_noun ter,u3_noun gen)991 _ap_core(u3_noun ter, 992 u3_noun gen) 993 { 994 u3_noun gat = u3j_hook(u3k(ter), "ap"); 995 996 return u3i_molt(gat, u3x_sam, u3k(gen), 0); 997 } 998 999 /* open 1000 */ 1001 static u3_noun _ap_open_n(u3_noun ter,u3_noun gen)1002 _ap_open_n(u3_noun ter, 1003 u3_noun gen) 1004 { 1005 u3_noun cor = _ap_core(ter, gen); 1006 1007 return u3j_soft(cor, "open"); 1008 } 1009 static u3_noun _ap_open_l(u3_noun ter,u3_noun gen)1010 _ap_open_l(u3_noun ter, 1011 u3_noun gen) 1012 { 1013 #if 0 1014 u3_noun pro = _open_in(ter, gen); 1015 1016 if ( u3_none != pro ) { 1017 return pro; 1018 } else { 1019 return _ap_open_n(ter, gen); 1020 } 1021 #else 1022 return _ap_open_n(ter, gen); 1023 #endif 1024 } 1025 1026 u3_noun u3qfp_open(u3_noun ter,u3_noun gen)1027 u3qfp_open(u3_noun ter, 1028 u3_noun gen) 1029 { 1030 return _ap_open_l(ter, gen); 1031 } 1032 1033 u3_noun u3qfp_nepo(u3_noun ter,u3_noun gen)1034 u3qfp_nepo(u3_noun ter, 1035 u3_noun gen) 1036 { 1037 return _ap_open_l(ter, gen); 1038 } 1039 1040 u3_noun u3wfp_open(u3_noun cor)1041 u3wfp_open(u3_noun cor) 1042 { 1043 u3_noun gen; 1044 1045 if ( u3_none == (gen = u3r_at(u3x_sam, cor)) ) { 1046 return u3m_bail(c3__fail); 1047 } else { 1048 u3_noun ter = u3r_at(u3x_con, cor); 1049 1050 return u3qfp_open(ter, gen); 1051 } 1052 } 1053 1054