1 //: Introduce a new transform to perform various checks in instructions before
  2 //: we start running them. It'll be extensible, so that we can add checks for
  3 //: new recipes as we extend 'run' to support them.
  4 //:
  5 //: Doing checking in a separate part complicates things, because the values
  6 //: of variables in memory and the processor (current_recipe_name,
  7 //: current_instruction) aren't available at checking time. If I had a more
  8 //: sophisticated layer system I'd introduce the simpler version first and
  9 //: transform it in a separate layer or set of layers.
 10 
 11 :(before "End Checks")
 12 Transform.push_back(check_instruction);  // idempotent
 13 
 14 :(code)
 15 void check_instruction(const recipe_ordinal r) {
 16   trace(9991, "transform") << "--- perform checks for recipe " << get(Recipe, r).name << end();
 17   map<string, vector<type_ordinal> > metadata;
 18   for (int i = 0;  i < SIZE(get(Recipe, r).steps);  ++i) {
 19   ¦ instruction& inst = get(Recipe, r).steps.at(i);
 20   ¦ if (inst.is_label) continue;
 21   ¦ switch (inst.operation) {
 22   ¦ ¦ // Primitive Recipe Checks
 23   ¦ ¦ case COPY: {
 24   ¦ ¦ ¦ if (SIZE(inst.products) > SIZE(inst.ingredients)) {
 25   ¦ ¦ ¦ ¦ raise << maybe(get(Recipe, r).name) << "too many products in '" << to_original_string(inst) << "'\n" << end();
 26   ¦ ¦ ¦ ¦ break;
 27   ¦ ¦ ¦ }
 28   ¦ ¦ ¦ for (int i = 0;  i < SIZE(inst.products);  ++i) {
 29   ¦ ¦ ¦ ¦ if (!types_coercible(inst.products.at(i), inst.ingredients.at(i))) {
 30   ¦ ¦ ¦ ¦ ¦ raise << maybe(get(Recipe, r).name) << "can't copy '" << inst.ingredients.at(i).original_string << "' to '" << inst.products.at(i).original_string << "'; types don't match\n" << end();
 31   ¦ ¦ ¦ ¦ ¦ goto finish_checking_instruction;
 32   ¦ ¦ ¦ ¦ }
 33   ¦ ¦ ¦ }
 34   ¦ ¦ ¦ break;
 35   ¦ ¦ }
 36   ¦ ¦ // End Primitive Recipe Checks
 37   ¦ ¦ default: {
 38   ¦ ¦ ¦ // Defined Recipe Checks
 39   ¦ ¦ ¦ // End Defined Recipe Checks
 40   ¦ ¦ }
 41   ¦ }
 42   ¦ finish_checking_instruction:;
 43   }
 44 }
 45 
 46 :(scenario copy_checks_reagent_count)
 47 % Hide_errors = true;
 48 def main [
 49   1:num, 2:num <- copy 34
 50 ]
 51 +error: main: too many products in '1:num, 2:num <- copy 34'
 52 
 53 :(scenario write_scalar_to_array_disallowed)
 54 % Hide_errors = true;
 55 def main [
 56   1:array:num <- copy 34
 57 ]
 58 +error: main: can't copy '34' to '1:array:num'; types don't match
 59 
 60 :(scenario write_scalar_to_array_disallowed_2)
 61 % Hide_errors = true;
 62 def main [
 63   1:num, 2:array:num <- copy 34, 35
 64 ]
 65 +error: main: can't copy '35' to '2:array:num'; types don't match
 66 
 67 :(scenario write_scalar_to_address_disallowed)
 68 % Hide_errors = true;
 69 def main [
 70   1:address:num <- copy 34
 71 ]
 72 +error: main: can't copy '34' to '1:address:num'; types don't match
 73 
 74 :(scenario write_address_to_number_allowed)
 75 def main [
 76   1:address:num <- copy 12/unsafe
 77   2:num <- copy 1:address:num
 78 ]
 79 +mem: storing 12 in location 2
 80 $error: 0
 81 
 82 :(scenario write_address_to_character_disallowed)
 83 % Hide_errors = true;
 84 def main [
 85   1:address:num <- copy 12/unsafe
 86   2:char <- copy 1:address:num
 87 ]
 88 +error: main: can't copy '1:address:num' to '2:char'; types don't match
 89 
 90 :(scenario write_number_to_character_allowed)
 91 def main [
 92   1:num <- copy 97
 93   2:char <- copy 1:num
 94 ]
 95 $error: 0
 96 
 97 :(scenario write_boolean_to_number_allowed)
 98 def main [
 99   1:bool <- copy 1/true
100   2:num <- copy 1:bool
101 ]
102 +mem: storing 1 in location 2
103 $error: 0
104 
105 :(scenario write_number_to_boolean_disallowed)
106 % Hide_errors = true;
107 def main [
108   1:num <- copy 34
109   2:bool <- copy 1:num
110 ]
111 +error: main: can't copy '1:num' to '2:bool'; types don't match
112 
113 :(code)
114 // types_match with some leniency
115 bool types_coercible(const reagent& to, const reagent& from) {
116   if (types_match(to, from)) return true;
117   if (is_mu_address(from) && is_real_mu_number(to)) return true;
118   if (is_mu_boolean(from) && is_real_mu_number(to)) return true;
119   if (is_real_mu_number(from) && is_mu_character(to)) return true;
120   // End types_coercible Special-cases
121   return false;
122 }
123 
124 bool types_match(const reagent& to, const reagent& from) {
125   // to sidestep type-checking, use /unsafe in the source.
126   // this will be highlighted in red inside vim. just for setting up some tests.
127   if (is_unsafe(from)) return true;
128   if (is_literal(from)) {
129   ¦ if (is_mu_array(to)) return false;
130   ¦ // End Matching Types For Literal(to)
131   ¦ // allow writing 0 to any address
132   ¦ if (is_mu_address(to)) return from.name == "0";
133   ¦ if (!to.type) return false;
134   ¦ if (to.type->atom && to.type->value == get(Type_ordinal, "boolean"))
135   ¦ ¦ return from.name == "0" || from.name == "1";
136   ¦ return size_of(to) == 1;  // literals are always scalars
137   }
138   return types_strictly_match(to, from);
139 }
140 
141 //: copy arguments for later layers
142 bool types_strictly_match(reagent/*copy*/ to, reagent/*copy*/ from) {
143   // End Preprocess types_strictly_match(reagent to, reagent from)
144   if (to.type == NULL) return false;  // error
145   if (is_literal(from) && to.type->value == get(Type_ordinal, "number")) return true;
146   // to sidestep type-checking, use /unsafe in the source.
147   // this will be highlighted in red inside vim. just for setting up some tests.
148   if (is_unsafe(from)) return true;
149   // '_' never raises type error
150   if (is_dummy(to)) return true;
151   if (!to.type) return !from.type;
152   return types_strictly_match(to.type, from.type);
153 }
154 
155 bool types_strictly_match(const type_tree* to, const type_tree* from) {
156   if (from == to) return true;
157   if (!to) return false;
158   if (!from) return to->atom && to->value == 0;
159   if (from->atom != to->atom) return false;
160   if (from->atom) {
161   ¦ if (from->value == -1) return from->name == to->name;
162   ¦ return from->value == to->value;
163   }
164   if (types_strictly_match(to->left, from->left) && types_strictly_match(to->right, from->right))
165   ¦ return true;
166   // fallback: (x) == x
167   if (to->right == NULL && types_strictly_match(to->left, from)) return true;
168   if (from->right == NULL && types_strictly_match(to, from->left)) return true;
169   return false;
170 }
171 
172 void test_unknown_type_does_not_match_unknown_type() {
173   reagent a("a:foo");
174   reagent b("b:bar");
175   CHECK(!types_strictly_match(a, b));
176 }
177 
178 void test_unknown_type_matches_itself() {
179   reagent a("a:foo");
180   reagent b("b:foo");
181   CHECK(types_strictly_match(a, b));
182 }
183 
184 void test_type_abbreviations_match_raw_types() {
185   put(Type_abbreviations, "text", new_type_tree("address:array:character"));
186   // a has type (address buffer (address array character))
187   reagent a("a:address:buffer:text");
188   expand_type_abbreviations(a.type);
189   // b has type (address buffer address array character)
190   reagent b("b:address:buffer:address:array:character");
191   CHECK(types_strictly_match(a, b));
192   delete Type_abbreviations["text"];
193   put(Type_abbreviations, "text", NULL);
194 }
195 
196 //: helpers
197 
198 bool is_unsafe(const reagent& r) {
199   return has_property(r, "unsafe");
200 }
201 
202 bool is_mu_array(reagent/*copy*/ r) {
203   // End Preprocess is_mu_array(reagent r)
204   return is_mu_array(r.type);
205 }
206 bool is_mu_array(const type_tree* type) {
207   if (!type) return false;
208   if (is_literal(type)) return false;
209   if (type->atom) return false;
210   if (!type->left->atom) {
211   ¦ raise << "invalid type " << to_string(type) << '\n' << end();
212   ¦ return false;
213   }
214   return type->left->value == get(Type_ordinal, "array");
215 }
216 
217 bool is_mu_address(reagent/*copy*/ r) {
218   // End Preprocess is_mu_address(reagent r)
219   return is_mu_address(r.type);
220 }
221 bool is_mu_address(const type_tree* type) {
222   if (!type) return false;
223   if (is_literal(type)) return false;
224   if (type->atom) return false;
225   if (!type->left->atom) {
226   ¦ raise << "invalid type " << to_string(type) << '\n' << end();
227   ¦ return false;
228   }
229   return type->left->value == get(Type_ordinal, "address");
230 }
231 
232 bool is_mu_boolean(reagent/*copy*/ r) {
233   // End Preprocess is_mu_boolean(reagent r)
234   if (!r.type) return false;
235   if (is_literal(r)) return false;
236   if (!r.type->atom) return false;
237   return r.type->value == get(Type_ordinal, "boolean");
238 }
239 
240 bool is_mu_number(reagent/*copy*/ r) {
241   if (is_mu_character(r.type)) return true;  // permit arithmetic on unicode code points
242   return is_real_mu_number(r);
243 }
244 
245 bool is_real_mu_number(reagent/*copy*/ r) {
246   // End Preprocess is_mu_number(reagent r)
247   if (!r.type) return false;
248   if (!r.type->atom) return false;
249   if (is_literal(r)) {
250   ¦ return r.type->name == "literal-fractional-number"
251   ¦ ¦ ¦ || r.type->name == "literal";
252   }
253   return r.type->value == get(Type_ordinal, "number");
254 }
255 
256 bool is_mu_character(reagent/*copy*/ r) {
257   // End Preprocess is_mu_character(reagent r)
258   return is_mu_character(r.type);
259 }
260 bool is_mu_character(const type_tree* type) {
261   if (!type) return false;
262   if (!type->atom) return false;
263   if (is_literal(type)) return false;
264   return type->value == get(Type_ordinal, "character");
265 }
266 
267 bool is_mu_scalar(reagent/*copy*/ r) {
268   return is_mu_scalar(r.type);
269 }
270 bool is_mu_scalar(const type_tree* type) {
271   if (!type) return false;
272   if (is_mu_address(type)) return true;
273   if (!type->atom) return false;
274   if (is_literal(type))
275   ¦ return type->name != "literal-string";
276   return size_of(type) == 1;
277 }