Re: bugreport, concise version

[Marius Vollmer]

Han-Wen Nienhuys  <address@hidden> writes:

> I consider this a very severe bug. Can you fix this please?

Done!

Dirk, could you double-check the diff below?  I think it is obviously
the right thing to do.  Without the change, bodies with internal
definitions would get expanded on every execution, not just on the
first time.

2004-01-22  Marius Vollmer  <address@hidden>

        * eval.c (m_expand_body): Rewrite the expression in place (by
        overwriting FORMS) also when a letrec is constructed, not only
        when no definitions are found.  Do not return rewritten expression
        to emphasize the in-place rewriting.  Changed all users.

Index: libguile/eval.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/eval.c,v
retrieving revision 1.350
diff -u -r1.350 eval.c
--- libguile/eval.c     21 Nov 2003 23:21:34 -0000      1.350
+++ libguile/eval.c     22 Jan 2004 22:41:15 -0000
@@ -764,9 +764,10 @@
 }
 
 
-/* The function m_expand_body memoizes a proper list of expressions forming a
- * body.  This function takes care of dealing with internal defines and
- * transforming them into an equivalent letrec expression.  */ 
+/* The function m_expand_body memoizes a proper list of expressions
+ * forming a body.  This function takes care of dealing with internal
+ * defines and transforming them into an equivalent letrec expression.
+ * The list of expressions is rewritten in place.  */ 
 
 /* This is a helper function for m_expand_body.  It helps to figure out whether
  * an expression denotes a syntactic keyword.  */ 
@@ -835,7 +836,7 @@
   return 0;
 }
 
-static SCM
+static void
 m_expand_body (const SCM forms, const SCM env)
 {
   /* The first body form can be skipped since it is known to be the ISYM that
@@ -948,14 +949,13 @@
       /* FIXME: forms does not hold information about the file location.  */
       letrec_expression = scm_cons_source (forms, scm_sym_letrec, letrec_tail);
       new_letrec_expression = scm_m_letrec (letrec_expression, env);
-      new_body = scm_list_1 (new_letrec_expression);
-      return new_body;
+      SCM_SETCAR (forms, new_letrec_expression);
+      SCM_SETCDR (forms, SCM_EOL);
     }
   else
     {
       SCM_SETCAR (forms, SCM_CAR (sequence));
       SCM_SETCDR (forms, SCM_CDR (sequence));
-      return forms;
     }
 }
 
@@ -967,7 +967,8 @@
 {
   scm_c_issue_deprecation_warning 
     ("`scm_m_expand_body' is deprecated.");
-  return m_expand_body (exprs, env);
+  m_expand_body (exprs, env);
+  return exprs;
 }
 
 #endif
@@ -2549,7 +2550,7 @@
              scm_rec_mutex_lock (&source_mutex);
              /* check for race condition */
              if (SCM_ISYMP (SCM_CAR (code)))
-               code = m_expand_body (code, env);
+               m_expand_body (code, env);
              scm_rec_mutex_unlock (&source_mutex);
              goto again;
            }
@@ -2951,7 +2952,7 @@
                  scm_rec_mutex_lock (&source_mutex);
                  /* check for race condition */
                  if (SCM_ISYMP (SCM_CAR (x)))
-                   x = m_expand_body (x, env);
+                   m_expand_body (x, env);
                  scm_rec_mutex_unlock (&source_mutex);
                  goto nontoplevel_begin;
                }
@@ -4604,7 +4605,7 @@
                  scm_rec_mutex_lock (&source_mutex);
                  /* check for race condition */
                  if (SCM_ISYMP (SCM_CAR (proc)))
-                   proc = m_expand_body (proc, args);
+                   m_expand_body (proc, args);
                  scm_rec_mutex_unlock (&source_mutex);
                  goto again;
                }

-- 
GPG: D5D4E405 - 2F9B BCCC 8527 692A 04E3  331E FAF8 226A D5D4 E405