1: #ifndef lint
2: static char RCSid[] = "$Header: types.c,v 2.0 85/11/21 07:21:51 jqj Exp $";
3: #endif
4:
5: /* $Log: types.c,v $
6: * Revision 2.0 85/11/21 07:21:51 jqj
7: * 4.3BSD standard release
8: *
9: * Revision 1.3 85/03/11 16:40:43 jqj
10: * *** empty log message ***
11: *
12: * Revision 1.3 85/03/11 16:40:43 jqj
13: * Public alpha-test version, released 11 March 1985
14: *
15: * Revision 1.2 85/02/21 11:06:29 jqj
16: * alpha test version
17: *
18: * Revision 1.1 85/02/15 13:55:49 jqj
19: * Initial revision
20: *
21: */
22:
23: #include "compiler.h"
24:
25: /*
26: * Object allocation.
27: */
28: struct type *
29: make_type(constr)
30: enum constr constr;
31: {
32: struct type *typtr;
33:
34: typtr = New(struct type);
35: typtr->type_constr = constr;
36: return(typtr);
37: }
38:
39: struct type *
40: enumeration_type(items)
41: list items;
42: {
43: struct type *typtr;
44:
45: typtr = make_type(C_ENUMERATION);
46: typtr->type_list = items;
47: return(typtr);
48: }
49:
50:
51: struct type *
52: record_type(fields)
53: list fields;
54: {
55: struct type *typtr;
56:
57: if (fields == NIL)
58: return (NilRecord_type);
59: typtr = make_type(C_RECORD);
60: typtr->type_list = fields;
61: return(typtr);
62: }
63:
64:
65: struct type *
66: error_type(arguments)
67: list arguments;
68: {
69: struct type *typtr;
70:
71: typtr = make_type(C_ERROR);
72: typtr->type_list = arguments;
73: return (typtr);
74: }
75:
76: struct type *
77: array_type(size, bt)
78: char *size;
79: struct type *bt;
80: {
81: struct type *typtr;
82:
83: typtr = make_type(C_ARRAY);
84: typtr->type_basetype = bt;
85: typtr->type_size = stringtocard(size);
86: return(typtr);
87: }
88:
89: struct type *
90: sequence_type(size, bt)
91: char *size;
92: struct type *bt;
93: {
94: struct type *typtr;
95:
96: typtr = make_type(C_SEQUENCE);
97: typtr->type_basetype = bt;
98: typtr->type_size = stringtocard(size);
99: return(typtr);
100: }
101:
102: struct type *
103: procedure_type(args, results, errors)
104: list args, results, errors;
105: {
106: struct type *typtr;
107:
108: typtr = make_type(C_PROCEDURE);
109: typtr->type_args = args;
110: typtr->type_results = results;
111: typtr->type_errors = errors;
112: return (typtr);
113: }
114:
115: /*
116: * Construct a choice type.
117: * There are two ways a choice can be specified:
118: * with an explicit enumeration type as a designator,
119: * or with an implicit enumeration type,
120: * by specifying values as well as names for each designator.
121: * Convert the second form into the first by creating
122: * an enumeration type on the fly.
123: */
124: struct type *
125: choice_type(designator, candidates)
126: struct type *designator;
127: list candidates;
128: {
129: struct type *typtr;
130: list p, q, dlist;
131: int bad = 0;
132:
133: if (designator != TNIL) {
134: if (designator->type_constr != C_ENUMERATION) {
135: error(ERROR, "designator type %s is not an enumeration type",
136: typename(designator));
137: return (Unspecified_type);
138: }
139: /*
140: * Check that designators don't specify conflicting values.
141: */
142: for (p = candidates; p != NIL; p = cdr(p))
143: for (q = caar(p); q != NIL; q = cdr(q))
144: if (cdar(q) != NIL &&
145: stringtocard((char *)cdar(q)) != enumvalue_of(caar(q))) {
146: error(ERROR, "conflicting value specified for designator %s",
147: name_of(caar(q)));
148: bad = 1;
149: continue;
150: }
151: } else {
152: /*
153: * Check that designators do specify values.
154: */
155: dlist = NIL;
156: for (p = candidates; p != NIL; p = cdr(p)) {
157: for (q = caar(p); q != NIL; q = cdr(q)) {
158: if (cdar(q) == NIL) {
159: error(ERROR, "value must be specified for designator %s",
160: name_of(caar(q)));
161: bad = 1;
162: continue;
163: }
164: dlist = nconc(dlist, cons(car(q), NIL));
165: }
166: }
167: if (!bad) {
168: designator = enumeration_type(dlist);
169: code_type(gensym("T_d"),designator);
170: }
171: }
172: if (bad)
173: return (Unspecified_type);
174: typtr = make_type(C_CHOICE);
175: typtr->type_designator = designator;
176: typtr->type_candidates = candidates;
177: return(typtr);
178: }
Defined functions
Defined variables
RCSid
defined in line
2;
never used