/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */ /* * \$Header: b1lta.c,v 1.4 85/08/22 16:49:05 timo Exp \$ */ /* Access and update lists and tables */ #include "b.h" #include "b0con.h" #include "b1obj.h" #ifndef INTEGRATION #include "b1btr.h" #include "b1val.h" #include "b3err.h" #include "b3scr.h" /* For at_nwl */ #endif #include "b1tlt.h" #ifndef INTEGRATION #ifndef DEBUG #define check(v, where) /*nothing*/ #endif DEBUG #define IsInner(p) (Flag(p) == Inner) #define IsBottom(p) (Flag(p) == Bottom) #define _Pxitm(p, l, iw) (IsInner(p) ? Piitm(p, l, iw) : Pbitm(p, l, iw)) Hidden itemptr Pxitm(p, l, iw) btreeptr p; intlet l, iw; { return _Pxitm(p, l, iw); } #define Inil ((itemptr)0) #define Incr(p, n) ((p) += (n)) Visible width itemwidth[4]= {Cw, Lw, Tw, Kw}; /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ typedef struct { btreeptr s_ptr; int s_lim; } finger[Maxheight], *fingertip; #define Snil ((fingertip)0) #define Push(s, p, l) ((s)->s_ptr= (p), ((s)->s_lim= (l)), (s)++) #define Top(s, p, l) ((p)= ((s)-1)->s_ptr, (l)= ((s)-1)->s_lim) #define Drop(s) (--(s)) #define Pop(s, p, l) (--(s), (p)= (s)->s_ptr, (l)= (s)->s_lim) /* Pop(s, p, l) is equivalent to Top(s, p, l); Drop(s) */ /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ Visible fingertip unzip(p, at, s) btreeptr p; int at; fingertip s; { int syz; intlet l; if (p == Bnil) return s; for (;;) { if (at <= 0) l= 0; else if (at >= Size(p)) l= Lim(p); else if (IsInner(p)) { l= 0; while (at > (syz= Size(Ptr(p, l)))) { ++l; at -= syz+1; } } else if (at >= Lim(p)) l= Lim(p) - 1; /* for Irange/Crange */ else l= at; /* Assume Bottom */ Push(s, p, l); if (!IsInner(p)) break; p= Ptr(p, l); } return s; } Visible Procedure cpynptrs(to, from, n) btreeptr *to, *from; int n; { while (--n >= 0) { *to= copybtree(*from); Incr(to, 1); Incr(from, 1); } } Visible int movnptrs(to, from, n) btreeptr *to, *from; int n; { int syz= 0; /* Collects sum of sizes */ while (--n >= 0) { *to= *from; syz += Size(*from); Incr(to, 1); Incr(from, 1); } return syz; } /* The following two routines may prove machine-dependent when moving N pointers is not equivalent to moving N*sizeof(pointer) characters. Also, the latter may be slower. */ Visible Procedure movnitms(to, from, n, iw) itemptr to, from; intlet n, iw; { register char *t= (char *)to, *f= (char *)from; n *= iw; while (--n >= 0) *t++ = *f++; } Hidden Procedure shift(p, l, iw) btreeptr p; intlet l, iw; { /* Move items and pointers from l upwards one to the right */ btreeptr *to, *from; intlet n= (Lim(p)-l) * iw; bool inner= IsInner(p); char *f= (char *) Pxitm(p, Lim(p), iw); char *t= f+iw; while (--n >= 0) *--t = *--f; if (inner) { from= &Ptr(p, Lim(p)); to= from; Incr(to, 1); n= Lim(p)-l; while (--n >= 0) { *to= *from; Incr(to, -1); Incr(from, -1); } } } Visible Procedure cpynitms(to, from, n, it) itemptr to, from; intlet n, it; { intlet i, iw= Itemwidth(it); movnitms(to, from, n, iw); switch (it) { case Lt: case Kt: case Tt: for (i= 0; i < n; ++i) { copy(Keyval(to)); if (it == Tt) copy(Ascval(to)); else if (it == Kt) Ascval(to)= Vnil; to= (itemptr) ((char*)to + iw); } } } /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Uflow uses a character array to hold the items. This may be wrong. */ Visible Procedure uflow(n, l, cbuf, pbuf, it) intlet n, l; char cbuf[]; btreeptr pbuf[]; intlet it; { char ncbuf[3*Maxbottom*sizeof(item)], *cp= ncbuf; btreeptr npbuf[3*Maxinner], *pp= npbuf, q; intlet iw= Itemwidth(it); bool inner= IsInner(pbuf[0]); intlet i, j, k, nn, l1= l>0 ? l-1 : l, l2= l 0) { movnitms((itemptr)(cbuf+(l1+i-1)*iw), (itemptr)cp, 1, iw); cp += iw; --nn; } pbuf[l1+i]= q= grabbtreenode(inner ? Inner : Bottom, it); Lim(q)= Size(q)= j= nn/(k-i); nn -= j; movnitms(Pxitm(q, 0, iw), (itemptr)cp, j, iw); cp += j*iw; if (inner) { Size(q) += movnptrs(&Ptr(q, 0), pp, j+1); Incr(pp, j+1); } } if (k < l2-l1+1) { movnitms((itemptr)(cbuf+(l1+k-1)*iw), (itemptr)(cbuf+l2*iw), n-l2, iw); VOID movnptrs(pbuf+l1+k, pbuf+l2+1, n-l2); n -= l2-l1+1 - k; } return n; } /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Low level access routines */ /* Meaning of 'flags' parameter to searchkey: */ #define NORMAL 0 #define UNIQUE 1 /* uniquify visited nodes */ #define DYAMAX 2 /* special for dyadic max (= previous element) */ #define DYAMIN 4 /* special for dyadic min (= next element) */ Hidden bool searchkey(v, pw, flags, ft) value v, *pw; int flags; fingertip *ft; { btreeptr p, *pp; intlet l, mid, h, it= Itemtype(*pw), iw= Itemwidth(it); bool inner; relation r; pp= &Root(*pw); if (*pp == Bnil) return No; if (flags&UNIQUE) { killranges(pw); uniql(pw); pp= &Root(*pw); } for (;;) { if (flags&UNIQUE) uniqlbtreenode(pp, it); p= *pp; inner= IsInner(p); l= 0; h= Lim(p); r= 1; /* For the (illegal?) case that there are no items */ while (l < h) { /* Binary search in {l..h-1} */ mid= (l+h)/2; r= compare(v, Keyval(Pxitm(p, mid, iw))); if (!comp_ok) return No; if (r == 0) { /* Found it */ if (flags&(DYAMIN|DYAMAX)) { /* Pretend not found */ if (flags&DYAMIN) r= 1; else r= -1; } else { /* Normal case, report success */ l= mid; break; } } if (r < 0) h= mid; /* Continue in {l..mid-1} */ else if (r > 0) l= mid+1; /* Cont. in {mid+1..h-i} */ } Push(*ft, p, l); if (r == 0) return Yes; if (!inner) { switch (Flag(p)) { case Irange: return h > 0 && l < Lim(p) && integral(v); case Crange: return h > 0 && l < Lim(p) && character(v); default: case Bottom: return No; } } pp= &Ptr(p, l); } } Hidden Procedure killranges(pv) value *pv; { btreeptr p= Root(*pv); if (p == Bnil) return; switch (Flag(p)) { case Crange: killCrange(p, pv); break; case Irange: killIrange(p, pv); break; } } Hidden Procedure killCrange(p, pv) btreeptr p; value *pv; { value w; intlet lwbchar= Lwbchar(p), upbchar= Upbchar(p); release(*pv); *pv= mk_elt(); do { w= mkchar(lwbchar); insert(w, pv); release(w); } while (++lwbchar <= upbchar); } Hidden Procedure killIrange(p, pv) btreeptr p; value *pv; { value w, lwb= copy(Lwbval(p)), upb= copy(Upbval(p)); release(*pv); *pv= mk_elt(); do { insert(lwb, pv); if (compare(lwb, upb) >= 0) break; w= lwb; lwb= sum(lwb, one); release(w); } while (still_ok); release(lwb); release(upb); } /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ Hidden btreeptr rem(f, ft, it) fingertip f, ft; intlet it; { btreeptr p, q, *pp; itemptr ip; intlet l, iw= Itemwidth(it); bool inner, underflow; Pop(ft, p, l); inner= IsInner(p); if (!inner) ip= Pbitm(p, l, iw); else { ip= Piitm(p, l, iw); do { Push(ft, p, l); uniqlbtreenode(pp= &Ptr(p, l), it); p= *pp; l= Lim(p); } while (IsInner(p)); inner= No; l -= 2; /* So the movnitms below works fine */ } release(Keyval(ip)); if (it == Tt || it == Kt) release(Ascval(ip)); --Lim(p); movnitms(ip, Pbitm(p, l+1, iw), Lim(p)-l, iw); for (;;) { underflow= Lim(p) < (inner ? Mininner : Minbottom); --Size(p); if (ft == f) break; Pop(ft, p, l); if (underflow) Lim(p)= uflow(Lim(p), l, (string)Piitm(p, 0, iw), &Ptr(p, 0), it); inner= Yes; } if (Lim(p) == 0) { /* Reduce tree level */ q= p; p= inner ? copybtree(Ptr(p, 0)) : Bnil; relbtree(q, it); } return p; } Hidden btreeptr ins(ip, f, ft, it) itemptr ip; fingertip f, ft; intlet it; { item new, old; btreeptr p, q= Bnil, pq, oldq, *pp; intlet l, iw= Itemwidth(it), nn, np, nq; bool inner, overflow; if (ft == f) { /* unify with rest? */ p= grabbtreenode(Bottom, it); movnitms(Pbitm(p, 0, iw), ip, 1, iw); Lim(p)= Size(p)= 1; return p; } Pop(ft, p, l); while (IsInner(p)) { Push(ft, p, l); uniqlbtreenode(pp= &Ptr(p, l), it); p= *pp; l= Lim(p); } overflow= Yes; inner= No; for (;;) { pq= p; if (overflow) { oldq= q; movnitms(&old, ip, 1, iw); ip= &new; overflow= Lim(p) == (inner ? Maxinner : Maxbottom); if (overflow) { nn= Lim(p); np= nn/2; nq= nn-np-1; q= grabbtreenode(inner ? Inner : Bottom, it); Size(q)= Lim(q)= nq; movnitms(&new, Pxitm(p, np, iw), 1, iw); movnitms(Pxitm(q, 0, iw), Pxitm(p, np+1, iw), nq, iw); if (inner) Size(q) += movnptrs(&Ptr(q, 0), &Ptr(p, np+1), nq+1); Lim(p)= np; Size(p) -= Size(q)+1; if (l > np) { l -= np+1; pq= q; } } shift(pq, l, iw); movnitms(Pxitm(pq, l, iw), &old, 1, iw); ++Lim(pq); if (inner) { Size(p) -= Size(oldq); Size(pq) += movnptrs(&Ptr(pq, l+1), &oldq, 1); } } ++Size(pq); if (ft == f) break; Pop(ft, p, l); inner= Yes; } if (overflow) p= mknewroot(p, ip, q, it); return p; } /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Tables */ Visible Procedure replace(a, pt, k) value a, *pt, k; { item new; finger f; fingertip ft= f; btreeptr p; value *pp; intlet it, iw, l; check(*pt, " (replace in)"); if (Is_ELT(*pt)) { (*pt)->type= Tab; Itemtype(*pt)= Tt; } it= Itemtype(*pt); if (searchkey(k, pt, UNIQUE, &ft)) { iw= Itemwidth(it); Pop(ft, p, l); pp= &Ascval(Pxitm(p, l, iw)); release(*pp); *pp= copy(a); } else { if (!comp_ok) return; Keyval(&new)= copy(k); Ascval(&new)= copy(a); Root(*pt)= ins(&new, f, ft, it); } check(*pt, " (replace out)"); } Visible /*bool*/ delete(pt, k) value *pt, k; { finger f; fingertip ft= f; intlet it= Itemtype(*pt); check(*pt, " (delete in)"); if (!searchkey(k, pt, UNIQUE, &ft)) return No; Root(*pt)= rem(f, ft, it); check(*pt, " (delete out)"); return Yes; } /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Lists */ Visible Procedure insert(v, pl) value v, *pl; { item new; finger f; fingertip ft= f; intlet it= Itemtype(*pl); check(*pl, " (insert in)"); if (Is_ELT(*pl)) (*pl)->type= Lis; VOID searchkey(v, pl, UNIQUE, &ft); if (!comp_ok) return; Keyval(&new)= copy(v); Ascval(&new)= Vnil; Root(*pl)= ins(&new, f, ft, it); check(*pl, " (insert out)"); } Visible Procedure remove(v, pl) value v, *pl; { if (!delete(pl, v) && still_ok) error(MESS(100, "removing non-existent list entry")); } /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Miscellaneous accesses */ Hidden itemptr findkey(key, pv, flags) value key, *pv; int flags; { finger f; fingertip ft= f; btreeptr p; intlet it= Itemtype(*pv), iw= Itemwidth(it), l; if (!searchkey(key, pv, flags, &ft)) return Inil; Pop(ft, p, l); return Pxitm(p, l, iw); } Visible value associate(t, k) value t, k; { /* t[k] */ itemptr ip; if (!Is_table(t)) { error(MESS(101, "in t[k], t is not a table")); return Vnil; } ip= findkey(k, &t, NORMAL); if (!ip) { if (still_ok) /* Could be type error; then shut up! */ error(MESS(102, "key not in table")); return Vnil; } return copy(Ascval(ip)); } Visible value* adrassoc(t, k) value t, k; { /* &t[k] */ itemptr ip= findkey(k, &t, NORMAL); if (!ip) return Pnil; return &Ascval(ip); } Visible bool uniq_assoc(t, k) value t, k; { /* uniql(&t[k]) */ itemptr ip= findkey(k, &t, UNIQUE); if (ip == Inil) return No; uniql(&Ascval(ip)); return Yes; } Visible bool in_keys(k, t) value k, t; { /* k in keys t */ return findkey(k, &t, NORMAL) != Inil; } Visible value keys(t) value t; { /* keys t */ value v; if (!Is_table(t)) { error(MESS(103, "in keys t, t is not a table")); return Vnil; } v= grab_tlt(Lis, Kt); Root(v)= copybtree(Root(t)); return v; } /* WARNING! The following routine is not reentrant, since (for range lists) it may return a pointer to static storage. */ Hidden itemptr getkth(k, v) int k; value v; { finger f; fingertip ft; btreeptr p; intlet it= Itemtype(v), iw= Itemwidth(it), l; static item baked; value vk; if (Root(v) == Bnil) return Inil; ft= unzip(Root(v), k, f); do { if (ft == f) return Inil; Pop(ft, p, l); } while (l >= Lim(p)); switch (Flag(p)) { default: case Inner: case Bottom: return Pxitm(p, l, iw); case Irange: release(Keyval(&baked)); Keyval(&baked)= sum(Lwbval(p), vk= mk_integer(k)); release(vk); return &baked; case Crange: release(Keyval(&baked)); Keyval(&baked)= mkchar(Lwbchar(p) + k); return &baked; } } Visible value* key(v, k) value v; intlet k; { /* &(++k th'of keys v) */ itemptr ip= getkth(k, v); return ip ? &Keyval(ip) : Pnil; } Visible value* assoc(v, k) value v; intlet k; { /* &v[++k th'of keys v] */ itemptr ip= getkth(k, v); return ip ? &Ascval(ip) : Pnil; } Visible value thof(k, v) int k; value v; { /* k th'of v */ itemptr ip= getkth(k-1, v); if (!ip) return Vnil; switch (Type(v)) { case Tex: return mkchar(Charval(ip)); case Lis: return copy(Keyval(ip)); case Tab: return copy(Ascval(ip)); default: return Vnil; } } /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Compare B-trees. Should use fingers, but to keep things simple (especially in the presence of range type nodes), doesn't. This makes its behaviour O(N log N), where it could be O(N), alas. */ /* WARNING! getkth may return a pointer to static storage (when retrieving elements from a range list). Therefore after the second call to getkth, the return value of the first may be invalid, but only for lists. So we extract the 'Key' values immediately after the call to getkth. */ Visible relation comp_tlt(u, v) value u, v; { itemptr up, vp; int k, ulen, vlen, len; relation r= 0; bool tex= Is_text(u), tab= Is_table(u); value key_u; len= ulen= Tltsize(u); vlen= Tltsize(v); if (vlen < len) len= vlen; for (k= 0; k < len; ++k) { up= getkth(k, u); if (!tex) key_u= copy(Keyval(up)); vp= getkth(k, v); if (tex) r= Charval(up) - Charval(vp); else { r= compare(key_u, Keyval(vp)); release(key_u); if (tab && r == 0) r= compare(Ascval(up), Ascval(vp)); } if (r != 0) break; } if (r == 0) r= ulen - vlen; return r; } /* Compare texts. When both texts are bottom nodes, compare with strncmp(), to speed up the most common use (look-up by the system of tags in a symbol table). Otherwise, call comp_tlt(). */ Visible relation comp_text(u, v) value u, v; { btreeptr p, q; int len; relation r; if (!Is_text(u) || !Is_text(v)) syserr(MESS(104, "comp_text")); p= Root(u), q= Root(v); if (p EQ Bnil) return (q EQ Bnil) ? 0 : -1; if (q EQ Bnil) return 1; if (Flag(p) EQ Bottom && Flag(q) EQ Bottom) { len= Lim(p); if (Lim(q) < len) len= Lim(q); r= strncmp(&Bchar(p, 0), &Bchar(q, 0), len); if (r NE 0) return r; return Lim(p) - Lim(q); } return comp_tlt(u, v); } /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Range type nodes */ Visible value mk_numrange(lwb, upb) value lwb, upb; { value lis; btreeptr proot; lis= grab_tlt(Lis, Lt); if (numcomp(lwb, upb) > 0) Root(lis)= Bnil; else { Root(lis)= proot= grabbtreenode(Irange, Lt); Lwbval(proot)= copy(lwb); Upbval(proot)= copy(upb); set_size_and_lim(proot); } return(lis); } /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ Visible value mk_charrange(lwb, upb) value lwb, upb; { value lis; btreeptr proot; intlet rsyz; lis= grab_tlt(Lis, Lt); rsyz= Bchar(Root(upb), 0) - Bchar(Root(lwb), 0) + 1; if (rsyz <= 0) Root(lis)= Bnil; else { Root(lis)= proot= grabbtreenode(Crange, Lt); Size(proot)= rsyz; Lim(proot)= rsyz > 1 ? 2 : 1; Lwbval(proot)= copy(lwb); Upbval(proot)= copy(upb); } return lis; } /* set size and lim for integer range node */ Hidden Procedure set_size_and_lim(pnode) btreeptr pnode; { value uml, uml1; uml= diff(Upbval(pnode), Lwbval(pnode)); uml1= sum(uml, one); if (large(uml1)) { Size(pnode)= Bigsize; Lim(pnode)= 2; error(MESS(105, "creating list of too many entries")); } else { Size(pnode)= intval(uml1); Lim(pnode)= Size(pnode) > 1 ? 2 : 1; } release(uml); release(uml1); } /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Dyadic min, max, size of lists */ Visible value l2min(e, v) value e, v; { /* e min v */ finger f; fingertip ft= f; btreeptr p; intlet it= Itemtype(v), iw= Itemwidth(it), l; VOID searchkey(e, &v, DYAMIN, &ft); for (;;) { if (ft == f) return Vnil; Top(ft, p, l); if (l < Lim(p)) { switch (Flag(p)) { case Inner: return copy(Keyval(Piitm(p, l, iw))); case Bottom: return copy(Keyval(Pbitm(p, l, iw))); case Irange: if (l == 0) return copy(Lwbval(p)); if (integral(e)) return sum(e, one); return ceilf(e); case Crange: if (l == 0) return copy(Lwbval(p)); return mkchar(Bchar(Root(e), 0) + 1); } } Drop(ft); } } Visible value l2max(e, v) value e, v; { /* e max v */ finger f; fingertip ft= f; btreeptr p; intlet it= Itemtype(v), iw= Itemwidth(it), l; VOID searchkey(e, &v, DYAMAX, &ft); for (;;) { if (ft == f) return Vnil; Top(ft, p, l); --l; if (l >= 0) { switch (Flag(p)) { case Inner: return copy(Keyval(Piitm(p, l, iw))); case Bottom: return copy(Keyval(Pbitm(p, l, iw))); case Irange: if (l == 1) return copy(Upbval(p)); if (integral(e)) return diff(e, one); return floorf(e); case Crange: if (l == 1) return copy(Upbval(p)); return mkchar(Bchar(Root(e), 0) - 1); } } Drop(ft); } } Visible int l2size(e, v) value e, v; { /* e#v */ finger f; fingertip ft= f; btreeptr p; int count= 0; intlet it= Itemtype(v), iw= Itemwidth(it), l, r; VOID searchkey(e, &v, DYAMIN, &ft); for (;;) { if (ft == f) return count; Pop(ft, p, l); while (--l >= 0) { r= compare(Keyval(Pxitm(p, l, iw)), e); if (r != 0) { switch (Flag(p)) { case Irange: /* See footnote */ if (l==0 && count==0 && integral(e)) ++count; break; case Crange: /* See footnote */ if (l==0 && count==0 && !character(e)) ++count; break; } return count; } ++count; while (IsInner(p)) { Push(ft, p, l); p= Ptr(p, l); l= Lim(p); } } } } /* Clarification of what happens for x#{a..b}: * Consider these five cases: x= 1; if a