1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2000 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: Analyzer - Parser */
22 /* File: seed7/src/type.c */
23 /* Changes: 1993, 1994 Thomas Mertes */
24 /* Content: Parse and assign a type of an object. */
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
36 #include "common.h"
37 #include "data.h"
38 #include "syvarutl.h"
39 #include "typeutl.h"
40 #include "traceutl.h"
41 #include "fatal.h"
42 #include "scanner.h"
43 #include "findid.h"
44 #include "objutl.h"
45 #include "listutl.h"
46 #include "object.h"
47 #include "match.h"
48 #include "error.h"
49 #include "expr.h"
50 #include "exec.h"
51
52 #undef EXTERN
53 #define EXTERN
54 #include "type.h"
55
56
57
decl_type(int * is_dollar_type,errInfoType * err_info)58 objectType decl_type (int *is_dollar_type, errInfoType *err_info)
59
60 {
61 objectType basic_type;
62 objectType type_expression;
63 objectType type_of_object;
64 typeType func_type;
65
66 /* decl_type */
67 logFunction(printf("decl_type\n"););
68 *is_dollar_type = 0;
69 scan_symbol();
70 if (current_ident == prog->id_for.colon) {
71 err_warning(TYPE_EXPECTED);
72 type_of_object = NULL;
73 scan_symbol();
74 } else {
75 if (current_ident == prog->id_for.dollar) {
76 scan_symbol();
77 if (current_ident == prog->id_for.func) {
78 scan_symbol();
79 basic_type = pars_infix_expression(WEAKEST_PRIORITY, TRUE);
80 if (CATEGORY_OF_OBJ(basic_type) == TYPEOBJECT) {
81 if ((func_type = get_func_type(NULL, take_type(basic_type))) != NULL) {
82 type_of_object = bld_type_temp(func_type);
83 } else {
84 *err_info = MEMORY_ERROR;
85 type_of_object = NULL;
86 } /* if */
87 } else {
88 err_object(TYPE_EXPECTED, basic_type);
89 type_of_object = NULL;
90 } /* if */
91 } else if (current_ident == prog->id_for.type) {
92 type_of_object = pars_infix_expression(WEAKEST_PRIORITY, TRUE);
93 *is_dollar_type = 1;
94 } else {
95 err_warning(DOLLAR_TYPE_WRONG);
96 type_of_object = NULL;
97 if (current_ident != prog->id_for.colon) {
98 scan_symbol();
99 } /* if */
100 } /* if */
101 } else {
102 type_expression = pars_infix_expression(WEAKEST_PRIORITY, TRUE);
103 /* printf("type_expression=%lu ", (long unsigned) type_expression);
104 trace1(type_expression);
105 printf("\n"); */
106 if (CATEGORY_OF_OBJ(type_expression) != TYPEOBJECT) {
107 /* printf("before evaluate\n"); */
108 if ((type_of_object = evaluate(type_expression)) != NULL &&
109 CATEGORY_OF_OBJ(type_of_object) == TYPEOBJECT) {
110 /* printf("type_of_object ");
111 trace1(type_of_object);
112 printf("\n"); */
113 } else {
114 /* printf("\n type expression: ");
115 trace1(type_expression);
116 printf("\n evaluated: ");
117 trace1(type_of_object);
118 printf("\n");
119 printf("&type_of_object->type_of %lu\n", (long unsigned) type_of_object->type_of); */
120 err_object(TYPE_EXPECTED, type_expression);
121 } /* if */
122 free_expression(type_expression);
123 } else {
124 type_of_object = type_expression;
125 } /* if */
126 } /* if */
127 if (current_ident == prog->id_for.colon) {
128 scan_symbol();
129 } else {
130 err_ident(EXPECTED_SYMBOL, prog->id_for.colon);
131 } /* if */
132 } /* if */
133 logFunction(printf("decl_type --> ");
134 trace1(type_of_object);
135 printf("\n"););
136 return type_of_object;
137 } /* decl_type */
138