![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b2exp.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bsmall|
Return to b2exp.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bsmall |
1.1 ! root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */ ! 2: /* $Header: b2exp.c,v 1.1 84/06/28 00:49:08 timo Exp $ */ ! 3: ! 4: /* B expression evaluation */ ! 5: #include "b.h" ! 6: #include "b0con.h" ! 7: #include "b1obj.h" ! 8: #include "b1mem.h" /* for ptr */ ! 9: #include "b2env.h" ! 10: #include "b2syn.h" ! 11: #include "b2sem.h" ! 12: #include "b2sou.h" ! 13: ! 14: /*************************************************************/ ! 15: /* */ ! 16: /* The operand and operator stacks are modelled as compounds */ ! 17: /* whose first field is the top and whose second field is */ ! 18: /* the remainder of the stack (i.e., linked lists). */ ! 19: /* A cleaner and more efficient implementation of */ ! 20: /* these heavily used stacks would be in order. */ ! 21: /* */ ! 22: /*************************************************************/ ! 23: ! 24: /* nd = operand, tor = operator (function) */ ! 25: ! 26: value ndstack, torstack; ! 27: #define Bot Vnil ! 28: fun Bra, Ket; ! 29: ! 30: Visible Procedure inittors() { ! 31: ndstack= torstack= Vnil; ! 32: Bra= mk_fun(-1, -1, Mon, (literal)Dummy, (txptr)Dummy, (txptr)Dummy, (value)Dummy, (bool)Dummy); ! 33: Ket= mk_fun( 0, 0, Dya, (literal)Dummy, (txptr)Dummy, (txptr)Dummy, (value)Dummy, (bool)Dummy); ! 34: } ! 35: ! 36: Hidden Procedure pop_stack(stack) value *stack; { ! 37: value oldstack= *stack; ! 38: *stack= *field(*stack, 1); ! 39: put_in_field(Vnil, &oldstack, 0); put_in_field(Vnil, &oldstack, 1); ! 40: release(oldstack); ! 41: } ! 42: ! 43: Hidden value popnd() { ! 44: value r; ! 45: if (ndstack == Vnil) syserr("operand stack underflow"); ! 46: r= *field(ndstack, 0); ! 47: pop_stack(&ndstack); ! 48: return r; ! 49: } ! 50: ! 51: Hidden Procedure pushnd(nd) value nd; { ! 52: value s= ndstack; ! 53: ndstack= mk_compound(2); ! 54: put_in_field(nd, &ndstack, 0); put_in_field(s, &ndstack, 1); ! 55: } ! 56: ! 57: Hidden Procedure pushmontor(tor) value tor; { ! 58: value s= torstack; ! 59: torstack= mk_compound(2); ! 60: put_in_field(tor, &torstack, 0); put_in_field(s, &torstack, 1); ! 61: } ! 62: ! 63: Hidden Procedure pushdyator(tor2) value tor2; { ! 64: value tor1; funprd *t1, *t2= Funprd(tor2); ! 65: intlet L1, H1, L2= t2->L, H2= t2->H; ! 66: prio: if (torstack == Vnil) syserr("operator stack underflow"); ! 67: tor1= *field(torstack, 0); t1= Funprd(tor1), ! 68: L1= t1->L; H1= t1->H; ! 69: if (L2 > H1) ! 70: if (tor2 == Ket) { ! 71: if (tor1 != Bra) ! 72: syserr("local operator stack underflow"); ! 73: pop_stack(&torstack); ! 74: } ! 75: else pushmontor(tor2); ! 76: else if (L1 >= H2) { ! 77: value nd1= Vnil, nd2= popnd(); ! 78: if (t1->adic == Dya) nd1= popnd(); ! 79: pushnd(formula(nd1, tor1, nd2)); ! 80: if (xeq) { ! 81: release(nd2); ! 82: release(nd1); ! 83: } ! 84: pop_stack(&torstack); ! 85: goto prio; ! 86: } else pprerr("priorities? use ( and ) to resolve", ""); ! 87: } ! 88: ! 89: Forward value basexpr(); ! 90: Forward value text_dis(); ! 91: Forward value tl_dis(); ! 92: ! 93: Hidden value statabsel(t, k) value t, k; { ! 94: /* temporary, while no static type check */ ! 95: return mk_elt(); ! 96: } ! 97: ! 98: Visible value expr(q) txptr q; { ! 99: value c, v; txptr i, j; intlet len, k; ! 100: if ((len= 1+count(",", q)) == 1) return basexpr(q); ! 101: c= mk_compound(len); ! 102: k_Overfields { ! 103: if (Lastfield(k)) i= q; ! 104: else req(",", q, &i, &j); ! 105: v= basexpr(i); ! 106: put_in_field(v, &c, k); ! 107: if (!Lastfield(k)) tx= j; ! 108: } ! 109: return c; ! 110: } ! 111: ! 112: Hidden value basexpr(q) txptr q; { ! 113: value v= obasexpr(q); ! 114: Skipsp(tx); ! 115: if (tx < q && Char(tx) == ',') ! 116: parerr("no commas allowed in this context", ""); ! 117: upto(q, "expression"); ! 118: return v; ! 119: } ! 120: ! 121: Forward bool primary(), clocondis(); ! 122: ! 123: #define Pbot {pushnd(Bot); pushmontor(Bra);} ! 124: #define Ipush if (!pushing) {Pbot; pushing= Yes;} ! 125: #define Fpush if (pushing) { \ ! 126: pushnd(v); pushdyator(Ket); v= popnd(); \ ! 127: if (popnd() != Bot) syserr( \ ! 128: xeq ? "formula evaluation awry" : \ ! 129: "formula parsing awry"); \ ! 130: } ! 131: ! 132: Visible value obasexpr(q) txptr q; { ! 133: value v, t; bool pushing= No; ! 134: nxtnd: Skipsp(tx); ! 135: nothing(q, "expression"); ! 136: t= tag(); ! 137: if (primary(q, t, &v, Yes)) /* then t is released */; ! 138: else if (t != Vnil) { ! 139: value f; ! 140: if (is_monfun(t, &f)) { ! 141: release(t); ! 142: Ipush; ! 143: pushmontor(f); ! 144: goto nxtnd; ! 145: } else { ! 146: release(t); ! 147: error("target has not yet received a value"); ! 148: } ! 149: } else if (Montormark(Char(tx))) { ! 150: Ipush; ! 151: pushmontor(montor()); ! 152: goto nxtnd; ! 153: } else parerr("no expression where expected", ""); ! 154: /* We are past an operand and look for an operator */ ! 155: Skipsp(tx); ! 156: if (tx < q) { ! 157: txptr tx0= tx; bool lt, eq, gt; ! 158: if (Letter(Char(tx))) { ! 159: fun f; ! 160: t= tag(); ! 161: if (is_dyafun(t, &f)) { ! 162: release(t); ! 163: Ipush; ! 164: pushnd(v); ! 165: pushdyator(f); ! 166: goto nxtnd; ! 167: } ! 168: release(t); ! 169: } else if (relop(<, &eq, >)); ! 170: else if (Dyatormark(Char(tx))) { ! 171: Ipush; ! 172: pushnd(v); ! 173: pushdyator(dyator()); ! 174: goto nxtnd; ! 175: } ! 176: tx= tx0; ! 177: } ! 178: Fpush; ! 179: return v; ! 180: } ! 181: ! 182: Hidden bool clocondis(q, p) txptr q; value *p; { ! 183: txptr i, j; ! 184: Skipsp(tx); ! 185: nothing(q, "expression"); ! 186: if (Char(tx) == '(') { ! 187: tx++; req(")", q, &i, &j); ! 188: *p= expr(i); tx= j; ! 189: return Yes; ! 190: } ! 191: if (Dig(Char(tx)) || Char(tx) == '.' || Char(tx) == 'E' && ! 192: (Dig(Char(tx+1)) || Char(tx+1)=='+' || Char(tx+1)=='-')) { ! 193: *p= constant(q); ! 194: return Yes; ! 195: } ! 196: if (Char(tx) == '\'' || Char(tx) == '"') { ! 197: *p= text_dis(q); ! 198: return Yes; ! 199: } ! 200: if (Char(tx) == '{') { ! 201: *p= tl_dis(q); ! 202: return Yes; ! 203: } ! 204: return No; ! 205: } ! 206: ! 207: Hidden bool primary(q, t, p, tri) txptr q; value t, *p; bool tri; { ! 208: /* If a tag has been seen, it is held in t. ! 209: Releasing t is a task of primary, but only if the call succeeds. */ ! 210: fun f; value tt, relt= Vnil; value *aa= &t; ! 211: if (t != Vnil) /* tag */ { ! 212: if (xeq) { ! 213: tt= t; ! 214: aa= lookup(t); ! 215: if (aa == Pnil) { ! 216: if (is_zerfun(t, &f)) { ! 217: t= formula(Vnil, f, Vnil); ! 218: aa= &t; ! 219: } else return No; ! 220: } else if (Is_refinement(*aa)) { ! 221: ref_et(*aa, Ret); t= resval; resval= Vnil; ! 222: aa= &t; ! 223: } else if (Is_formal(*aa)) { ! 224: t= eva_formal(*aa); ! 225: aa= &t; ! 226: } else if (Is_shared(*aa)) { ! 227: if (!in_env(prmnv->tab, t, &aa)) return No; ! 228: if (Is_filed(*aa)) ! 229: if (!is_tloaded(t, &aa)) return No; ! 230: t= Vnil; ! 231: } else if (Is_filed(*aa)) { ! 232: if (!is_tloaded(t, &aa)) return No; ! 233: t= Vnil; ! 234: } else t= Vnil; ! 235: release(tt); ! 236: } ! 237: } else if (clocondis(q, &t)) aa= &t; ! 238: else return No; ! 239: Skipsp(tx); ! 240: while (tx < q && Char(tx) == '[') { ! 241: txptr i, j; value s; ! 242: tx++; req("]", q, &i, &j); ! 243: s= expr(i); tx= j; ! 244: /* don't copy table for selection */ ! 245: if (xeq) { ! 246: aa= adrassoc(*aa, s); ! 247: release(s); ! 248: relt= t; ! 249: if (aa == Pnil) error("key not in table"); ! 250: } else { ! 251: t= statabsel(tt= t, s); ! 252: release(tt); release(s); ! 253: } ! 254: Skipsp(tx); ! 255: } ! 256: if (tri && tx < q && (Char(tx) == '@' || Char(tx) == '|')) { ! 257: intlet B, C; ! 258: if (xeq && !Is_text(*aa)) ! 259: parerr("in t@p or t|p, t is not a text", ""); ! 260: trimbc(q, xeq ? length(*aa) : 0, &B, &C); ! 261: if (xeq) { ! 262: relt= t; ! 263: t= trim(*aa, B, C); ! 264: aa= &t; ! 265: } ! 266: } ! 267: *p= t == Vnil || relt != Vnil ? copy(*aa) : t; ! 268: release(relt); ! 269: return Yes; ! 270: } ! 271: ! 272: Forward intlet trimi(); ! 273: ! 274: Visible Procedure trimbc(q, len, B, C) txptr q; intlet len, *B, *C; { ! 275: char bc; intlet N; ! 276: *B= *C= 0; ! 277: while (tx < q && (Char(tx) == '@' || Char(tx) == '|')) { ! 278: bc= Char(tx++); ! 279: N= trimi(q); ! 280: if (bc == '@') *B+= N-1; ! 281: else *C+= (len-*B-*C)-N; ! 282: if (*B < 0 || *C < 0 || *B+*C > len) ! 283: error("in t@p or t|p, p is out of bounds"); ! 284: Skipsp(tx); ! 285: } ! 286: } ! 287: ! 288: Hidden intlet trimi(q) txptr q; { ! 289: value v, t; bool pushing= No; ! 290: nxtnd: Skipsp(tx); ! 291: nothing(q, "expression"); ! 292: t= tag(); ! 293: if (primary(q, t, &v, No)); /* then t is released */ ! 294: else if (t != Vnil) { ! 295: value f; ! 296: if (is_monfun(t, &f)) { ! 297: release(t); ! 298: Ipush; ! 299: pushmontor(f); ! 300: goto nxtnd; ! 301: } else { ! 302: release(t); ! 303: error("target has not yet received a value"); ! 304: } ! 305: } else if (Montormark(Char(tx))) { ! 306: Ipush; ! 307: pushmontor(montor()); ! 308: goto nxtnd; ! 309: } else parerr("no expression where expected", ""); ! 310: Fpush; ! 311: {int ii; intlet i= 0; ! 312: if (xeq) { ! 313: ii= intval(v); ! 314: if (ii < 0) error("in t@p or t|p, p is negative"); ! 315: if (ii > Maxintlet) ! 316: error("in t@p or t|p, p is excessive"); ! 317: i= ii; ! 318: } ! 319: release(v); ! 320: return i; ! 321: } ! 322: } ! 323: ! 324: Visible value constant(q) txptr q; { ! 325: bool dig= No; txptr first= tx; ! 326: while (tx < q && Dig(Char(tx))) { ! 327: ++tx; ! 328: dig= Yes; ! 329: } ! 330: if (tx < q && Char(tx) == '.') { ! 331: tx++; ! 332: while (tx < q && Dig(Char(tx))) { ! 333: dig= Yes; ! 334: ++tx; ! 335: } ! 336: if (!dig) pprerr("point without digits", ""); ! 337: } ! 338: if (tx < q && Char(tx) == 'E') { ! 339: tx++; ! 340: if (!(Dig(Char(tx))) && Keymark(Char(tx))) { ! 341: tx--; ! 342: goto done; ! 343: } ! 344: if (tx < q && (Char(tx) == '+' || Char(tx) == '-')) ++tx; ! 345: dig= No; ! 346: while (tx < q && Dig(Char(tx))) { ! 347: dig= Yes; ! 348: ++tx; ! 349: } ! 350: if (!dig) parerr("E not followed by exponent", ""); ! 351: } ! 352: done: return numconst(first, tx); ! 353: } ! 354: ! 355: char txdbuf[TXDBUFSIZE]; ! 356: txptr txdbufend= &txdbuf[TXDBUFSIZE]; ! 357: ! 358: Visible Procedure concat_to(v, s) value* v; string s; { /*TEMPORARY*/ ! 359: value v1, v2; ! 360: if (*v == Vnil) *v= mk_text(s); ! 361: else { ! 362: *v= concat(v1= *v, v2= mk_text(s)); ! 363: release(v1); release(v2); ! 364: } ! 365: } ! 366: ! 367: Hidden value text_dis(q) txptr q; { ! 368: char aq[2]; txptr tp= txdbuf; value t= Vnil, t1, t2; ! 369: aq[1]= '\0'; *aq= Char(tx++); ! 370: fbuf: while (tx < q && Char(tx) != *aq) { ! 371: if (Char(tx) == '`') { ! 372: if (Char(tx+1) == '`') tx++; ! 373: else { ! 374: *tp= '\0'; ! 375: concat_to(&t, txdbuf); ! 376: t= concat(t1= t, t2= conversion(q)); ! 377: release(t1); release(t2); ! 378: tp= txdbuf; goto fbuf; ! 379: } ! 380: } ! 381: *tp++= Char(tx++); ! 382: if (tp+1 >= txdbufend) { ! 383: *(txdbufend-1)= '\0'; ! 384: concat_to(&t, txdbuf); ! 385: tp= txdbuf; ! 386: } ! 387: } ! 388: if (tx >= q) parerr("cannot find matching ", aq); ! 389: if (++tx < q && Char(tx) == *aq) { ! 390: *tp++= Char(tx++); ! 391: goto fbuf; ! 392: } ! 393: *tp= '\0'; ! 394: concat_to(&t, txdbuf); ! 395: return t; ! 396: } ! 397: ! 398: Visible value conversion(q) txptr q; { ! 399: txptr f, t; value v, c; ! 400: thought('`'); ! 401: req("`", q, &f, &t); ! 402: v= expr(f); c= Ifxeq(convert(v, Yes, Yes)); ! 403: if (xeq) release(v); ! 404: tx= t; return c; ! 405: } ! 406: ! 407: Hidden value tl_dis(q) txptr q; { ! 408: txptr f, t, ff, tt; ! 409: intlet len, k; ! 410: thought('{'); ! 411: Skipsp(tx); ! 412: if (Char(tx) == '}') { ! 413: tx++; ! 414: return Ifxeq(mk_elt()); ! 415: } ! 416: req("}", q, &f, &t); ! 417: if (find("..", f, &ff, &tt)) { ! 418: value enu, lo, hi; ! 419: lo= basexpr(ff); ! 420: if (!xeq || Is_number(lo)) { ! 421: tx= tt; while (Char(tx) == '.') tx++; ! 422: hi= basexpr(f); ! 423: if (xeq) { ! 424: value entries; ! 425: if (!integral(lo)) ! 426: error("in {p..q}, p is a number but not an integer"); ! 427: if (!Is_number(hi)) ! 428: error("in {p..q}, p is a number but q is not"); ! 429: if (!integral(hi)) ! 430: error("in {p..q}, q is a number but not an integer"); ! 431: entries= diff(lo, hi); ! 432: if (compare(entries, one)>0) ! 433: error("in {p..q}, integer q < x < p"); ! 434: enu= mk_numrange(lo, hi); ! 435: release(entries); ! 436: } else enu= mk_elt(); ! 437: release(hi); release(lo); ! 438: } else if (Is_text(lo)) { ! 439: char a, z; ! 440: if (!character(lo)) ! 441: error("in {p..q}, p is a text but not a character"); ! 442: tx= tt; hi= basexpr(f); ! 443: if (!Is_text(hi)) ! 444: error("in {p..q}, p is a text but q is not"); ! 445: if (!character(hi)) ! 446: error("in {p..q}, q is a text but not a character"); ! 447: a= charval(lo); z= charval(hi); ! 448: if (z < a-1) error("in {p..q}, character q < x < p"); ! 449: enu= mk_charrange(lo, hi); ! 450: release(lo); release(hi); ! 451: } else error("in {p..q}, p is neither a number nor a text"); ! 452: tx= t; return enu; ! 453: } ! 454: len= 1+count(";", f); ! 455: Skipsp(tx); ! 456: if (Char(tx) == '[') { ! 457: value ta, ke, a; ! 458: ta= mk_elt(); ! 459: k_Over_len { ! 460: Skipsp(tx); ! 461: need("["); ! 462: req("]", f, &ff, &tt); ! 463: ke= expr(ff); tx= tt; ! 464: need(":"); ! 465: if (Last(k)) {ff= f; tt= t;} ! 466: else req(";", f, &ff, &tt); ! 467: a= basexpr(ff); tx= tt; ! 468: replace(a, &ta, ke); ! 469: release(ke); release(a); ! 470: } ! 471: return ta; ! 472: } ! 473: {value l, v; ! 474: l= mk_elt(); ! 475: k_Over_len { ! 476: if (Last(k)) {ff= f; tt= t;} ! 477: else req(";", f, &ff, &tt); ! 478: v= basexpr(ff); tx= tt; ! 479: insert(v, &l); ! 480: release(v); ! 481: } ! 482: return l; ! 483: } ! 484: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.