checkexpr.c
4.08 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
#include "compil.h"
void check_type_fi(Expr t)
{
}
void check_types_fi(Expr ts)
{
}
void check_head(Expr head);
void check_case(Expr clause)
{
/* clause = ((<name> (<var> . <type>) ...) <lc> . <int head>) */
check_head(cdr2(clause));
}
void check_cases(Expr cases)
{
if (consp(cases))
{
check_case(car(cases));
check_cases(cdr(cases));
}
}
void check_heads(Expr heads)
{
if (consp(heads))
{
check_head(car(heads));
check_heads(cdr(heads));
}
}
void check_head(Expr head)
{
if (!show_reads) return;
assert(consp(head));
//debug(head);
switch(car(head))
{
case avm: /* (avm <lc> <instr> ...) */
case string: /* (string <lc> . <string>) */
case anb_int32: /* (int32 <lc> . <Cint>) */
case fpnum: /* (fpnum <lc> <int32 mantissa> . <int32 exponent>) */
return;
case global_variable: /* (global_variable <lc> . <i>) */
{
char *filename = string_content(variables[integer_value(cdr2(head))].file_name);
if (!is_visible(filename))
{
add_missing_read(get_file_id(filename));
}
}
return;
case alt_number: /* (alt_number <lc> . <head>) */
case protect: /* (protect <lc> . <head>) */
case debug_avm: /* (debug_avm <lc> . <head>) */
case terminal: /* (terminal <lc> . <head>) */
case anb_read: /* (anb_read <lc> . <conn>) */
case serialize: /* (serialize <lc> . <term>) */
case vcopy: /* (vcopy n . v) */
check_head(cdr2(head));
return;
case lock: /* (lock <lc> <filename> . <term>) */
case anb_write: /* (anb_write <lc> <conn> . <value>) */
case delegate: /* (delegate <lc> <head (delegated)> . <head (body)>) */
check_head(third(head));
check_head(cdr3(head));
return;
case operation: /* (operation <lc> <opid> <name> <parms> <type> . <types>) */
{
char *filename = string_content(operations[integer_value(third(head))].file_name);
if (!is_visible(filename))
{
add_missing_read(get_file_id(filename));
}
}
check_type_fi(sixth(head));
check_types_fi(cdr6(head));
return;
case small_datum: /* (small_datum <type> . <Cint>) */
check_type_fi(second(head));
return;
case local: /* (local <name> <i> . <type>) */
check_type_fi(cdr3(head));
return;
case app: /* (app <lc> <op int head> . <int heads>) */
check_head(third(head));
check_heads(cdr3(head));
return;
case cond: /* (cond <lc> <int head> ((<name> (<var> . <type>) ...) <lc> . <int head>) ...) */
check_head(third(head));
check_cases(cdr3(head));
return;
case select_cond_interp: /*
(select_cond_interp <lc> <test head> <index> <clause head> <head then> . <head else>) */
check_head(third(head));
check_head(sixth(head));
check_head(cdr6(head));
return;
case with: /* (with <lc> <symbol> <int head> . <int head>) */
check_head(forth(head));
check_head(cdr4(head));
return;
case connect_IP_RW: /* (connect_IP_RW <lc> <return type> <head (address)> . <head (port)>) */
check_type_fi(third(head));
check_head(forth(head));
check_head(cdr4(head));
return;
case wait_for: /* (wait_for <lc> <head (condition)> <head (milliseconds)> . <head (after)>) */
check_head(third(head));
check_head(forth(head));
check_head(cdr4(head));
return;
case unserialize: /* (unserialize <lc> <type> . <head>) */
case connect_file_R: /* (connect_file_? <lc> <return type> . <head (string)>) */
case connect_file_W:
case connect_file_RW:
case of_type: /* (of_type <lc> <type> . <term>) */
check_type_fi(third(head));
check_head(cdr3(head));
return;
case bit_width: /* (bit_width . <type>) */
case indirect_type: /* (indirect_type . <type>) */
check_type_fi(cdr(head));
return;
default: internal_error("Unknown head",head);
return;
}
}