klisp

commit c98368c294ebad77b9af6c134c5f9373e470f8ad
parent 41116efe8ffe4ce81f5171e8489813e0fced70b1
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Mar 2011 18:13:28 -0300

Bugfix to with-i/o-file: added a continuation to close the port after return.

Diffstat:
M
src/kgports.c
 | 
37
+++++++++++++++++++++++++++++++++----
M
src/kgports.h
 | 
3
++-
M
src/kground.c
 | 
5
++++-
M
src/kport.c
 | 
5
+++++

4 files changed, 44 insertions(+), 6 deletions(-)
diff --git a/src/kgports.c b/src/kgports.c
@@ -38,7 +38,31 @@
 /* use ftypep */
 
 /* 15.1.3 with-input-from-file, with-ouput-to-file */
-/* TODO */
+/* helper for with-i/o-from/to-file & call-with-i/o-file */
+void do_close_file_ret(klisp_State *K, TValue *xparams, TValue obj)
+{
+    /*
+    ** xparams[0]: port
+    */
+
+    TValue port = xparams[0];
+    kclose_port(K, port);
+    /* obj is the ret_val */
+    kapply_cc(K, obj);
+}
+
+void with_file(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv)
+{
+/*    char *name = ksymbol_buf(xparams[0]);
+    bool writep = bvalue(xparams[1]);
+    TValue key = xparams[2];
+*/
+    UNUSED(denv);
+    UNUSED(ptree);
+
+    kapply_cc(K, KINERT);
+}
 
 /* 15.1.4 get-current-input-port, get-current-output-port */
 void get_current_port(klisp_State *K, TValue *xparams, TValue ptree,
@@ -194,6 +218,11 @@ void call_with_file(klisp_State *K, TValue *xparams, TValue ptree,
     TValue empty_env = kmake_empty_environment(K);
     TValue new_port = kmake_port(K, filename, writep, KNIL, KNIL);
     TValue expr = kcons(K, comb, kcons(K, new_port, KNIL));
+
+    /* make the continuation to close the file before returning */
+    TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL, 
+					 do_close_file_ret, 1, new_port);
+    kset_cc(K, new_cont);
     ktail_eval(K, expr, empty_env);
 }
 
@@ -222,8 +251,8 @@ TValue read_all_expr(klisp_State *K, TValue port)
     }
 }
 
-/* interceptor for errors during reading */
-void do_close_file(klisp_State *K, TValue *xparams, TValue ptree, 
+/* interceptor for errors during reading, also for the continuat */
+void do_int_close_file(klisp_State *K, TValue *xparams, TValue ptree, 
 		   TValue denv)
 {
     /*
@@ -266,7 +295,7 @@ inline TValue make_return_value_cont(klisp_State *K, TValue parent, TValue obj)
 TValue make_guarded_read_cont(klisp_State *K, TValue parent, TValue port)
 {
     /* create the guard to close file after read errors */
-    TValue exit_int = kmake_operative(K, KNIL, KNIL, do_close_file, 
+    TValue exit_int = kmake_operative(K, KNIL, KNIL, do_int_close_file, 
 				      1, port);
     TValue exit_guard = kcons(K, K->error_cont, exit_int);
     TValue exit_guards = kcons(K, exit_guard, KNIL);
diff --git a/src/kgports.h b/src/kgports.h
@@ -25,7 +25,8 @@
 /* use ftypep */
 
 /* 15.1.3 with-input-from-file, with-ouput-to-file */
-/* TODO */
+void with_file(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv);
 
 /* 15.1.4 get-current-input-port, get-current-output-port */
 void get_current_port(klisp_State *K, TValue *xparams, TValue ptree,
diff --git a/src/kground.c b/src/kground.c
@@ -767,7 +767,10 @@ void kinit_ground_env(klisp_State *K)
 		    p2tv(kis_output_port));
 
     /* 15.1.3 with-input-from-file, with-ouput-to-file */
-    /* TODO */
+    add_applicative(K, ground_env, "with-input-from-file", with_file, 
+		    2, symbol, b2tv(false), K->kd_in_port_key);
+    add_applicative(K, ground_env, "with-output-to-file", with_file, 
+		    2, symbol, b2tv(true), K->kd_out_port_key);
 
     /* 15.1.4 get-current-input-port, get-current-output-port */
     add_applicative(K, ground_env, "get-current-input-port", get_current_port, 
diff --git a/src/kport.c b/src/kport.c
@@ -14,6 +14,11 @@
 #include "kerror.h"
 #include "kstring.h"
 
+/* XXX: per the c spec, this truncates the file if it extists! */
+/* Ask John: what would be best? Probably should also include delete,
+   file-exists? and a mechanism to truncate or append to a file, or 
+   throw error if it exists.
+   Should use open, but it is non standard (fcntl.h, POSIX only) */
 TValue kmake_port(klisp_State *K, TValue filename, bool writep, TValue name, 
 			  TValue si)
 {