# 2.11BSD#431 - /usr/src/new/PORT/B/src/bint/b3typ.c

##### Functions

    length            X
    loctype           X
    must_agree        X
    valtype           X

##### Macros

    Tnil              X

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

#### Defined functions

length defined in line 21; used 19 times

- in /usr/src/new/PORT/B/src/bint/b1mem.c line 72-73(2)
- in /usr/src/new/PORT/B/src/bint/b1obj.c line 95, 139, 169, 182, 215
- in /usr/src/new/PORT/B/src/bint/b1obj.h line 178
- in /usr/src/new/PORT/B/src/bint/b3env.c line 137, 150
- in /usr/src/new/PORT/B/src/bint/b3fil.c line 281
- in /usr/src/new/PORT/B/src/bint/b3sou.c line 55, 768, 785, 831, 838, 854, 879, 894

loctype defined in line 28; used 3 times

- in line 36, 46
- in /usr/src/new/PORT/B/src/bint/b3typ.h line 11

must_agree defined in line 85; used 5 times

- in line 95-105(4)
- in /usr/src/new/PORT/B/src/bint/b3scr.c line 416

valtype defined in line 54; used 12 times

- in line 16, 33, 59, 66, 73-74(2)
- in /usr/src/new/PORT/B/src/bint/b1obj.c line 27-29(2), 266-268(2)
- in /usr/src/new/PORT/B/src/bint/b3scr.c line 410
- in /usr/src/new/PORT/B/src/bint/b3typ.h line 10

#### Defined macros

Tnil defined in line 14; used 8 times

- in line 32-39(4), 50, 81, 88(2)

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