[uim-commit] r2136 - branches/r5rs/sigscheme

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-11-14 05:26:25 -0800 (Mon, 14 Nov 2005)
New Revision: 2136

Modified:
   branches/r5rs/sigscheme/debug.c
   branches/r5rs/sigscheme/sigscheme.h
   branches/r5rs/sigscheme/storage-symbol.c
Log:
* sigscheme/sigscheme.h
  - (Scm_SymbolBoundTo): New function decl
* sigscheme/storage-symbol.c
  - (Scm_SymbolBoundTo): New function
* sigscheme/debug.c
  - (print_ScmObj_internal):
    * Add procedure/syntax name printing using Scm_SymbolBoundTo()
    * Remove the unfamiliar colon in closure expression


Modified: branches/r5rs/sigscheme/debug.c
===================================================================
--- branches/r5rs/sigscheme/debug.c	2005-11-14 13:19:59 UTC (rev 2135)
+++ branches/r5rs/sigscheme/debug.c	2005-11-14 13:26:25 UTC (rev 2136)
@@ -211,6 +211,8 @@
 
 static void print_ScmObj_internal(ScmObj port, ScmObj obj, enum OutputType otype)
 {
+    ScmObj sym;
+
 #if SCM_USE_SRFI38
     if (INTERESTINGP(obj)) {
         int index = get_shared_index(obj);
@@ -243,10 +245,16 @@
         print_string(port, obj, otype);
         break;
     case ScmFunc:
-        SCM_PORT_PRINT(port, (SCM_SYNTAXP(obj)) ? "#<syntax>" : "#<subr>");
+        SCM_PORT_PRINT(port, (SCM_SYNTAXP(obj)) ? "#<syntax " : "#<subr ");
+        sym = Scm_SymbolBoundTo(obj);
+        if (NFALSEP(sym))
+            SigScm_DisplayToPort(port, sym);
+        else
+            SigScm_PortPrintf(port, "%p", (void *)obj);
+        SCM_PORT_PRINT(port, ">");
         break;
     case ScmClosure:
-        SCM_PORT_PRINT(port, "#<closure:");
+        SCM_PORT_PRINT(port, "#<closure ");
         print_ScmObj_internal(port, SCM_CLOSURE_EXP(obj), otype);
         SCM_PORT_PRINT(port, ">");
         break;

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-11-14 13:19:59 UTC (rev 2135)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-11-14 13:26:25 UTC (rev 2136)
@@ -414,6 +414,7 @@
 
 /* storage-symbol.c */
 ScmObj Scm_Intern(const char *name);
+ScmObj Scm_SymbolBoundTo(ScmObj obj);
 
 /* eval.c */
 ScmObj ScmOp_eval(ScmObj obj, ScmObj env);

Modified: branches/r5rs/sigscheme/storage-symbol.c
===================================================================
--- branches/r5rs/sigscheme/storage-symbol.c	2005-11-14 13:19:59 UTC (rev 2135)
+++ branches/r5rs/sigscheme/storage-symbol.c	2005-11-14 13:26:25 UTC (rev 2136)
@@ -92,6 +92,27 @@
     return sym;
 }
 
+/* lookup the symbol bound to an obj reversely */
+ScmObj Scm_SymbolBoundTo(ScmObj obj)
+{
+    int i;
+    ScmObj sym_lst, sym, val;
+
+    for (i = 0; i < NAMEHASH_SIZE; i++) {
+        for (sym_lst = scm_symbol_hash[i];
+             CONSP(sym_lst);
+             sym_lst = CDR(sym_lst))
+        {
+            sym = CAR(sym_lst);
+            val = SCM_SYMBOL_VCELL(sym);
+            if (!EQ(val, SCM_UNBOUND) && EQ(val, obj))
+                return sym;
+        }
+    }
+
+    return SCM_FALSE;
+}
+
 void SigScm_InitSymbol(void)
 {
     initialize_symbol_hash();