```   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: }
```

#### Defined functions

greater defined in line 64; used 2 times
less defined in line 63; used 2 times
max1 defined in line 174; used 1 times
max2 defined in line 180; used 1 times
min2 defined in line 161; used 1 times
mm1 defined in line 66; used 2 times
mm2 defined in line 98; used 2 times
size2 defined in line 17; used 1 times
th_of defined in line 193; used 5 times
value defined in line 219; used 53 times

#### Defined macros

Lisent defined in line 15; used 8 times
 Last modified: 1985-08-27 Generated: 2016-12-26 Generated by src2html V0.67 page hit count: 2232