![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b2stc.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / new / B / src / bint|
Return to b2stc.c CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / new / B / src / bint |
1.1 ! root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */ ! 2: ! 3: /* ! 4: $Header: b2stc.c,v 1.4 85/08/22 16:55:56 timo Exp $ ! 5: */ ! 6: ! 7: /* B (intra-unit) type check */ ! 8: ! 9: #include "b.h" ! 10: #include "b1obj.h" ! 11: #include "b2nod.h" ! 12: #include "b2syn.h" /* temporary? for Cap in tc_refinement */ ! 13: #include "b2tcP.h" ! 14: #include "b2tcU.h" ! 15: #include "b2tcE.h" ! 16: #include "b3err.h" ! 17: ! 18: /* ******************************************************************** */ ! 19: ! 20: Hidden value refname; ! 21: ! 22: /* ! 23: * if in commandsuite of refinement: ! 24: * holds refinement name; ! 25: * if in commandsuite of yield unit: ! 26: * holds B-text "returned value" ! 27: * (used in error messages, no confusion possible) ! 28: * else ! 29: * Vnil ! 30: * To be used in tc_return() ! 31: */ ! 32: ! 33: /* ******************************************************************** */ ! 34: ! 35: Forward polytype pt_expr(); ! 36: ! 37: Visible Procedure type_check(v) parsetree v; { ! 38: typenode n; ! 39: extern bool extcmds; /* Set in main by -E option */ ! 40: ! 41: if (extcmds || !still_ok || v EQ NilTree) ! 42: return; ! 43: n = nodetype(v); ! 44: curline= v; curlino= one; ! 45: start_vars(); ! 46: refname = Vnil; ! 47: usetypetable(mk_elt()); ! 48: if (Unit(n)) tc_unit(v); ! 49: else if (Command(n)) tc_command(v); ! 50: else if (Expression(n)) p_release(pt_expr(v)); ! 51: else syserr(MESS(2300, "wrong argument of 'type_check'")); ! 52: end_vars(); ! 53: deltypetable(); ! 54: } ! 55: ! 56: #define TABSIZE 72 ! 57: ! 58: Hidden Procedure (*(uni_tab[TABSIZE]))(); /*Units*/ ! 59: Hidden Procedure (*(cmd_tab[TABSIZE]))(); /*Commands*/ ! 60: Hidden polytype (*(exp_tab[TABSIZE]))(); /*Expressions*/ ! 61: Hidden Procedure (*(tes_tab[TABSIZE]))(); /*Tests*/ ! 62: ! 63: #define FF First_fieldnr ! 64: ! 65: Hidden Procedure tc_node(v, tab) parsetree v; int (*(tab[]))(); { ! 66: auto (*f)()= tab[nodetype(v)]; ! 67: switch (Nbranches(v)) { ! 68: case 0: (*f)(); break; ! 69: case 1: (*f)(*Branch(v,FF)); break; ! 70: case 2: (*f)(*Branch(v,FF), *Branch(v,FF+1)); break; ! 71: case 3: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 72: *Branch(v,FF+2)); break; ! 73: case 4: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 74: *Branch(v,FF+2), *Branch(v,FF+3)); break; ! 75: case 5: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 76: *Branch(v,FF+2), *Branch(v,FF+3), ! 77: *Branch(v,FF+4)); break; ! 78: case 6: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 79: *Branch(v,FF+2), *Branch(v,FF+3), ! 80: *Branch(v,FF+4), *Branch(v,FF+5)); break; ! 81: case 7: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 82: *Branch(v,FF+2), *Branch(v,FF+3), ! 83: *Branch(v,FF+4), *Branch(v,FF+5), ! 84: *Branch(v,FF+6)); break; ! 85: case 8: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 86: *Branch(v,FF+2), *Branch(v,FF+3), ! 87: *Branch(v,FF+4), *Branch(v,FF+5), ! 88: *Branch(v,FF+6), *Branch(v,FF+7)); break; ! 89: case 9: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 90: *Branch(v,FF+2), *Branch(v,FF+3), ! 91: *Branch(v,FF+4), *Branch(v,FF+5), ! 92: *Branch(v,FF+6), *Branch(v,FF+7), ! 93: *Branch(v,FF+8)); break; ! 94: default: syserr(MESS(2301, "Wrong size node in tc_node")); ! 95: } ! 96: } ! 97: ! 98: Hidden polytype pt_node(v, tab) parsetree v; polytype (*(tab[]))(); { ! 99: polytype (*f)()= tab[nodetype(v)]; ! 100: switch (Nbranches(v)) { ! 101: case 0: (*f)(); break; ! 102: case 1: (*f)(*Branch(v,FF)); break; ! 103: case 2: (*f)(*Branch(v,FF), *Branch(v,FF+1)); break; ! 104: case 3: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 105: *Branch(v,FF+2)); break; ! 106: case 4: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 107: *Branch(v,FF+2), *Branch(v,FF+3)); break; ! 108: case 5: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 109: *Branch(v,FF+2), *Branch(v,FF+3), ! 110: *Branch(v,FF+4)); break; ! 111: case 6: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 112: *Branch(v,FF+2), *Branch(v,FF+3), ! 113: *Branch(v,FF+4), *Branch(v,FF+5)); break; ! 114: case 7: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 115: *Branch(v,FF+2), *Branch(v,FF+3), ! 116: *Branch(v,FF+4), *Branch(v,FF+5), ! 117: *Branch(v,FF+6)); break; ! 118: case 8: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 119: *Branch(v,FF+2), *Branch(v,FF+3), ! 120: *Branch(v,FF+4), *Branch(v,FF+5), ! 121: *Branch(v,FF+6), *Branch(v,FF+7)); break; ! 122: case 9: (*f)(*Branch(v,FF), *Branch(v,FF+1), ! 123: *Branch(v,FF+2), *Branch(v,FF+3), ! 124: *Branch(v,FF+4), *Branch(v,FF+5), ! 125: *Branch(v,FF+6), *Branch(v,FF+7), ! 126: *Branch(v,FF+8)); break; ! 127: default: syserr(MESS(2302, "Wrong size node in pt_node")); ! 128: /* NOTREACHED */ ! 129: } ! 130: } ! 131: ! 132: /* ******************************************************************** */ ! 133: /* Type Check units */ ! 134: /* ******************************************************************** */ ! 135: ! 136: Hidden Procedure tc_unit(v) parsetree v; { ! 137: if (v != NilTree) tc_node(v, uni_tab); ! 138: } ! 139: ! 140: Hidden Procedure tc_howto_unit(name, formals, cmt, ! 141: suite, refinement, reftab, nlocals) ! 142: parsetree suite, refinement; ! 143: value name, formals, cmt, reftab, nlocals; { ! 144: ! 145: tc_command(suite); ! 146: tc_unit(refinement); ! 147: } ! 148: ! 149: Hidden Procedure tc_yield_unit(name, adic, formals, cmt, ! 150: suite, refinement, reftab, nlocals) ! 151: parsetree suite, refinement; ! 152: value name, adic, formals, cmt, reftab, nlocals; { ! 153: ! 154: refname = mk_text("returned value"); ! 155: tc_command(suite); ! 156: release(refname); refname = Vnil; ! 157: tc_unit(refinement); ! 158: } ! 159: ! 160: Hidden Procedure tc_test_unit(name, adic, formals, cmt, ! 161: suite, refinement, reftab, nlocals) ! 162: parsetree suite, refinement; ! 163: value name, adic, formals, cmt, reftab, nlocals; { ! 164: ! 165: tc_command(suite); ! 166: tc_unit(refinement); ! 167: } ! 168: ! 169: Hidden Procedure tc_refinement(name, cmt, suite, next) ! 170: parsetree suite, next; value name, cmt; { ! 171: value n1 = curtail(name, one); ! 172: ! 173: if (!Cap(charval(n1))) /* should test for expression refinement */ ! 174: refname = copy(name); ! 175: release(n1); ! 176: tc_command(suite); ! 177: if (refname NE Vnil) { ! 178: release(refname); refname = Vnil; ! 179: } ! 180: ! 181: tc_unit(next); ! 182: } ! 183: ! 184: /* ******************************************************************** */ ! 185: /* TypeCheck commands */ ! 186: /* ******************************************************************** */ ! 187: ! 188: Hidden Procedure tc_command(v) parsetree v; { ! 189: curline= v; ! 190: end_vars(); ! 191: start_vars(); ! 192: if (v != NilTree) tc_node(v, cmd_tab); ! 193: } ! 194: ! 195: Hidden Procedure tc_suite(lino, cmd, cmt, next) ! 196: parsetree cmd, next; value lino, cmt; { ! 197: ! 198: curlino= lino; ! 199: tc_command(cmd); ! 200: tc_command(next); ! 201: } ! 202: ! 203: Hidden Procedure tc_put(e, t) parsetree e, t; { ! 204: polytype te, tt, u; ! 205: te = pt_expr(e); ! 206: tt = pt_expr(t); ! 207: unify(te, tt, &u); ! 208: p_release(te); p_release(tt); p_release(u); ! 209: } ! 210: ! 211: Hidden Procedure tc_ins_rem(e, t) parsetree e, t; { ! 212: polytype t_list_e, tt, u; ! 213: t_list_e = mkt_list(pt_expr(e)); ! 214: tt = pt_expr(t); ! 215: unify(tt, t_list_e, &u); ! 216: p_release(t_list_e); p_release(tt); p_release(u); ! 217: } ! 218: ! 219: Hidden Procedure tc_choose(t, e) parsetree t, e; { ! 220: polytype t_tlt_t, te, u; ! 221: t_tlt_t = mkt_tlt(pt_expr(t)); ! 222: te = pt_expr(e); ! 223: unify(te, t_tlt_t, &u); ! 224: p_release(te); p_release(t_tlt_t); p_release(u); ! 225: } ! 226: ! 227: Hidden Procedure tc_draw(t) parsetree t; { ! 228: polytype t_number, tt, u; ! 229: tt = pt_expr(t); ! 230: t_number = mkt_number(); ! 231: unify(tt, t_number, &u); ! 232: p_release(t_number); p_release(tt); p_release(u); ! 233: } ! 234: ! 235: Hidden Procedure tc_set_random(e) parsetree e; { ! 236: p_release(pt_expr(e)); ! 237: } ! 238: ! 239: Hidden Procedure tc_delete(t) parsetree t; { ! 240: p_release(pt_expr(t)); ! 241: } ! 242: ! 243: Hidden Procedure tc_check(c) parsetree c; { ! 244: tc_test(c); ! 245: } ! 246: ! 247: Hidden Procedure tc_nothing(t) parsetree t; {} ! 248: ! 249: Hidden Procedure tc_write(nl1, e, nl2) parsetree e; value nl1, nl2; { ! 250: if (e != NilTree) ! 251: p_release(pt_expr(e)); ! 252: } ! 253: ! 254: Hidden Procedure tc_read(t, e) parsetree t, e; { ! 255: polytype te, tt, u; ! 256: te = pt_expr(e); ! 257: tt = pt_expr(t); ! 258: unify(tt, te, &u); ! 259: p_release(te); p_release(tt); p_release(u); ! 260: } ! 261: ! 262: Hidden Procedure tc_raw_read(t) parsetree t; { ! 263: polytype t_text, tt, u; ! 264: t_text = mkt_text(); ! 265: tt = pt_expr(t); ! 266: unify(tt, t_text, &u); ! 267: p_release(t_text); p_release(tt); p_release(u); ! 268: } ! 269: ! 270: Hidden Procedure tc_ifwhile(c, cmt, s) parsetree c, s; value cmt; { ! 271: tc_test(c); ! 272: tc_command(s); ! 273: } ! 274: ! 275: Hidden Procedure tc_for(t, e, cmt, s) parsetree t, e, s; value cmt; { ! 276: polytype t_tlt_t, te, u; ! 277: ! 278: t_tlt_t = mkt_tlt(pt_expr(t)); ! 279: te = pt_expr(e); ! 280: unify(te, t_tlt_t, &u); ! 281: p_release(te); p_release(t_tlt_t); p_release(u); ! 282: ! 283: tc_command(s); ! 284: } ! 285: ! 286: Hidden Procedure tc_select(cmt, s) parsetree s; value cmt; { ! 287: tc_command(s); ! 288: } ! 289: ! 290: Hidden Procedure tc_tes_suite(lino, c, cmt, s, next) ! 291: parsetree c, s, next; value lino, cmt; { ! 292: curlino= lino; ! 293: if (c != NilTree) { ! 294: tc_test(c); ! 295: tc_command(s); ! 296: } ! 297: tc_command(next); ! 298: } ! 299: ! 300: Hidden Procedure tc_else(lino, cmt, s) parsetree s; value lino, cmt; { ! 301: curlino= lino; ! 302: tc_command(s); ! 303: } ! 304: ! 305: Hidden Procedure tc_return(e) parsetree e; { ! 306: polytype te, tt, u; ! 307: te = pt_expr(e); ! 308: if (refname EQ Vnil) ! 309: error(MESS(2303, "RETURN not in YIELD unit or expression refinement")); ! 310: else { ! 311: tt = mkt_var(copy(refname)); ! 312: unify(tt, te, &u); ! 313: p_release(tt); p_release(u); ! 314: } ! 315: p_release(te); ! 316: } ! 317: ! 318: Hidden Procedure tc_report(c) parsetree c; { ! 319: tc_test(c); ! 320: } ! 321: ! 322: Hidden Procedure tc_user_command(name, v) value name, v; { ! 323: parsetree e; value w= v; ! 324: while (w != Vnil) { ! 325: e= *Branch(w, ACT_EXPR); ! 326: if (e != NilTree) ! 327: p_release(pt_expr(e)); ! 328: w= *Branch(w, ACT_NEXT); ! 329: } ! 330: } ! 331: ! 332: /* ******************************************************************** */ ! 333: /* calculate PolyType of EXPRessions ! 334: /* ******************************************************************** */ ! 335: ! 336: Hidden polytype pt_expr(v) parsetree v; { ! 337: return pt_node(v, exp_tab); ! 338: } ! 339: ! 340: Hidden polytype pt_compound(e) parsetree e; { ! 341: return pt_expr(e); ! 342: } ! 343: ! 344: Hidden polytype pt_collateral(e) value e; { ! 345: intlet k, len= Nfields(e); ! 346: polytype tc; ! 347: tc = mkt_compound(len); ! 348: for (k = 0; k < len; k++) ! 349: putsubtype(pt_expr(*Field(e, k)), tc, k); ! 350: return tc; ! 351: } ! 352: ! 353: Hidden bool is_string(v, s) value v; string s; { ! 354: value t; ! 355: relation rel; ! 356: ! 357: rel = compare(v, t= mk_text(s)); ! 358: release(t); ! 359: return (rel EQ 0 ? Yes : No); ! 360: } ! 361: ! 362: Hidden bool monf_on_number(n) value n; { ! 363: return (is_string(n, "~") || ! 364: is_string(n, "+") || ! 365: is_string(n, "-") || ! 366: is_string(n, "*/") || ! 367: is_string(n, "/*") || ! 368: is_string(n, "root") || ! 369: is_string(n, "abs") || ! 370: is_string(n, "sign") || ! 371: is_string(n, "floor") || ! 372: is_string(n, "ceiling") || ! 373: is_string(n, "round") || ! 374: is_string(n, "sin") || ! 375: is_string(n, "cos") || ! 376: is_string(n, "tan") || ! 377: is_string(n, "atan") || ! 378: is_string(n, "exp") || ! 379: is_string(n, "log") ! 380: ); ! 381: } ! 382: ! 383: Hidden bool dyaf_on_number(n) value n; { ! 384: return (is_string(n, "+") || ! 385: is_string(n, "-") || ! 386: is_string(n, "*") || ! 387: is_string(n, "/") || ! 388: is_string(n, "**") || ! 389: is_string(n, "root") || ! 390: is_string(n, "round") || ! 391: is_string(n, "mod") || ! 392: is_string(n, "atan") || ! 393: is_string(n, "log") ! 394: ); ! 395: } ! 396: ! 397: Hidden polytype pt_monf(name, r, fct) parsetree r; value name, fct; { ! 398: polytype tr, tf, u; ! 399: ! 400: tr = pt_expr(r); ! 401: ! 402: if (monf_on_number(name)) { ! 403: polytype t_number = mkt_number(); ! 404: unify(tr, t_number, &u); ! 405: p_release(u); ! 406: tf = t_number; ! 407: } ! 408: else if (is_string(name, "keys")) { ! 409: polytype t_table, t_keys; ! 410: t_keys = mkt_newvar(); ! 411: t_table = mkt_table(p_copy(t_keys), mkt_newvar()); ! 412: unify(tr, t_table, &u); ! 413: p_release(t_table); p_release(u); ! 414: tf = mkt_list(t_keys); ! 415: } ! 416: else if (is_string(name, "#")) { ! 417: polytype t_tlt = mkt_tlt(mkt_newvar()); ! 418: unify(tr, t_tlt, &u); ! 419: p_release(t_tlt); p_release(u); ! 420: tf = mkt_number(); ! 421: } ! 422: else if (is_string(name, "min") || is_string(name, "max")) { ! 423: polytype t_tlt_x, t_x; ! 424: t_x = mkt_newvar(); ! 425: t_tlt_x = mkt_tlt(p_copy(t_x)); ! 426: unify(tr, t_tlt_x, &u); ! 427: p_release(t_tlt_x); p_release(u); ! 428: tf = t_x; ! 429: } ! 430: else { ! 431: tf = mkt_newvar(); ! 432: } ! 433: ! 434: p_release(tr); ! 435: return tf; ! 436: } ! 437: ! 438: Hidden polytype pt_dyaf(l, name, r, fct) parsetree l, r; value name, fct; { ! 439: polytype tl, tr, tf, u; ! 440: ! 441: tl = pt_expr(l); ! 442: tr = pt_expr(r); ! 443: if (dyaf_on_number(name)){ ! 444: polytype t_number = mkt_number(); ! 445: unify(tl, t_number, &u); ! 446: p_release(u); ! 447: unify(tr, t_number, &u); ! 448: p_release(u); ! 449: tf = t_number; ! 450: } ! 451: else if (is_string(name, "^")) { ! 452: polytype t_text = mkt_text(); ! 453: unify(tl, t_text, &u); ! 454: p_release(u); ! 455: unify(tr, t_text, &u); ! 456: p_release(u); ! 457: tf = t_text; ! 458: } ! 459: else if (is_string(name, "^^")) { ! 460: polytype t_text = mkt_text(), t_number = mkt_number(); ! 461: unify(tl, t_text, &u); ! 462: p_release(u); ! 463: unify(tr, t_number, &u); ! 464: p_release(u); p_release(t_number); ! 465: tf = t_text; ! 466: } ! 467: else if (is_string(name, "<<") ! 468: || ! 469: is_string(name, "><") ! 470: || ! 471: is_string(name, ">>")) ! 472: { ! 473: polytype t_number = mkt_number(); ! 474: unify(tr, t_number, &u); ! 475: p_release(u); p_release(t_number); ! 476: tf = mkt_text(); ! 477: } ! 478: else if (is_string(name, "#")) { ! 479: polytype t_tlt_l = mkt_tlt(p_copy(tl)); ! 480: unify(tr, t_tlt_l, &u); ! 481: p_release(t_tlt_l); p_release(u); ! 482: tf = mkt_number(); ! 483: } ! 484: else if (is_string(name, "min") || is_string(name, "max")) { ! 485: polytype t_tlt_l = mkt_tlt(p_copy(tl)); ! 486: unify(tr, t_tlt_l, &u); ! 487: tf = p_copy(asctype(u)); ! 488: p_release(t_tlt_l); p_release(u); ! 489: } ! 490: else if (is_string(name, "th'of")) { ! 491: polytype t_number, t_tlt_x, t_x; ! 492: t_number = mkt_number(); ! 493: unify(tl, t_number, &u); ! 494: p_release(t_number); p_release(u); ! 495: t_x = mkt_newvar(); ! 496: t_tlt_x = mkt_tlt(p_copy(t_x)); ! 497: unify(tr, t_tlt_x, &u); ! 498: p_release(t_tlt_x); p_release(u); ! 499: tf = t_x; ! 500: } ! 501: else { ! 502: tf = mkt_newvar(); ! 503: } ! 504: ! 505: p_release(tl); ! 506: p_release(tr); ! 507: ! 508: return tf; ! 509: } ! 510: ! 511: Hidden polytype pt_tag(name) value name; { ! 512: polytype var; ! 513: /* ! 514: * if (is_globalstring(name, "pi") || is_globalstring(name, "e")) ! 515: * return mkt_number(); ! 516: * else ! 517: */ ! 518: var = mkt_var(copy(name)); ! 519: add_var(var); ! 520: return var; ! 521: } ! 522: ! 523: Hidden polytype pt_tformal(name, number) value name, number; { ! 524: return pt_tag(name); ! 525: } ! 526: ! 527: Hidden polytype pt_tlocal(name, number) value name, number; { ! 528: return pt_tag(name); ! 529: } ! 530: ! 531: Hidden polytype pt_tglobal(name) value name; { ! 532: return pt_tag(name); ! 533: } ! 534: ! 535: Hidden polytype pt_tmystery(name, number) value name, number; { ! 536: return pt_tag(name); ! 537: } ! 538: ! 539: Hidden polytype pt_trefinement(name) value name; { ! 540: return pt_tag(name); ! 541: } ! 542: ! 543: Hidden polytype pt_tfun(name, fct) value name, fct; { ! 544: return pt_tag(name); ! 545: } ! 546: ! 547: Hidden polytype pt_tprd(name, fct) value name, fct; { ! 548: return pt_tag(name); ! 549: } ! 550: ! 551: Hidden polytype pt_number(v, t) value v, t; { ! 552: return mkt_number(); ! 553: } ! 554: ! 555: Hidden polytype pt_text_dis(q, v) parsetree v; value q; { ! 556: while(v NE NilTree) { ! 557: switch (nodetype(v)) { ! 558: case TEXT_LIT: ! 559: v = *Branch(v, XLIT_NEXT); ! 560: break; ! 561: case TEXT_CONV: ! 562: p_release(pt_expr(*Branch(v, XCON_EXPR))); ! 563: v = *Branch(v, XCON_NEXT); ! 564: break; ! 565: default: ! 566: v = NilTree; ! 567: } ! 568: } ! 569: return mkt_text(); ! 570: } ! 571: ! 572: Hidden polytype pt_elt_dis() { ! 573: return mkt_lt(mkt_newvar()); ! 574: } ! 575: ! 576: Hidden polytype pt_list_dis(e) value e; { ! 577: intlet k, len= Nfields(e); ! 578: polytype tres = pt_expr(*Field(e, 0)); ! 579: for (k = 1; k < len; k++) { ! 580: polytype te, u; ! 581: te = pt_expr(*Field(e, k)); ! 582: unify(te, tres, &u); ! 583: p_release(te); p_release(tres); ! 584: tres = u; ! 585: } ! 586: return mkt_list(tres); ! 587: } ! 588: ! 589: Hidden polytype pt_range_dis(l, h) parsetree l, h; { ! 590: polytype tl, th, t_tn, tres, u; ! 591: t_tn = mkt_tn(); ! 592: tl = pt_expr(l); ! 593: unify(tl, t_tn, &tres); ! 594: p_release(tl); p_release(t_tn); ! 595: th = pt_expr(h); ! 596: unify(th, tres, &u); ! 597: release(th); release(tres); ! 598: return mkt_list(u); ! 599: } ! 600: ! 601: Hidden polytype pt_tab_dis(e) value e; { ! 602: intlet k, len= Nfields(e); ! 603: polytype tresk, tresa; ! 604: tresk = pt_expr(*Field(e, 0)); ! 605: tresa = pt_expr(*Field(e, 1)); ! 606: for (k = 2; k < len; k += 2) { ! 607: polytype tk, ta, u; ! 608: tk = pt_expr(*Field(e, k)); ! 609: unify(tk, tresk, &u); ! 610: p_release(tk); p_release(tresk); ! 611: tresk = u; ! 612: ta = pt_expr(*Field(e, k+1)); ! 613: unify(ta, tresa, &u); ! 614: p_release(ta); p_release(tresa); ! 615: tresa = u; ! 616: } ! 617: return mkt_table(tresk, tresa); ! 618: } ! 619: ! 620: Hidden polytype pt_selection(t, k) parsetree t, k; { ! 621: polytype tt, ta, ttab, u; ! 622: tt = pt_expr(t); ! 623: ta = mkt_newvar(); ! 624: ttab = mkt_table(pt_expr(k), p_copy(ta)); ! 625: unify(tt, ttab, &u); ! 626: p_release(tt); p_release(ttab); p_release(u); ! 627: return ta; ! 628: } ! 629: ! 630: Hidden polytype pt_trim(l, r) parsetree l, r; { ! 631: polytype tl, tr, t_text, t_number, u; ! 632: ! 633: tl = pt_expr(l); ! 634: t_text = mkt_text(); ! 635: unify(tl, t_text, &u); ! 636: p_release(tl); p_release(u); ! 637: tr = pt_expr(r); ! 638: t_number = mkt_number(); ! 639: unify(tr, t_number, &u); ! 640: p_release(tr); p_release(t_number); p_release(u); ! 641: return t_text; ! 642: } ! 643: ! 644: Hidden polytype pt_unparsed(v, t) parsetree v, t; { ! 645: return mkt_newvar(); ! 646: } ! 647: ! 648: /* ******************************************************************** */ ! 649: /* Type Check tests */ ! 650: /* ******************************************************************** */ ! 651: ! 652: Hidden Procedure tc_test(v) parsetree v; { ! 653: tc_node(v, tes_tab); ! 654: } ! 655: ! 656: Hidden Procedure tc_compound(c) parsetree c; { ! 657: tc_test(c); ! 658: } ! 659: ! 660: Hidden Procedure tc_junction(l, r) parsetree l, r; { ! 661: tc_test(l); ! 662: tc_test(r); ! 663: } ! 664: ! 665: Hidden Procedure tc_not(r) parsetree r; { ! 666: tc_test(r); ! 667: } ! 668: ! 669: Hidden Procedure tc_in_quantification(t, e, c) parsetree t, e, c; { ! 670: polytype t_tlt_t, te, u; ! 671: ! 672: t_tlt_t = mkt_tlt(pt_expr(t)); ! 673: te = pt_expr(e); ! 674: unify(te, t_tlt_t, &u); ! 675: p_release(te); p_release(t_tlt_t); p_release(u); ! 676: ! 677: tc_test(c); ! 678: } ! 679: ! 680: Hidden Procedure tc_p_quantification(t, e, c) parsetree t, e, c; { ! 681: intlet k, len; ! 682: value ct; /* the Collateral Tag in t */ ! 683: polytype t_text, te, u; ! 684: ! 685: t_text = mkt_text(); ! 686: ! 687: ct = *Branch(t, COLL_SEQ); ! 688: len = Nfields(ct); ! 689: k_Over_len { ! 690: polytype ttag; ! 691: ttag = mkt_var(copy(*Branch(*Field(ct, k), TAG_NAME))); ! 692: add_var(ttag); ! 693: unify(ttag, t_text, &u); ! 694: p_release(ttag); p_release(u); ! 695: } ! 696: ! 697: te = pt_expr(e); ! 698: unify(te, t_text, &u); ! 699: p_release(te); p_release(t_text); p_release(u); ! 700: ! 701: tc_test(c); ! 702: } ! 703: ! 704: Hidden Procedure tc_tag(name) value name; {} ! 705: ! 706: Hidden Procedure tc_tformal(name, number) value name, number; { ! 707: tc_tag(name); ! 708: } ! 709: ! 710: Hidden Procedure tc_tlocal(name, number) value name, number; { ! 711: tc_tag(name); ! 712: } ! 713: ! 714: Hidden Procedure tc_tglobal(name) value name; { ! 715: tc_tag(name); ! 716: } ! 717: ! 718: Hidden Procedure tc_tmystery(name, number) value name, number; { ! 719: tc_tag(name); ! 720: } ! 721: ! 722: Hidden Procedure tc_trefinement(name) value name; { ! 723: tc_tag(name); ! 724: } ! 725: ! 726: Hidden Procedure tc_tfun(name, fct) value name, fct; { ! 727: tc_tag(name); ! 728: } ! 729: ! 730: Hidden Procedure tc_tprd(name, fct) value name, fct; { ! 731: tc_tag(name); ! 732: } ! 733: ! 734: Hidden Procedure tc_monprd(name, r, pred) parsetree r; value name, pred; { ! 735: p_release(pt_expr(r)); ! 736: } ! 737: ! 738: Hidden Procedure tc_dyaprd(l, name, r, pred) parsetree l, r; value name, pred; { ! 739: polytype tl, tr; ! 740: tl = pt_expr(l); ! 741: tr = pt_expr(r); ! 742: if (is_string(name, "in") || is_string(name, "not'in")) { ! 743: polytype t_tlt_l, u; ! 744: t_tlt_l = mkt_tlt(p_copy(tl)); ! 745: unify(tr, t_tlt_l, &u); ! 746: p_release(t_tlt_l); p_release(u); ! 747: } ! 748: p_release(tl); p_release(tr); ! 749: } ! 750: ! 751: Forward polytype pt_relop(); ! 752: ! 753: Hidden Procedure tc_relop(l, r) parsetree l, r; { ! 754: p_release(pt_relop(l, r)); ! 755: } ! 756: ! 757: Hidden polytype pt_relop(l, r) parsetree l, r; { ! 758: polytype tl, tr, u; ! 759: ! 760: if (Comparison(nodetype(l))) ! 761: tl = pt_relop(*Branch(l, REL_LEFT), *Branch(l, REL_RIGHT)); ! 762: else ! 763: tl = pt_expr(l); ! 764: tr = pt_expr(r); ! 765: unify(tl, tr, &u); ! 766: p_release(tl); p_release(tr); ! 767: return u; ! 768: } ! 769: ! 770: Hidden Procedure tc_unparsed(c, t) parsetree c, t; {} ! 771: ! 772: Hidden Procedure uni_bad() { syserr(MESS(2304, "bad uni node in type check")); } ! 773: Hidden Procedure cmd_bad() { syserr(MESS(2305, "bad cmd node in type check")); } ! 774: Hidden polytype exp_bad() { syserr(MESS(2306, "bad exp node in type check")); ! 775: return (polytype) 0; } ! 776: Hidden Procedure tes_bad() { syserr(MESS(2307, "bad tes node in type check")); } ! 777: ! 778: Visible Procedure inittyp() { ! 779: int i; ! 780: for (i= 0; i<TABSIZE; i++) { ! 781: uni_tab[i]= uni_bad; ! 782: cmd_tab[i]= cmd_bad; ! 783: exp_tab[i]= exp_bad; ! 784: tes_tab[i]= tes_bad; ! 785: } ! 786: ! 787: uni_tab[HOW_TO]= tc_howto_unit; ! 788: uni_tab[YIELD]= tc_yield_unit; ! 789: uni_tab[TEST]= tc_test_unit; ! 790: uni_tab[REFINEMENT]= tc_refinement; ! 791: ! 792: cmd_tab[SUITE]= tc_suite; ! 793: cmd_tab[PUT]= tc_put; ! 794: cmd_tab[INSERT]= tc_ins_rem; ! 795: cmd_tab[REMOVE]= tc_ins_rem; ! 796: cmd_tab[CHOOSE]= tc_choose; ! 797: cmd_tab[DRAW]= tc_draw; ! 798: cmd_tab[SET_RANDOM]= tc_set_random; ! 799: cmd_tab[DELETE]= tc_delete; ! 800: cmd_tab[CHECK]= tc_check; ! 801: cmd_tab[SHARE]= tc_nothing; ! 802: cmd_tab[WRITE]= tc_write; ! 803: cmd_tab[READ]= tc_read; ! 804: cmd_tab[READ_RAW]= tc_raw_read; ! 805: cmd_tab[IF]= tc_ifwhile; ! 806: cmd_tab[WHILE]= tc_ifwhile; ! 807: cmd_tab[FOR]= tc_for; ! 808: cmd_tab[SELECT]= tc_select; ! 809: cmd_tab[TEST_SUITE]= tc_tes_suite; ! 810: cmd_tab[ELSE]= tc_else; ! 811: cmd_tab[QUIT]= tc_nothing; ! 812: cmd_tab[RETURN]= tc_return; ! 813: cmd_tab[REPORT]= tc_report; ! 814: cmd_tab[SUCCEED]= tc_nothing; ! 815: cmd_tab[FAIL]= tc_nothing; ! 816: cmd_tab[USER_COMMAND]= tc_user_command; ! 817: cmd_tab[EXTENDED_COMMAND]= tc_nothing; ! 818: exp_tab[TAG]= pt_tag; ! 819: tes_tab[TAG]= tc_tag; ! 820: exp_tab[TAGformal]= pt_tformal; ! 821: tes_tab[TAGformal]= tc_tformal; ! 822: exp_tab[TAGlocal]= pt_tlocal; ! 823: tes_tab[TAGlocal]= tc_tlocal; ! 824: exp_tab[TAGglobal]= pt_tglobal; ! 825: tes_tab[TAGglobal]= tc_tglobal; ! 826: exp_tab[TAGmystery]= pt_tmystery; ! 827: tes_tab[TAGmystery]= tc_tmystery; ! 828: exp_tab[TAGrefinement]= pt_trefinement; ! 829: tes_tab[TAGrefinement]= tc_trefinement; ! 830: exp_tab[TAGzerfun]= pt_tfun; ! 831: tes_tab[TAGzerfun]= tc_tfun; ! 832: exp_tab[TAGzerprd]= pt_tprd; ! 833: tes_tab[TAGzerprd]= tc_tprd; ! 834: ! 835: exp_tab[COMPOUND]= pt_compound; ! 836: tes_tab[COMPOUND]= tc_compound; ! 837: exp_tab[COLLATERAL]= pt_collateral; ! 838: exp_tab[SELECTION]= pt_selection; ! 839: exp_tab[BEHEAD]= pt_trim; ! 840: exp_tab[CURTAIL]= pt_trim; ! 841: ! 842: exp_tab[UNPARSED]= pt_unparsed; ! 843: tes_tab[UNPARSED]= tc_unparsed; ! 844: ! 845: exp_tab[MONF]= pt_monf; ! 846: exp_tab[DYAF]= pt_dyaf; ! 847: exp_tab[NUMBER]= pt_number; ! 848: exp_tab[TEXT_DIS]= pt_text_dis; ! 849: exp_tab[ELT_DIS]= pt_elt_dis; ! 850: exp_tab[LIST_DIS]= pt_list_dis; ! 851: exp_tab[RANGE_DIS]= pt_range_dis; ! 852: exp_tab[TAB_DIS]= pt_tab_dis; ! 853: ! 854: tes_tab[AND]= tc_junction; ! 855: tes_tab[OR]= tc_junction; ! 856: tes_tab[NOT]= tc_not; ! 857: tes_tab[SOME_IN]= tc_in_quantification; ! 858: tes_tab[EACH_IN]= tc_in_quantification; ! 859: tes_tab[NO_IN]= tc_in_quantification; ! 860: tes_tab[SOME_PARSING]= tc_p_quantification; ! 861: tes_tab[EACH_PARSING]= tc_p_quantification; ! 862: tes_tab[NO_PARSING]= tc_p_quantification; ! 863: tes_tab[MONPRD]= tc_monprd; ! 864: tes_tab[DYAPRD]= tc_dyaprd; ! 865: tes_tab[LESS_THAN]= tc_relop; ! 866: tes_tab[AT_MOST]= tc_relop; ! 867: tes_tab[GREATER_THAN]= tc_relop; ! 868: tes_tab[AT_LEAST]= tc_relop; ! 869: tes_tab[EQUAL]= tc_relop; ! 870: tes_tab[UNEQUAL]= tc_relop; ! 871: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.