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

##### Functions

    empty             X
    length            X
    loctype           X
    must_agree        X
    valtype           X

##### Macros

    Tnil              X

       1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
       2: /* $Header: b2typ.c,v 1.1 84/06/28 00:49:27 timo Exp $ */
       3:
       4: /* Type matching */
       5: #include "b.h"
       6: #include "b1obj.h"
       7: #include "b2env.h"
       8: #include "b2sem.h"
       9: #include "b2typ.h"
      10:
      11: #define Tnil ((btype) Vnil)
      12:
      13: Forward btype valtype();
      14:
      15: /* All the routines in this file are temporary */
      16: /* Thus length() and empty() have been put here too */
      17:
      18: Visible int length(v) value v; {
      19:     value s= size(v);
      20:     int len= intval(s);
      21:     release(s);
      22:     return len;
      23: }
      24:
      25: Visible bool empty(v) value v; {
      26:     value s= size(v);
      27:     bool b= large(s) || intval(s)!=0;
      28:     release(s);
      29:     return !b;
      30: }
      31:
      32: Visible btype loctype(l) loc l; {
      33:     value *ll;
      34:     if (Is_simploc(l)) {
      35:         simploc *sl= Simploc(l);
      36:         if (!in_env(sl->e->tab, sl->i, &ll)) return Tnil;
      37:         return valtype(*ll);
      38:     } else if (Is_tbseloc(l)) {
      39:         tbseloc *tl= Tbseloc(l);
      40:         btype tt= loctype(tl->R), associate;
      41:         if (tt == Tnil) return Tnil;
      42:         if (!empty(tt)) associate= th_of(one, tt);
      43:         else associate= Tnil;
      44:         release(tt);
      45:         return associate;
      46:     } else if (Is_trimloc(l)) {
      47:         return mk_text("");
      48:     } else if (Is_compound(l)) {
      49:         btype ct= mk_compound(Nfields(l)); intlet k, len= Nfields(l);
      50:         k_Overfields { put_in_field(loctype(*field(l, k)), &ct, k); }
      51:         return ct;
      52:     } else {
      53:         syserr("loctype asked of non-target");
      54:         return Tnil;
      55:     }
      56: }
      57:
      58: Visible btype valtype(v) value v; {
      59:     if (Is_number(v)) return mk_integer(0);
      60:     else if (Is_text(v)) return mk_text("");
      61:     else if (Is_compound(v)) {
      62:         btype ct= mk_compound(Nfields(v)); intlet k, len= Nfields(v);
      63:         k_Overfields { put_in_field(valtype(*field(v, k)), &ct, k); }
      64:         return ct;
      65:     } else if (Is_ELT(v)) {
      66:         return mk_elt();
      67:     } else if (Is_list(v)) {
      68:         btype tt= mk_elt(), vt, ve;
      69:         if (!empty(v)) {
      70:             insert(vt= valtype(ve= min1(v)), &tt);
      71:             release(vt); release(ve);
      72:         }
      73:         return tt;
      74:     } else if (Is_table(v)) {
      75:         btype tt= mk_elt(), vk, va;
      76:         if (!empty(v)) {
      77:             vk= valtype(*key(v, 0));
      78:             va= valtype(*assoc(v, 0));
      79:             replace(va, &tt, vk);
      80:             release(vk); release(va);
      81:         }
      82:         return tt;
      83:     } else {
      84:         syserr("valtype called with unknown type");
      85:         return Tnil;
      86:     }
      87: }
      88:
      89: Visible must_agree(t, u, m) btype t, u; string m; {
      90:     intlet k, len;
      91:     value vt, vu;
      92:     if (t == Tnil || u == Tnil || t == u) return;
      93:     if ((Is_number(t) && Is_number(u))
      94:      || (Is_text(t) && Is_text(u))
      95:      || (Is_ELT(u) && (Is_ELT(t) || Is_list(t) || Is_table(t)))
      96:      || (Is_ELT(t) && (Is_ELT(u) || Is_list(u) || Is_table(u)))) return;
      97:     else if (Is_compound(t) && Is_compound(u)) {
      98:         if ((len= Nfields(t)) != Nfields(u)) error(m);
      99:         else k_Overfields { must_agree(*field(t,k), *field(u,k), m); }
     100:     } else {
     101:         if (Is_list(t) && Is_list(u)) {
     102:             if (!empty(t) && !empty(u)) {
     103:                 must_agree(vt= min1(t), vu= min1(u), m);
     104:                 release(vt); release(vu);
     105:             }
     106:         } else if (Is_table(t) && Is_table(u)) {
     107:             if (!empty(t) && !empty(u)) {
     108:                 must_agree(*key(t, 0), *key(u, 0), m);
     109:                 must_agree(*assoc(t, 0), *assoc(u, 0), m);
     110:             }
     111:         } else error(m);
     112:     }
     113: }

#### Defined functions

empty defined in line 25; used 9 times

- in line 42, 69, 76, 102-107(4)
- in /usr/src/new/PORT/B/src/bsmall/b1obj.h line 176
- in /usr/src/new/PORT/B/src/bsmall/b2loc.c line 41

length defined in line 18; used 15 times

- in /usr/src/new/PORT/B/src/bsmall/b1obj.h line 175
- in /usr/src/new/PORT/B/src/bsmall/b2env.c line 108
- in /usr/src/new/PORT/B/src/bsmall/b2err.c line 48
- in /usr/src/new/PORT/B/src/bsmall/b2exp.c line 260
- in /usr/src/new/PORT/B/src/bsmall/b2fil.c line 104, 118, 136
- in /usr/src/new/PORT/B/src/bsmall/b2loc.c line 92
- in /usr/src/new/PORT/B/src/bsmall/b2sou.c line 336, 446, 485
- in /usr/src/new/PORT/B/src/bsmall/b2tar.c line 71
- in /usr/src/new/PORT/B/src/bsmall/b2tes.c line 189
- in /usr/src/new/PORT/B/src/bsmall/b2uni.c line 534, 549

loctype defined in line 32; used 4 times

- in line 40, 50
- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 158
- in /usr/src/new/PORT/B/src/bsmall/b2typ.h line 8

must_agree defined in line 89; used 6 times

- in line 99-109(4)
- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 68, 164

valtype defined in line 58; used 11 times

- in line 13, 37, 63, 70, 77-78(2)
- in /usr/src/new/PORT/B/src/bsmall/B1obj.c line 21-23(2)
- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 61, 162
- in /usr/src/new/PORT/B/src/bsmall/b2typ.h line 7

#### Defined macros

Tnil defined in line 11; used 8 times

- in line 36-43(4), 54, 85, 92(2)

Last modified: 1985-08-27 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 743 |