|
|
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.