|
|
1.1 ! root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */ ! 2: /* $Header: B1lis.c,v 1.1 84/06/28 00:48:55 timo Exp $ */ ! 3: ! 4: /* B lists */ ! 5: #include "b.h" ! 6: #include "b1obj.h" ! 7: #include "B1tlt.h" ! 8: #include "b0con.h" ! 9: ! 10: Visible value list_elem(l, i) value l; intlet i; { ! 11: return List_elem(l, i); ! 12: } ! 13: ! 14: Visible insert(v, ll) value v, *ll; { ! 15: intlet len= Length(*ll); register value *lp, *lq; ! 16: intlet k; register intlet kk; ! 17: if (!Is_list(*ll)) error("inserting in non-list"); ! 18: VOID found(list_elem, *ll, v, &k); ! 19: if (Unique(*ll) && !Is_ELT(*ll)) { ! 20: xtndlt(ll, 1); ! 21: lq= Ats(*ll)+len; lp= lq-1; ! 22: for (kk= len; kk > k; kk--) *lq--= *lp--; ! 23: *lq= copy(v); ! 24: } else { ! 25: lp= Ats(*ll); ! 26: release(*ll); ! 27: *ll= grab_lis(++len); ! 28: lq= Ats(*ll); ! 29: for (kk= 0; kk < len; kk++) *lq++= copy (kk == k ? v : *lp++); ! 30: } ! 31: } ! 32: ! 33: Visible remove(v, ll) value v; value *ll; { ! 34: register value *lp, *lq; ! 35: intlet len; intlet k; ! 36: if (!Is_list(*ll)) error("removing from non-list"); ! 37: lp= Ats(*ll); len= Length(*ll); ! 38: if (len == 0) error("removing from empty list"); ! 39: if (!found(list_elem, *ll, v, &k)) ! 40: error("removing non-existing list entry"); ! 41: /* lp[k] = v */ ! 42: if (Unique(*ll)) { ! 43: release(*(lp+=k)); ! 44: for (k= k; k < len; k++) {*lp= *(lp+1); lp++;} ! 45: xtndlt(ll, -1); ! 46: } else { ! 47: intlet kk= k; ! 48: lq= Ats(*ll); ! 49: release(*ll); ! 50: *ll= grab_lis(--len); ! 51: lp= Ats(*ll); ! 52: Overall { ! 53: *lp++= copy (*lq++); ! 54: if (k == kk) lq++; ! 55: } ! 56: } ! 57: } ! 58: ! 59: Visible value mk_numrange(a, z) value a, z; { ! 60: value l= mk_elt(), m= copy(a), n; ! 61: ! 62: while (compare(m, z)<=0) { ! 63: insert(m, &l); ! 64: m= sum(n=m, one); ! 65: release(n); ! 66: } ! 67: release(m); ! 68: return l; ! 69: } ! 70: ! 71: Visible value mk_charrange(av, zv) value av, zv; { ! 72: char a= charval(av), z= charval(zv); ! 73: value l= grab_lis((intlet) (z-a+1)); register value *ep= Ats(l); ! 74: char m[2]; ! 75: m[1]= '\0'; ! 76: for (m[0]= a; m[0] <= z; m[0]++) { ! 77: *ep++= mk_text(m); ! 78: } ! 79: return l; ! 80: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.