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:&:num <- copy 34
 71 ]
 72 +error: main: can't copy '34' to '1:&:num'; types don't match
 73 
 74 :(scenario write_address_to_character_disallowed)
 75 % Hide_errors = true;
 76 def main [
 77   1:&:num <- copy 12/unsafe
 78   2:char <- copy 1:&:num
 79 ]
 80 +error: main: can't copy '1:&:num' to '2:char'; types don't match
 81 
 82 :(scenario write_number_to_character_allowed)
 83 def main [
 84   1:num <- copy 97
 85   2:char <- copy 1:num
 86 ]
 87 $error: 0
 88 
 89 :(code)
 90 // types_match with some leniency
 91 bool types_coercible(reagent/*copy*/ to, reagent/*copy*/ from) {
 92   // Begin types_coercible(reagent to, reagent from)
 93   if (types_match_sub(to, from)) return true;
 94   if (is_real_mu_number(from) && is_mu_character(to)) return true;
 95   // End types_coercible Special-cases
 96   return false;
 97 }
 98 
 99 bool types_match_sub(const reagent& to, const reagent& from) {
100   // to sidestep type-checking, use /unsafe in the source.
101   // this will be highlighted in red inside vim. just for setting up some tests.
102   if (is_unsafe(from)) return true;
103   if (is_literal(from)) {
104     if (is_mu_array(to)) return false;
105     // End Matching Types For Literal(to)
106     if (!to.type) return false;
107     // allow writing null to any address
108     if (is_mu_address(to)) return from.name == "null";
109     return size_of(to) == 1;  // literals are always scalars
110   }
111   return types_strictly_match_sub(to, from);
112 }
113 // variant for others to call
114 bool types_match(reagent/*copy*/ to, reagent/*copy*/ from) {
115   // Begin types_match(reagent to, reagent from)
116   return types_match_sub(to, from);
117 }
118 
119 //: copy arguments for later layers
120 bool types_strictly_match_sub(const reagent& to, const reagent& from) {
121   if (to.type == NULL) return false;  // error
122   if (is_literal(from) && to.type->value == Number_type_ordinal) return true;
123   // to sidestep type-checking, use /unsafe in the source.
124   // this will be highlighted in red inside vim. just for setting up some tests.
125   if (is_unsafe(from)) return true;
126   // '_' never raises type error
127   if (is_dummy(to)) return true;
128   if (!to.type) return !from.type;
129   return types_strictly_match(to.type, from.type);
130 }
131 // variant for others to call
132 bool types_strictly_match(reagent/*copy*/ to, reagent/*copy*/ from) {
133   // Begin types_strictly_match(reagent to, reagent from)
134   return types_strictly_match_sub(to, from);
135 }
136 
137 bool types_strictly_match(const type_tree* to, const type_tree* from) {
138   if (from == to) return true;
139   if (!to) return false;
140   if (!from) return to->atom && to->value == 0;
141   if (from->atom != to->atom) return false;
142   if (from->atom) {
143     if (from->value == -1) return from->name == to->name;
144     return from->value == to->value;
145   }
146   if (types_strictly_match(to->left, from->left) && types_strictly_match(to->right, from->right))
147     return true;
148   // fallback: (x) == x
149   if (to->right == NULL && types_strictly_match(to->left, from)) return true;
150   if (from->right == NULL && types_strictly_match(to, from->left)) return true;
151   return false;
152 }
153 
154 void test_unknown_type_does_not_match_unknown_type() {
155   reagent a("a:foo");
156   reagent b("b:bar");
157   CHECK(!types_strictly_match(a, b));
158 }
159 
160 void test_unknown_type_matches_itself() {
161   reagent a("a:foo");
162   reagent b("b:foo");
163   CHECK(types_strictly_match(a, b));
164 }
165 
166 void test_type_abbreviations_match_raw_types() {
167   put(Type_abbreviations, "text", new_type_tree("address:array:character"));
168   // a has type (address buffer (address array character))
169   reagent a("a:address:buffer:text");
170   expand_type_abbreviations(a.type);
171   // b has type (address buffer address array character)
172   reagent b("b:address:buffer:address:array:character");
173   CHECK(types_strictly_match(a, b));
174   delete Type_abbreviations["text"];
175   put(Type_abbreviations, "text", NULL);
176 }
177 
178 //: helpers
179 
180 bool is_unsafe(const reagent& r) {
181   return has_property(r, "unsafe");
182 }
183 
184 bool is_mu_array(reagent/*copy*/ r) {
185   // End Preprocess is_mu_array(reagent r)
186   return is_mu_array(r.type);
187 }
188 bool is_mu_array(const type_tree* type) {
189   if (!type) return false;
190   if (is_literal(type)) return false;
191   if (type->atom) return false;
192   if (!type->left->atom) {
193     raise << "invalid type " << to_string(type) << '\n' << end();
194     return false;
195   }
196   return type->left->value == Array_type_ordinal;
197 }
198 
199 bool is_mu_boolean(reagent/*copy*/ r) {
200   // End Preprocess is_mu_boolean(reagent r)
201   if (!r.type) return false;
202   if (is_literal(r)) return false;
203   if (!r.type->atom) return false;
204   return r.type->value == Boolean_type_ordinal;
205 }
206 
207 bool is_mu_number(reagent/*copy*/ r) {
208   if (is_mu_character(r.type)) return true;  // permit arithmetic on unicode code points
209   return is_real_mu_number(r);
210 }
211 
212 bool is_real_mu_number(reagent/*copy*/ r) {
213   // End Preprocess is_mu_number(reagent r)
214   if (!r.type) return false;
215   if (!r.type->atom) return false;
216   if (is_literal(r)) {
217     return r.type->name == "literal-fractional-number"
218         || r.type->name == "literal";
219   }
220   return r.type->value == Number_type_ordinal;
221 }
222 
223 bool is_mu_character(reagent/*copy*/ r) {
224   // End Preprocess is_mu_character(reagent r)
225   return is_mu_character(r.type);
226 }
227 bool is_mu_character(const type_tree* type) {
228   if (!type) return false;
229   if (!type->atom) return false;
230   if (is_literal(type)) return false;
231   return type->value == Character_type_ordinal;
232 }