* Re: bugreport, concise version
[not found] <16397.51592.882068.847986@localhost.localdomain>
@ 2004-01-22 22:47 ` Marius Vollmer
2004-01-23 12:44 ` Dirk Herrmann
0 siblings, 1 reply; 2+ messages in thread
From: Marius Vollmer @ 2004-01-22 22:47 UTC (permalink / raw)
Cc: bug-guile, Dirk Herrmann, guile-devel
Han-Wen Nienhuys <hanwen@xs4all.nl> 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 <mvo@zagadka.de>
* 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
_______________________________________________
Bug-guile mailing list
Bug-guile@gnu.org
http://mail.gnu.org/mailman/listinfo/bug-guile
^ permalink raw reply [flat|nested] 2+ messages in thread