klisp

commit 9238bb6160c21e7fc7cd17e7967c5cfcac4f1487
parent c98368c294ebad77b9af6c134c5f9373e470f8ad
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Mar 2011 18:27:56 -0300

Added with-input-from-file & with-output-to-file to the ground environment. Strings & Ports sections finished. (Except char oriented port ops that are not even mentioned in the report, but I will add later).

Diffstat:
M
src/kgkd_vars.h
 | 
6
++++++
M
src/kgports.c
 | 
24
+++++++++++++++++++-----
M
src/kground.c
 | 
4
++--

3 files changed, 27 insertions(+), 7 deletions(-)
diff --git a/src/kgkd_vars.h b/src/kgkd_vars.h
@@ -18,6 +18,12 @@
 #include "kstate.h"
 #include "kghelpers.h"
 
+/* This is also used by kgports.c */
+void do_bind(klisp_State *K, TValue *xparams, TValue ptree, 
+	     TValue denv);
+void do_access(klisp_State *K, TValue *xparams, TValue ptree, 
+	     TValue denv);
+
 /* 10.1.1 make-keyed-dynamic-variable */
 void make_keyed_dynamic_variable(klisp_State *K, TValue *xparams, 
 				 TValue ptree, TValue denv);
diff --git a/src/kgports.c b/src/kgports.c
@@ -51,17 +51,31 @@ void do_close_file_ret(klisp_State *K, TValue *xparams, TValue obj)
     kapply_cc(K, obj);
 }
 
+/* XXX: The report is incomplete here... for now use an empty environment, 
+   the dynamic environment can be captured in the construction of the combiner 
+   ASK John
+*/
 void with_file(klisp_State *K, TValue *xparams, TValue ptree, 
 		    TValue denv)
 {
-/*    char *name = ksymbol_buf(xparams[0]);
+    char *name = ksymbol_buf(xparams[0]);
     bool writep = bvalue(xparams[1]);
     TValue key = xparams[2];
-*/
-    UNUSED(denv);
-    UNUSED(ptree);
 
-    kapply_cc(K, KINERT);
+    bind_2tp(K, name, ptree, "string", ttisstring, filename,
+	     "combiner", ttiscombiner, comb);
+
+    /* gc: root intermediate values */
+    TValue new_port = kmake_port(K, filename, writep, KNIL, 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);
+
+    TValue op = kmake_operative(K, KNIL, KNIL, do_bind, 1, key);
+    TValue args = kcons(K, new_port, kcons(K, comb, KNIL));
+    /* even if we call with denv, do_bind calls comb in an empty env */
+    ktail_call(K, op, args, denv);
 }
 
 /* 15.1.4 get-current-input-port, get-current-output-port */
diff --git a/src/kground.c b/src/kground.c
@@ -768,9 +768,9 @@ void kinit_ground_env(klisp_State *K)
 
     /* 15.1.3 with-input-from-file, with-ouput-to-file */
     add_applicative(K, ground_env, "with-input-from-file", with_file, 
-		    2, symbol, b2tv(false), K->kd_in_port_key);
+		    3, 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);
+		    3, 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,