klisp

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

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:
Msrc/Makefile | 2+-
Msrc/kenvironment.c | 1+
Msrc/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 */