![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b1tlt.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 b1tlt.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: b1tlt.c,v 1.4 85/08/22 16:53:20 timo Exp $
5: */
6:
7: /* generic routines for B texts, lists and tables */
8:
9: #include "b.h"
10: #include "b0fea.h"
11: #include "b1obj.h"
12: #ifndef INTEGRATION
13: #include "b0con.h"
14: #include "b1btr.h"
15: #include "b1val.h"
16: #endif
17: #include "b1tlt.h"
18: #include "b3err.h"
19:
20: #ifndef INTEGRATION
21:
22: /* From b1lta.c */
23: int l2size();
24: value l2min(), l2max();
25:
26: Visible value mk_elt() { /* {}, internal only */
27: value e = grab_tlt(ELT, Lt);
28: Root(e) = Bnil;
29: return e;
30: }
31:
32: Visible bool empty(v) value v; { /* #v=0, internal only */
33: switch (Type(v)) {
34: case ELT:
35: case Lis:
36: case Tex:
37: case Tab:
38: return Root(v) EQ Bnil;
39: default:
40: return No;
41: /* Some routines must test empty(t) end return an error
42: message if it fails, before testing Type(t).
43: In this way, they won't give the wrong error message. */
44: }
45: }
46:
47: /* return size of (number of items in) dependent tree */
48:
49: Hidden value treesize(pnode) btreeptr pnode; {
50: int psize;
51: value vsize, childsize, u;
52: intlet l;
53: psize = Size(pnode);
54: if (psize EQ Bigsize) {
55: switch (Flag(pnode)) {
56: case Inner:
57: vsize = mk_integer((int) Lim(pnode));
58: for (l = 0; l <= Lim(pnode); l++) {
59: childsize = treesize(Ptr(pnode, l));
60: u = vsize;
61: vsize = sum(vsize, childsize);
62: release(u);
63: release(childsize);
64: }
65: break;
66: case Irange:
67: u = diff(Upbval(pnode), Lwbval(pnode));
68: vsize = sum(u, one);
69: release(u);
70: break;
71: case Bottom:
72: case Crange:
73: syserr(MESS(1700, "Bigsize in Bottom or Crange"));
74: }
75: return(vsize);
76: }
77: return mk_integer(psize);
78: }
79:
80: Visible value size(t) value t; { /* #t */
81: int tsize;
82: switch (Type(t)) {
83: case ELT:
84: case Lis:
85: case Tex:
86: case Tab:
87: tsize = Tltsize(t);
88: if (tsize EQ Bigsize) return treesize(Root(t));
89: return mk_integer(tsize);
90: default:
91: reqerr(MESS(1701, "in #t, t is not a text, list or table"));
92: return zero;
93: }
94: }
95:
96: Visible value th_of(num, v) value num, v; { /* num th'of v */
97: value m= Vnil;
98: if (!Is_tlt(v))
99: error(MESS(1702, "in n th'of t, t is not a text, list or table"));
100: else if (!Is_number(num))
101: error(MESS(1703, "in n th'of t, n is not a number"));
102: else if (empty(v))
103: error(MESS(1704, "in n th'of t, t is empty"));
104: else if (numcomp(num, one) < 0)
105: error(MESS(1705, "in n th'of t, n is < 1"));
106: else {
107: /*RANGES?*/
108: m= thof(intval(num), v);
109: if (m == Vnil && still_ok)
110: error(MESS(1706, "in n th'of t, n exceeds #t"));
111: }
112: return m;
113: }
114:
115: /*
116: * 'Walktree' handles functions on texts and associates of tables.
117: * The actual function performed is determined by the 'visit' function.
118: * The tree is walked (possibly recursively) and all items are visited.
119: * The return value of walktree() and visit() is used to determine whether
120: * the walk should continue (Yes == continue, No == stop now).
121: * Global variables are used to communicate the result, and the parameters
122: * of the function. The naming convention is according to "e func t".
123: */
124:
125: Hidden intlet tt; /* type of walked value t */
126: Hidden intlet wt; /* width of items in walked value t */
127: Hidden value ve; /* value of e, if func is dyadic */
128: Hidden char ce; /* C char in e, if t is a text */
129:
130: Hidden int count; /* result of size2 */
131: Hidden bool found; /* result for in */
132: Hidden intlet m_char; /* result for min/max on texts */
133: Hidden value m_val; /* result for min/max on tables */
134:
135: #define Lowchar (-Maxintlet) /* -infinity for characters */
136: #define Highchar (Maxintlet) /* +infinity */
137:
138: Hidden bool walktree(p, visit) btreeptr p; bool (*visit)(); {
139: intlet l;
140:
141: if (p EQ Bnil) return Yes; /* i.e., not found (used by in() !) */
142: for (l=0; l < Lim(p); l++) {
143: switch (Flag(p)) {
144: case Inner:
145: if (!walktree(Ptr(p, l), visit) || !still_ok)
146: return No;
147: if (!(*visit)(Piitm(p, l, wt)) || !still_ok)
148: return No;
149: break;
150: case Bottom:
151: if (!(*visit)(Pbitm(p, l, wt)) || !still_ok)
152: return No;
153: }
154: }
155: return Flag(p) EQ Bottom || walktree(Ptr(p, l), visit);
156: }
157:
158: /* Common code for min/max-1/2, size2, in. */
159:
160: Hidden Procedure tlt_func(e, t, where, li_func, te_visit, ta_visit)
161: value e, t; /* [e] func t */
162: string where; /* "in [e] func_name t" */
163: value (*li_func)(); /* func for lists */
164: bool (*te_visit)(), (*ta_visit)(); /* 'visit' for walktree */
165: {
166: m_val = Vnil;
167: if (empty(t)) {
168: error3(MESSMAKE(where), Vnil, MESS(1707, ", t is empty"));
169: return;
170: }
171: wt = Itemwidth(Itemtype(t));
172: tt = Type(t);
173: switch (tt) {
174: case Lis:
175: m_val = (*li_func)(e, t);
176: break;
177: case Tex:
178: if (e NE Vnil) {
179: if (!Character(e)) {
180: error3(MESSMAKE(where), Vnil,
181: MESS(1708, ", t is a text, but e is not a character"));
182: return;
183: }
184: ce = Bchar(Root(e), 0);
185: }
186: found = !walktree(Root(t), te_visit);
187: if (m_char NE Lowchar && m_char NE Highchar)
188: m_val = mkchar(m_char);
189: break;
190: case Tab:
191: ve = e;
192: found = !walktree(Root(t), ta_visit);
193: break;
194: default:
195: error3(MESSMAKE(where), Vnil,
196: MESS(1709, ", t is not a text list or table"));
197: }
198: }
199:
200: Hidden value li2size(e, t) value e, t; {
201: count = l2size(e, t);
202: return Vnil;
203: }
204:
205: Hidden bool te2size(pitm) itemptr pitm; {
206: if (ce EQ Charval(pitm))
207: count++;
208: return Yes;
209: }
210:
211: Hidden bool ta2size(pitm) itemptr pitm; {
212: if (compare(ve, Ascval(pitm)) EQ 0)
213: count++;
214: return Yes;
215: }
216:
217: Visible value size2(e, t) value e, t; { /* e#t */
218: if (empty(t)) /* Must check here because tlt_func would complain */
219: return copy(zero);
220: m_char = Lowchar;
221: count = 0;
222: tlt_func(e, t, "in e#t", li2size, te2size, ta2size);
223: return mk_integer(count);
224: }
225:
226: Hidden value li_in(e, t) value e, t; {
227: found = in_keys(e, t);
228: return Vnil;
229: }
230:
231: Hidden bool te_in(pitm) itemptr pitm; {
232: return Charval(pitm) NE ce;
233: }
234:
235: Hidden bool ta_in(pitm) itemptr pitm; {
236: return compare(ve, Ascval(pitm)) NE 0;
237: }
238:
239: Visible bool in(e, t) value e, t; {
240: if (empty(t)) /* Must check here because tlt_func would complain */
241: return No;
242: m_char = Lowchar;
243: found = No;
244: tlt_func(e, t, "in the test e in t", li_in, te_in, ta_in);
245: return found;
246: }
247:
248: Hidden value li_min(e, t) value e, t; {
249: return th_of(one, t);
250: }
251:
252: Hidden bool te_min(pitm) itemptr pitm; {
253: if (m_char > Charval(pitm))
254: m_char = Charval(pitm);
255: return Yes;
256: }
257:
258: Hidden bool ta_min(pitm) itemptr pitm; {
259: if (m_val EQ Vnil || compare(m_val, Ascval(pitm)) > 0) {
260: release(m_val);
261: m_val = copy(Ascval(pitm));
262: }
263: return Yes;
264: }
265:
266: Visible value min1(t) value t; {
267: m_char = Highchar;
268: tlt_func(Vnil, t, "in min t", li_min, te_min, ta_min);
269: return m_val;
270: }
271:
272: Hidden value li_max(e, t) value e, t; {
273: value v= size(t);
274: m_val = th_of(v, t);
275: release(v);
276: return m_val;
277: }
278:
279: Hidden bool te_max(pitm) itemptr pitm; {
280: if (m_char < Charval(pitm))
281: m_char = Charval(pitm);
282: return Yes;
283: }
284:
285: Hidden bool ta_max(pitm) itemptr pitm; {
286: if (m_val EQ Vnil || compare(Ascval(pitm), m_val) > 0) {
287: release(m_val);
288: m_val = copy(Ascval(pitm));
289: }
290: return Yes;
291: }
292:
293: Visible value max1(t) value t; {
294: m_char = Lowchar;
295: tlt_func(Vnil, t, "in max t", li_max, te_max, ta_max);
296: return m_val;
297: }
298:
299: Hidden bool te2min(pitm) itemptr pitm; {
300: if (m_char > Charval(pitm) && Charval(pitm) > ce) {
301: m_char = Charval(pitm);
302: }
303: return Yes;
304: }
305:
306: Hidden bool ta2min(pitm) itemptr pitm; {
307: if (compare(Ascval(pitm), ve) > 0
308: &&
309: (m_val EQ Vnil || compare(m_val, Ascval(pitm)) > 0)) {
310: release(m_val);
311: m_val = copy(Ascval(pitm));
312: }
313: return Yes;
314: }
315:
316: Visible value min2(e, t) value e, t; {
317: m_char = Highchar;
318: tlt_func(e, t, "in e min t", l2min, te2min, ta2min);
319: if (m_val EQ Vnil && still_ok)
320: reqerr(MESS(1710, "in e min t, no element of t exceeds e"));
321: return m_val;
322: }
323:
324: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
325:
326: Hidden bool te2max(pitm) itemptr pitm; {
327: if (ce > Charval(pitm) && Charval(pitm) > m_char) {
328: m_char = Charval(pitm);
329: }
330: return Yes;
331: }
332:
333: Hidden bool ta2max(pitm) itemptr pitm; {
334: if (compare(ve, Ascval(pitm)) > 0
335: &&
336: (m_val EQ Vnil || compare(Ascval(pitm), m_val) > 0)) {
337: release(m_val);
338: m_val = copy(Ascval(pitm));
339: }
340: return Yes;
341: }
342:
343: Visible value max2(e, t) value e, t; {
344: m_char = Lowchar;
345: tlt_func(e, t, "in e max t", l2max, te2max, ta2max);
346: if (m_val EQ Vnil && still_ok)
347: reqerr(MESS(1711, "in e max t, no element of t is less than e"));
348: return m_val;
349: }
350:
351: #else INTEGRATION
352:
353: Visible value mk_elt() { return grab_elt(); }
354:
355: Visible value size(x) value x; { /* monadic # operator */
356: if (!Is_tlt(x))
357: error(MESS(1712, "in #t, t is not a text, list or table"));
358: return mk_integer((int) Length(x));
359: }
360:
361: #define Lisent(tp,k) (*(tp+(k)))
362:
363: Visible value size2(v, t) value v, t; { /* Dyadic # operator */
364: intlet len= Length(t), n= 0, k; value *tp= Ats(t);
365: if (!Is_tlt(t)) {
366: error(MESS(1713, "in e#t, t is not a text, list or table"));
367: return mk_integer((int) n);
368: }
369: switch (Type(t)) {
370: case Tex:
371: {string cp= (string)tp; char c;
372: if (Type(v) != Tex)
373: error(MESS(1714, "in e#t, t is a text but e is not"));
374: if (Length(v) != 1)
375: error(MESS(1715, "in e#t, e is a text but not a character"));
376: c= *Str(v);
377: Overall if (*cp++ == c) n++;
378: } break;
379: case ELT:
380: break;
381: case Lis:
382: {intlet lo= -1, mi, xx, mm, hi= len; relation c;
383: bins: if (hi-lo < 2) break;
384: mi= (lo+hi)/2;
385: if ((c= compare(v, Lisent(tp,mi))) == 0) goto some;
386: if (c < 0) hi= mi; else lo= mi;
387: goto bins;
388: some: xx= mi;
389: while (xx-lo > 1) {
390: mm= (lo+xx)/2;
391: if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
392: else lo= mm;
393: }
394: xx= mi;
395: while (hi-xx > 1) {
396: mm= (xx+hi)/2;
397: if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
398: else hi= mm;
399: }
400: n= hi-lo-1;
401: } break;
402: case Tab:
403: Overall if (compare(v, Dts(*tp++)) == 0) n++;
404: break;
405: default:
406: syserr(MESS(1716, "e#t with non text, list or table"));
407: break;
408: }
409: return mk_integer((int) n);
410: }
411:
412: Hidden bool less(r) relation r; { return r<0; }
413: Hidden bool greater(r) relation r; { return r>0; }
414:
415: Hidden value mm1(t, rel) value t; bool (*rel)(); {
416: intlet len= Length(t), k; value m, *tp= Ats(t);
417: switch (Type(t)) {
418: case Tex:
419: {string cp= (string) tp; char mc= '\0', mm[2];
420: Overall {
421: if (mc == '\0' || ((*rel)(*cp < mc ? -1 : (*cp > mc ? 1 : 0))))
422: mc= *cp;
423: cp++;
424: }
425: mm[0]= mc; mm[1]= '\0';
426: m= mk_text(mm);
427: } break;
428: case Lis:
429: if ((*rel)(-1)) /*min*/ m= copy(*Ats(t));
430: else m= copy(*(Ats(t)+len-1));
431: break;
432: case Tab:
433: {value dm= Vnil;
434: Overall {
435: if (dm == Vnil || (*rel)(compare(Dts(*tp), dm)))
436: dm= Dts(*tp);
437: tp++;
438: }
439: m= copy(dm);
440: } break;
441: default:
442: syserr(MESS(1717, "min or max t, with non text, list or table"));
443: }
444: return m;
445: }
446:
447: #ifdef NO_ABS
448:
449: Hidden int abs(i) int i; {
450: return i >= 0 ? i : -i;
451: }
452:
453: #endif
454:
455: Hidden value mm2(v, t, rel) value v, t; bool (*rel)(); {
456: intlet len= Length(t), k; value m= Vnil, *tp= Ats(t);
457: switch (Type(t)) {
458: case Tex:
459: {string cp= (string) tp; char c, mc= '\0', mm[2];
460: c= *Str(v);
461: Overall {
462: if ((*rel)(c < *cp ? -1 : c > *cp ? 1 : 0)) {
463: if (mc == '\0' || (*rel)(*cp < mc ? -1 : *cp>mc ? 1 : 0))
464: mc= *cp;
465: }
466: cp++;
467: }
468: if (mc != '\0') {
469: mm[0]= mc; mm[1]= '\0';
470: m= mk_text(mm);
471: }
472: } break;
473: case Lis:
474: {intlet lim1, mid, lim2;
475: if ((*rel)(-1)) { /*min*/
476: lim1= 1; lim2= len-1;
477: } else {
478: lim2= 1; lim1= len-1;
479: }
480: if (!(*rel)(compare(v, Lisent(tp,lim2)))) break;
481: if (len == 1 || (*rel)(compare(v, Lisent(tp,lim1)))) {
482: m= copy(Lisent(tp,lim1));
483: break;
484: }
485: /* v rel tp[lim2] && !(v rel tp[lim1]) */
486: while (abs(lim2-lim1) > 1) {
487: mid= (lim1+lim2)/2;
488: if ((*rel)(compare(v, Lisent(tp,mid)))) lim2= mid;
489: else lim1= mid;
490: }
491: m= copy(Lisent(tp,lim2));
492: } break;
493: case Tab:
494: {value dm= Vnil;
495: Overall {
496: if ((*rel)(compare(v, Dts(*tp)))) {
497: if (dm == Vnil ||
498: (*rel)(compare(Dts(*tp), dm)))
499: dm= Dts(*tp);
500: }
501: tp++;
502: }
503: if (dm != Vnil) m= copy(dm);
504: } break;
505: default:
506: syserr(MESS(1718, "min2 or max2 with non text, list or table"));
507: break;
508: }
509: return m;
510: }
511:
512: Visible value min1(t) value t; { /* Monadic min */
513: value m= Vnil;
514: if (!Is_tlt(t))
515: error(MESS(1719, "in min t, t is not a text, list or table"));
516: else if (Length(t) == 0)
517: error(MESS(1720, "in min t, t is empty"));
518: else m= mm1(t, less);
519: return m;
520: }
521:
522: Visible value min2(v, t) value v, t; {
523: value m= Vnil;
524: if (!Is_tlt(t))
525: error(MESS(1721, "in e min t, t is not a text, list or table"));
526: else if (Length(t) == 0)
527: error(MESS(1722, "in e min t, t is empty"));
528: else if (Is_text(t)) {
529: if (!Is_text(v))
530: error(MESS(1723, "in e min t, t is a text but e is not"));
531: else if (Length(v) != 1)
532: error(MESS(1724, "in e min t, e is a text but not a character"));
533: }
534: if (still_ok) {
535: m= mm2(v, t, less);
536: if (m == Vnil)
537: error(MESS(1725, "in e min t, no element of t exceeds e"));
538: }
539: return m;
540: }
541:
542: Visible value max1(t) value t; {
543: value m= Vnil;
544: if (!Is_tlt(t))
545: error(MESS(1726, "in max t, t is not a text, list or table"));
546: else if (Length(t) == 0)
547: error(MESS(1727, "in max t, t is empty"));
548: else m= mm1(t, greater);
549: return m;
550: }
551:
552: Visible value max2(v, t) value v, t; {
553: value m= Vnil;
554: if (!Is_tlt(t))
555: error(MESS(1728, "in e max t, t is not a text, list or table"));
556: else if (Length(t) == 0)
557: error(MESS(1729, "in e max t, t is empty"));
558: else if (Is_text(t)) {
559: if (!Is_text(v))
560: error(MESS(1730, "in e max t, t is a text but e is not"));
561: else if (Length(v) != 1)
562: error(MESS(1731, "in e max t, e is a text but not a character"));
563: }
564: if (still_ok) {
565: m= mm2(v, t, greater);
566: if (m == Vnil)
567: error(MESS(1732, "in e max t, no element of t is less than e"));
568: }
569: return m;
570: }
571:
572: Visible value th_of(n, t) value n, t; {
573: return thof(intval(n), t);
574: }
575:
576: Visible value thof(n, t) int n; value t; {
577: intlet len= Length(t); value w= Vnil;
578: if (!Is_tlt(t))
579: error(MESS(1733, "in n th'of t, t is not a text, list or table"));
580: else if (n <= 0 || n > len)
581: error(MESS(1734, "in n th'of t, n is out of bounds"));
582: else {
583: switch (Type(t)) {
584: case Tex:
585: {char ww[2];
586: ww[0]= *(Str(t)+n-1); ww[1]= '\0';
587: w= mk_text(ww);
588: } break;
589: case Lis:
590: w= copy(*(Ats(t)+n-1));
591: break;
592: case Tab:
593: w= copy(Dts(*(Ats(t)+n-1)));
594: break;
595: default:
596: syserr(MESS(1735, "th'of with non text, list or table"));
597: }
598: }
599: return w;
600: }
601:
602: Visible bool found(elem, v, probe, where)
603: value (*elem)(), v, probe; intlet *where;
604: /* think of elem(v,lo-1) as -Infinity and elem(v,hi+1) as +Infinity.
605: found and where at the end satisfy:
606: SELECT:
607: SOME k IN {lo..hi} HAS probe = elem(v,k):
608: found = Yes AND where = k
609: ELSE: found = No AND elem(v,where-1) < probe < elem(v,where).
610: */
611: {relation c; intlet lo=0, hi= Length(v)-1;
612: if (lo > hi) { *where= lo; return No; }
613: if ((c= compare(probe, (*elem)(v, lo))) == 0) {*where= lo; return Yes; }
614: if (c < 0) { *where=lo; return No; }
615: if (lo == hi) { *where=hi+1; return No; }
616: if ((c= compare(probe, (*elem)(v, hi))) == 0) { *where=hi; return Yes; }
617: if (c > 0) { *where=hi+1; return No; }
618: /* elem(lo) < probe < elem(hi) */
619: while (hi-lo > 1) {
620: if ((c= compare(probe, (*elem)(v, (lo+hi)/2))) == 0) {
621: *where= (lo+hi)/2; return Yes;
622: }
623: if (c < 0) hi= (lo+hi)/2; else lo= (lo+hi)/2;
624: }
625: *where= hi; return No;
626: }
627:
628: Visible bool in(v, t) value v, t; {
629: intlet where, k, len= Length(t); value *tp= Ats(t);
630: if (!Is_tlt(t)) {
631: error(MESS(1736, "in the test e in t, t is not a text, list or table"));
632: return No;
633: }
634: switch (Type(t)) {
635: case Tex:
636: if (Type(v) != Tex)
637: error(MESS(1737, "in the test e in t, t is a text but e is not"));
638: else if (Length(v) != 1)
639: error(MESS(1738, "in the test e in t, e is a text but not a character"));
640: else return index((string) tp, *Str(v)) != 0;
641: return No;
642: case ELT:
643: return No;
644: case Lis:
645: return found(list_elem, t, v, &where);
646: case Tab:
647: Overall if (compare(v, Dts(*tp++)) == 0) return Yes;
648: return No;
649: default:
650: syserr(MESS(1739, "e in t with non text, list or table"));
651: return No;
652: }
653: }
654:
655: Visible bool empty(v) value v; {
656: switch (Type(v)) {
657: case Tex:
658: case Lis:
659: case Tab:
660: case ELT:
661: return (Length(v) == 0);
662: default:
663: syserr(MESS(1740, "empty() on non tlt value"));
664: return (No);
665: }
666: }
667:
668: #endif INTEGRATION
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.