klisp

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

commit 03598eeee311f97596356e73490f519bd7d2aee3
parent c706ac20b438a864a022aeaba17c10a275bf5a23
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu, 21 Apr 2011 22:26:01 -0300

Added source code info to all the ground combiners.

Diffstat:
Msrc/Makefile | 3++-
Msrc/kground.c | 44+++++++++++++++++++++++++-------------------
Msrc/kwrite.c | 22+++++++++-------------
3 files changed, 36 insertions(+), 33 deletions(-)

diff --git a/src/Makefile b/src/Makefile @@ -88,7 +88,8 @@ kground.o: kground.c kground.h kstate.h kobject.h klisp.h kenvironment.h \ kgbooleans.h kgeqp.h kgequalp.h kgsymbols.h kgpairs_lists.h \ kgpair_mut.h kgenvironments.h kgenv_mut.h kgcombiners.h \ kgcontinuations.h kgencapsulations.h kgpromises.h kgkd_vars.h \ - kgks_vars.h kgports.h kgchars.h kgnumbers.h kgstrings.o + kgks_vars.h kgports.h kgchars.h kgnumbers.h kgstrings.o \ + klispconf.h kghelpers.o: kghelpers.c kghelpers.h kstate.h kstate.h klisp.h kpair.h \ kapplicative.h koperative.h kerror.h kobject.h ksymbol.h \ kcontinuation.h diff --git a/src/kground.c b/src/kground.c @@ -44,38 +44,44 @@ ** BEWARE: this is highly unhygienic, it assumes variables "symbol" and ** "value", both of type TValue. symbol will be bound to a symbol named by ** "n_" and can be referrenced in the var_args -** GC: All of these assume that the extra args are rooted +** GC: All of these should be called when GC is deactivated on startup */ -/* Right now all symbols are rooted, but when possible, they will - be moved to a weak hashtable, so just in case root symbols during - operand/applicative construction */ +#if KTRACK_SI +#define add_operative(K_, env_, n_, fn_, ...) \ + { symbol = ksymbol_new(K_, n_); \ + value = kmake_operative(K_, fn_, __VA_ARGS__); \ + TValue str = kstring_new_b_imm(K_, __FILE__); \ + TValue si = kcons(K, str, kcons(K_, i2tv(__LINE__), \ + i2tv(0))); \ + kset_source_info(K_, value, si); \ + kadd_binding(K_, env_, symbol, value); } + +#define add_applicative(K_, env_, n_, fn_, ...) \ + { symbol = ksymbol_new(K_, n_); \ + value = kmake_applicative(K_, fn_, __VA_ARGS__); \ + TValue str = kstring_new_b_imm(K_, __FILE__); \ + TValue si = kcons(K, str, kcons(K_, i2tv(__LINE__), \ + i2tv(0))); \ + kset_source_info(K_, kunwrap(value), si); \ + kset_source_info(K_, value, si); \ + kadd_binding(K_, env_, symbol, value); } +#else /* KTRACK_SI */ #define add_operative(K_, env_, n_, fn_, ...) \ { symbol = ksymbol_new(K_, n_); \ - krooted_tvs_push(K_, symbol); \ value = kmake_operative(K_, fn_, __VA_ARGS__); \ - krooted_tvs_push(K_, value); \ - kadd_binding(K_, env_, symbol, value); \ - krooted_tvs_pop(K_); \ - krooted_tvs_pop(K_); } + kadd_binding(K_, env_, symbol, value); } #define add_applicative(K_, env_, n_, fn_, ...) \ { symbol = ksymbol_new(K_, n_); \ - krooted_tvs_push(K_, symbol); \ value = kmake_applicative(K_, fn_, __VA_ARGS__); \ - krooted_tvs_push(K_, value); \ - kadd_binding(K_, env_, symbol, value); \ - krooted_tvs_pop(K_); \ - krooted_tvs_pop(K_); } + kadd_binding(K_, env_, symbol, value); } +#endif /* KTRACK_SI */ #define add_value(K_, env_, n_, v_) \ { value = v_; \ - krooted_tvs_push(K_, value); \ symbol = ksymbol_new(K_, n_); \ - krooted_tvs_push(K_, symbol); \ - kadd_binding(K_, env_, symbol, v_); \ - krooted_tvs_pop(K_); \ - krooted_tvs_pop(K_); } + kadd_binding(K_, env_, symbol, v_); } /* ** This is called once to bind all symbols in the ground environment diff --git a/src/kwrite.c b/src/kwrite.c @@ -209,25 +209,21 @@ void kw_print_name(klisp_State *K, TValue obj) /* Assumes obj has a si */ void kw_print_si(klisp_State *K, TValue obj) { + /* should be an improper list of 2 pairs, + with a string and 2 fixints */ TValue si = kget_source_info(K, obj); - /* should be either a string or an improper list of 2 pairs, - with a string and 2 fixints, just check if pair */ - klisp_assert(kstringp(si) || kpairp(si)); - kw_printf(K, " @ "); /* this is a hack, would be better to change the interface of kw_print_string */ bool saved_displayp = K->write_displayp; K->write_displayp = true; /* avoid "s and escapes */ - if (ttisstring(si)) { - kw_print_string(K, si); - } else { - TValue str = kcar(si); - 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); - } + + TValue str = kcar(si); + 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); + K->write_displayp = saved_displayp; } #endif /* KTRACK_SI */