new_var.c
3.58 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
/* new_var.c ****************************************************
The Anubis Compiler (version 1)
Creating global variables.
****************************************************************/
#include <stdlib.h>
#include "compil.h"
void new_variable (Expr lc,
int global,
Expr type,
Expr name,
Expr init)
{
Expr aux, init_ints, init_ints1;
int i;
if (types_only) return;
if (verbose && par_seen)
printf(msgtext_checking_variable[0],
string_content(name),
line_in(lc));
/* parameters are forbidden in type and init */
aux = nil;
collect_type_variables(&aux,type);
collect_type_variables(&aux,init);
if (aux != nil)
{
err_line_col(lc,"E001", str_format(
msgtext_variable_with_parms[0],
string_content(name)));
return;
}
/* check type */
check_explicit_type(lc,type,nil);
if (errors) return;
/* avoid redeclaration */
for (i = 0; i < next_variable; i++)
if (variables[i].name == name)
if (same_type(variables[i].type,nil,type,nil))
{
err_line_col(lc,"E002", str_format(
msgtext_variable_redeclaration[0],
name));
return ;
}
/* interpret initial value */
init_ints = term_interpretations(type,
init,
nil,
nil,
nil,0);
/* keep them for error message E006 */
init_ints1 = init_ints;
/* keep only those interpretations whose type is 'type' */
aux = init_ints;
init_ints = nil;
while (consp(aux))
{
Expr new_env;
new_env = unify(type_from_interpretation(car(car(aux)),cdr(car(aux))),
cdr(car(aux)),
type,
nil);
if (new_env != not_unifiable)
init_ints = cons(cons(car(car(aux)),new_env),init_ints);
aux = cdr(aux);
}
if (init_ints == nil)
{
err_line_col(lc,"E006", str_format(msgtext_variable_no_init[0]));
show_interpretations_types(errfile,init_ints1);
return;
}
must_be_non_ambiguous(init_ints);
if (errors) return;
/* record the new variable */
if (next_variable == max_variable)
{
max_variable += 100;
variables = (struct Variable_struct *)reallocz(variables,
max_variable*sizeof(struct Variable_struct));
}
variables[next_variable].name = name;
variables[next_variable].abs_file_path = new_string(current_file_abs_path);
variables[next_variable].global = global;
variables[next_variable].init = substitute(car(car(init_ints)),cdr(car(init_ints)));
variables[next_variable].lc = lc;
variables[next_variable].type = cons(type_GAddr,type);
add_symbol_index_entry(name,syms_variable,next_variable);
next_variable++;
#if 0
if (predef_aux != NULL)
{
fprintf(predef_aux,"\nnew_variable(new_integer(0),%d,\n",global);
print_expr_to_C(predef_aux,type);
fprintf(predef_aux,"\n");
print_expr_to_C(predef_aux,name);
fprintf(predef_aux,"\n");
print_expr_to_C(predef_aux,init);
fprintf(predef_aux,"\n");
}
#endif
if (predef_npd_aux != NULL)
{
fprintf(predef_npd_aux,"\nnew_variable(new_integer(0),%d,\n",global);
print_expr_to_C(predef_npd_aux,type);
fprintf(predef_npd_aux,"\n");
print_expr_to_C(predef_npd_aux,name);
fprintf(predef_npd_aux,"\n");
print_expr_to_C(predef_npd_aux,init);
fprintf(predef_npd_aux,"\n");
}
}