klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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:
Msrc/kgc.c | 1+
Msrc/kgports.c | 6++++++
Msrc/kgports.h | 2++
Msrc/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"); }