```   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 {
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
loctype defined in line 32; used 4 times
must_agree defined in line 89; used 6 times
valtype defined in line 58; used 11 times

#### Defined macros

Tnil defined in line 11; used 8 times
 Last modified: 1985-08-27 Generated: 2016-12-26 Generated by src2html V0.67 page hit count: 1048