Return to b1obj.c CVS log

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

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

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
        !             2: 
        !             3: /*
        !             4:   $Header: b1obj.c,v 1.4 85/08/22 16:52:13 timo Exp $
        !             5: */
        !             6: 
        !             7: /* Generic routines for all values */
        !             8: 
        !             9: #include "b.h"
        !            10: #include "b1obj.h"
        !            11: #ifndef INTEGRATION
        !            12: #include "b1btr.h"
        !            13: #include "b1val.h"
        !            14: #endif
        !            15: #include "b1tlt.h"
        !            16: #include "b3err.h"
        !            17: #include "b3typ.h"
        !            18: 
        !            19: #ifndef INTEGRATION
        !            20: 
        !            21: Visible bool comp_ok = Yes;            /* Temporary, to catch type errors */
        !            22: 
        !            23: relation comp_tlt(), comp_text();      /* From b1lta.c */
        !            24: 
        !            25: Hidden Procedure incompatible(v, w) value v, w; {
        !            26:        value message, m1, m2, m3, m4, m5, m6;
        !            27:        message= concat(m1= convert(m2= (value) valtype(v), No, No),
        !            28:                 m3= concat(m4= mk_text(" and "),
        !            29:                 m5= convert(m6= (value) valtype(w), No, No)));
        !            30:        error2(MESS(1400, "incompatible types "), message);
        !            31:        release(message);
        !            32:        release(m1); release(m2); release(m3);
        !            33:        release(m4); release(m5); release(m6);
        !            34: }
        !            35: 
        !            36: Visible relation compare(v, w) value v, w; {
        !            37:        literal vt, wt;
        !            38:        int i;
        !            39:        relation rel;
        !            40:        
        !            41:        comp_ok = Yes;
        !            42: 
        !            43:        if (v EQ w) return(0);
        !            44:        if (IsSmallInt(v) && IsSmallInt(w))
        !            45:                return SmallIntVal(v) - SmallIntVal(w);
        !            46:        vt = Type(v);
        !            47:        wt = Type(w);
        !            48:        switch (vt) {
        !            49:        case Num:
        !            50:                if (wt != Num) {
        !            51:  incomp:
        !            52:                        /*Temporary until static checks are implemented*/
        !            53:                        incompatible(v, w);
        !            54:                        comp_ok= No;
        !            55:                        return -1;
        !            56:                }
        !            57:                return(numcomp(v, w));
        !            58:        case Com:
        !            59:                if (wt != Com || Nfields(v) != Nfields(w)) goto incomp;
        !            60:                for (i = 0; i < Nfields(v); i++) {
        !            61:                        rel = compare(*Field(v, i), *Field(w, i));
        !            62:                        if (rel NE 0) return(rel);
        !            63:                }
        !            64:                return(0);
        !            65:        case Tex:
        !            66:                if (wt != Tex) goto incomp;
        !            67:                return(comp_text(v, w));
        !            68:        case Lis:
        !            69:                if (wt != Lis && wt != ELT) goto incomp;
        !            70:                return(comp_tlt(v, w));
        !            71:        case Tab:
        !            72:                if (wt != Tab && wt != ELT) goto incomp;
        !            73:                return(comp_tlt(v, w));
        !            74:        case ELT:
        !            75:                if (wt != Tab && wt != Lis && wt != ELT) goto incomp;
        !            76:                return(Root(w) EQ Bnil ? 0 : -1);
        !            77:        default: 
        !            78:                syserr(MESS(1401, "comparison of unknown types"));
        !            79:                /*NOTREACHED*/
        !            80:        }
        !            81: }
        !            82: 
        !            83: /* Used for set'random. Needs to be rewritten so that for small changes in v */
        !            84: /* you get large changes in hash(v) */
        !            85: 
        !            86: Visible double hash(v) value v; {
        !            87:        if (Is_number(v)) return numhash(v);
        !            88:        else if (Is_compound(v)) {
        !            89:                int len= Nfields(v), k; double d= .404*len;
        !            90:                k_Overfields {
        !            91:                        d= .874*d+.310*hash(*Field(v, k));
        !            92:                }
        !            93:                return d;
        !            94:        } else {
        !            95:                int len= length(v), k; double d= .404*len;
        !            96:                if (len == 0) return .909;
        !            97:                else if (Is_text(v)) {
        !            98:                        value ch;
        !            99:                        k_Over_len {
        !           100:                                ch= thof(k+1, v);
        !           101:                                d= .987*d+.277*charval(ch);
        !           102:                                release(ch);
        !           103:                        }
        !           104:                        return d;
        !           105:                } else if (Is_list(v)) {
        !           106:                        value el;
        !           107:                        k_Over_len {
        !           108:                                d= .874*d+.310*hash(el= thof(k+1, v));
        !           109:                                release(el);
        !           110:                        }
        !           111:                        return d;
        !           112:                } else if (Is_table(v)) {
        !           113:                        k_Over_len {
        !           114:                                d= .874*d+.310*hash(*key(v, k))
        !           115:                                         +.123*hash(*assoc(v, k));
        !           116:                        }
        !           117:                        return d;
        !           118:                } else {
        !           119:                        syserr(MESS(1402, "hash called with unknown type"));
        !           120:                        return (double) Dummy;
        !           121:                }
        !           122:        }
        !           123: }
        !           124: 
        !           125: Hidden Procedure concato(v, t) value* v; value t; {
        !           126:        value v1= *v;
        !           127:        *v= concat(*v, t);
        !           128:        release(v1);
        !           129: }
        !           130: 
        !           131: Visible value convert(v, coll, outer) value v; bool coll, outer; {
        !           132:        value t, quote, c, cv, sep, th, open, close; int k, len; char ch;
        !           133:        switch (Type(v)) {
        !           134:        case Num:
        !           135:                return mk_text(convnum(v));
        !           136:        case Tex:
        !           137:                if (outer) return copy(v);
        !           138:                quote= mk_text("\"");
        !           139:                len= length(v);
        !           140:                t= copy(quote);
        !           141:                for (k=1; k<=len; k++) {
        !           142:                        c= thof(k, v);
        !           143:                        ch= charval(c);
        !           144:                        concato(&t, c);
        !           145:                        if (ch == '"' || ch == '`') concato(&t, c);
        !           146:                        release(c);
        !           147:                }
        !           148:                concato(&t, quote);
        !           149:                release(quote);
        !           150:                break;
        !           151:        case Com:
        !           152:                len= Nfields(v);
        !           153:                outer&= coll;
        !           154:                sep= mk_text(outer ? " " : ", ");
        !           155:                t= mk_text(coll ? "" : "(");
        !           156:                k_Over_len {
        !           157:                        concato(&t, cv= convert(*Field(v, k), No, outer));
        !           158:                        release(cv);
        !           159:                        if (!Last(k)) concato(&t, sep);
        !           160:                }
        !           161:                release(sep);
        !           162:                if (!coll) {
        !           163:                        concato(&t, cv= mk_text(")"));
        !           164:                        release(cv);
        !           165:                }
        !           166:                break;
        !           167:        case Lis:
        !           168:        case ELT:
        !           169:                len= length(v);
        !           170:                t= mk_text("{");
        !           171:                sep= mk_text("; ");
        !           172:                for (k=1; k<=len; k++) {
        !           173:                        concato(&t, cv= convert(th= thof(k, v), No, No));
        !           174:                        release(cv); release(th);
        !           175:                        if (k != len) concato(&t, sep);
        !           176:                }
        !           177:                release(sep);
        !           178:                concato(&t, cv= mk_text("}"));
        !           179:                release(cv);
        !           180:                break;
        !           181:        case Tab:
        !           182:                len= length(v);
        !           183:                open= mk_text("[");
        !           184:                close= mk_text("]: ");
        !           185:                sep= mk_text("; ");
        !           186:                t= mk_text("{");
        !           187:                k_Over_len {
        !           188:                        concato(&t, open);
        !           189:                        concato(&t, cv= convert(*key(v, k), Yes, No));
        !           190:                        release(cv);
        !           191:                        concato(&t, close);
        !           192:                        concato(&t, cv= convert(*assoc(v, k), No, No));
        !           193:                        release(cv);
        !           194:                        if (!Last(k)) concato(&t, sep);
        !           195:                }
        !           196:                concato(&t, cv= mk_text("}")); release(cv);
        !           197:                release(open); release(close); release(sep);
        !           198:                break;
        !           199:        default:
        !           200:                if (bugs || testing) {
        !           201:                        t= mk_text("?");
        !           202:                        concato(&t, cv= mkchar(Type(v))); release(cv);
        !           203:                        concato(&t, cv= mkchar('$')); release(cv);
        !           204:                        break;
        !           205:                }
        !           206:                syserr(MESS(1403, "unknown type in convert"));
        !           207:        }
        !           208:        return t;
        !           209: }
        !           210: 
        !           211: Hidden value adj(v, w, side) value v, w; char side; {
        !           212:        value t, c, sp, r, i;
        !           213:        int len, wid, diff, left, right;
        !           214:        c= convert(v, Yes, Yes);
        !           215:        len= length(c);
        !           216:        wid= intval(w);
        !           217:        if (wid<=len) return c;
        !           218:        else {
        !           219:                diff= wid-len;
        !           220:                if (side == 'L') { left= 0; right= diff; }
        !           221:                else if (side == 'R') { left= diff; right= 0; }
        !           222:                else {left= diff/2; right= (diff+1)/2; }
        !           223:                sp= mk_text(" ");
        !           224:                if (left == 0) t= c;
        !           225:                else {
        !           226:                        t= repeat(sp, i= mk_integer(left)); release(i);
        !           227:                        concato(&t, c);
        !           228:                        release(c);
        !           229:                }
        !           230:                if (right != 0) {
        !           231:                        r= repeat(sp, i= mk_integer(right)); release(i);
        !           232:                        concato(&t, r);
        !           233:                        release(r);
        !           234:                }
        !           235:                release(sp);
        !           236:                return t;
        !           237:        }
        !           238: }
        !           239: 
        !           240: Visible value adjleft(v, w) value v, w; {
        !           241:        return adj(v, w, 'L');
        !           242: }
        !           243: 
        !           244: Visible value adjright(v, w) value v, w; {
        !           245:        return adj(v, w, 'R');
        !           246: }
        !           247: 
        !           248: Visible value centre(v, w) value v, w; {
        !           249:        return adj(v, w, 'C');
        !           250: }
        !           251: 
        !           252: #else INTEGRATION
        !           253: 
        !           254: #define Sgn(d) (d)
        !           255: 
        !           256: Visible relation compare(v, w) value v, w; {
        !           257:        literal vt= Type(v), wt= Type(w);
        !           258:        register intlet vlen, wlen, len, k;
        !           259:        value message;
        !           260:        vlen= IsSmallInt(v) ? 0 : Length(v);
        !           261:        wlen= IsSmallInt(w) ? 0 : Length(w);
        !           262:        if (v == w) return 0;
        !           263:        if (!(vt == wt && !(vt == Com && vlen != wlen) ||
        !           264:                            vt == ELT && (wt == Lis || wt == Tab) ||
        !           265:                            wt == ELT && (vt == Lis || vt == Tab))) {
        !           266:                message= concat(convert((value) valtype(v), No, No),
        !           267:                         concat(mk_text(" and "),
        !           268:                         convert((value) valtype(w), No, No)));
        !           269:                error2(MESS(1404, "incompatible types "), message);
        !           270:                       /*doesn't return: so can't release message*/
        !           271:        }
        !           272:        if (vt != Num && (vlen == 0 || wlen == 0))
        !           273:                return Sgn(vlen-wlen);
        !           274:        switch (vt) {
        !           275:        case Num: return numcomp(v, w);
        !           276:        case Tex: return strcmp(Str(v), Str(w));
        !           277: 
        !           278:        case Com:
        !           279:        case Lis:
        !           280:        case Tab:
        !           281:        case ELT:
        !           282:                {value *vp= Ats(v), *wp= Ats(w);
        !           283:                 relation c;
        !           284:                        len= vlen < wlen ? vlen : wlen;
        !           285:                        Overall if ((c= compare(*vp++, *wp++)) != 0) return c;
        !           286:                        return Sgn(vlen-wlen);
        !           287:                }
        !           288:        default:
        !           289:                syserr(MESS(1405, "comparison of unknown types"));
        !           290:                /* NOTREACHED */
        !           291:        }
        !           292: }
        !           293: 
        !           294: Visible double hash(v) value v; {
        !           295:        literal t= Type(v); intlet len= Length(v), k; double d= t+.404*len;
        !           296:        switch (t) {
        !           297:        case Num: return numhash(v);
        !           298:        case Tex:
        !           299:                {string vp= Str(v);
        !           300:                        Overall d= .987*d+.277*(*vp++);
        !           301:                        return d;
        !           302:                }
        !           303:        case Com:
        !           304:        case Lis:
        !           305:        case Tab:
        !           306:        case ELT:
        !           307:                {value *vp= Ats(v);
        !           308:                        if (len == 0) return .909;
        !           309:                        Overall d= .874*d+.310*hash(*vp++);
        !           310:                        return d;
        !           311:                }
        !           312:        default:
        !           313:                syserr(MESS(1406, "hash called with unknown type"));
        !           314:                /* NOTREACHED */
        !           315:        }
        !           316: }
        !           317: 
        !           318: #endif INTEGRATION

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.