unknowns.c
4.04 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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
/* unknowns.c *******************************************************
Anubis Web Server
Managing unknowns.
********************************************************************/
#include "compil.h"
/* testing if a term has unknowns */
int has_unknowns_aux(Expr term, Expr env)
{
/* unknowns in term, which are keys of env are considered as
implicitly replaced by their value (as found in env). */
begin:
if (is_unknown(term))
{
/* get its value */
term = assoc(term,env);
if (term == key_not_found)
/* unknown has no value */
return 1;
else
/* try again with the value */
goto begin;
}
else if (consp(term))
{
Expr car_term = car(term);
if (car_term == anb_int32) return 0;
if (car_term == integer_10) return 0;
if (car_term == integer_16) return 0;
if (car_term == anb_int_10) return 0;
if (car_term == anb_int_16) return 0;
if (car_term == word_64) return 0;
if (car_term == word_128) return 0;
if (car_term == small_datum) return has_unknowns_aux(second(term),env);
if (has_unknowns_aux(car_term, env)) return 1;
return has_unknowns_aux(cdr(term),env);
}
else return 0;
}
int has_unknowns(Expr term, Expr env)
{
int result;
result = has_unknowns_aux(term,env);
return result;
}
/* testing if a term (given its list of interpretations) is non
ambiguous (error message if ambiguous) */
void must_be_non_ambiguous(Expr interps)
{
/* interps is a list of interpretations. It must have length 1, and
the unique interpretation must not contain uninstanciated
internal type variables */
int n = length(interps); /* number of interpretations */
if (n == 0)
{
/* No interpretation at all. Do not generate an error message,
because there must be a subterm which has no interpretation,
and which already generated an error message. */
return;
}
if (n >= 2)
{
err_line_col(car(cdr(car(car(interps)))),"E083", str_format(
msgtext_ambiguous_term[0],
length(interps)));
show_interpretations(errfile,interps);
return;
}
/* now there is one and only one interpretation, but it may still be
ambiguous, because it may contain an unknown */
if (has_unknowns(car(car(interps)),
cdr(car(interps))))
{
err_line_col(car(cdr(car(car(interps)))),"E084",
msgtext_term_with_unknowns[0]);
show_interpretation(errfile,car(car(interps)),cdr(car(interps)));
return;
}
}
/* refreshing an expression: replace all user type variables by fresh
internal type variables */
Expr refresh(Expr expr, /* expression to refresh */
Expr *already_refreshed) /* (($T . $n) ...) */
{
/* assert(!is_unknown(expr)); */
/* type variables */
if (is_user_type_variable(expr))
{
Expr replacement = assoc(expr,*already_refreshed);
if (replacement == key_not_found)
{
/* type variable not seen already */
Expr result = fresh_unknown();
*already_refreshed = cons(cons(expr,
result),
*already_refreshed);
return result;
}
else
{
/* type variable already seen */
return replacement;
}
}
if (consp(expr))
{
/* pairs */
return cons(refresh(car(expr),already_refreshed),
refresh(cdr(expr),already_refreshed));
}
else
{
/* other atoms */
return expr;
}
}
Expr merge_envs(Expr e1, Expr e2)
{
/* verify that common keys in e1 and e2 have the same value, and put
them only one time in result. Keep all other keys. */
while (consp(e1))
{
if (is_key_of(e2,car(car(e1))))
{
if (!equal(cdr(car(e1)),assoc(car(car(e1)),e2)))
{
return not_unifiable; /* cannot merge */
debug(e1);
debug(e2);
internal_error("Should be equal",cons(cdr(car(e1)),assoc(car(car(e1)),e2)));
}
}
else
e2 = cons(car(e1),e2);
e1 = cdr(e1);
}
return e2;
}