|
|
1.1 ! root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */ ! 2: ! 3: /* $Header: b2fix.c,v 1.4 85/08/22 16:55:08 timo Exp $ */ ! 4: ! 5: /* Fix unparsed expr/test */ ! 6: ! 7: #include "b.h" ! 8: #include "b1obj.h" ! 9: #include "b2exp.h" ! 10: #include "b2nod.h" ! 11: #include "b2gen.h" /* Must be after b2nod.h */ ! 12: #include "b2par.h" /* For is_b_tag */ ! 13: #include "b3err.h" ! 14: #include "b3env.h" ! 15: #include "b3sem.h" ! 16: ! 17: Forward parsetree fix_expr(), fix_test(); ! 18: ! 19: Visible Procedure f_eunparsed(pt) parsetree *pt; { ! 20: f_unparsed(pt, fix_expr); ! 21: } ! 22: ! 23: Visible Procedure f_cunparsed(pt) parsetree *pt; { ! 24: f_unparsed(pt, fix_test); ! 25: } ! 26: ! 27: Hidden Procedure f_unparsed(pt, fct) parsetree *pt, (*fct)(); { ! 28: parsetree t= *pt; unpadm adm; ! 29: struct state v; ! 30: /* Ignore visits done during resolving UNPARSED: */ ! 31: hold(&v); ! 32: initunp(&adm, *Branch(t, UNP_SEQ)); ! 33: t= (*fct)(&adm); ! 34: release(*pt); ! 35: *pt= t; ! 36: jumpto(NilTree); ! 37: let_go(&v); ! 38: } ! 39: ! 40: /* ******************************************************************** */ ! 41: ! 42: #define Fld *Field(Node(adm), N_fld(adm)) ! 43: #define Is_fld (N_fld(adm) < Nfields(Node(adm))) ! 44: #define Get_fld(v) v= copy(Fld); N_fld(adm)++ ! 45: ! 46: Hidden Procedure initunp(adm, root) unpadm *adm; value root; { ! 47: Prop(adm)= No; ! 48: Node(adm)= root; ! 49: N_fld(adm)= 0; ! 50: } ! 51: ! 52: /* ******************************************************************** */ ! 53: ! 54: Hidden bool f_dyafun(v, s, fct) value v, *fct; string s; { ! 55: value t= Vnil; ! 56: bool is= Is_text(v) && compare(v, t= mk_text(s)) == 0 && is_dyafun(v, fct); ! 57: release(t); ! 58: return is; ! 59: } ! 60: ! 61: Hidden bool f_dyatag(v, fct) value v, *fct; { ! 62: return Is_text(v) && is_b_tag(v) && is_dyafun(v, fct); ! 63: } ! 64: ! 65: Visible bool is_b_tag(v) value v; { ! 66: value a, b, c; bool x; ! 67: /* REPORT v|1 in {'a' .. 'z'} */ ! 68: a= mk_charrange(b= mk_text("a"), c= mk_text("z")); ! 69: release(b); release(c); ! 70: x= in(b= curtail(v, one), a); ! 71: release(a); release(b); ! 72: return x; ! 73: } ! 74: ! 75: /* ******************************************************************** */ ! 76: ! 77: Hidden Procedure fix_formula(adm, v, fct, lev, right) ! 78: unpadm *adm; parsetree *v, (*right)(); value fct; intlet lev; { ! 79: ! 80: parsetree w; value name; ! 81: if (Level(adm) < lev) fixerr(Prio); ! 82: Get_fld(name); ! 83: w= (*right)(adm); ! 84: if (Trim(adm)) *v= node3(b_behead(name) ? BEHEAD : CURTAIL, *v, w); ! 85: else *v= node5(DYAF, *v, name, w, copy(fct)); ! 86: } ! 87: ! 88: /* ******************************************************************** */ ! 89: ! 90: Hidden bool b_expr_opr(v, fct) value v, *fct; { ! 91: return f_dyafun(v, "^^", fct) || f_dyafun(v, "><", fct) || ! 92: f_dyafun(v, "<<", fct) || f_dyafun(v, ">>", fct) || ! 93: f_dyatag(v, fct); ! 94: } ! 95: ! 96: Forward parsetree fix_term(), fix_factor(), fix_primary(), fix_base(); ! 97: ! 98: Hidden parsetree fix_expr(adm) unpadm *adm; { ! 99: parsetree v; value fct; ! 100: if (!Is_fld) { ! 101: fixerr(MESS(4700, "no expression where expected")); ! 102: return NilTree; ! 103: } ! 104: v= fix_term(adm); ! 105: if (Is_fld && b_expr_opr(Fld, &fct)) { ! 106: if (nodetype(v) == DYAF) fixerr(Prio); ! 107: fix_formula(adm, &v, fct, L_expr, fix_base); ! 108: } ! 109: if (Is_fld && !Prop(adm)) { ! 110: value f; ! 111: if (Is_text(Fld) && is_dyafun(Fld, &f)) fixerr(Prio); ! 112: else fixerr(MESS(4701, "something unexpected following expression")); ! 113: } ! 114: return v; ! 115: } ! 116: ! 117: Hidden parsetree fix_test(adm) unpadm *adm; { ! 118: parsetree v; value w= Vnil, f= Vnil; value *aa; ! 119: if (!Is_fld) { ! 120: fixerr(MESS(4702, "no test where expected")); ! 121: return NilTree; ! 122: } ! 123: if (Is_text(Fld)) { ! 124: Get_fld(v); ! 125: if (is_zerprd(v, &f)) { ! 126: if (Is_fld) ! 127: fixerr(MESS(4703, "something unexpected following test")); ! 128: return node3(TAGzerprd, v, copydef(f)); ! 129: } else if (aa= envassoc(refinements, v)) { ! 130: if (!Is_fld) return node3(TAGrefinement, v, copy(*aa)); ! 131: } else if (is_monprd(v, &f)) ! 132: return node4(MONPRD, v, fix_expr(adm), copydef(f)); ! 133: release(v); ! 134: N_fld(adm)--; ! 135: } ! 136: Prop(adm)= Yes; ! 137: v= fix_expr(adm); ! 138: Prop(adm)= No; ! 139: if (!(Is_fld && Is_text(Fld) && is_dyaprd(Fld, &f))) ! 140: fixerr(MESS(4704, "no test where expected")); ! 141: if (Is_fld) Get_fld(w); ! 142: return node5(DYAPRD, v, w, fix_expr(adm), copydef(f)); ! 143: } ! 144: ! 145: /* ******************************************************************** */ ! 146: ! 147: Hidden bool b_term_opr(v, fct) value v, *fct; { ! 148: return f_dyafun(v, "+", fct) || f_dyafun(v, "-", fct) || ! 149: f_dyafun(v, "^", fct); ! 150: } ! 151: ! 152: Hidden parsetree fix_term(adm) unpadm *adm; { ! 153: parsetree v; value fct; ! 154: v= fix_factor(adm); ! 155: while (Is_fld && b_term_opr(Fld, &fct)) ! 156: fix_formula(adm, &v, fct, L_term, fix_factor); ! 157: return v; ! 158: } ! 159: ! 160: /* ******************************************************************** */ ! 161: ! 162: Hidden parsetree fix_factor(adm) unpadm *adm; { ! 163: parsetree v; value fct; ! 164: v= fix_primary(adm); ! 165: while (Is_fld && f_dyafun(Fld, "*", &fct)) ! 166: fix_formula(adm, &v, fct, L_factor, fix_primary); ! 167: if (Is_fld && f_dyafun(Fld, "/", &fct)) ! 168: fix_formula(adm, &v, fct, L_factor, fix_primary); ! 169: return v; ! 170: } ! 171: ! 172: /* ******************************************************************** */ ! 173: ! 174: Hidden parsetree fix_primary(adm) unpadm *adm; { ! 175: parsetree v; value fct; ! 176: v= fix_base(adm); ! 177: if (Is_fld && f_dyafun(Fld, "#", &fct)) ! 178: fix_formula(adm, &v, fct, L_number, fix_base); ! 179: if (Is_fld && f_dyafun(Fld, "**", &fct)) ! 180: fix_formula(adm, &v, fct, L_power, fix_base); ! 181: return v; ! 182: } ! 183: ! 184: /* ******************************************************************** */ ! 185: ! 186: Forward parsetree fix_rbase(); ! 187: ! 188: Hidden parsetree fix_base(adm) unpadm *adm; { ! 189: Level(adm)= L_expr; ! 190: Trim(adm)= No; ! 191: return fix_rbase(adm); ! 192: } ! 193: ! 194: Forward parsetree fix_monadic(); ! 195: ! 196: Hidden parsetree fix_rbase(adm) unpadm *adm; { ! 197: parsetree v, w= NilTree; value f; ! 198: if (!Is_fld && !Prop(adm)) { ! 199: fixerr(MESS(4705, "no expression where expected")); ! 200: return NilTree; ! 201: } ! 202: if (Is_parsetree(Fld)) { ! 203: f_expr(Branch(Node(adm), N_fld(adm))); ! 204: Get_fld(v); ! 205: fix_trim(adm, &v); ! 206: return v; ! 207: } ! 208: Get_fld(v); ! 209: if (modify_tag(v, &w)) fix_trim(adm, &w); ! 210: else if (is_monfun(v, &f)) w= fix_monadic(adm, v, f); ! 211: else { ! 212: fixerr2(v, MESS(4706, " has not yet received a value")); ! 213: release(v); ! 214: } ! 215: return w; ! 216: } ! 217: ! 218: Hidden Procedure adjust_level(adm, lev) unpadm *adm; intlet lev; { ! 219: if (lev < Level(adm)) Level(adm)= lev; ! 220: } ! 221: ! 222: Hidden parsetree fix_monadic(adm, v, fct) unpadm *adm; value v, fct; { ! 223: if (!Trim(adm)) { ! 224: if (b_minus(v)) adjust_level(adm, L_factor); ! 225: else if (b_number(v)) adjust_level(adm, L_power); ! 226: else if (!(b_plus(v) || b_about(v))) ! 227: adjust_level(adm, L_bottom); ! 228: } ! 229: if (!Trim(adm) && b_minus(v)) { ! 230: intlet lev= Level(adm); ! 231: parsetree t= node4(MONF, v, fix_primary(adm), copydef(fct)); ! 232: adjust_level(adm, lev); ! 233: return t; ! 234: } else ! 235: return node4(MONF, v, fix_rbase(adm), copydef(fct)); ! 236: } ! 237: ! 238: Hidden Procedure fix_trim(adm, v) unpadm *adm; parsetree *v; { ! 239: if (!Trim(adm)) { ! 240: Trim(adm)= Yes; ! 241: while (Is_fld && (b_behead(Fld) || b_curtail(Fld))) ! 242: fix_formula(adm, v, Vnil, L_bottom, fix_rbase); ! 243: Trim(adm)= No; ! 244: } ! 245: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.