2.11BSD#431 - /usr/src/new/PORT/B/src/bsmall/B1lis.c

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

Defined functions