1 //: Interacting with the file system.
  2 //:   '$open-file-for-reading' returns a FILE* as a number (ugh)
  3 //:   '$read-from-file' accepts a number, interprets it as a FILE* (double ugh) and reads a character from it
  4 //: Similarly for writing files.
  5 //: These interfaces are ugly and tied to the current (Linux) host Mu happens
  6 //: to be implemented atop. Later layers will wrap them with better, more
  7 //: testable interfaces.
  8 //:
  9 //: Clearly we don't care about performance or any of that so far.
 10 //: todo: reading/writing binary files
 11 
 12 :(before "End Primitive Recipe Declarations")
 13 _OPEN_FILE_FOR_READING,
 14 :(before "End Primitive Recipe Numbers")
 15 put(Recipe_ordinal, "$open-file-for-reading", _OPEN_FILE_FOR_READING);
 16 :(before "End Primitive Recipe Checks")
 17 case _OPEN_FILE_FOR_READING: {
 18   if (SIZE(inst.ingredients) != 1) {
 19   ¦ raise << maybe(get(Recipe, r).name) << "'$open-file-for-reading' requires exactly one ingredient, but got '" << inst.original_string << "'\n" << end();
 20   ¦ break;
 21   }
 22   if (!is_mu_text(inst.ingredients.at(0))) {
 23   ¦ raise << maybe(get(Recipe, r).name) << "first ingredient of '$open-file-for-reading' should be a string, but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
 24   ¦ break;
 25   }
 26   if (SIZE(inst.products) != 1) {
 27   ¦ raise << maybe(get(Recipe, r).name) << "'$open-file-for-reading' requires exactly one product, but got '" << inst.original_string << "'\n" << end();
 28   ¦ break;
 29   }
 30   if (!is_mu_number(inst.products.at(0))) {
 31   ¦ raise << maybe(get(Recipe, r).name) << "first product of '$open-file-for-reading' should be a number (file handle), but got '" << to_string(inst.products.at(0)) << "'\n" << end();
 32   ¦ break;
 33   }
 34   break;
 35 }
 36 :(before "End Primitive Recipe Implementations")
 37 case _OPEN_FILE_FOR_READING: {
 38   string filename = read_mu_text(ingredients.at(0).at(0));
 39   assert(sizeof(long long int) >= sizeof(FILE*));
 40   FILE* f = fopen(filename.c_str(), "r");
 41   long long int result = reinterpret_cast<long long int>(f);
 42   products.resize(1);
 43   products.at(0).push_back(static_cast<double>(result));
 44   break;
 45 }
 46 
 47 :(before "End Primitive Recipe Declarations")
 48 _OPEN_FILE_FOR_WRITING,
 49 :(before "End Primitive Recipe Numbers")
 50 put(Recipe_ordinal, "$open-file-for-writing", _OPEN_FILE_FOR_WRITING);
 51 :(before "End Primitive Recipe Checks")
 52 case _OPEN_FILE_FOR_WRITING: {
 53   if (SIZE(inst.ingredients) != 1) {
 54   ¦ raise << maybe(get(Recipe, r).name) << "'$open-file-for-writing' requires exactly one ingredient, but got '" << inst.original_string << "'\n" << end();
 55   ¦ break;
 56   }
 57   if (!is_mu_text(inst.ingredients.at(0))) {
 58   ¦ raise << maybe(get(Recipe, r).name) << "first ingredient of '$open-file-for-writing' should be a string, but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
 59   ¦ break;
 60   }
 61   if (SIZE(inst.products) != 1) {
 62   ¦ raise << maybe(get(Recipe, r).name) << "'$open-file-for-writing' requires exactly one product, but got '" << inst.original_string << "'\n" << end();
 63   ¦ break;
 64   }
 65   if (!is_mu_number(inst.products.at(0))) {
 66   ¦ raise << maybe(get(Recipe, r).name) << "first product of '$open-file-for-writing' should be a number (file handle), but got '" << to_string(inst.products.at(0)) << "'\n" << end();
 67   ¦ break;
 68   }
 69   break;
 70 }
 71 :(before "End Primitive Recipe Implementations")
 72 case _OPEN_FILE_FOR_WRITING: {
 73   string filename = read_mu_text(ingredients.at(0).at(0));
 74   assert(sizeof(long long int) >= sizeof(FILE*));
 75   long long int result = reinterpret_cast<long long int>(fopen(filename.c_str(), "w"));
 76   products.resize(1);
 77   products.at(0).push_back(static_cast<double>(result));
 78   break;
 79 }
 80 
 81 :(before "End Primitive Recipe Declarations")
 82 _READ_FROM_FILE,
 83 :(before "End Primitive Recipe Numbers")
 84 put(Recipe_ordinal, "$read-from-file", _READ_FROM_FILE);
 85 :(before "End Primitive Recipe Checks")
 86 case _READ_FROM_FILE: {
 87   if (SIZE(inst.ingredients) != 1) {
 88   ¦ raise << maybe(get(Recipe, r).name) << "'$read-from-file' requires exactly one ingredient, but got '" << inst.original_string << "'\n" << end();
 89   ¦ break;
 90   }
 91   if (!is_mu_number(inst.ingredients.at(0))) {
 92   ¦ raise << maybe(get(Recipe, r).name) << "first ingredient of '$read-from-file' should be a number, but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
 93   ¦ break;
 94   }
 95   if (SIZE(inst.products) != 2) {
 96   ¦ raise << maybe(get(Recipe, r).name) << "'$read-from-file' requires exactly two products, but got '" << inst.original_string << "'\n" << end();
 97   ¦ break;
 98   }
 99   if (!is_mu_character(inst.products.at(0))) {
100   ¦ raise << maybe(get(Recipe, r).name) << "first product of '$read-from-file' should be a character, but got '" << to_string(inst.products.at(0)) << "'\n" << end();
101   ¦ break;
102   }
103   if (!is_mu_boolean(inst.products.at(1))) {
104   ¦ raise << maybe(get(Recipe, r).name) << "second product of '$read-from-file' should be a boolean, but got '" << to_string(inst.products.at(1)) << "'\n" << end();
105   ¦ break;
106   }
107   break;
108 }
109 :(before "End Primitive Recipe Implementations")
110 case _READ_FROM_FILE: {
111   long long int x = static_cast<long long int>(ingredients.at(0).at(0));
112   FILE* f = reinterpret_cast<FILE*>(x);
113   if (f == NULL) {
114   ¦ raise << maybe(current_recipe_name()) << "can't read from null file in '" << to_string(current_instruction()) << "'\n" << end();
115   ¦ break;
116   }
117   products.resize(2);
118   if (feof(f)) {
119   ¦ products.at(0).push_back(0);
120   ¦ products.at(1).push_back(1);  // eof
121   ¦ break;
122   }
123   if (ferror(f)) {
124   ¦ raise << maybe(current_recipe_name()) << "file in invalid state in '" << to_string(current_instruction()) << "'\n" << end();
125   ¦ break;
126   }
127   char c = getc(f);  // todo: unicode
128   if (c == EOF) {
129   ¦ products.at(0).push_back(0);
130   ¦ products.at(1).push_back(1);  // eof
131   ¦ break;
132   }
133   if (ferror(f)) {
134   ¦ raise << maybe(current_recipe_name()) << "couldn't read from file in '" << to_string(current_instruction()) << "'\n" << end();
135   ¦ raise << "  errno: " << errno << '\n' << end();
136   ¦ break;
137   }
138   products.at(0).push_back(c);
139   products.at(1).push_back(0);  // not eof
140   break;
141 }
142 :(before "End Includes")
143 #include <errno.h>
144 
145 :(before "End Primitive Recipe Declarations")
146 _WRITE_TO_FILE,
147 :(before "End Primitive Recipe Numbers")
148 put(Recipe_ordinal, "$write-to-file", _WRITE_TO_FILE);
149 :(before "End Primitive Recipe Checks")
150 case _WRITE_TO_FILE: {
151   if (SIZE(inst.ingredients) != 2) {
152   ¦ raise << maybe(get(Recipe, r).name) << "'$write-to-file' requires exactly two ingredients, but got '" << inst.original_string << "'\n" << end();
153   ¦ break;
154   }
155   if (!is_mu_number(inst.ingredients.at(0))) {
156   ¦ raise << maybe(get(Recipe, r).name) << "first ingredient of '$write-to-file' should be a number, but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
157   ¦ break;
158   }
159   if (!is_mu_character(inst.ingredients.at(1))) {
160   ¦ raise << maybe(get(Recipe, r).name) << "second ingredient of '$write-to-file' should be a character, but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
161   ¦ break;
162   }
163   if (!inst.products.empty()) {
164   ¦ raise << maybe(get(Recipe, r).name) << "'$write-to-file' writes to no products, but got '" << inst.original_string << "'\n" << end();
165   ¦ break;
166   }
167   break;
168 }
169 :(before "End Primitive Recipe Implementations")
170 case _WRITE_TO_FILE: {
171   long long int x = static_cast<long long int>(ingredients.at(0).at(0));
172   FILE* f = reinterpret_cast<FILE*>(x);
173   if (f == NULL) {
174   ¦ raise << maybe(current_recipe_name()) << "can't write to null file in '" << to_string(current_instruction()) << "'\n" << end();
175   ¦ break;
176   }
177   if (feof(f)) break;
178   if (ferror(f)) {
179   ¦ raise << maybe(current_recipe_name()) << "file in invalid state in '" << to_string(current_instruction()) << "'\n" << end();
180   ¦ break;
181   }
182   long long int y = static_cast<long long int>(ingredients.at(1).at(0));
183   char c = static_cast<char>(y);
184   putc(c, f);  // todo: unicode
185   if (ferror(f)) {
186   ¦ raise << maybe(current_recipe_name()) << "couldn't write to file in '" << to_string(current_instruction()) << "'\n" << end();
187   ¦ raise << "  errno: " << errno << '\n' << end();
188   ¦ break;
189   }
190   break;
191 }
192 
193 :(before "End Primitive Recipe Declarations")
194 _CLOSE_FILE,
195 :(before "End Primitive Recipe Numbers")
196 put(Recipe_ordinal, "$close-file", _CLOSE_FILE);
197 :(before "End Primitive Recipe Checks")
198 case _CLOSE_FILE: {
199   if (SIZE(inst.ingredients) != 1) {
200   ¦ raise << maybe(get(Recipe, r).name) << "'$close-file' requires exactly one ingredient, but got '" << inst.original_string << "'\n" << end();
201   ¦ break;
202   }
203   if (!is_mu_number(inst.ingredients.at(0))) {
204   ¦ raise << maybe(get(Recipe, r).name) << "first ingredient of '$close-file' should be a number, but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
205   ¦ break;
206   }
207   if (SIZE(inst.products) != 1) {
208   ¦ raise << maybe(get(Recipe, r).name) << "'$close-file' requires exactly one product, but got '" << inst.original_string << "'\n" << end();
209   ¦ break;
210   }
211   if (inst.products.at(0).name != inst.ingredients.at(0).name) {
212   ¦ raise << maybe(get(Recipe, r).name) << "'$close-file' requires its product to be the same as its ingredient, but got '" << inst.original_string << "'\n" << end();
213   ¦ break;
214   }
215   break;
216 }
217 :(before "End Primitive Recipe Implementations")
218 case _CLOSE_FILE: {
219   long long int x = static_cast<long long int>(ingredients.at(0).at(0));
220   FILE* f = reinterpret_cast<FILE*>(x);
221   fclose(f);
222   products.resize(1);
223   products.at(0).push_back(0);  // todo: ensure that caller always resets the ingredient
224   break;
225 }