![[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.