klisp

commit 41116efe8ffe4ce81f5171e8489813e0fced70b1
parent a21f26480db63bfccfb7e54121976c16d721da23
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Mar 2011 17:51:11 -0300

Added call-with-input-file and call-with-output-file to the ground environment.

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

3 files changed, 25 insertions(+), 3 deletions(-)
diff --git a/src/kgports.c b/src/kgports.c
@@ -176,8 +176,26 @@ void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 }
 
 /* 15.2.1 call-with-input-file, call-with-output-file */
-/* TODO */
+/* 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 call_with_file(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv)
+{
+    char *name = ksymbol_buf(xparams[0]);
+    bool writep = bvalue(xparams[1]);
+    UNUSED(denv);
+
+    bind_2tp(K, name, ptree, "string", ttisstring, filename,
+	     "combiner", ttiscombiner, comb);
 
+    /* gc: root intermediate values */
+    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));
+    ktail_eval(K, expr, empty_env);
+}
 
 /* helpers for load */
 
diff --git a/src/kgports.h b/src/kgports.h
@@ -50,7 +50,8 @@ void write(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 15.2.1 call-with-input-file, call-with-output-file */
-/* TODO */
+void call_with_file(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv);
 
 /* 15.2.2 load */
 void load(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
diff --git a/src/kground.c b/src/kground.c
@@ -813,7 +813,10 @@ void kinit_ground_env(klisp_State *K)
     */
 
     /* 15.2.1 call-with-input-file, call-with-output-file */
-    /* TODO */
+    add_applicative(K, ground_env, "call-with-input-file", call_with_file, 
+		    2, symbol, b2tv(false));
+    add_applicative(K, ground_env, "call-with-output-file", call_with_file, 
+		    2, symbol, b2tv(true));
 
     /* 15.2.2 load */
     add_applicative(K, ground_env, "load", load, 0);