# 2.11BSD#431 - /usr/src/new/PORT/B/src/bint/b1obj.c

##### Functions

    adj               X
    adjleft           X
    adjright          X
    centre            X
    compare           X
    concato           X
    convert           X
    hash              X
    incompatible      X

##### Variables

    comp_ok           X

##### Macros

    Sgn               X

       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

#### Defined functions

adj defined in line 211; used 3 times

- in line 241-249(3)

adjleft defined in line 240; used 1 times

- in /usr/src/new/PORT/B/src/bint/b1obj.h line 76

adjright defined in line 244; used 1 times

- in /usr/src/new/PORT/B/src/bint/b1obj.h line 78

centre defined in line 248; used 1 times

- in /usr/src/new/PORT/B/src/bint/b1obj.h line 77

compare defined in line 256; used 74 times

- in line 61, 285
- in /usr/src/new/PORT/B/src/bint/b1lta.c line 229, 284, 574-577(2), 732, 824, 834-841(3), 980
- in /usr/src/new/PORT/B/src/bint/b1obj.h line 12
- in /usr/src/new/PORT/B/src/bint/b1tlt.c line 212, 236, 259, 286, 307-309(2), 334-336(2), 385, 391, 397, 403, 435, 480-481(2), 488, 496-498(2), 613-620(3), 647
- in /usr/src/new/PORT/B/src/bint/b2dis.c line 193, 225(2)
- in /usr/src/new/PORT/B/src/bint/b2exp.c line 601
- in /usr/src/new/PORT/B/src/bint/b2fix.c line 56
- in /usr/src/new/PORT/B/src/bint/b2gen.c line 493
- in /usr/src/new/PORT/B/src/bint/b2stc.c line 357
- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 221
- in /usr/src/new/PORT/B/src/bint/b2tcP.c line 171-179(3), 185, 192-232(12), 239(2), 246(2)
- in /usr/src/new/PORT/B/src/bint/b3in2.c line 44
- in /usr/src/new/PORT/B/src/bint/b3int.c line 39
- in /usr/src/new/PORT/B/src/bint/b3loc.c line 113-114(3), 142-143(3), 203
- in /usr/src/new/PORT/B/src/bint/b3sou.c line 468, 570

concato defined in line 125; used 19 times

- in line 144-148(3), 157-163(3), 173-178(3), 188-196(6), 202-203(2), 227-232(2)

convert defined in line 131; used 14 times

- in line 27-29(2), 157, 173, 189-192(2), 214, 266-268(2)
- in /usr/src/new/PORT/B/src/bint/b1obj.h line 80
- in /usr/src/new/PORT/B/src/bint/b2tcP.c line 157
- in /usr/src/new/PORT/B/src/bint/b3err.c line 397
- in /usr/src/new/PORT/B/src/bint/b3int.c line 104, 259

hash defined in line 294; used 7 times

- in line 91, 108, 114-115(2), 309
- in /usr/src/new/PORT/B/src/bint/b1num.c line 291
- in /usr/src/new/PORT/B/src/bint/b1obj.h line 57

incompatible defined in line 25; used 1 times

- in line 53

#### Defined variables

comp_ok defined in line 21; used 2 times

- in line 41, 54

#### Defined macros

Sgn defined in line 254; used 2 times

- in line 273, 286

Last modified: 1985-08-27 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1207 |