![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b2tcE.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 / bint|
Return to b2tcE.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint |
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
2:
3: /*
4: $Header: b2tcE.c,v 1.4 85/08/22 16:56:55 timo Exp $
5: */
6:
7: /* process type unification errors */
8:
9: #include "b.h"
10: #include "b1obj.h"
11: #include "b2tcP.h"
12: #include "b2tcE.h"
13: #include "b2tcU.h"
14:
15: /*
16: * The variables from the users line are inserted in var_list.
17: * This is used to produce the right variable names
18: * in the error message.
19: * Call start_vars() when a new error context is established
20: * with the setting of curline.
21: */
22:
23: Hidden value var_list;
24:
25: Visible Procedure start_vars() {
26: var_list = mk_elt();
27: }
28:
29: Visible Procedure add_var(tvar) polytype tvar; {
30: insert(tvar, &var_list);
31: }
32:
33: Hidden bool in_vars(t) polytype t; {
34: return in(t, var_list);
35: }
36:
37: Visible Procedure end_vars() {
38: release(var_list);
39: }
40:
41: /* t_repr(u) is used to print polytypes when an error
42: * has occurred.
43: * Because the errors are printed AFTER unification, the variable
44: * polytypes in question have changed to the error-type.
45: * To print the real types in error, the table has to be
46: * saved in reprtable.
47: * The routines are called in unify().
48: */
49:
50: Hidden value reprtable;
51: extern value typeof; /* defined in b2tcP.c */
52:
53: Visible Procedure setreprtable() {
54: reprtable = copy(typeof);
55: }
56:
57: Visible Procedure delreprtable() {
58: release(reprtable);
59: }
60:
61: /* miscellaneous procs */
62:
63: Hidden value conc(v, w) value v, w; {
64: value c;
65: c = concat(v, w);
66: release(v); release(w);
67: return c;
68: }
69:
70: Hidden bool newvar(u) polytype u; {
71: value u1;
72: char ch;
73: u1 = curtail(ident(u), one);
74: ch = charval(u1);
75: release(u1);
76: return (bool) ('0' <= ch && ch <= '9');
77: }
78:
79: #define Known(tu) (!t_is_var(kind(tu)) && !t_is_error(kind(tu)))
80:
81: Hidden bool knowntype(u) polytype u; {
82: value tu;
83: tu = u;
84: while (t_is_var(kind(tu)) && in_keys(ident(tu), reprtable))
85: tu = *adrassoc(reprtable, ident(tu));
86: return Known(tu);
87: }
88:
89: Hidden bool outervar = Yes;
90:
91: Hidden value t_repr(u) polytype u; {
92: typekind u_kind;
93: value c;
94:
95: u_kind = kind(u);
96: if (t_is_number(u_kind)) {
97: return mk_text("0");
98: }
99: else if (t_is_text(u_kind)) {
100: return mk_text("''");
101: }
102: else if (t_is_tn(u_kind)) {
103: return mk_text("'' or 0");
104: }
105: else if (t_is_compound(u_kind)) {
106: intlet k, len = nsubtypes(u);
107: c = mk_text("(");
108: for (k = 0; k < len - 1; k++) {
109: c = conc(c, t_repr(subtype(u, k)));
110: c = conc(c, mk_text(", "));
111: }
112: c = conc(c, t_repr(subtype(u, k)));
113: return conc(c, mk_text(")"));
114: }
115: else if (t_is_error(u_kind)) {
116: return mk_text(" ");
117: }
118: else if (t_is_var(u_kind)) {
119: value tu;
120: tu = u;
121: while (t_is_var(kind(tu)) && in_keys(ident(tu), reprtable))
122: tu = *adrassoc(reprtable, ident(tu));
123: if (in_vars(u)) {
124: if (Known(tu)) {
125: if (outervar) {
126: outervar = No;
127: c = conc(t_repr(tu), mk_text(" for "));
128: outervar = Yes;
129: return conc(c, copy(ident(u)));
130: }
131: else
132: return t_repr(tu);
133: }
134: else {
135: return copy(ident(u));
136: }
137: }
138: else if (Known(tu))
139: return t_repr(tu);
140: else if (newvar(u))
141: return mk_text(" ");
142: else
143: return copy(ident(u));
144: }
145: else if (t_is_table(u_kind)) {
146: if (knowntype(keytype(u))) {
147: if (knowntype(asctype(u))) {
148: c = conc(mk_text("{["),
149: t_repr(keytype(u)));
150: c = conc(c, mk_text("]:"));
151: c = conc(c, t_repr(asctype(u)));
152: return conc(c, mk_text("}"));
153: }
154: else {
155: c = conc(mk_text("table with type "),
156: t_repr(keytype(u)));
157: return conc(c, mk_text(" keys"));
158: }
159: }
160: else if (knowntype(asctype(u))) {
161: c = conc(mk_text("table with type "),
162: t_repr(asctype(u)));
163: return conc(c, mk_text(" associates"));
164: }
165: else {
166: return mk_text("table");
167: }
168: }
169: else if (t_is_list(u_kind)) {
170: if (knowntype(asctype(u))) {
171: c = conc(mk_text("{"), t_repr(asctype(u)));
172: return conc(c, mk_text("}"));
173: }
174: else {
175: return mk_text("list");
176: }
177: }
178: else if (t_is_lt(u_kind)) {
179: if (knowntype(asctype(u)))
180: return conc(mk_text("list or table of "),
181: t_repr(asctype(u)));
182: else
183: return mk_text("{}");
184: }
185: else if (t_is_tlt(u_kind)) {
186: if (knowntype(asctype(u)))
187: return conc(mk_text("text list or table of "),
188: t_repr(asctype(u)));
189: else
190: return mk_text("text list or table");
191: }
192: else {
193: syserr(MESS(4300, "unknown polytype in t_repr"));
194: return mk_text("***");
195: }
196: }
197:
198: /* now, the real error messages */
199:
200: Visible Procedure badtyperr(a, b) polytype a, b; {
201: value t;
202:
203: /*error4("incompatible types: ", ta, ", and ", tb); */
204:
205: t = conc(t_repr(a), mk_text(" and "));
206: t = conc(t, t_repr(b));
207: error2(MESS(4301, "incompatible types "), t);
208: release(t);
209: }
210:
211: Visible Procedure cyctyperr(a) polytype a; {
212: value vcyc;
213:
214: vcyc = Vnil;
215: if (in_vars(a))
216: vcyc = ident(a);
217: else {
218: value n, m, nvars, v;
219: n = copy(one);
220: nvars = size(var_list);
221: while (compare(n, nvars) <= 0) {
222: v = th_of(n, var_list);
223: if (equal_vars(v, a) || contains(v, a)) {
224: vcyc = ident(v);
225: break;
226: }
227: m = n;
228: n = sum(n, one);
229: release(m); release(v);
230: }
231: release(n); release(nvars);
232: if (vcyc EQ Vnil) {
233: error2(MESS(4302, "unknown cyclic type"), ident(a));
234: syserr(MESS(4303, "unknown cyclic type"));
235: return;
236: }
237: }
238: error3(MESS(4304, "(sub)type of "), vcyc,
239: MESS(4305, " contains itself"));
240: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.