![[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 / bsmall|
Return to B1tlt.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bsmall |
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
2: /* $Header: B1tlt.c,v 1.1 84/06/28 00:49:00 timo Exp $ */
3:
4: #include "b.h"
5: #include "b1obj.h"
6: #include "B1tlt.h"
7:
8: Visible value mk_elt() { return grab_elt(); }
9:
10: Visible value size(x) value x; { /* monadic # operator */
11: if (!Is_tlt(x)) error("in #t, t is not a text, list or table");
12: return mk_integer((int) Length(x));
13: }
14:
15: #define Lisent(tp,k) (*(tp+(k)))
16:
17: Visible value size2(v, t) value v, t; { /* Dyadic # operator */
18: intlet len= Length(t), n= 0, k; value *tp= Ats(t);
19: if (!Is_tlt(t)) error("in e#t, t is not a text, list or table");
20: switch (t->type) {
21: case Tex:
22: {string cp= (string)tp; char c;
23: if (v->type != Tex)
24: error("in e#t, t is a text but e is not");
25: if (Length(v) != 1) error(
26: "in e#t, e is a text but not a character");
27: c= *Str(v);
28: Overall if (*cp++ == c) n++;
29: } break;
30: case ELT:
31: break;
32: case Lis:
33: {intlet lo= -1, mi, xx, mm, hi= len; relation c;
34: bins: if (hi-lo < 2) break;
35: mi= (lo+hi)/2;
36: if ((c= compare(v, Lisent(tp,mi))) == 0) goto some;
37: if (c < 0) hi= mi; else lo= mi;
38: goto bins;
39: some: xx= mi;
40: while (xx-lo > 1) {
41: mm= (lo+xx)/2;
42: if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
43: else lo= mm;
44: }
45: xx= mi;
46: while (hi-xx > 1) {
47: mm= (xx+hi)/2;
48: if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
49: else hi= mm;
50: }
51: n= hi-lo-1;
52: } break;
53: case Tab:
54: Overall if (compare(v, Dts(*tp++)) == 0) n++;
55: break;
56: default:
57: syserr("e#t with non text, list or table");
58: break;
59: }
60: return mk_integer((int) n);
61: }
62:
63: Hidden bool less(r) relation r; { return r<0; }
64: Hidden bool greater(r) relation r; { return r>0; }
65:
66: Hidden value mm1(t, rel) value t; bool (*rel)(); {
67: intlet len= Length(t), k; value m, *tp= Ats(t);
68: switch (t->type) {
69: case Tex:
70: {string cp= (string) tp; char mc= '\0', mm[2];
71: Overall {
72: if (mc == '\0' || ((*rel)(*cp < mc ? -1 : (*cp > mc ? 1 : 0))))
73: mc= *cp;
74: cp++;
75: }
76: mm[0]= mc; mm[1]= '\0';
77: m= mk_text(mm);
78: } break;
79: case Lis:
80: if ((*rel)(-1)) /*min*/ m= copy(*Ats(t));
81: else m= copy(*(Ats(t)+len-1));
82: break;
83: case Tab:
84: {value dm= Vnil;
85: Overall {
86: if (dm == Vnil || (*rel)(compare(Dts(*tp), dm)))
87: dm= Dts(*tp);
88: tp++;
89: }
90: m= copy(dm);
91: } break;
92: default:
93: syserr("min or max t, with non text, list or table");
94: }
95: return m;
96: }
97:
98: Hidden value mm2(v, t, rel) value v, t; bool (*rel)(); {
99: intlet len= Length(t), k; value m= Vnil, *tp= Ats(t);
100: switch (t->type) {
101: case Tex:
102: {string cp= (string) tp; char c, mc= '\0', mm[2];
103: c= *Str(v);
104: Overall {
105: if ((*rel)(c < *cp ? -1 : c > *cp ? 1 : 0)) {
106: if (mc == '\0' || (*rel)(*cp < mc ? -1 : *cp>mc ? 1 : 0))
107: mc= *cp;
108: }
109: cp++;
110: }
111: if (mc != '\0') {
112: mm[0]= mc; mm[1]= '\0';
113: m= mk_text(mm);
114: }
115: } break;
116: case Lis:
117: {intlet lim1, mid, lim2;
118: if ((*rel)(-1)) { /*min*/
119: lim1= 1; lim2= len-1;
120: } else {
121: lim2= 1; lim1= len-1;
122: }
123: if (!(*rel)(compare(v, Lisent(tp,lim2)))) break;
124: if (len == 1 || (*rel)(compare(v, Lisent(tp,lim1)))) {
125: m= copy(Lisent(tp,lim1));
126: break;
127: }
128: /* v rel tp[lim2] && !(v rel tp[lim1]) */
129: while (abs(lim2-lim1) > 1) {
130: mid= (lim1+lim2)/2;
131: if ((*rel)(compare(v, Lisent(tp,mid)))) lim2= mid;
132: else lim1= mid;
133: }
134: m= copy(Lisent(tp,lim2));
135: } break;
136: case Tab:
137: {value dm= Vnil;
138: Overall {
139: if ((*rel)(compare(v, Dts(*tp)))) {
140: if (dm == Vnil ||
141: (*rel)(compare(Dts(*tp), dm)))
142: dm= Dts(*tp);
143: }
144: tp++;
145: }
146: if (dm != Vnil) m= copy(dm);
147: } break;
148: default:
149: syserr("min2 or max2 with non text, list or table");
150: break;
151: }
152: return m;
153: }
154:
155: Visible value min1(t) value t; { /* Monadic min */
156: if (!Is_tlt(t)) error("in min t, t is not a text, list or table");
157: if (Length(t) == 0) error("in min t, t is empty");
158: return mm1(t, less);
159: }
160:
161: Visible value min2(v, t) value v, t; {
162: value m;
163: if (!Is_tlt(t)) error("in e min t, t is not a text, list or table");
164: if (Length(t) == 0) error("in e min t, t is empty");
165: if (Is_text(t)) {
166: if (!Is_text(v)) error("in e min t, t is a text but e is not");
167: if (Length(v) != 1) error("in e min t, e is a text but not a character");
168: }
169: m= mm2(v, t, less);
170: if (m == Vnil) error("in e min t, no element of t exceeds e");
171: return m;
172: }
173:
174: Visible value max1(t) value t; {
175: if (!Is_tlt(t)) error("in max t, t is not a text, list or table");
176: if (Length(t) == 0) error("in max t, t is empty");
177: return mm1(t, greater);
178: }
179:
180: Visible value max2(v, t) value v, t; {
181: value m;
182: if (!Is_tlt(t)) error("in e max t, t is not a text, list or table");
183: if (Length(t) == 0) error("in e max t, t is empty");
184: if (Is_text(t)) {
185: if (!Is_text(v)) error("in e max t, t is a text but e is not");
186: if (Length(v) != 1) error("in e max t, e is a text but not a character");
187: }
188: m= mm2(v, t, greater);
189: if (m == Vnil) error("in e max t, no element of t is less than e");
190: return m;
191: }
192:
193: Visible value th_of(n, t) value n, t; {
194: return thof(intval(n), t);
195: }
196:
197: Visible value thof(n, t) int n; value t; {
198: intlet len= Length(t); value w;
199: if (!Is_tlt(t)) error("in n th'of t, t is not a text, list or table");
200: if (n <= 0 || n > len) error("in n th'of t, n is out of bounds");
201: switch (t->type) {
202: case Tex:
203: {char ww[2];
204: ww[0]= *(Str(t)+n-1); ww[1]= '\0';
205: w= mk_text(ww);
206: } break;
207: case Lis:
208: w= copy(*(Ats(t)+n-1));
209: break;
210: case Tab:
211: w= copy(Dts(*(Ats(t)+n-1)));
212: break;
213: default:
214: syserr("th'of with non text, list or table");
215: }
216: return w;
217: }
218:
219: Visible bool found(elem, v, probe, where)
220: value (*elem)(), v, probe; intlet *where;
221: /* think of elem(v,lo-1) as -Infinity and elem(v,hi+1) as +Infinity.
222: found and where at the end satisfy:
223: SELECT:
224: SOME k IN {lo..hi} HAS probe = elem(v,k):
225: found = Yes AND where = k
226: ELSE: found = No AND elem(v,where-1) < probe < elem(v,where).
227: */
228: {relation c; intlet lo=0, hi= Length(v)-1;
229: if (lo > hi) { *where= lo; return No; }
230: if ((c= compare(probe, (*elem)(v, lo))) == 0) {*where= lo; return Yes; }
231: if (c < 0) { *where=lo; return No; }
232: if (lo == hi) { *where=hi+1; return No; }
233: if ((c= compare(probe, (*elem)(v, hi))) == 0) { *where=hi; return Yes; }
234: if (c > 0) { *where=hi+1; return No; }
235: /* elem(lo) < probe < elem(hi) */
236: while (hi-lo > 1) {
237: if ((c= compare(probe, (*elem)(v, (lo+hi)/2))) == 0) {
238: *where= (lo+hi)/2; return Yes;
239: }
240: if (c < 0) hi= (lo+hi)/2; else lo= (lo+hi)/2;
241: }
242: *where= hi; return No;
243: }
244:
245: Visible bool in(v, t) value v, t; {
246: intlet where, k, len= Length(t); value *tp= Ats(t);
247: if (!Is_tlt(t)) error("in the test e in t, t is not a text, list or table");
248: switch (t->type) {
249: case Tex:
250: if (v->type != Tex)
251: error("in the test e in t, t is a text but e is not");
252: if (Length(v) != 1)
253: error("in the test e in t, e is a text but not a character");
254: return index((string) tp, *Str(v)) != 0;
255: case ELT:
256: return No;
257: case Lis:
258: return found(list_elem, t, v, &where);
259: case Tab:
260: Overall if (compare(v, Dts(*tp++)) == 0) return Yes;
261: return No;
262: default:
263: syserr("e in t with non text, list or table");
264: return No;
265: }
266: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.