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: }
Last modified: 1986-03-13
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1385
Valid CSS Valid XHTML 1.0 Strict