klisp

commit 9d91b639cb26831d98193e6b9e61abf507aa0c8c
parent 2e48b96cd94d6e1d670c55eb17ff2a4f25ed6f6c
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu, 24 Nov 2011 18:52:48 -0300

Refactor: moved rename-file, delete-file and file-exist? to kgsystem.c

Diffstat:
M
src/kgports.c
 | 
87
-------------------------------------------------------------------------------
M
src/kgports.h
 | 
9
---------
M
src/kgsystem.c
 | 
86
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

3 files changed, 86 insertions(+), 96 deletions(-)
diff --git a/src/kgports.c b/src/kgports.c
@@ -866,80 +866,6 @@ void flush(klisp_State *K)
     kapply_cc(K, KINERT);
 }
 
-/* 15.1.? file-exists? */
-void file_existsp(klisp_State *K)
-{
-    TValue *xparams = K->next_xparams;
-    TValue ptree = K->next_value;
-    TValue denv = K->next_env;
-    klisp_assert(ttisenvironment(K->next_env));
-    UNUSED(xparams);
-    UNUSED(denv);
-
-    bind_1tp(K, ptree, "string", ttisstring, filename);
-
-    /* TEMP: this should probably be done in a operating system specific
-       manner, but this will do for now */
-    TValue res = KFALSE;
-    FILE *file = fopen(kstring_buf(filename), "r");
-    if (file) {
-	res = KTRUE;
-	UNUSED(fclose(file));
-    }
-    kapply_cc(K, res);
-}
-
-/* 15.1.? delete-file */
-void delete_file(klisp_State *K)
-{
-    TValue *xparams = K->next_xparams;
-    TValue ptree = K->next_value;
-    TValue denv = K->next_env;
-    klisp_assert(ttisenvironment(K->next_env));
-    UNUSED(xparams);
-    UNUSED(denv);
-
-    bind_1tp(K, ptree, "string", ttisstring, filename);
-
-    /* TEMP: this should probably be done in a operating system specific
-       manner, but this will do for now */
-    /* XXX: this could fail if there's a dead (in the gc sense) port still 
-       open, should probably retry once after doing a complete GC */
-    if (remove(kstring_buf(filename))) {
-        klispE_throw_errno_with_irritants(K, "remove", 1, filename);
-        return;
-    } else {
-	kapply_cc(K, KINERT);
-	return;
-    }
-}
-
-/* 15.1.? rename-file */
-void rename_file(klisp_State *K)
-{
-    TValue *xparams = K->next_xparams;
-    TValue ptree = K->next_value;
-    TValue denv = K->next_env;
-    klisp_assert(ttisenvironment(K->next_env));
-    UNUSED(xparams);
-    UNUSED(denv);
-
-    bind_2tp(K, ptree, "string", ttisstring, old_filename, 
-	     "string", ttisstring, new_filename);
-
-    /* TEMP: this should probably be done in a operating system specific
-       manner, but this will do for now */
-    /* XXX: this could fail if there's a dead (in the gc sense) port still 
-       open, should probably retry once after doing a complete GC */
-    if (rename(kstring_buf(old_filename), kstring_buf(new_filename))) {
-        klispE_throw_errno_with_irritants(K, "rename", 2, old_filename, new_filename);
-        return;
-    } else {
-	kapply_cc(K, KINERT);
-	return;
-    }
-}
-
 /* init ground */
 void kinit_ports_ground_env(klisp_State *K)
 {
@@ -1085,19 +1011,6 @@ void kinit_ports_ground_env(klisp_State *K)
     /* 15.1.? flush-output-port */
     add_applicative(K, ground_env, "flush-output-port", flush, 0);
 
-    /* REFACTOR move to system module */
-
-    /* 15.1.? file-exists? */
-    add_applicative(K, ground_env, "file-exists?", file_existsp, 0);
-
-    /* 15.1.? delete-file */
-    add_applicative(K, ground_env, "delete-file", delete_file, 0);
-
-    /* this isn't in r7rs but it's in ansi c and quite easy to implement */
-
-    /* 15.1.? rename-file */
-    add_applicative(K, ground_env, "rename-file", rename_file, 0);
-
     /*
      * That's all there is in the report combined with r5rs and r7rs scheme.
      * TODO
diff --git a/src/kgports.h b/src/kgports.h
@@ -105,15 +105,6 @@ void do_close_file_ret(klisp_State *K);
 /* 15.1.? flush-output-port */
 void flush(klisp_State *K);
 
-/* 15.1.? file-exists? */
-void file_existsp(klisp_State *K);
-
-/* 15.1.? delete-file */
-void delete_file(klisp_State *K);
-
-/* 15.1.? rename-file */
-void rename_file(klisp_State *K);
-
 /* init ground */
 void kinit_ports_ground_env(klisp_State *K);
 
diff --git a/src/kgsystem.c b/src/kgsystem.c
@@ -7,6 +7,7 @@
 #include <assert.h>
 #include <stdlib.h>
 #include <stdbool.h>
+#include <stdio.h>
 #include <stdint.h>
 #include <time.h>
 
@@ -100,6 +101,80 @@ void jiffies_per_second(klisp_State *K)
     }
 }
 
