![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b1obj.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 b1obj.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: 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.