1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2010 Thomas Mertes */
5 /* */
6 /* This program is free software; you can redistribute it and/or */
7 /* modify it under the terms of the GNU General Public License as */
8 /* published by the Free Software Foundation; either version 2 of */
9 /* the License, or (at your option) any later version. */
10 /* */
11 /* This program is distributed in the hope that it will be useful, */
12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
14 /* GNU General Public License for more details. */
15 /* */
16 /* You should have received a copy of the GNU General Public */
17 /* License along with this program; if not, write to the */
18 /* Free Software Foundation, Inc., 51 Franklin Street, */
19 /* Fifth Floor, Boston, MA 02110-1301, USA. */
20 /* */
21 /* Module: Compiler data reflection */
22 /* File: seed7/src/typ_data.c */
23 /* Changes: 1993, 1994, 1999, 2000, 2008, 2010 Thomas Mertes */
24 /* Content: Primitive actions for the type type. */
25 /* */
26 /********************************************************************/
27
28 #define LOG_FUNCTIONS 0
29 #define VERBOSE_EXCEPTIONS 0
30
31 #include "version.h"
32
33 #include "stdlib.h"
34 #include "stdio.h"
35 #include "string.h"
36
37 #include "common.h"
38 #include "data.h"
39 #include "data_rtl.h"
40 #include "heaputl.h"
41 #include "datautl.h"
42 #include "typeutl.h"
43 #include "striutl.h"
44 #include "hsh_rtl.h"
45 #include "rtl_err.h"
46
47 #undef EXTERN
48 #define EXTERN
49 #include "typ_data.h"
50
51
52
53 /**
54 * Compare two types.
55 * @return -1, 0 or 1 if the first argument is considered to be
56 * respectively less than, equal to, or greater than the
57 * second.
58 */
typCmp(const const_typeType type1,const const_typeType type2)59 intType typCmp (const const_typeType type1, const const_typeType type2)
60
61 {
62 intType signumValue;
63
64 /* typCmp */
65 if ((memSizeType) type1 < (memSizeType) type2) {
66 signumValue = -1;
67 } else {
68 signumValue = (memSizeType) type1 > (memSizeType) type2;
69 } /* if */
70 return signumValue;
71 } /* typCmp */
72
73
74
75 /**
76 * Reinterpret the generic parameters as typeType and call typCmp.
77 * Function pointers in C programs generated by the Seed7 compiler
78 * may point to this function. This assures correct behaviour even
79 * if sizeof(genericType) != sizeof(typeType).
80 * @return -1, 0 or 1 if the first argument is considered to be
81 * respectively less than, equal to, or greater than the
82 * second.
83 */
typCmpGeneric(const genericType value1,const genericType value2)84 intType typCmpGeneric (const genericType value1, const genericType value2)
85
86 { /* typCmpGeneric */
87 return typCmp((const_typeType) ((const_rtlObjectType *) &value1)->value.typeValue,
88 (const_typeType) ((const_rtlObjectType *) &value2)->value.typeValue);
89 } /* typCmpGeneric */
90
91
92
typFunc(typeType basic_type)93 typeType typFunc (typeType basic_type)
94
95 {
96 typeType func_type;
97
98 /* typFunc */
99 logFunction(printf("typFunc(" FMT_X_MEM ")\n", (memSizeType) basic_type););
100 if (unlikely((func_type = get_func_type(NULL, basic_type)) == NULL)) {
101 raise_error(MEMORY_ERROR);
102 } /* if */
103 logFunction(printf("typFunc --> " FMT_X_MEM "\n", (memSizeType) func_type););
104 return func_type;
105 } /* typFunc */
106
107
108
typIsDerived(typeType any_type)109 boolType typIsDerived (typeType any_type)
110
111 { /* typIsDerived */
112 return any_type->meta != NULL;
113 } /* typIsDerived */
114
115
116
typIsFunc(typeType any_type)117 boolType typIsFunc (typeType any_type)
118
119 { /* typIsFunc */
120 return any_type->result_type != NULL && !any_type->is_varfunc_type;
121 } /* typIsFunc */
122
123
124
typIsVarfunc(typeType any_type)125 boolType typIsVarfunc (typeType any_type)
126
127 { /* typIsVarfunc */
128 return any_type->result_type != NULL && any_type->is_varfunc_type;
129 } /* typIsVarfunc */
130
131
132
typMatchobj(typeType actual_type)133 objectType typMatchobj (typeType actual_type)
134
135 { /* typMatchobj */
136 return actual_type->match_obj;
137 } /* typMatchobj */
138
139
140
typMeta(typeType any_type)141 typeType typMeta (typeType any_type)
142
143 {
144 typeType meta;
145
146 /* typMeta */
147 logFunction(printf("typMeta(" FMT_X_MEM ")\n", (memSizeType) any_type););
148 meta = any_type->meta;
149 if (unlikely(meta == NULL)) {
150 raise_error(RANGE_ERROR);
151 } /* if */
152 logFunction(printf("typMeta --> " FMT_X_MEM "\n", (memSizeType) meta););
153 return meta;
154 } /* typMeta */
155
156
157
typNum(typeType actual_type)158 intType typNum (typeType actual_type)
159
160 {
161 static rtlHashType type_table = NULL;
162 static intType next_free_number = 1;
163 intType type_num;
164
165 /* typNum */
166 logFunction(printf("typNum(" FMT_X_MEM ")\n", (memSizeType) actual_type););
167 if (unlikely(actual_type == NULL)) {
168 type_num = 0;
169 } else {
170 if (unlikely(type_table == NULL)) {
171 type_table = hshEmpty();
172 } /* if */
173 if (unlikely(type_table == NULL)) {
174 raise_error(MEMORY_ERROR);
175 type_num = 0;
176 } else {
177 type_num = (intType) hshIdxEnterDefault(type_table, (genericType) (memSizeType) actual_type,
178 (genericType) next_free_number,
179 (intType) (((memSizeType) actual_type) >> 6));
180 if (type_num == next_free_number) {
181 next_free_number++;
182 } /* if */
183 } /* if */
184 } /* if */
185 logFunction(printf("typNum --> " FMT_D "\n", type_num););
186 return type_num;
187 } /* typNum */
188
189
190
typResult(typeType any_type)191 typeType typResult (typeType any_type)
192
193 {
194 typeType result_type;
195
196 /* typResult */
197 logFunction(printf("typResult(" FMT_X_MEM ")\n", (memSizeType) any_type););
198 result_type = any_type->result_type;
199 if (unlikely(result_type == NULL)) {
200 raise_error(RANGE_ERROR);
201 } /* if */
202 logFunction(printf("typResult --> " FMT_X_MEM "\n", (memSizeType) result_type););
203 return result_type;
204 } /* typResult */
205
206
207
typStr(typeType type_arg)208 striType typStr (typeType type_arg)
209
210 {
211 const_cstriType stri;
212 errInfoType err_info = OKAY_NO_ERROR;
213 striType result;
214
215 /* typStr */
216 logFunction(printf("typStr(" FMT_X_MEM ")\n", (memSizeType) type_arg););
217 if (unlikely(type_arg == NULL)) {
218 stri = "*NULL_TYPE*";
219 } else if (type_arg->name != NULL) {
220 stri = id_string2(type_arg->name);
221 } else {
222 stri = "*ANONYM_TYPE*";
223 } /* if */
224 result = cstri8_to_stri(stri, &err_info);
225 if (unlikely(result == NULL)) {
226 raise_error(err_info);
227 } /* if */
228 logFunction(printf("typStr --> \"%s\"\n", striAsUnquotedCStri(result)););
229 return result;
230 } /* typStr */
231
232
233
typVarfunc(typeType basic_type)234 typeType typVarfunc (typeType basic_type)
235
236 {
237 typeType result;
238
239 /* typVarfunc */
240 logFunction(printf("typVarfunc(" FMT_X_MEM ")\n", (memSizeType) basic_type););
241 if (unlikely((result = get_varfunc_type(NULL, basic_type)) == NULL)) {
242 raise_error(MEMORY_ERROR);
243 } /* if */
244 logFunction(printf("typVarfunc --> " FMT_X_MEM "\n", (memSizeType) result););
245 return result;
246 } /* typVarfunc */
247