archive/1.vm/087file.cc

   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 '" << to_original_string(inst) << "'\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 '" << to_original_string(inst) << "'\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(/*skip alloc id*/1));
  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 '" << to_original_string(inst) << "'\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 '" << to_original_string(inst) << "'\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(/*skip alloc id*/1));
  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 '" << to_original_string(inst) << "'\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 '" << to_original_string(inst) << "'\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 '" << to_original_string(inst) << "'\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 '" << to_original_string(inst) << "'\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 '" << to_original_string(inst) << "'\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 '" << to_original_string(inst) << "'\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 '" << to_original_string(inst) << "'\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 }