klisp

commit 43c8008d8ebda38c9c9e8ad2fe5ab3e0790a9ddb
parent 83b40d9230948d6e2c169cac135702aca8a1af9c
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 13 Jul 2011 15:06:45 -0300

Added current-error-port and with-error-to-file to the ground environment. Added error-port key to gc roots. Moved the errors in the repl to stderr instead of stdout.

Diffstat:
M
src/kgc.c
 | 
1
+
M
src/kgports.c
 | 
6
++++++
M
src/kgports.h
 | 
2
++
M
src/krepl.c
 | 
18
++++++++----------

4 files changed, 17 insertions(+), 10 deletions(-)
diff --git a/src/kgc.c b/src/kgc.c
@@ -582,6 +582,7 @@ static void markroot (klisp_State *K) {
 
     markvalue(K, K->kd_in_port_key);
     markvalue(K, K->kd_out_port_key);
+    markvalue(K, K->kd_error_port_key);
     markvalue(K, K->empty_string);
     markvalue(K, K->empty_blob);
 
diff --git a/src/kgports.c b/src/kgports.c
@@ -564,15 +564,21 @@ void kinit_ports_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "output-port?", ftypep, 2, symbol, 
 		    p2tv(kis_output_port));
     /* 15.1.3 with-input-from-file, with-ouput-to-file */
+    /* 15.1.? with-error-to-file */
     add_applicative(K, ground_env, "with-input-from-file", with_file, 
 		    3, symbol, b2tv(false), K->kd_in_port_key);
     add_applicative(K, ground_env, "with-output-to-file", with_file, 
 		    3, symbol, b2tv(true), K->kd_out_port_key);
+    add_applicative(K, ground_env, "with-error-to-file", with_file, 
+		    3, symbol, b2tv(true), K->kd_error_port_key);
     /* 15.1.4 get-current-input-port, get-current-output-port */
+    /* 15.1.? get-current-error-port */
     add_applicative(K, ground_env, "get-current-input-port", get_current_port, 
 		    2, symbol, K->kd_in_port_key);
     add_applicative(K, ground_env, "get-current-output-port", get_current_port, 
 		    2, symbol, K->kd_out_port_key);
+    add_applicative(K, ground_env, "get-current-error-port", get_current_port, 
+		    2, symbol, K->kd_error_port_key);
     /* 15.1.5 open-input-file, open-output-file */
     add_applicative(K, ground_env, "open-input-file", open_file, 2, symbol, 
 		    b2tv(false));
diff --git a/src/kgports.h b/src/kgports.h
@@ -25,10 +25,12 @@
 /* use ftypep */
 
 /* 15.1.3 with-input-from-file, with-ouput-to-file */
+/* 15.1.? with-error-to-file */
 void with_file(klisp_State *K, TValue *xparams, TValue ptree, 
 		    TValue denv);
 
 /* 15.1.4 get-current-input-port, get-current-output-port */
+/* 15.1.? get-current-error-port */
 void get_current_port(klisp_State *K, TValue *xparams, TValue ptree,
 		      TValue denv);
 
diff --git a/src/krepl.c b/src/krepl.c
@@ -126,11 +126,9 @@ void do_repl_error(klisp_State *K, TValue *xparams, TValue obj)
     ** xparams[0]: dynamic environment
     */
 
-    /* TEMP: should be better to have an error port
-       like in scheme r6rs & r7rs (draft) */
     /* FOR NOW used only for irritant list */
-    TValue port = kcdr(K->kd_out_port_key);
-    klisp_assert(kport_file(port) == stdout);
+    TValue port = kcdr(K->kd_error_port_key);
+    klisp_assert(kport_file(port) == stderr);
 
     /* TEMP: obj should be an error obj */
     if (ttiserror(obj)) {
@@ -152,15 +150,15 @@ void do_repl_error(klisp_State *K, TValue *xparams, TValue obj)
 	    who_str = "?";
 	}
 	char *msg = kstring_buf(err_obj->msg);
-	fprintf(stdout, "\n*ERROR*: \n");
-	fprintf(stdout, "%s: %s", who_str, msg);
+	fprintf(stderr, "\n*ERROR*: \n");
+	fprintf(stderr, "%s: %s", who_str, msg);
 
 	krooted_tvs_push(K, obj);
 
 	/* Msg + irritants */
 	/* TODO move to a new function */
 	if (!ttisnil(err_obj->irritants)) {
-	    fprintf(stdout, ": ");
+	    fprintf(stderr, ": ");
 	    kwrite_display_to_port(K, port, err_obj->irritants, false);
 	}
 	kwrite_newline_to_port(K, port);
@@ -171,7 +169,7 @@ void do_repl_error(klisp_State *K, TValue *xparams, TValue obj)
 	/* TODO move to a new function */
 	/* MAYBE: remove */
 	if (khas_name(who) || khas_si(who)) {
-	    fprintf(stdout, "Location: ");
+	    fprintf(stderr, "Location: ");
 	    kwrite_display_to_port(K, port, who, false);
 	    kwrite_newline_to_port(K, port);
 	}
@@ -179,7 +177,7 @@ void do_repl_error(klisp_State *K, TValue *xparams, TValue obj)
 	/* Backtrace */
 	/* TODO move to a new function */
 	TValue tv_cont = err_obj->cont;
-	fprintf(stdout, "Backtrace: \n");
+	fprintf(stderr, "Backtrace: \n");
 	while(ttiscontinuation(tv_cont)) {
 	    kwrite_display_to_port(K, port, tv_cont, false);
 	    kwrite_newline_to_port(K, port);
@@ -192,7 +190,7 @@ void do_repl_error(klisp_State *K, TValue *xparams, TValue obj)
 #endif
 	krooted_tvs_pop(K);
     } else {
-	fprintf(stdout, "\n*ERROR*: not an error object passed to " 
+	fprintf(stderr, "\n*ERROR*: not an error object passed to " 
 		"error continuation");
     }