commit 5cdfefd27bd1fbdc76c42a340ea067e8f7f21ab0
parent 33849c33ab736dfab708bf633c5a512358da8827
Author: Andres Navarro <canavarro82@gmail.com>
Date: Fri, 22 Apr 2011 00:05:20 -0300
Revamped the whole read/write interface to incorporate a port argument. Added error checking to write & added source code info updating to ports after read (even if there is an error).
Diffstat:
14 files changed, 224 insertions(+), 140 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -44,7 +44,7 @@ klisp.o: klisp.c klisp.h kobject.h kread.h kwrite.h klimits.h kstate.h kmem.h \
kapplicative.h koperative.h keval.h krepl.h kground.h
kobject.o: kobject.c kobject.h klimits.h klispconf.h
ktoken.o: ktoken.c ktoken.h kobject.h kstate.h kpair.h kstring.h ksymbol.h \
- kerror.h klisp.h kinteger.h
+ kerror.h klisp.h kinteger.h kport.h
kinteger.o: kinteger.c kinteger.h kobject.h kstate.h kmem.h klisp.h imath.h \
kgc.h
kpair.o: kpair.c kpair.h kobject.h kstate.h kmem.h klisp.h kgc.h
@@ -82,7 +82,7 @@ ktable.o: ktable.c ktable.h kobject.h kstate.h kmem.h klisp.h kgc.h \
keval.o: keval.c keval.h kcontinuation.h kenvironment.h kstate.h kobject.h \
kpair.h kerror.h klisp.h klispconf.h
krepl.o: krepl.c krepl.h kcontinuation.h kstate.h kobject.h keval.h klisp.h \
- kread.h kwrite.h kenvironment.h ksymbol.h
+ kread.h kwrite.h kenvironment.h ksymbol.h kport.h kpair.h
kground.o: kground.c kground.h kstate.h kobject.h klisp.h kenvironment.h \
kapplicative.h koperative.h ksymbol.h kerror.h kghelpers.h \
kgbooleans.h kgeqp.h kgequalp.h kgsymbols.h kgpairs_lists.h \
diff --git a/src/kgports.c b/src/kgports.c
@@ -156,13 +156,8 @@ void read(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
return;
}
- /* TEMP: for now set this by hand */
- K->curr_in = kport_file(port);
- ktok_reset_source_info(K); /* this should be saved in the port
- and restored before the call to
- read and saved after it */
- K->read_mconsp = true; /* read mutable pairs */
- TValue obj = kread(K); /* this may throw an error, that's ok */
+ /* this may throw an error, that's ok */
+ TValue obj = kread_from_port(K, port, true); /* read mutable pairs */
kapply_cc(K, obj);
}
@@ -185,12 +180,9 @@ void write(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
klispE_throw(K, "write: the port is already closed");
return;
}
-
- /* TEMP: for now set this by hand */
- K->curr_out = kport_file(port);
- K->write_displayp = false;
- kwrite(K, obj);
+ /* false: quote strings, escape chars */
+ kwrite_display_to_port(K, port, obj, false);
kapply_cc(K, KINERT);
}
@@ -215,10 +207,7 @@ void newline(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
return;
}
- /* TEMP: for now set this by hand */
- K->curr_out = kport_file(port);
-
- kwrite_newline(K);
+ kwrite_newline_to_port(K, port);
kapply_cc(K, KINERT);
}
@@ -242,15 +231,8 @@ void write_char(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
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);
- }
+ kwrite_char_to_port(K, port, ch);
+ kapply_cc(K, KINERT);
}
/* Helper for read-char and peek-char */
@@ -278,33 +260,7 @@ void read_peek_char(klisp_State *K, TValue *xparams, TValue ptree,
return;
}
- /* TODO update source info on the port */
- FILE *f = K->curr_in = kport_file(port);
- int ch = fgetc(f);
- TValue obj;
- if (ch == EOF) {
- if (ferror(f) != 0) {
- /* clear error marker to allow retries later */
- clearerr(f);
- klispE_throw_extra(K, name, ": reading error");
- return;
- } else { /* if (feof(f) != 0) */
- /* let the eof marker set */
- obj = KEOF;
- }
- } else {
- obj = ch2tv((char) ch);
- /* check to see if this was a peek-char call */
- if (ret_charp) {
- if (ungetc(ch, f) == EOF) {
- /* shouldn't happen, but better be safe than sorry */
- /* clear error marker to allow retries later */
- clearerr(f);
- klispE_throw_extra(K, name, ": error ungetting char");
- return;
- }
- }
- }
+ TValue obj = kread_peek_char_from_port(K, port, ret_charp);
kapply_cc(K, obj);
}
@@ -378,18 +334,13 @@ void call_with_file(klisp_State *K, TValue *xparams, TValue ptree,
/* GC: assume port is rooted */
TValue read_all_expr(klisp_State *K, TValue port)
{
- /* TEMP: for now set this by hand */
- K->curr_in = kport_file(port);
- ktok_reset_source_info(K);
- K->read_mconsp = false; /* read immutable pairs */
-
/* GC: root dummy and obj */
TValue tail = kget_dummy1(K);
TValue obj = KINERT;
krooted_vars_push(K, &obj);
while(true) {
- obj = kread(K);
+ obj = kread_from_port(K, port, false); /* read immutable pairs */
if (ttiseof(obj)) {
krooted_vars_pop(K);
return kcutoff_dummy1(K);
@@ -580,10 +531,7 @@ void display(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
return;
}
- /* TEMP: for now set this by hand */
- K->curr_out = kport_file(port);
- K->write_displayp = true;
-
- kwrite(K, obj);
+ /* true: don't quote strings, don't escape chars */
+ kwrite_display_to_port(K, port, obj, true);
kapply_cc(K, KINERT);
}
diff --git a/src/kobject.h b/src/kobject.h
@@ -390,6 +390,9 @@ typedef struct __attribute__ ((__packed__)) {
typedef struct __attribute__ ((__packed__)) {
CommonHeader;
TValue filename;
+ /* TEMP: for now source code info is in fixints */
+ int32_t row;
+ int32_t col;
FILE *file;
} Port;
diff --git a/src/kport.c b/src/kport.c
@@ -30,7 +30,7 @@ TValue kmake_port(klisp_State *K, TValue filename, bool writep)
klispE_throw(K, "Create port: could't open file");
return KINERT;
} else {
- return kmake_std_port(K, filename, writep, KNIL, KNIL, f);
+ return kmake_std_port(K, filename, writep, f);
}
}
@@ -39,7 +39,7 @@ TValue kmake_port(klisp_State *K, TValue filename, bool writep)
/* GC: Assumes filename, name & si are rooted */
TValue kmake_std_port(klisp_State *K, TValue filename, bool writep,
- TValue name, TValue si, FILE *file)
+ FILE *file)
{
Port *new_port = klispM_new(K, Port);
@@ -51,8 +51,12 @@ TValue kmake_std_port(klisp_State *K, TValue filename, bool writep,
/* port specific fields */
new_port->filename = filename;
new_port->file = file;
+ TValue tv_port = gc2port(new_port);
+ /* line is 1-based and col is 0-based */
+ kport_line(tv_port) = 1;
+ kport_col(tv_port) = 0;
- return gc2port(new_port);
+ return tv_port;
}
/* if the port is already closed do nothing */
@@ -70,3 +74,16 @@ void kclose_port(klisp_State *K, TValue port)
return;
}
+
+void kport_reset_source_info(TValue port)
+{
+ /* line is 1-based and col is 0-based */
+ kport_line(port) = 1;
+ kport_col(port) = 0;
+}
+
+void kport_update_source_info(TValue port, int32_t line, int32_t col)
+{
+ kport_line(port) = line;
+ kport_col(port) = col;
+}
diff --git a/src/kport.h b/src/kport.h
@@ -19,7 +19,7 @@ TValue kmake_port(klisp_State *K, TValue filename, bool writep);
helper for the one above */
/* GC: Assumes filename, name & si are rooted */
TValue kmake_std_port(klisp_State *K, TValue filename, bool writep,
- TValue name, TValue si, FILE *file);
+ FILE *file);
/* This closes the underlying FILE * (unless it is a std port) and also
set the closed flag to true, this shouldn't throw errors because it
@@ -28,4 +28,11 @@ TValue kmake_std_port(klisp_State *K, TValue filename, bool writep,
void kclose_port(klisp_State *K, TValue port);
#define kport_file(p_) (tv2port(p_)->file)
+#define kport_filename(p_) (tv2port(p_)->filename)
+#define kport_line(p_) (tv2port(p_)->row)
+#define kport_col(p_) (tv2port(p_)->col)
+
+void kport_reset_source_info(TValue port);
+void kport_update_source_info(TValue port, int32_t line, int32_t col);
+
#endif
diff --git a/src/kread.c b/src/kread.c
@@ -15,6 +15,7 @@
#include "kstate.h"
#include "kerror.h"
#include "ktable.h"
+#include "kport.h"
/*
@@ -67,6 +68,10 @@ void kread_error(klisp_State *K, char *str)
krooted_tvs_clear(K);
krooted_vars_clear(K);
+ /* save the source code info on the port anyways */
+ kport_update_source_info(K->curr_port, K->ktok_source_info.line,
+ K->ktok_source_info.col);
+
klispE_throw(K, str);
}
@@ -507,3 +512,35 @@ TValue kread(klisp_State *K)
return obj;
}
+
+
+TValue kread_from_port(klisp_State *K, TValue port, bool mut)
+{
+ K->curr_port = port;
+ K->curr_in = kport_file(port);
+ K->read_mconsp = mut;
+
+ ktok_set_source_info(K, kport_filename(port),
+ kport_line(port), kport_col(port));
+
+ TValue obj = kread(K);
+
+ kport_update_source_info(port, K->ktok_source_info.line,
+ K->ktok_source_info.col);
+ return obj;
+}
+
+TValue kread_peek_char_from_port(klisp_State *K, TValue port, bool peek)
+{
+ K->curr_port = port;
+ K->curr_in = kport_file(port);
+ /* only needed if not peek, but do it anyways */
+ ktok_set_source_info(K, kport_filename(port),
+ kport_line(port), kport_col(port));
+ int ch = peek? ktok_peekc(K) : ktok_getc(K);
+ TValue res = ch == EOF? KEOF : ch2tv((char)ch);
+ /* same as above */
+ kport_update_source_info(port, K->ktok_source_info.line,
+ K->ktok_source_info.col);
+ return res;
+}
diff --git a/src/kread.h b/src/kread.h
@@ -13,7 +13,8 @@
/*
** Reader interface
*/
-TValue kread(klisp_State *K);
+TValue kread_from_port(klisp_State *K, TValue port, bool mut);
+TValue kread_peek_char_from_port(klisp_State *K, TValue port, bool peek);
#endif
diff --git a/src/krepl.c b/src/krepl.c
@@ -17,6 +17,8 @@
#include "kstring.h"
#include "krepl.h"
#include "ksymbol.h"
+#include "kport.h"
+#include "kpair.h"
/* the exit continuation, it exits the loop */
void exit_fn(klisp_State *K, TValue *xparams, TValue obj)
@@ -38,12 +40,11 @@ void read_fn(klisp_State *K, TValue *xparams, TValue obj)
/* show prompt */
fprintf(stdout, "klisp> ");
- /* TEMP: for now set this by hand */
- K->curr_in = stdin;
- ktok_reset_source_info(K);
- K->read_mconsp = true; /* read mutable pairs */
+ TValue port = kcdr(K->kd_in_port_key);
+ klisp_assert(kport_file(port) == stdin);
- obj = kread(K);
+ kport_reset_source_info(port);
+ obj = kread_from_port(K, port, true); /* read mutable pairs */
kapply_cc(K, obj);
}
@@ -92,11 +93,13 @@ void loop_fn(klisp_State *K, TValue *xparams, TValue obj)
** xparams[0]: dynamic environment
*/
- /* TEMP: for now set this by hand */
- K->curr_out = stdout;
- K->write_displayp = false;
- kwrite(K, obj);
- kwrite_newline(K);
+ TValue port = kcdr(K->kd_out_port_key);
+ klisp_assert(kport_file(port) == stdout);
+
+ /* false: quote strings, escape chars */
+ kwrite_display_to_port(K, port, obj, false);
+ kwrite_newline_to_port(K, port);
+
TValue denv = xparams[0];
create_loop(K, denv);
}
diff --git a/src/kstate.c b/src/kstate.c
@@ -82,10 +82,9 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
K->ud = ud;
/* current input and output */
- K->curr_in = stdin;
- K->curr_out = stdout;
- K->filename_in = "*STDIN*";
- K->filename_out = "*STDOUT*";
+ K->curr_in = NULL; /* set on each call to read */
+ K->curr_out = NULL; /* set on each call to write */
+ K->curr_port = KINERT; /* set on each call to read/write */
/* input / output for dynamic keys */
/* these are init later */
@@ -162,16 +161,19 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
/* TEMP: For now just hardcode it to 8 spaces tab-stop */
K->ktok_source_info.tab_width = 8;
- K->ktok_source_info.filename = "*STDIN*";
+ /* all three are set on each call to read */
+ K->ktok_source_info.filename = KINERT;
+ K->ktok_source_info.line = 1;
+ K->ktok_source_info.col = 0;
+
ktok_init(K);
- ktok_reset_source_info(K);
/* initialize reader */
K->shared_dict = KNIL;
- K->read_mconsp = false; /* should be set before calling read */
+ K->read_mconsp = false; /* set on each call to read */
/* initialize writer */
- K->write_displayp = false; /* should be set before calling write */
+ K->write_displayp = false; /* set on each call to write */
/* initialize temp stack */
K->ssize = KS_ISSIZE;
@@ -180,9 +182,9 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
/* the dynamic ports and the keys for the dynamic ports */
TValue in_port = kmake_std_port(K, kstring_new_b_imm(K, "*STDIN*"),
- false, KNIL, KNIL, stdin);
+ false, stdin);
TValue out_port = kmake_std_port(K, kstring_new_b_imm(K, "*STDOUT*"),
- true, KNIL, KNIL, stdout);
+ true, stdout);
K->kd_in_port_key = kcons(K, KTRUE, in_port);
K->kd_out_port_key = kcons(K, KTRUE, out_port);
diff --git a/src/kstate.h b/src/kstate.h
@@ -24,12 +24,12 @@
/* XXX: for now, lines and column names are fixints */
/* MAYBE: this should be in tokenizer */
typedef struct {
- char *filename;
+ TValue filename;
int32_t tab_width;
int32_t line;
int32_t col;
- char *saved_filename;
+ TValue saved_filename;
int32_t saved_line;
int32_t saved_col;
} ksource_info_t;
@@ -98,12 +98,10 @@ struct klisp_State {
/* TEMP: error handling */
jmp_buf error_jb;
- /* standard input and output */
- /* TODO: eventually these should be ports */
+ /* input and output files in use (for read & write) */
+ TValue curr_port; /* save the port to update source info on errors */
FILE *curr_in;
FILE *curr_out;
- char *filename_in;
- char *filename_out;
/* for current-input-port, current-output-port */
TValue kd_in_port_key;
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -40,6 +40,7 @@
#include "kstring.h"
#include "ksymbol.h"
#include "kerror.h"
+#include "kport.h"
/*
** Char sets for fast ASCII char classification
@@ -123,8 +124,36 @@ void ktok_init(klisp_State *K)
}
/*
+** Error management
+*/
+
+void clear_shared_dict(klisp_State *K)
+{
+ K->shared_dict = KNIL;
+}
+
+void ktok_error(klisp_State *K, char *str)
+{
+ /* clear up before throwing */
+ ks_tbclear(K);
+ ks_sclear(K);
+ clear_shared_dict(K);
+
+ krooted_tvs_clear(K);
+ krooted_vars_clear(K);
+
+ /* save the source code info on the port anyways */
+ kport_update_source_info(K->curr_port, K->ktok_source_info.line,
+ K->ktok_source_info.col);
+
+ klispE_throw(K, str);
+}
+
+/*
** Underlying stream interface & source code location tracking
*/
+
+/* TODO check for error if getc returns EOF */
int ktok_getc(klisp_State *K) {
/* WORKAROUND: for stdin line buffering & reading of EOF */
/* Is this really necessary?? double check */
@@ -134,8 +163,16 @@ int ktok_getc(klisp_State *K) {
int chi = getc(K->curr_in);
if (chi == EOF) {
/* NOTE: eof doesn't change source code location info */
- K->ktok_seen_eof = true;
- return EOF;
+ if (ferror(K->curr_in) != 0) {
+ /* clear error marker to allow retries later */
+ clearerr(K->curr_in);
+ ktok_error(K, "reading error");
+ return 0;
+ } else { /* if (feof(K->curr_in) != 0) */
+ /* let the eof marker set */
+ K->ktok_seen_eof = true;
+ return EOF;
+ }
}
/* track source code location before returning the char */
@@ -170,13 +207,6 @@ int ktok_peekc(klisp_State *K) {
}
}
-void ktok_reset_source_info(klisp_State *K)
-{
- /* line is 1-base and col is 0-based */
- K->ktok_source_info.line = 1;
- K->ktok_source_info.col = 0;
-}
-
void ktok_save_source_info(klisp_State *K)
{
K->ktok_source_info.saved_filename = K->ktok_source_info.filename;
@@ -186,40 +216,22 @@ void ktok_save_source_info(klisp_State *K)
TValue ktok_get_source_info(klisp_State *K)
{
- /* NOTE: the filename doesn't contains embedded '\0's */
- TValue filename_str =
- kstring_new_b_imm(K, K->ktok_source_info.saved_filename);
- krooted_tvs_push(K, filename_str);
/* TEMP: for now, lines and column names are fixints */
- TValue res = kcons(K, i2tv(K->ktok_source_info.saved_line),
+ TValue pos = kcons(K, i2tv(K->ktok_source_info.saved_line),
i2tv(K->ktok_source_info.saved_col));
- krooted_tvs_push(K, res);
- res = kcons(K, filename_str, res);
- krooted_tvs_pop(K);
+ krooted_tvs_push(K, pos);
+ /* the filename is rooted in the port */
+ TValue res = kcons(K, K->ktok_source_info.filename, pos);
krooted_tvs_pop(K);
return res;
}
-/*
-** Error management
-*/
-
-void clear_shared_dict(klisp_State *K)
-{
- K->shared_dict = KNIL;
-}
-
-void ktok_error(klisp_State *K, char *str)
+void ktok_set_source_info(klisp_State *K, TValue filename, int32_t line,
+ int32_t col)
{
- /* clear up before throwing */
- ks_tbclear(K);
- ks_sclear(K);
- clear_shared_dict(K);
-
- krooted_tvs_clear(K);
- krooted_vars_clear(K);
-
- klispE_throw(K, str);
+ K->ktok_source_info.filename = filename;
+ K->ktok_source_info.line = line;
+ K->ktok_source_info.col = col;
}
diff --git a/src/ktoken.h b/src/ktoken.h
@@ -17,12 +17,19 @@
*/
void ktok_init(klisp_State *K);
TValue ktok_read_token(klisp_State *K);
-void ktok_reset_source_info(klisp_State *K);
+
+/* return a fresh ilist of the form (filename line . col) */
TValue ktok_get_source_info(klisp_State *K);
+void ktok_set_source_info(klisp_State *K, TValue filename, int32_t line,
+ int32_t col);
/* This is needed here to allow cleanup of shared dict from tokenizer */
void clear_shared_dict(klisp_State *K);
+/* This is used in for peek-char & read-char */
+int ktok_getc(klisp_State *K);
+int ktok_peekc(klisp_State *K);
+
/* This is needed for string->symbol to check if a symbol has external
representation as an identifier */
/* REFACTOR: think out a better interface to all this */
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -18,6 +18,7 @@
#include "kstate.h"
#include "kerror.h"
#include "ktable.h"
+#include "kport.h"
/*
** Stack for the write FSM
@@ -29,11 +30,24 @@
#define data_is_empty(ks_) (ks_sisempty(ks_))
/* macro for printing */
-#define kw_printf(ks_, ...) fprintf((ks_)->curr_out, __VA_ARGS__)
-#define kw_flush(ks_) fflush((ks_)->curr_out)
+#define kw_printf(ks_, ...) \
+ if (fprintf((ks_)->curr_out, __VA_ARGS__) < 0) { \
+ clearerr((ks_)->curr_out); /* clear error for next time */ \
+ kwrite_error(ks_, "error writing"); \
+ }
+
+#define kw_flush(ks_) \
+ if (fflush((ks_)->curr_out) == EOF) { \
+ clearerr((ks_)->curr_out); /* clear error for next time */ \
+ kwrite_error(ks_, "error writing"); \
+ }
void kwrite_error(klisp_State *K, char *msg)
{
+ /* clear up before throwing */
+ ks_tbclear(K);
+ ks_sclear(K);
+
klispE_throw(K, msg);
}
@@ -107,10 +121,11 @@ void kw_print_string(klisp_State *K, TValue str)
while(i < size && (*ptr == '\0' ||
(!K->write_displayp && (*ptr == '\\' || *ptr == '"')))) {
- if (*ptr == '\0')
+ if (*ptr == '\0') {
kw_printf(K, "%c", '\0'); /* this may not show in the terminal */
- else
+ } else {
kw_printf(K, "\\%c", *ptr);
+ }
i++;
ptr++;
}
@@ -222,7 +237,7 @@ void kw_print_si(klisp_State *K, TValue obj)
int32_t row = ivalue(kcadr(si));
int32_t col = ivalue(kcddr(si));
kw_print_string(K, str);
- kw_printf(K, " (row: %d, col: %d)", row, col);
+ kw_printf(K, " (line: %d, col: %d)", row, col);
K->write_displayp = saved_displayp;
}
@@ -473,3 +488,35 @@ void kwrite_newline(klisp_State *K)
kw_printf(K, "\n");
kw_flush(K);
}
+
+/*
+** Interface
+*/
+void kwrite_display_to_port(klisp_State *K, TValue port, TValue obj,
+ bool displayp)
+{
+ K->curr_port = port;
+ K->curr_out = kport_file(port);
+ K->write_displayp = displayp;
+ kwrite(K, obj);
+}
+
+void kwrite_newline_to_port(klisp_State *K, TValue port)
+{
+ kwrite_char_to_port(K, port, ch2tv('\n'));
+}
+
+void kwrite_char_to_port(klisp_State *K, TValue port, TValue ch)
+{
+ K->curr_port = port;
+ K->curr_out = kport_file(port);
+ int res = fputc(chvalue(ch), K->curr_out);
+ /* implicit flush, MAYBE add flush call */
+ if (res != EOF)
+ res = fflush(K->curr_out);
+
+ if (res == EOF) {
+ clearerr(K->curr_out); /* clear error for next time */
+ kwrite_error(K, "error writing char");
+ }
+}
diff --git a/src/kwrite.h b/src/kwrite.h
@@ -13,8 +13,10 @@
/*
** Writer interface
*/
-void kwrite(klisp_State *K, TValue obj);
-void kwrite_newline(klisp_State *K);
+void kwrite_display_to_port(klisp_State *K, TValue port, TValue obj,
+ bool displayp);
+void kwrite_newline_to_port(klisp_State *K, TValue port);
+void kwrite_char_to_port(klisp_State *K, TValue port, TValue ch);
#endif
