4.3BSD - /usr/src/new/B/src/bsmall/B1tlt.c

   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

Defined macros