1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */ 2: 3: /* 4: $Header: b2exp.c,v 1.4 85/08/22 16:54:36 timo Exp $ 5: */ 6: 7: #include "b.h" 8: #include "b1obj.h" 9: #include "b2par.h" 10: #include "b2syn.h" 11: #include "b2nod.h" 12: #include "b2exp.h" 13: #include "b3err.h" 14: 15: /* ******************************************************************** */ 16: /* expression */ 17: /* ******************************************************************** */ 18: 19: Visible parsetree expr(q) txptr q; { 20: return collateral(q, singexpr); 21: } 22: 23: Forward parsetree rsingexpr(); 24: 25: Visible parsetree singexpr(q) txptr q; { 26: if (nothing(q, "expression")) return NilTree; 27: else { 28: expadm adm; 29: initexp(&adm); 30: return rsingexpr(q, &adm); 31: } 32: } 33: 34: Hidden Procedure initexp(adm) expadm *adm; { 35: Parsed(adm)= Yes; 36: N_fld(adm)= 0; 37: Prop(adm)= dya_proposition; 38: dya_proposition= No; 39: } 40: 41: Hidden bool expr_opr() { 42: return reptext_sign() || center_sign() || leftadj_sign() || 43: rightadj_sign(); 44: } 45: 46: Forward parsetree term(), factor(), primary(), base(), unp_expr(); 47: Forward bool element(); 48: 49: Hidden parsetree rsingexpr(q, adm) txptr q; expadm *adm; { 50: parsetree v; value w; txptr tx0= tx; 51: v= term(q, adm); 52: skipsp(&tx); 53: if (Parsed(adm) && Text(q) && expr_opr()) { 54: if (nodetype(v) == DYAF) pprerr(Prio); 55: dya_formula(q, adm, &v, mk_text(textsign), L_expr, base); 56: } 57: skipsp(&tx); 58: if (Parsed(adm) && Prop(adm)) { 59: if (Text(q) && (nodetype(v) == DYAF || Level(adm) < L_expr)) 60: /* predicate must follow */ 61: return v; 62: else if (Text(q) && tag_operator(q, &w)) 63: dya_formula(q, adm, &v, w, L_expr, unp_expr); 64: else 65: parerr(MESS(2100, "no test where expected")); 66: } 67: if (Parsed(adm) && Text(q) && tag_operator(q, &w)) { 68: if (nodetype(v) == DYAF) pprerr(Prio); 69: dya_formula(q, adm, &v, w, L_expr, base); 70: } 71: if (!Parsed(adm)) /* v is an UNPARSED node */ 72: *Branch(v, UNP_TEXT)= cr_text(tx0, tx); 73: upto_expr(q); 74: return v; 75: } 76: 77: Hidden Procedure dya_formula(q, adm, v, name, lev, fct) 78: txptr q; expadm *adm; parsetree *v, (*fct)(); value name; intlet lev; { 79: 80: parsetree w; 81: if (Level(adm) < lev) pprerr(Prio); 82: N_fld(adm)+= 2; 83: w= (*fct)(q, adm); 84: if (Parsed(adm)) { 85: N_fld(adm)-= 2; 86: if (Trim(adm)) 87: *v= node3(b_behead(name) ? BEHEAD : CURTAIL, *v, w); 88: else 89: *v= node5(DYAF, *v, name, w, Vnil); 90: } else { 91: *Field(Unp_comp(adm), --N_fld(adm))= name; 92: *Field(Unp_comp(adm), --N_fld(adm))= *v; 93: *v= w; 94: } 95: } 96: 97: /* ******************************************************************** */ 98: /* term */ 99: /* ******************************************************************** */ 100: 101: Hidden bool term_opr() { 102: return plus_sign() || minus_sign() || join_sign(); 103: } 104: 105: Hidden parsetree term(q, adm) txptr q; expadm *adm; { 106: parsetree v= factor(q, adm); 107: skipsp(&tx); 108: while (Parsed(adm) && Text(q) && term_opr()) { 109: dya_formula(q, adm, &v, mk_text(textsign), L_term, factor); 110: skipsp(&tx); 111: } 112: return v; 113: } 114: 115: /* ******************************************************************** */ 116: /* factor */ 117: /* ******************************************************************** */ 118: 119: Hidden parsetree factor(q, adm) txptr q; expadm *adm; { 120: parsetree v= primary(q, adm); 121: skipsp(&tx); 122: while (Parsed(adm) && Text(q) && times_sign()) { 123: dya_formula(q, adm, &v, mk_text(textsign), L_factor, primary); 124: skipsp(&tx); 125: } 126: if (Parsed(adm) && Text(q) && over_sign()) 127: dya_formula(q, adm, &v, mk_text(textsign), L_factor, primary); 128: return v; 129: } 130: 131: /* ******************************************************************** */ 132: /* primary */ 133: /* ******************************************************************** */ 134: 135: Hidden parsetree primary(q, adm) txptr q; expadm *adm; { 136: parsetree v; 137: v= base(q, adm); 138: skipsp(&tx); 139: if (Parsed(adm) && Text(q) && number_sign()) 140: dya_formula(q, adm, &v, mk_text(textsign), L_number, base); 141: skipsp(&tx); 142: if (Parsed(adm) && Text(q) && power_sign()) 143: dya_formula(q, adm, &v, mk_text(textsign), L_power, base); 144: return v; 145: } 146: 147: /* ******************************************************************** */ 148: /* base */ 149: /* ******************************************************************** */ 150: 151: Forward parsetree rbase(); 152: 153: Hidden parsetree base(q, adm) txptr q; expadm *adm; { 154: State(adm)= S_else; 155: Level(adm)= L_expr; 156: Trim(adm)= No; 157: return rbase(q, adm); 158: } 159: 160: Hidden bool critical(adm, v) expadm *adm; value v; { 161: if (State(adm) == S_t) { 162: if (b_plus(v) || b_minus(v)) 163: return Level(adm) >= L_term; 164: if (b_number(v)) 165: return Level(adm) >= L_number; 166: } 167: return No; 168: } 169: 170: Hidden parsetree mon_formula(q, adm, w, fct) 171: txptr q; expadm *adm; value w; parsetree (*fct)(); { 172: 173: parsetree v; 174: N_fld(adm)++; 175: v= (*fct)(q, adm); 176: if (Parsed(adm)) { 177: N_fld(adm)--; 178: return v == NilTree ? node2(TAG, w) : node4(MONF, w, v, Vnil); 179: } else { 180: *Field(Unp_comp(adm), --N_fld(adm))= w; 181: return v; 182: } 183: } 184: 185: Hidden Procedure adjust_level(adm, lev) expadm *adm; intlet lev; { 186: if (lev < Level(adm)) Level(adm)= lev; 187: } 188: 189: Hidden parsetree rbase(q, adm) txptr q; expadm *adm; { 190: parsetree v; value name; 191: skipsp(&tx); 192: if (Text(q) && tag_operator(q, &name)) { 193: if (State(adm) == S_tt) 194: return mon_formula(q, adm, name, unp_expr); 195: if (State(adm) == S_t) { 196: if (Level(adm) == L_expr || Prop(adm)) State(adm)= S_tt; 197: else if (!Trim(adm)) adjust_level(adm, L_bottom); 198: } else State(adm)= S_t; 199: v= mon_formula(q, adm, name, rbase); 200: if (!Trim(adm) && Parsed(adm) && nodetype(v) == MONF) 201: adjust_level(adm, L_bottom); 202: return v; 203: } else if (Text(q) && (dyamon_sign() || mon_sign())) { 204: name= mk_text(textsign); 205: if (State(adm) == S_tt || critical(adm, name)) 206: return mon_formula(q, adm, name, unp_expr); 207: if (!Trim(adm)) { 208: if (State(adm) == S_t) adjust_level(adm, L_bottom); 209: else if (b_minus(name)) adjust_level(adm, L_factor); 210: else if (b_number(name)) adjust_level(adm, L_number); 211: else if (b_numtor(name) || b_denomtor(name)) 212: adjust_level(adm, L_bottom); 213: } 214: State(adm)= S_else; 215: if (!Trim(adm) && b_minus(name)) { 216: intlet lev= Level(adm); 217: v= mon_formula(q, adm, name, primary); 218: adjust_level(adm, lev); 219: return v; 220: } else 221: return mon_formula(q, adm, name, rbase); 222: } else if (Text(q) && element(q, &v)) { 223: if (State(adm) == S_tt) 224: return mon_formula(q, adm, v, unp_expr); 225: exp_trimmed_text(q, adm, &v); 226: return v; 227: } else { 228: if (State(adm) == S_else) 229: parerr(MESS(2101, "no expression where expected")); 230: return NilTree; 231: } 232: } 233: 234: /* ******************************************************************** */ 235: /* element */ 236: /* ******************************************************************** */ 237: 238: Forward bool closed_expr(), constant(), text_dis(), tlr_dis(), seltrim_tag(); 239: 240: Hidden bool element(q, v) txptr q; parsetree *v; { 241: if (seltrim_tag(q, v) || closed_expr(q, v) || constant(q, v) || 242: text_dis(q, v) || tlr_dis(q, v) 243: ) { 244: selection(q, v); 245: return Yes; 246: } 247: return No; 248: } 249: 250: /* ******************************************************************** */ 251: /* (seltrim_tag) */ 252: /* ******************************************************************** */ 253: 254: Hidden bool seltrim_tag(q, v) txptr q; parsetree *v; { 255: value name; txptr tx0= tx; 256: if (Text(q) && is_tag(&name)) { 257: txptr tx1= tx; 258: skipsp(&tx); 259: if (Text(q) && (sub_sign() || trim_sign())) { 260: tx= tx1; 261: *v= node2(TAG, name); 262: return Yes; 263: } else { 264: release(name); 265: tx= tx0; 266: } 267: } 268: return No; 269: } 270: 271: /* ******************************************************************** */ 272: /* (expression) */ 273: /* ******************************************************************** */ 274: 275: Hidden bool closed_expr(q, v) txptr q; parsetree *v; { 276: return open_sign() ? (*v= compound(q, expr), Yes) : No; 277: } 278: 279: /* ******************************************************************** */ 280: /* constant */ 281: /* */ 282: /* note: stand_alone E<number> not allowed */ 283: /* ******************************************************************** */ 284: 285: Forward bool digits(); 286: 287: Hidden bool constant(q, v) txptr q; parsetree *v; { 288: if (Dig(Char(tx)) || Char(tx) == '.') { 289: txptr tx0= tx; 290: bool d= digits(q); 291: if (Text(q) && point_sign() && !digits(q) && !d) 292: pprerr(MESS(2102, "point without digits")); 293: if (Text(q) && Char(tx) == 'E' && 294: (Dig(Char(tx+1)) || !keymark(Char(tx+1))) 295: ) { 296: tx++; 297: if (Text(q) && (plus_sign() || minus_sign())); 298: if (!digits(q)) pprerr(MESS(2103, "E not followed by exponent")); 299: } 300: *v= node3(NUMBER, numconst(tx0, tx), cr_text(tx0, tx)); 301: return Yes; 302: } 303: return No; 304: } 305: 306: Hidden bool digits(q) txptr q; { 307: txptr tx0= tx; 308: while (Text(q) && Dig(Char(tx))) tx++; 309: return tx > tx0; 310: } 311: 312: /* ******************************************************************** */ 313: /* textual_display */ 314: /* ******************************************************************** */ 315: 316: Forward parsetree text_body(); 317: 318: Hidden bool text_dis(q, v) txptr q; parsetree *v; { 319: if (apostrophe_sign() || quote_sign()) { 320: parsetree w; value aq= mk_text(textsign); 321: w= text_body(q, textsign); 322: if (w == NilTree) w= node3(TEXT_LIT, mk_text(""), NilTree); 323: *v= node3(TEXT_DIS, aq, w); 324: return Yes; 325: } 326: return No; 327: } 328: 329: Forward bool is_conversion(); 330: 331: Hidden parsetree text_body(q, aq) txptr q; string aq; { 332: value head; parsetree tail; 333: txptr tx0= tx; 334: while (Text(q)) { 335: if (Char(tx) == *aq || Char(tx) == '`') { 336: head= tx0 < tx ? cr_text(tx0, tx) : Vnil; 337: if (Char(tx) == Char(tx+1)) { 338: value spec= cr_text(tx, tx+1); 339: tx+= 2; 340: tail= text_body(q, aq); 341: tail= node3(TEXT_LIT, spec, tail); 342: } else { 343: parsetree e; 344: if (is_conversion(q, &e)) { 345: tail= text_body(q, aq); 346: tail= node3(TEXT_CONV, e, tail); 347: } else { 348: tx++; 349: tail= NilTree; 350: } 351: } 352: if (head == Vnil) return tail; 353: else return node3(TEXT_LIT, head, tail); 354: } else 355: tx++; 356: } 357: parerr2(MESS(2104, "cannot find matching "), MESSMAKE(aq)); 358: return NilTree; 359: } 360: 361: Hidden bool is_conversion(q, v) txptr q; parsetree *v; { 362: if (conv_sign()) { 363: txptr ftx, ttx; 364: req("`", q, &ftx, &ttx); 365: *v= expr(ftx); tx= ttx; 366: return Yes; 367: } 368: return No; 369: } 370: 371: /* ******************************************************************** */ 372: /* table_display; list_display; range_display; */ 373: /* ******************************************************************** */ 374: 375: Hidden bool elt_dis(v) parsetree *v; { 376: if (curlyclose_sign()) { 377: *v= node1(ELT_DIS); 378: return Yes; 379: } 380: return No; 381: } 382: 383: Hidden bool range_dis(q, v) txptr q; parsetree *v; { 384: txptr ftx, ttx; 385: if (find("..", q, &ftx, &ttx)) { 386: parsetree w; 387: if (Char(ttx) == '.') { ftx++; ttx++; } 388: w= singexpr(ftx); tx= ttx; 389: *v= node3(RANGE_DIS, w, singexpr(q)); 390: return Yes; 391: } 392: return No; 393: } 394: 395: Forward value tab_comp(); 396: 397: Hidden bool tab_dis(q, v) txptr q; parsetree *v; { 398: if (Char(tx) == '[') { 399: *v= node2(TAB_DIS, tab_comp(q, 1)); 400: return Yes; 401: } 402: return No; 403: } 404: 405: Hidden value tab_comp(q, n) txptr q; intlet n; { 406: value v; parsetree key, assoc; txptr ftx, ttx; 407: if (find(";", q, &ftx, &ttx)) { 408: tab_elem(ftx, &key, &assoc); tx= ttx; 409: v= tab_comp(q, n+2); 410: } else { 411: tab_elem(q, &key, &assoc); 412: v= mk_compound(n+1); 413: } 414: *Field(v, n-1)= key; 415: *Field(v, n)= assoc; 416: return v; 417: } 418: 419: Hidden Procedure tab_elem(q, key, assoc) txptr q; parsetree *key, *assoc; { 420: txptr ftx, ttx; 421: need("["); 422: req("]", q, &ftx, &ttx); 423: *key= expr(ftx); tx= ttx; 424: need(":"); 425: *assoc= singexpr(q); 426: } 427: 428: Forward value list_comp(); 429: 430: Hidden Procedure list_dis(q, v) txptr q; parsetree *v; { 431: *v= node2(LIST_DIS, list_comp(q, 1)); 432: } 433: 434: Hidden value list_comp(q, n) txptr q; intlet n; { 435: value v; parsetree w; txptr ftx, ttx; 436: if (find(";", q, &ftx, &ttx)) { 437: w= singexpr(ftx); tx= ttx; 438: v= list_comp(q, n+1); 439: } else { 440: w= singexpr(q); 441: v= mk_compound(n); 442: } 443: *Field(v, n-1)= w; 444: return v; 445: } 446: 447: Hidden bool tlr_dis(q, v) txptr q; parsetree *v; { 448: if (curlyopen_sign()) { 449: skipsp(&tx); 450: if (!elt_dis(v)) { 451: txptr ftx, ttx; 452: req("}", q, &ftx, &ttx); 453: if (!range_dis(ftx, v)) { 454: skipsp(&tx); 455: if (!tab_dis(ftx, v)) list_dis(ftx, v); 456: } 457: tx= ttx; 458: } 459: return Yes; 460: } 461: return No; 462: } 463: 464: /* ******************************************************************** */ 465: /* selection */ 466: /* ******************************************************************** */ 467: 468: Visible Procedure selection(q, v) txptr q; parsetree *v; { 469: txptr ftx, ttx; 470: skipsp(&tx); 471: while (Text(q) && sub_sign()) { 472: req("]", q, &ftx, &ttx); 473: *v= node3(SELECTION, *v, expr(ftx)); tx= ttx; 474: skipsp(&tx); 475: } 476: } 477: 478: /* ******************************************************************** */ 479: /* trimmed_text */ 480: /* ******************************************************************** */ 481: 482: Hidden bool is_trimmed_text(q) txptr q; { 483: txptr tx0= tx; bool b; 484: skipsp(&tx); 485: b= Text(q) && trim_sign(); 486: tx= tx0; 487: return b; 488: } 489: 490: Hidden Procedure trimmed_text(q, adm, v) txptr q; expadm *adm; parsetree *v; { 491: Trim(adm)= Yes; 492: while (Parsed(adm) && Text(q) && trim_sign()) { 493: State(adm)= S_else; 494: dya_formula(q, adm, v, mk_text(textsign), L_bottom, rbase); 495: skipsp(&tx); 496: } 497: Trim(adm)= No; 498: } 499: 500: Visible Procedure tar_trimmed_text(q, v) txptr q; parsetree *v; { 501: if (is_trimmed_text(q)) { 502: expadm adm; 503: initexp(&adm); 504: Level(&adm)= L_bottom; 505: trimmed_text(q, &adm, v); 506: } 507: } 508: 509: Hidden Procedure exp_trimmed_text(q, adm, v) 510: txptr q; expadm *adm; parsetree *v; { 511: 512: if (!Trim(adm) && is_trimmed_text(q)) { 513: intlet s= State(adm); /* save */ 514: if (State(adm) == S_t) adjust_level(adm, L_bottom); 515: trimmed_text(q, adm, v); 516: State(adm)= s; /* restore */ 517: } 518: } 519: 520: /* ******************************************************************** */ 521: /* unp_expr, unp_test */ 522: /* ******************************************************************** */ 523: 524: Forward bool item(); 525: 526: Hidden parsetree unp_expr(q, adm) txptr q; expadm *adm; { 527: value v; 528: skipsp(&tx); 529: if (Text(q) && item(q, &v)) { 530: return mon_formula(q, adm, v, unp_expr); 531: } else { 532: Parsed(adm)= No; 533: Unp_comp(adm)= mk_compound(N_fld(adm)); 534: return node3(UNPARSED, Unp_comp(adm), Vnil); 535: } 536: } 537: 538: Visible parsetree unp_test(q) txptr q; { 539: parsetree v; expadm adm; txptr tx0= tx; 540: initexp(&adm); 541: v= unp_expr(q, &adm); 542: *Branch(v, UNP_TEXT)= cr_text(tx0, tx); 543: return v; 544: } 545: 546: Visible bool tag_operator(q, v) txptr q; value *v; { 547: txptr tx0= tx; 548: if (Text(q) && is_tag(v)) { 549: skipsp(&tx); 550: if (!(Text(q) && (sub_sign() || trim_sign()))) return Yes; 551: else { 552: release(*v); 553: tx= tx0; 554: } 555: } 556: return No; 557: } 558: 559: Hidden bool dm_operator(q, v) txptr q; value *v; { 560: return dyamon_sign() ? (*v= mk_text(textsign), Yes) : tag_operator(q, v); 561: } 562: 563: Hidden bool d_operator(q, v) txptr q; value *v; { 564: return dya_sign() ? (*v= mk_text(textsign), Yes) : dm_operator(q, v); 565: } 566: 567: Hidden bool m_operator(q, v) txptr q; value *v; { 568: return mon_sign() ? (*v= mk_text(textsign), Yes) : dm_operator(q, v); 569: } 570: 571: Hidden bool trim_operator(q, v) txptr q; value *v; { 572: return trim_sign() ? (*v= mk_text(textsign), Yes) : No; 573: } 574: 575: Hidden bool item(q, v) txptr q; value *v; { 576: return tag_operator(q, v) || trim_operator(q, v) || 577: d_operator(q, v) || m_operator(q, v) || 578: element(q, v); 579: } 580: 581: /* ******************************************************************** */ 582: /* upto_expr */ 583: /* ******************************************************************** */ 584: 585: Hidden Procedure upto_expr(q) txptr q; { 586: skipsp(&tx); 587: if (Text(q)) { 588: value dum; 589: if (d_operator(q, &dum)) { 590: release(dum); 591: pprerr(Prio); 592: } else parerr(MESS(2105, "something unexpected following expression")); 593: tx= q; 594: } 595: } 596: 597: /* ******************************************************************** */ 598: 599: Hidden bool is_opr(v, s) value v; string s; { 600: value t= Vnil; 601: bool is= Is_text(v) && compare(v, t= mk_text(s)) == 0; 602: release(t); 603: return is; 604: } 605: 606: Visible bool b_about(v) value v; { return is_opr(v, "~"); } 607: Visible bool b_numtor(v) value v; { return is_opr(v, "*/"); } 608: Visible bool b_denomtor(v) value v; { return is_opr(v, "/*"); } 609: Visible bool b_plus(v) value v; { return is_opr(v, "+"); } 610: Visible bool b_minus(v) value v; { return is_opr(v, "-"); } 611: Visible bool b_number(v) value v; { return is_opr(v, "#"); } 612: Visible bool b_behead(v) value v; { return is_opr(v, "@"); } 613: Visible bool b_curtail(v) value v; { return is_opr(v, "|"); } 614: #ifdef NOT_USED 615: Visible bool b_times(v) value v; { return is_opr(v, "*"); } 616: Visible bool b_over(v) value v; { return is_opr(v, "/"); } 617: Visible bool b_power(v) value v; { return is_opr(v, "**"); } 618: Visible bool b_join(v) value v; { return is_opr(v, "^"); } 619: Visible bool b_reptext(v) value v; { return is_opr(v, "^^"); } 620: Visible bool b_center(v) value v; { return is_opr(v, "><"); } 621: Visible bool b_leftadj(v) value v; { return is_opr(v, "<<"); } 622: Visible bool b_rightadj(v) value v; { return is_opr(v, ">>"); } 623: #endif