klisp

commit 93ac1aacdd26b3ff6f4ea1222c0afab426fed283
parent 325ec791772b76cc10b2beb006b12a86af2b2f5e
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu, 17 Mar 2011 17:08:17 -0300

Added newline and eof-object? (both from r5rs) to the ground environment.

Diffstat:
M
src/kgports.c
 | 
27
+++++++++++++++++++++++++++
M
src/kgports.h
 | 
6
++++++
M
src/kground.c
 | 
11
+++++++++++

3 files changed, 44 insertions(+), 0 deletions(-)
diff --git a/src/kgports.c b/src/kgports.c
@@ -120,6 +120,33 @@ void write(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     kapply_cc(K, KINERT);
 }
 
+/* 15.1.? eof-object? */
+/* uses typep */
+
+/* 15.1.? newline */
+/* TEMP: the port parameter is not optional yet */
+void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+    
+    bind_1tp(K, "newline", ptree, "port", ttisport, port);
+
+    if (!kport_is_output(port)) {
+	klispE_throw(K, "write: the port should be an output port");
+	return;
+    } else if (kport_is_closed(port)) {
+	klispE_throw(K, "write: the port is already closed");
+	return;
+    }
+    
+    /* TEMP: for now set this by hand */
+    K->curr_out = tv2port(port)->file;
+
+    knewline(K);
+    kapply_cc(K, KINERT);
+}
+
 /* 15.2.1 call-with-input-file, call-with-output-file */
 /* TODO */
 
diff --git a/src/kgports.h b/src/kgports.h
@@ -42,6 +42,12 @@ void read(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 /* 15.1.8 write */
 void write(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
+/* 15.1.? eof-object? */
+/* uses typep */
+
+/* 15.1.? newline */
+void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
 /* 15.2.1 call-with-input-file, call-with-output-file */
 /* TODO */
 
diff --git a/src/kground.c b/src/kground.c
@@ -518,6 +518,17 @@ void kinit_ground_env(klisp_State *K)
     /* 15.1.8 write */
     add_applicative(K, ground_env, "write", write, 0);
 
+    /*
+    ** These are from scheme (r5rs)
+    */
+
+    /* 15.1.? eof-object? */
+    add_applicative(K, ground_env, "eof-object?", typep, 2, symbol, 
+		    i2tv(K_TEOF));
+
+    /* 15.1.? newline */
+    add_applicative(K, ground_env, "newline", newline, 0);
+
     /* 
     ** 15.2 Library features
     */