https://github.com/akkartik/mu/blob/master/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 }