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

   1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
   2: /* $Header: b2tar.c,v 1.1 84/06/28 00:49:23 timo Exp $ */
   3: 
   4: /* B target locating */
   5: #include "b.h"
   6: #include "b1obj.h"
   7: #include "b2env.h"
   8: #include "b2syn.h"
   9: #include "b2sem.h"
  10: 
  11: Visible loc statrimloc(l, v) loc l; value v; {
  12:     /* temporary, while no static type check */
  13:     return (loc) mk_elt();
  14: }
  15: 
  16: Visible loc statbseloc(l, k) loc l; value k; {
  17:     /* temporary, while no static type check */
  18:     return (loc) mk_elt();
  19: }
  20: 
  21: Visible loc targ(q) txptr q; {
  22:     value c; loc l; txptr i, j; intlet len, k;
  23:     if ((len= 1+count(",", q)) == 1) return bastarg(q);
  24:     c= mk_compound(len);
  25:     k_Overfields {
  26:         if (!Lastfield(k)) req(",", q, &i, &j);
  27:         else i= q;
  28:         l= bastarg(i);
  29:         put_in_field(l, &c, k);
  30:         if (!Lastfield(k)) tx= j;
  31:     }
  32:     return (loc) c;
  33: }
  34: 
  35: Visible loc bastarg(q) txptr q; {
  36:     loc l; txptr i, j; value k;
  37:     Skipsp(tx);
  38:     nothing(q, "target");
  39:     if (Char(tx) == '(') {
  40:         tx++; req(")", q, &i, &j);
  41:         l= targ(i); tx= j;
  42:     } else if (Letter(Char(tx))) {
  43:         value t= tag(), *aa;
  44:         aa= lookup(t);
  45:         if (aa == Pnil) l= local_loc(t);
  46:         else if (Is_refinement(*aa))
  47:             pprerr("refined targets are not allowed", "");
  48:         else if (Is_formal(*aa)) {
  49:             l= loc_formal(*aa);
  50:         } else if (Is_shared(*aa))
  51:             l= global_loc(t);
  52:         else l= local_loc(t);
  53:         release(t);
  54:     } else parerr("no target where expected", "");
  55:     Skipsp(tx);
  56:     while (tx < q && Char(tx) == '[') {
  57:         if (xeq) check_location(l);
  58:         tx++; req("]", q, &i, &j);
  59:         k= expr(i); tx= j;
  60:         if (xeq) {
  61:             loc ll= l;
  62:             l= tbsel_loc(l, k);
  63:             release(k); release(ll);
  64:         } else l= statbseloc(l, k);
  65:         Skipsp(tx);
  66:     }
  67:     if (tx < q && (Char(tx) == '@' || Char(tx) == '|')) {
  68:         value v= xeq ? content(l) : Vnil; intlet B, C;
  69:         if (xeq && !Is_text(v))
  70:           error("in the target t@p or t|p, t does not contain a text");
  71:         trimbc(q, xeq ? length(v) : 0, &B, &C);
  72:         release(v);
  73:         if (xeq) l= trim_loc(l, B, C);
  74:         else l= statrimloc(l, k);
  75:         Skipsp(tx);
  76:     }
  77:     if (tx < q) parerr(Char(tx) == ',' ? "comma not allowed here" :
  78:                     "garbage following target", "");
  79:     return l;
  80: }

Defined functions