4.3BSD - /usr/src/new/B/src/bint/b2tcE.c

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

Defined functions

Defined variables

Defined macros