+/* 15.1.? file-exists? */
+void file_existsp(klisp_State *K)
+{
+    TValue *xparams = K->next_xparams;
+    TValue ptree = K->next_value;
+    TValue denv = K->next_env;
+    klisp_assert(ttisenvironment(K->next_env));
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    bind_1tp(K, ptree, "string", ttisstring, filename);
+
+    /* TEMP: this should probably be done in a operating system specific
+       manner, but this will do for now */
+    TValue res = KFALSE;
+    FILE *file = fopen(kstring_buf(filename), "r");
+    if (file) {
+	res = KTRUE;
+	UNUSED(fclose(file));
+    }
+    kapply_cc(K, res);
+}
+
+/* 15.1.? delete-file */
+void delete_file(klisp_State *K)
+{
+    TValue *xparams = K->next_xparams;
+    TValue ptree = K->next_value;
+    TValue denv = K->next_env;
+    klisp_assert(ttisenvironment(K->next_env));
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    bind_1tp(K, ptree, "string", ttisstring, filename);
+
+    /* TEMP: this should probably be done in a operating system specific
+       manner, but this will do for now */
+    /* XXX: this could fail if there's a dead (in the gc sense) port still 
+       open, should probably retry once after doing a complete GC */
+    if (remove(kstring_buf(filename))) {
+        klispE_throw_errno_with_irritants(K, "remove", 1, filename);
+        return;
+    } else {
+	kapply_cc(K, KINERT);
+	return;
+    }
+}
+
+/* 15.1.? rename-file */
+void rename_file(klisp_State *K)
+{
+    TValue *xparams = K->next_xparams;
+    TValue ptree = K->next_value;
+    TValue denv = K->next_env;
+    klisp_assert(ttisenvironment(K->next_env));
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    bind_2tp(K, ptree, "string", ttisstring, old_filename, 
+	     "string", ttisstring, new_filename);
+
+    /* TEMP: this should probably be done in a operating system specific
+       manner, but this will do for now */
+    /* XXX: this could fail if there's a dead (in the gc sense) port still 
+       open, should probably retry once after doing a complete GC */
+    if (rename(kstring_buf(old_filename), kstring_buf(new_filename))) {
+        klispE_throw_errno_with_irritants(K, "rename", 2, old_filename, new_filename);
+        return;
+    } else {
+	kapply_cc(K, KINERT);
+	return;
+    }
+}
+
 /* init ground */
 void kinit_system_ground_env(klisp_State *K)
 {
@@ -113,4 +188,15 @@ void kinit_system_ground_env(klisp_State *K)
     /* ??.?.? jiffies-per-second */
     add_applicative(K, ground_env, "jiffies-per-second", jiffies_per_second, 
 		    0);
+
+    /* ?.? file-exists? */
+    add_applicative(K, ground_env, "file-exists?", file_existsp, 0);
+
+    /* ?.? delete-file */
+    add_applicative(K, ground_env, "delete-file", delete_file, 0);
+
+    /* this isn't in r7rs but it's in ansi c and quite easy to implement */
+
+    /* ?.? rename-file */
+    add_applicative(K, ground_env, "rename-file", rename_file, 0);
 }