Return to b2tcE.c CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / new / B / src / bint

Annotation of 43BSDTahoe/new/B/src/bint/b2tcE.c, revision 1.1

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.