klisp

commit 8d489b0de87801a64077b93da977b5b7967b4b65
parent 9dff9d52a4523d34aabce1e0d92c5b701b572490
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 20 Apr 2011 22:50:30 -0300

Completed simple naming scheme for printing.

Diffstat:
M
src/Makefile
 | 
2
+-
M
src/kenvironment.c
 | 
1
+
M
src/kwrite.c
 | 
39
++++++++++++++++++++++++++++++++++-----

3 files changed, 36 insertions(+), 6 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -55,7 +55,7 @@ ksymbol.o: ksymbol.c ksymbol.h kobject.h kpair.h kstring.h kstate.h kmem.h \
 kread.o: kread.c kread.h kobject.h ktoken.h kpair.h kstate.h kerror.h klisp.h \
 	kport.h
 kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h kstate.h kerror.h \
-	klisp.h kport.h kinteger.h
+	klisp.h kport.h kinteger.h ktable.h
 kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.h klisp.h \
 	kenvironment.h kpair.h keval.h koperative.h kground.h \
 	krepl.h kcontinuation.h kapplicative.h kport.h ksymbol.h kport.h \
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -117,6 +117,7 @@ void try_set_name(klisp_State *K, TValue obj, TValue sym)
 	   that if this object receives a name it can pass on that
 	   name to other objs, like applicatives to operatives & 
 	   some applicatives to objects */
+	gcvalue(obj)->gch.kflags |= K_FLAG_HAS_NAME;
 	TValue *node = klispH_set(K, tv2table(K->name_table), obj);
 	*node = sym;
     }
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -17,6 +17,7 @@
 #include "ksymbol.h"
 #include "kstate.h"
 #include "kerror.h"
+#include "ktable.h"
 
 /*
 ** Stack for the write FSM
@@ -185,6 +186,14 @@ void kw_set_initial_marks(klisp_State *K, TValue root)
     assert(ks_sisempty(K));
 }
 
+/* Assumes obj has a name */
+TValue kget_name(klisp_State *K, TValue obj)
+{
+    const TValue *node = klispH_get(tv2table(K->name_table),
+				    obj);
+    klisp_assert(node != &kfree);
+    return *node;
+}
 /*
 ** Writes all values except strings and pairs
 */
@@ -251,16 +260,32 @@ void kwrite_simple(klisp_State *K, TValue obj)
 	kw_printf(K, "#[eof]");
 	break;
     case K_TENVIRONMENT:
-	kw_printf(K, "#[environment]");
+	kw_printf(K, "#[environment");
+	if (khas_name(obj)) {
+	    kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
+	}
+	kw_printf(K, "]");
 	break;
     case K_TCONTINUATION:
-	kw_printf(K, "#[continuation]");
+	kw_printf(K, "#[continuation");
+	if (khas_name(obj)) {
+	    kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
+	}
+	kw_printf(K, "]");
 	break;
     case K_TOPERATIVE:
-	kw_printf(K, "#[operative]");
+	kw_printf(K, "#[operative");
+	if (khas_name(obj)) {
+	    kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
+	}
+	kw_printf(K, "]");
 	break;
     case K_TAPPLICATIVE:
-	kw_printf(K, "#[applicative]");
+	kw_printf(K, "#[applicative");
+	if (khas_name(obj)) {
+	    kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
+	}
+	kw_printf(K, "]");
 	break;
     case K_TENCAPSULATION:
 	/* TODO try to get the name */
@@ -272,7 +297,11 @@ void kwrite_simple(klisp_State *K, TValue obj)
 	break;
     case K_TPORT:
 	/* TODO try to get the name/ I/O direction / filename */
-	kw_printf(K, "#[port]");
+	kw_printf(K, "#[%s port", kport_is_input(obj)? "input" : "output");
+	if (khas_name(obj)) {
+	    kw_printf(K, ": %s", ksymbol_buf(kget_name(K, obj)));
+	}
+	kw_printf(K, "]");
 	break;
     default:
 	/* shouldn't happen */