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

##### Functions

    are_same_types    X
    asctype           X
    bottom_var        X
    deltypetable      X
    has_lt            X
    has_number        X
    has_text          X
    have_same_structureX
    ident             X
    initpol           X
    keytype           X
    kind              X
    mkt_compound      X
    mkt_error         X
    mkt_list          X
    mkt_lt            X
    mkt_newvar        X
    mkt_number        X
    mkt_polytype      X
    mkt_table         X
    mkt_text          X
    mkt_tlt           X
    mkt_tn            X
    mkt_var           X
    nsubtypes         X
    p_copy            X
    p_release         X
    putsubtype        X
    repl_type_of      X
    subtype           X
    t_is_compound     X
    t_is_error        X
    t_is_list         X
    t_is_lt           X
    t_is_number       X
    t_is_table        X
    t_is_text         X
    t_is_tlt          X
    t_is_tn           X
    t_is_var          X
    table_has_type_of X
    type_of           X
    usetypetable      X

##### Variables

    nnewvar           X
    typeof            X

##### Macros

    Asc               X
    Id                X
    Ident             X
    Key               X
    Kin               X
    Kind              X
    Psubtypes         X
    Sub               X

       1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
       2:
       3: /*
       4:   $Header: b2tcP.c,v 1.4 85/08/22 16:57:02 timo Exp $
       5: */
       6:
       7: /* polytype representation */
       8:
       9: #include "b.h"
      10: #include "b1obj.h"
      11: #include "b2tcP.h"
      12:
      13: /* A polytype is a compound with two fields.
      14:  * The first field is a B text, and holds the typekind.
      15:  * If the typekind is 'Variable', the second field is
      16:  *   a B text, holding the identifier of the variable;
      17:  * otherwise, the second field is a compound of sub(poly)types,
      18:  *   indexed from 0 to one less then the number of subtypes.
      19:  */
      20:
      21: #define Kin 0
      22: #define Sub 1
      23: #define Id  Sub
      24: #define Asc 0
      25: #define Key 1
      26:
      27: #define Kind(u)     ((typekind) *Field((value) (u), Kin))
      28: #define Psubtypes(u)    (Field((value) (u), Sub))
      29: #define Ident(u)    (*Field((value) (u), Id))
      30:
      31: typekind var_kind;
      32: typekind num_kind;
      33: typekind tex_kind;
      34: typekind lis_kind;
      35: typekind tab_kind;
      36: typekind com_kind;
      37: typekind t_n_kind;
      38: typekind l_t_kind;
      39: typekind tlt_kind;
      40: typekind err_kind;
      41:
      42: polytype num_type;
      43: polytype tex_type;
      44: polytype err_type;
      45: polytype t_n_type;
      46:
      47: /* Making, setting and accessing (the fields of) polytypes */
      48:
      49: Visible polytype mkt_polytype(k, nsub) typekind k; intlet nsub; {
      50:     value u;
      51:
      52:     u = mk_compound(2);
      53:     *Field(u, Kin)= copy((value) k);
      54:     *Field(u, Sub)= mk_compound(nsub);
      55:     return ((polytype) u);
      56: }
      57:
      58: Procedure putsubtype(sub, u, isub) polytype sub, u; intlet isub; {
      59:     *Field(*Psubtypes(u), isub)= (value) sub;
      60: }
      61:
      62: typekind kind(u) polytype u; {
      63:     return (Kind(u));
      64: }
      65:
      66: intlet nsubtypes(u) polytype u; {
      67:     return (Nfields(*Psubtypes(u)));
      68: }
      69:
      70: polytype subtype(u, i) polytype u; intlet i; {
      71:     return ((polytype) *Field(*Psubtypes(u), i));
      72: }
      73:
      74: polytype asctype(u) polytype u; {
      75:     return (subtype(u, Asc));
      76: }
      77:
      78: polytype keytype(u) polytype u; {
      79:     return (subtype(u, Key));
      80: }
      81:
      82: value ident(u) polytype u; {
      83:     return (Ident(u));
      84: }
      85:
      86: /* making new polytypes */
      87:
      88: polytype mkt_number() {
      89:     return(p_copy(num_type));
      90: }
      91:
      92: polytype mkt_text() {
      93:     return(p_copy(tex_type));
      94: }
      95:
      96: polytype mkt_tn() {
      97:     return(p_copy(t_n_type));
      98: }
      99:
     100: polytype mkt_error() {
     101:     return(p_copy(err_type));
     102: }
     103:
     104: polytype mkt_list(s) polytype s; {
     105:     polytype u;
     106:
     107:     u = mkt_polytype(lis_kind, 1);
     108:     putsubtype(s, u, Asc);
     109:     return (u);
     110: }
     111:
     112: polytype mkt_table(k, a) polytype k, a; {
     113:     polytype u;
     114:
     115:     u = mkt_polytype(tab_kind, 2);
     116:     putsubtype(a, u, Asc);
     117:     putsubtype(k, u, Key);
     118:     return (u);
     119: }
     120:
     121: polytype mkt_lt(s) polytype s; {
     122:     polytype u;
     123:
     124:     u = mkt_polytype(l_t_kind, 1);
     125:     putsubtype(s, u, Asc);
     126:     return (u);
     127: }
     128:
     129: polytype mkt_tlt(s) polytype s; {
     130:     polytype u;
     131:
     132:     u = mkt_polytype(tlt_kind, 1);
     133:     putsubtype(s, u, Asc);
     134:     return (u);
     135: }
     136:
     137: polytype mkt_compound(nsub) intlet nsub; {
     138:     return mkt_polytype(com_kind, nsub);
     139: }
     140:
     141: polytype mkt_var(id) value id; {
     142:     polytype u;
     143:
     144:     u = mk_compound(2);
     145:     *Field(u, Kin)= copy((value) var_kind);
     146:     *Field(u, Id)= id;
     147:     return (u);
     148: }
     149:
     150: Hidden value nnewvar;
     151:
     152: polytype mkt_newvar() {
     153:     value v;
     154:     v = sum(nnewvar, one);
     155:     release(nnewvar);
     156:     nnewvar = v;
     157:     return mkt_var(convert(nnewvar, No, No));
     158: }
     159:
     160: polytype p_copy(u) polytype u; {
     161:     return((polytype) copy((polytype) u));
     162: }
     163:
     164: Procedure p_release(u) polytype u; {
     165:     release((polytype) u);
     166: }
     167:
     168: /* predicates */
     169:
     170: bool are_same_types(u, v) polytype u, v; {
     171:     if (compare((value) Kind(u), (value) Kind(v)) NE 0)
     172:         return (No);
     173:     else if (t_is_var(Kind(u)))
     174:         return (compare(Ident(u), Ident(v)) EQ 0);
     175:     else
     176:         return (
     177:             (nsubtypes(u) EQ nsubtypes(v))
     178:             &&
     179:             (compare(*Psubtypes(u), *Psubtypes(v)) EQ 0)
     180:         );
     181: }
     182:
     183: bool have_same_structure(u, v) polytype u, v; {
     184:     return(
     185:         (compare((value) Kind(u), (value) Kind(v)) EQ 0)
     186:         &&
     187:         nsubtypes(u) EQ nsubtypes(v)
     188:     );
     189: }
     190:
     191: bool t_is_number(kind) typekind kind; {
     192:     return (compare((value) kind, (value) num_kind) EQ 0 ? Yes : No);
     193: }
     194:
     195: bool t_is_text(kind) typekind kind; {
     196:     return (compare((value) kind, (value) tex_kind) EQ 0 ? Yes : No);
     197: }
     198:
     199: bool t_is_tn(kind) typekind kind; {
     200:     return (compare((value) kind, (value) t_n_kind) EQ 0 ? Yes : No);
     201: }
     202:
     203: bool t_is_error(kind) typekind kind; {
     204:     return (compare((value) kind, (value) err_kind) EQ 0 ? Yes : No);
     205: }
     206:
     207: bool t_is_list(kind) typekind kind; {
     208:     return (compare((value) kind, (value) lis_kind) EQ 0 ? Yes : No);
     209: }
     210:
     211: bool t_is_table(kind) typekind kind; {
     212:     return (compare((value) kind, (value) tab_kind) EQ 0 ? Yes : No);
     213: }
     214:
     215: bool t_is_lt(kind) typekind kind; {
     216:     return (compare((value) kind, (value) l_t_kind) EQ 0 ? Yes : No);
     217: }
     218:
     219: bool t_is_tlt(kind) typekind kind; {
     220:     return (compare((value) kind, (value) tlt_kind) EQ 0 ? Yes : No);
     221: }
     222:
     223: bool t_is_compound(kind) typekind kind; {
     224:     return (compare((value) kind, (value) com_kind) EQ 0 ? Yes : No);
     225: }
     226:
     227: bool t_is_var(kind) typekind kind; {
     228:     return (compare((value) kind, (value) var_kind) EQ 0 ? Yes : No);
     229: }
     230:
     231: bool has_number(kind) typekind kind; {
     232:     if (compare(kind, num_kind) EQ 0 || compare(kind, t_n_kind) EQ 0)
     233:         return (Yes);
     234:     else
     235:         return (No);
     236: }
     237:
     238: bool has_text(kind) typekind kind; {
     239:     if (compare(kind, tex_kind) EQ 0 || compare(kind, t_n_kind) EQ 0)
     240:         return (Yes);
     241:     else
     242:         return (No);
     243: }
     244:
     245: bool has_lt(kind) typekind kind; {
     246:     if (compare(kind, l_t_kind) EQ 0 || compare(kind, tlt_kind) EQ 0)
     247:         return (Yes);
     248:     else
     249:         return (No);
     250: }
     251:
     252: /* The table "typeof" maps the identifiers of the variables (B texts)
     253:  * to polytypes.
     254:  */
     255:
     256: value typeof;
     257:
     258: Procedure repl_type_of(u, p) polytype u, p; {
     259:     replace((value) p, &typeof, Ident(u));
     260: }
     261:
     262: bool table_has_type_of(u) polytype u; {
     263:     return(in_keys(Ident(u), typeof));
     264: }
     265:
     266: polytype type_of(u) polytype u; {
     267:     return((polytype) *adrassoc(typeof, Ident(u)));
     268: }
     269:
     270: polytype bottom_var(u) polytype u; {
     271:     polytype b;
     272:
     273:     if (!t_is_var(Kind(u)))
     274:         return (u);
     275:     /* Kind(u) == Variable */
     276:     while (table_has_type_of(u)) {
     277:         b = type_of(u);
     278:         if (t_is_var(Kind(b)))
     279:             u = b;
     280:         else
     281:             break;
     282:     }
     283:     /* Kind(u) == Variable && !table_has_type_of(u)*/
     284:     return (u);
     285: }
     286:
     287: Visible Procedure usetypetable(t) value t; {
     288:     typeof = t;
     289: }
     290:
     291: Visible Procedure deltypetable() {
     292:     release(typeof);
     293: }
     294:
     295: /* init */
     296:
     297: Visible Procedure initpol() {
     298:     num_kind = mk_text("Number");
     299:     num_type = mkt_polytype(num_kind, 0);
     300:     tex_kind = mk_text("Text");
     301:     tex_type = mkt_polytype(tex_kind, 0);
     302:     t_n_kind = mk_text("TN");
     303:     t_n_type = mkt_polytype(t_n_kind, 0);
     304:     err_kind = mk_text("Error");
     305:     err_type = mkt_polytype(err_kind, 0);
     306:
     307:     lis_kind = mk_text("List");
     308:     tab_kind = mk_text("Table");
     309:     com_kind = mk_text("Compound");
     310:     l_t_kind = mk_text("LT");
     311:     tlt_kind = mk_text("TLT");
     312:     var_kind = mk_text("Variable");
     313:
     314:     nnewvar = zero;
     315: }

#### Defined functions

are_same_types defined in line 170; used 5 times

- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 47
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 39, 159-161(2), 215

asctype defined in line 74; used 22 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 487
- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 147-151(2), 160-162(2), 170-171(2), 179-188(4)
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 17
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 55-59(2), 67-75(6), 82(2)

bottom_var defined in line 270; used 4 times

- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 69
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 151-155(2), 215

deltypetable defined in line 291; used 1 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 53

has_lt defined in line 245; used 5 times

- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 62
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 62-64(2), 70-74(2)

has_number defined in line 231; used 3 times

- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 60
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 48(2)

has_text defined in line 238; used 5 times

- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 61
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 51-58(4)

have_same_structure defined in line 183; used 2 times

- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 48
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 45

ident defined in line 82; used 12 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 73, 84-85(2), 121-122(2), 129, 135, 143, 216, 224, 233
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 19

initpol defined in line 297; used 1 times

- in /usr/src/new/PORT/B/src/bint/b3mai.c line 208

keytype defined in line 78; used 6 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 146-149(2), 156
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 18
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 72-76(2)

kind defined in line 62; used 54 times

- in line 191-232(34), 238-239(4), 245-246(4)
- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 79-84(3), 95, 121
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 14
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 36-37(2), 104, 123-124(2), 194

mkt_compound defined in line 137; used 2 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 347
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 38

mkt_error defined in line 100; used 4 times

- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 32
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 86-89(2), 182

mkt_list defined in line 104; used 6 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 213, 414, 586, 598
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 33
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 68

mkt_lt defined in line 121; used 3 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 573
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 35
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 83

mkt_newvar defined in line 152; used 11 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 410-411(2), 417, 424, 431, 495, 502, 573, 623, 645
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 40

mkt_number defined in line 88; used 12 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 230, 403, 420, 444, 460, 473, 482, 492, 552, 638
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 29
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 49

mkt_polytype defined in line 49; used 11 times

- in line 107, 115, 124, 132, 138, 299-305(4)
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 23
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 104

mkt_table defined in line 112; used 6 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 411, 617, 624
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 34
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 72-76(2)

mkt_text defined in line 92; used 12 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 264, 452, 460, 476, 569, 634, 685
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 30
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 52-59(3), 170

mkt_tlt defined in line 129; used 10 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 221, 278, 417, 425, 479, 485, 496, 672, 744
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 36

mkt_tn defined in line 96; used 2 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 591
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 31

mkt_var defined in line 141; used 5 times

- in line 157
- in /usr/src/new/PORT/B/src/bint/b2stc.c line 311, 518, 691
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 39

nsubtypes defined in line 66; used 8 times

- in line 177(2), 187(2)
- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 106
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 15
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 103, 202

p_copy defined in line 160; used 18 times

- in line 89-101(4)
- in /usr/src/new/PORT/B/src/bint/b2stc.c line 411, 425, 479, 485-487(2), 496, 624, 744
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 42
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 40, 72-76(2), 146-148(2)

p_release defined in line 164; used 94 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 50, 208(3), 216(3), 224(3), 232-240(5), 251, 259(3), 267(3), 281(3), 313-315(3), 327, 405, 413(2), 419(2), 427(2), 434, 446-448(2), 454-456(2), 462-464(3), 475(2), 481(2), 488(2), 494-498(4), 505-506(2), 562, 583(2), 594(2), 610-614(4), 626(3), 636-640(5), 675(3), 694-699(5), 735, 746-748(4), 754, 766(2)
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 56-60(2), 175, 184-186(2)

putsubtype defined in line 58; used 7 times

- in line 108, 116-117(2), 125, 133
- in /usr/src/new/PORT/B/src/bint/b2stc.c line 349
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 109

repl_type_of defined in line 258; used 2 times

- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 160-162(2)

subtype defined in line 70; used 8 times

- in line 75-79(2)
- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 109-112(2)
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 16
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 106-107(2), 204

t_is_compound defined in line 223; used 2 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 105
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 58

t_is_error defined in line 203; used 5 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 79, 115
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 53
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 85(2)

t_is_list defined in line 207; used 4 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 169
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 54
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 62-64(2)

t_is_lt defined in line 215; used 4 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 178
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 56
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 78-80(2)

t_is_number defined in line 191; used 2 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 96
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 50

t_is_table defined in line 211; used 4 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 145
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 55
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 70-74(2)

t_is_text defined in line 195; used 2 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 99
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 51

t_is_tlt defined in line 219; used 6 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 185
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 57
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 54-58(2), 78-80(2)

t_is_tn defined in line 199; used 2 times

- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 102
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 52

t_is_var defined in line 227; used 18 times

- in line 173, 273-278(2)
- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 79-84(2), 118-121(2)
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 59
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 42(2), 126, 134, 145-161(5), 194

table_has_type_of defined in line 262; used 5 times

- in line 276
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 67
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 126, 134, 195

type_of defined in line 266; used 5 times

- in line 277
- in /usr/src/new/PORT/B/src/bint/b2tcP.h line 68
- in /usr/src/new/PORT/B/src/bint/b2tcU.c line 127, 135, 196

usetypetable defined in line 287; used 1 times

- in /usr/src/new/PORT/B/src/bint/b2stc.c line 47

#### Defined variables

nnewvar defined in line 150; used 5 times

- in line 154-157(4), 314

typeof defined in line 256; used 6 times

- in line 259-267(3), 288-292(2)
- in /usr/src/new/PORT/B/src/bint/b2tcE.c line 54

#### Defined macros

Asc defined in line 24; used 5 times

- in line 75, 108, 116, 125, 133

Id defined in line 23; used 2 times

- in line 29, 146

Ident defined in line 29; used 6 times

- in line 83, 174(2), 259-267(3)

Key defined in line 25; used 2 times

- in line 79, 117

Kin defined in line 21; used 3 times

- in line 27, 53, 145

Kind defined in line 27; used 8 times

- in line 63, 171-173(3), 185(2), 273-278(2)

Psubtypes defined in line 28; used 5 times

- in line 59, 67-71(2), 179(2)

Sub defined in line 22; used 3 times

- in line 23-28(2), 54

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