klisp

commit 76396dbc2626f86b7d1305ff1c3b0bcd18c3ec31
parent 3ac5c10247f17806939f9c425a89d8a5937c083e
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 21 Oct 2011 14:07:23 -0300

Added file-exists? to the ground environment.

Diffstat:
M
src/kgports.c
 | 
26
++++++++++++++++++++++++--
M
src/kgports.h
 | 
4
+++-

2 files changed, 27 insertions(+), 3 deletions(-)
diff --git a/src/kgports.c b/src/kgports.c
@@ -556,7 +556,7 @@ void display(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 }
 
 /* 15.1.? flush-output-port */
-void kflush(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+void flush(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 {
     UNUSED(xparams);
     UNUSED(denv);
@@ -581,6 +581,25 @@ void kflush(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     kapply_cc(K, KINERT);
 }
 
+/* 15.1.? file-exists? */
+void file_existsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    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);
+}
+
 /* init ground */
 void kinit_ports_ground_env(klisp_State *K)
 {
@@ -672,5 +691,8 @@ void kinit_ports_ground_env(klisp_State *K)
     /* r7rs */
 
     /* 15.1.? flush-output-port */
-    add_applicative(K, ground_env, "flush-output-port", kflush, 0);
+    add_applicative(K, ground_env, "flush-output-port", flush, 0);
+
+    /* 15.1.? file-exists? */
+    add_applicative(K, ground_env, "file-exists?", file_existsp, 0);
 }
diff --git a/src/kgports.h b/src/kgports.h
@@ -88,8 +88,10 @@ void display(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 void do_close_file_ret(klisp_State *K, TValue *xparams, TValue obj);
 
 /* 15.1.? flush-output-port */
-void kflush(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+void flush(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
+/* 15.1.? file-exists? */
+void file_existsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* init ground */
 void kinit_ports_ground_env(klisp_State *K);