add file ops

lib/ext/file.c

@@ -74,12 +74,80 @@ pic_fopen(pic_state *pic, FILE *fp, const char *mode) {
   }
 }
 
+PIC_NORETURN static void
+file_error(pic_state *pic, const char *msg, const char *fname)
+{
+  pic_value fn = pic_cstr_value(pic, fname);
+
+  pic_raise(pic, pic_make_error(pic, "file", msg, pic_list(pic, 1, fn)));
+}
+
+pic_value
+pic_file_open_input_file(pic_state *pic)
+{
+  const char *fname;
+  FILE *fp;
+
+  pic_get_args(pic, "z", &fname);
+
+  if ((fp = fopen(fname, "r")) == NULL) {
+    file_error(pic, "could not open file", fname);
+  }
+  return pic_fopen(pic, fp, "r");
+}
+
+pic_value
+pic_file_open_output_file(pic_state *pic)
+{
+  const char *fname;
+  FILE *fp;
+
+  pic_get_args(pic, "z", &fname);
+
+  if ((fp = fopen(fname, "w")) == NULL) {
+    file_error(pic, "could not open file", fname);
+  }
+  return pic_fopen(pic, fp, "w");
+}
+
+pic_value
+pic_file_exists_p(pic_state *pic)
+{
+  const char *fname;
+  FILE *fp;
+
+  pic_get_args(pic, "z", &fname);
+
+  fp = fopen(fname, "r");
+  if (fp) {
+    fclose(fp);
+  }
+  return pic_bool_value(pic, fp != NULL);
+}
+
+pic_value
+pic_file_delete(pic_state *pic)
+{
+  const char *fname;
+
+  pic_get_args(pic, "z", &fname);
+
+  if (remove(fname) != 0) {
+    file_error(pic, "file cannot be deleted", fname);
+  }
+  return pic_undef_value(pic);
+}
+
 void
 pic_init_file(pic_state *pic)
 {
   pic_defvar(pic, "current-input-port", pic_fopen(pic, stdin, "r"));
   pic_defvar(pic, "current-output-port", pic_fopen(pic, stdout, "w"));
   pic_defvar(pic, "current-error-port", pic_fopen(pic, stdout, "w"));
+  pic_defun(pic, "open-binary-input-file", pic_file_open_input_file);
+  pic_defun(pic, "open-binary-output-file", pic_file_open_output_file);
+  pic_defun(pic, "file-exists?", pic_file_exists_p);
+  pic_defun(pic, "delete-file", pic_file_delete);
 }
 
 #endif

lib/gc.c

@@ -417,7 +417,7 @@ gc_finalize_object(pic_state *pic, struct object *obj)
   case PIC_TYPE_IREP: {
     struct irep *irep = &obj->u.irep;
     if ((irep->flags & IREP_CODE_STATIC) == 0) {
-      pic_free(pic, irep->code);
+      pic_free(pic, (code_t *) irep->code);
     }
     pic_free(pic, irep->obj);
     pic_free(pic, irep->irep);