commit 6f168541efab052dd5f9d8c2e0b761546f131f4a
parent 7fefb8001f8a6dc8b459b7eeea37246876cad4cf
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 21 Apr 2011 20:36:08 -0300
Added some simple printing of source code info for applicatives and operatives.
Diffstat:
5 files changed, 82 insertions(+), 22 deletions(-)
diff --git a/src/kgcombiners.c b/src/kgcombiners.c
@@ -58,9 +58,13 @@ void Svau(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
#if KTRACK_SI
/* save as source code info the info from the expression whose evaluation
got us here */
- krooted_tvs_push(K, new_op);
- kset_source_info(K, new_op, kget_csi(K));
- krooted_tvs_pop(K);
+ TValue si = kget_csi(K);
+ if (!ttisnil(si)) {
+ krooted_tvs_push(K, new_op);
+ gcvalue(new_op)->gch.kflags |= K_FLAG_HAS_SI;
+ kset_source_info(K, new_op, si);
+ krooted_tvs_pop(K);
+ }
#endif
krooted_tvs_pop(K);
@@ -122,9 +126,13 @@ void wrap(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
#if KTRACK_SI
/* save as source code info the info from the expression whose evaluation
got us here */
- krooted_tvs_push(K, new_app);
- kset_source_info(K, new_app, kget_csi(K));
- krooted_tvs_pop(K);
+ TValue si = kget_csi(K);
+ if (!ttisnil(si)) {
+ krooted_tvs_push(K, new_app);
+ gcvalue(new_app)->gch.kflags |= K_FLAG_HAS_SI;
+ kset_source_info(K, new_app, si);
+ krooted_tvs_pop(K);
+ }
#endif
kapply_cc(K, new_app);
}
@@ -162,9 +170,13 @@ void Slambda(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
#if KTRACK_SI
/* save as source code info the info from the expression whose evaluation
got us here */
- krooted_tvs_push(K, new_app);
- kset_source_info(K, new_app, kget_csi(K));
- krooted_tvs_pop(K);
+ TValue si = kget_csi(K);
+ if (!ttisnil(si)) {
+ krooted_tvs_push(K, new_app);
+ gcvalue(new_app)->gch.kflags |= K_FLAG_HAS_SI;
+ kset_source_info(K, new_app, si);
+ krooted_tvs_pop(K);
+ }
#endif
krooted_tvs_pop(K);
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -453,9 +453,3 @@ void string_to_symbol(klisp_State *K, TValue *xparams, TValue ptree,
TValue new_sym = ksymbol_new_check_i(K, str);
kapply_cc(K, new_sym);
}
-
-/* Helpers */
-bool kstringp(TValue obj)
-{
- return ttisstring(obj);
-}
diff --git a/src/kstring.c b/src/kstring.c
@@ -214,3 +214,5 @@ bool kstring_equalp(TValue obj1, TValue obj2)
return false;
}
}
+
+bool kstringp(TValue obj) { return ttisstring(obj); }
diff --git a/src/kstring.h b/src/kstring.h
@@ -78,4 +78,6 @@ TValue kstring_new_sf(klisp_State *K, uint32_t size, char fill);
but differentiates immutable from mutable strings */
bool kstring_equalp(TValue obj1, TValue obj2);
+bool kstringp(TValue obj);
+
#endif
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -186,8 +186,9 @@ void kw_set_initial_marks(klisp_State *K, TValue root)
assert(ks_sisempty(K));
}
+#if KTRACK_NAMES
/* Assumes obj has a name */
-TValue kget_name(klisp_State *K, TValue obj)
+TValue kw_get_name(klisp_State *K, TValue obj)
{
const TValue *node = klispH_get(tv2table(K->name_table),
obj);
@@ -195,12 +196,43 @@ TValue kget_name(klisp_State *K, TValue obj)
return *node;
}
+void kw_print_name(klisp_State *K, TValue obj)
+{
+ kw_printf(K, ": %s", ksymbol_buf(kw_get_name(K, obj)));
+}
+#endif /* KTRACK_NAMES */
+
+#if KTRACK_SI
+/* Assumes obj has a si */
+void kw_print_si(klisp_State *K, TValue obj)
+{
+ 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);
+ }
+ K->write_displayp = saved_displayp;
+}
+#endif /* KTRACK_SI */
/*
** Writes all values except strings and pairs
*/
-/* TODO add #if #endif for track names */
void kwrite_simple(klisp_State *K, TValue obj)
{
switch(ttype(obj)) {
@@ -265,30 +297,46 @@ void kwrite_simple(klisp_State *K, TValue obj)
break;
case K_TENVIRONMENT:
kw_printf(K, "#[environment");
+ #if KTRACK_NAMES
if (khas_name(obj)) {
- kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
+ kw_print_name(K, obj);
}
+ #endif
kw_printf(K, "]");
break;
case K_TCONTINUATION:
kw_printf(K, "#[continuation");
+ #if KTRACK_NAMES
if (khas_name(obj)) {
- kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
+ kw_print_name(K, obj);
}
+ #endif
kw_printf(K, "]");
break;
case K_TOPERATIVE:
kw_printf(K, "#[operative");
+ #if KTRACK_NAMES
if (khas_name(obj)) {
- kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
+ kw_print_name(K, obj);
}
+ #endif
+ #if KTRACK_SI
+ if (khas_si(obj))
+ kw_print_si(K, obj);
+ #endif
kw_printf(K, "]");
break;
case K_TAPPLICATIVE:
kw_printf(K, "#[applicative");
+ #if KTRACK_NAMES
if (khas_name(obj)) {
- kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
+ kw_print_name(K, obj);
}
+ #endif
+ #if KTRACK_SI
+ if (khas_si(obj))
+ kw_print_si(K, obj);
+ #endif
kw_printf(K, "]");
break;
case K_TENCAPSULATION:
@@ -302,9 +350,11 @@ void kwrite_simple(klisp_State *K, TValue obj)
case K_TPORT:
/* TODO try to get the name/ I/O direction / filename */
kw_printf(K, "#[%s port", kport_is_input(obj)? "input" : "output");
+ #if KTRACK_NAMES
if (khas_name(obj)) {
- kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
+ kw_print_name(K, obj);
}
+ #endif
kw_printf(K, "]");
break;
default:
