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: }
|
Last modified: 1985-08-27
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 3044 |
|