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: }

Defined functions

adjust_level defined in line 218; used 4 times
b_expr_opr defined in line 90; used 1 times
b_term_opr defined in line 147; used 1 times
f_cunparsed defined in line 23; used 1 times
f_dyafun defined in line 54; used 11 times
f_dyatag defined in line 61; used 1 times
  • in line 93
f_eunparsed defined in line 19; used 1 times
f_unparsed defined in line 27; used 2 times
fix_base defined in line 188; used 5 times
fix_expr defined in line 98; used 5 times
fix_factor defined in line 162; used 3 times
fix_formula defined in line 77; used 7 times
fix_monadic defined in line 222; used 2 times
fix_primary defined in line 174; used 5 times
fix_rbase defined in line 196; used 4 times
fix_term defined in line 152; used 2 times
fix_test defined in line 117; used 2 times
fix_trim defined in line 238; used 2 times
initunp defined in line 46; used 1 times
  • in line 32
is_b_tag defined in line 65; used 5 times

Defined macros

Fld defined in line 42; used 15 times
Get_fld defined in line 44; used 5 times
Is_fld defined in line 43; used 15 times
Last modified: 1985-08-27
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1721
Valid CSS Valid XHTML 1.0 Strict