klisp

commit 51ddb2f98e38a8daa537e754d77011bd342b61bb
parent 9d4de19f1f619ed72433bffd8e62260502030679
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Tue,  5 Apr 2011 15:55:19 -0300

Added write-char to the ground environment.

Diffstat:
M
src/kgports.c
 | 
47
+++++++++++++++++++++++++++++++++++++++++++++++
M
src/kgports.h
 | 
19
+++++++++++++++++++
M
src/kground.c
 | 
27
++++++++++++++++++++++-----

3 files changed, 88 insertions(+), 5 deletions(-)
diff --git a/src/kgports.c b/src/kgports.c
@@ -214,6 +214,50 @@ void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     kapply_cc(K, KINERT);
 }
 
+/* 15.1.? write-char */
+void write_char(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+    
+    bind_al1tp(K, "write-char", ptree, "char", ttischar, ch,
+	       port);
+
+    if (!get_opt_tpar(K, "write-char", K_TPORT, &port)) {
+	port = kcdr(K->kd_out_port_key); /* access directly */
+    } else if (!kport_is_output(port)) {
+	klispE_throw(K, "write-char: the port should be an output port");
+	return;
+    } 
+    if (kport_is_closed(port)) {
+	klispE_throw(K, "write-char: the port is already closed");
+	return;
+    }
+    
+    /* REFACTOR: move this to kwrite, update source info? */
+    FILE *f = K->curr_out = kport_file(port);
+    if (fputc(chvalue(ch), f) == EOF) {
+	/* clear error marker to allow retries later */
+	clearerr(f);
+	klispE_throw(K, "write-char: writing error");
+    } else {
+	kapply_cc(K, KINERT);
+    }
+}
+
+/* 15.1.? read-char */
+/* TODO */
+
+/* 15.1.? peek-char */
+/* TODO */
+
+/* 15.1.? char-ready? */
+/* TODO */
+/* XXX: this always return #t, proper behaviour requires platform 
+   specific code (probably select for posix, a thread for windows
+   (at least for files & consoles), I think pipes and sockets may
+   have something */
+
 /* 15.2.1 call-with-input-file, call-with-output-file */
 /* XXX: The report is incomplete here... for now use an empty environment, 
    the dynamic environment can be captured in the construction of the combiner 
@@ -397,3 +441,6 @@ void get_module(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 	ktail_eval(K, kcar(ls), env);
     }
 }
+
+/* 15.2.? display */
+/* TODO */
diff --git a/src/kgports.h b/src/kgports.h
@@ -50,6 +50,22 @@ void write(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 /* 15.1.? newline */
 void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
+/* 15.1.? write-char */
+void write_char(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
+/* 15.1.? read-char */
+/* TODO */
+
+/* 15.1.? peek-char */
+/* TODO */
+
+/* 15.1.? char-ready? */
+/* TODO */
+/* XXX: this always return #t, proper behaviour requires platform 
+   specific code (probably select for posix, a thread for windows
+   (at least for files & consoles), I think pipes and sockets may
+   have something */
+
 /* 15.2.1 call-with-input-file, call-with-output-file */
 void call_with_file(klisp_State *K, TValue *xparams, TValue ptree, 
 		    TValue denv);
@@ -60,4 +76,7 @@ void load(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 /* 15.2.3 get-module */
 void get_module(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
+/* 15.2.? display */
+/* TODO */
+
 #endif
diff --git a/src/kground.c b/src/kground.c
@@ -960,6 +960,22 @@ void kinit_ground_env(klisp_State *K)
     /* 15.1.? newline */
     add_applicative(K, ground_env, "newline", newline, 0);
 
+    /* 15.1.? write-char */
+    add_applicative(K, ground_env, "write-char", write_char, 0);
+    
+    /* 15.1.? read-char */
+    /* TODO */
+    
+    /* 15.1.? peek-char */
+    /* TODO */
+
+    /* 15.1.? char-ready? */
+    /* TODO */
+    /* XXX: this always return #t, proper behaviour requires platform 
+       specific code (probably select for posix, a thread for windows
+       (at least for files & consoles), I think pipes and sockets may
+       have something */
+
     /* 
     ** 15.2 Library features
     */
@@ -976,13 +992,14 @@ void kinit_ground_env(klisp_State *K)
     /* 15.2.3 get-module */
     add_applicative(K, ground_env, "get-module", get_module, 0);
 
-    /* TODO: That's all there is in the report, but we will probably need:
-       (from r5rs) char-ready?, read-char, peek-char, eof-object?, newline,
-       and write-char; (from c) file-exists?, rename-file and remove-file.
+    /* 15.2.? display */
+    /* TODO */
+
+    /* MAYBE: That's all there is in the report combined with r5rs scheme, 
+       but we will probably need: file-exists?, rename-file and remove-file.
        It would also be good to be able to select between append, truncate and
        error if a file exists, but that would need to be an option in all three 
-       methods of opening */
-    
+       methods of opening. Also some directory checking, traversing etc */
 
     return;