klisp

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

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:
Msrc/Makefile | 4++--
Msrc/kgports.c | 74+++++++++++---------------------------------------------------------------
Msrc/kobject.h | 3+++
Msrc/kport.c | 23++++++++++++++++++++---
Msrc/kport.h | 9++++++++-
Msrc/kread.c | 37+++++++++++++++++++++++++++++++++++++
Msrc/kread.h | 3++-
Msrc/krepl.c | 23+++++++++++++----------
Msrc/kstate.c | 22++++++++++++----------
Msrc/kstate.h | 10++++------
Msrc/ktoken.c | 84+++++++++++++++++++++++++++++++++++++++++++++----------------------------------
Msrc/ktoken.h | 9++++++++-
Msrc/kwrite.c | 57++++++++++++++++++++++++++++++++++++++++++++++++++++-----
Msrc/kwrite.h | 6++++--
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