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

[kzk at freedesktop.org]

Author: kzk
Date: 2005-09-29 19:47:41 -0700 (Thu, 29 Sep 2005)
New Revision: 1680

Modified:
   branches/r5rs/sigscheme/error.c
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* show more useful backtrace

* sigscheme/sigschemeinternal.h
  - (struct trace_frame): add member "ScmObj env"
* sigscheme/eval.c
  - (ScmOp_eval): set environment to trace_frame
* sigscheme/error.c
  - (SigScm_ShowBacktrace): if symbol is contained in trace_frame's
    obj, print its value.



Modified: branches/r5rs/sigscheme/error.c
===================================================================
--- branches/r5rs/sigscheme/error.c	2005-09-29 05:03:03 UTC (rev 1679)
+++ branches/r5rs/sigscheme/error.c	2005-09-30 02:47:41 UTC (rev 1680)
@@ -126,13 +126,51 @@
 {
 #if SCM_DEBUG
     struct trace_frame *f;
+    ScmObj obj;
+    ScmObj env;
 
     SigScm_ErrorPrintf(SCM_BACKTRACE_HEADER);
 
     /* show each frame's obj */
     for (f = scm_trace_root; f; f = f->prev) {
-        SigScm_WriteToPort(scm_current_error_port, f->obj);
+        SigScm_ErrorPrintf("------------------------------\n");
+
+        obj = f->obj;
+        env = f->env;
+
+        SigScm_WriteToPort(scm_current_error_port, obj);
         SigScm_ErrorNewline();
+
+#define IS_UNBOUND(var, env)                                    \
+        (NULLP(lookup_environment(var, env))                    \
+         && NULLP(lookup_environment(var, scm_letrec_env))      \
+         && EQ(SCM_SYMBOL_VCELL(var), SCM_UNBOUND))
+
+        switch (SCM_TYPE(obj)) {
+        case ScmSymbol:
+            if (IS_UNBOUND(obj, env))
+                break;
+            SigScm_ErrorPrintf("  - \"%s\": ", SCM_SYMBOL_NAME(obj));
+            SigScm_WriteToPort(scm_current_error_port, symbol_value(obj, env));
+            SigScm_ErrorNewline();
+            break;
+
+        case ScmCons:
+            for (; !NULLP(obj); obj = CDR(obj)) {
+                if (SYMBOLP(CAR(obj))) {
+                    if (IS_UNBOUND(CAR(obj), env))
+                        break;
+                    SigScm_ErrorPrintf("  - \"%s\": ", SCM_SYMBOL_NAME(CAR(obj)));
+                    SigScm_WriteToPort(scm_current_error_port, symbol_value(CAR(obj), env));
+                    SigScm_ErrorNewline();
+                }
+            }
+            break;
+
+        default:
+            break;
+        }
+#undef IS_UNBOUND
     }
 #endif
 }

Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-09-29 05:03:03 UTC (rev 1679)
+++ branches/r5rs/sigscheme/eval.c	2005-09-30 02:47:41 UTC (rev 1680)
@@ -466,6 +466,7 @@
     struct trace_frame frame;
     frame.prev = scm_trace_root;
     frame.obj  = obj;
+    frame.env  = env;
     scm_trace_root = &frame;
 #endif
 

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2005-09-29 05:03:03 UTC (rev 1679)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2005-09-30 02:47:41 UTC (rev 1680)
@@ -51,6 +51,7 @@
 struct trace_frame {
     struct trace_frame *prev;
     ScmObj obj;
+    ScmObj env;    
 };
 
 /*=======================================