mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

(m_expand_body): Rewrite the expression in place (by overwriting

Browse source 
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.
This commit is contained in:
Marius Vollmer 2004-01-22 22:42:29 +00:00
parent 2153f45947
commit 9d4bf6d39a
1 changed files with 12 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

23
libguile/eval.c
View file

@ -764,9 +764,10 @@ m_body (SCM op, SCM exprs)
} }
/* The function m_expand_body memoizes a proper list of expressions forming a /* The function m_expand_body memoizes a proper list of expressions
* body. This function takes care of dealing with internal defines and * forming a body. This function takes care of dealing with internal
* transforming them into an equivalent letrec expression. */ * 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 /* This is a helper function for m_expand_body. It helps to figure out whether
* an expression denotes a syntactic keyword. */ * an expression denotes a syntactic keyword. */
@ -835,7 +836,7 @@ is_system_macro_p (const SCM syntactic_keyword, const SCM form, const SCM env)
return 0; return 0;
} }
static SCM static void
m_expand_body (const SCM forms, const SCM env) 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 /* The first body form can be skipped since it is known to be the ISYM that
@ -948,14 +949,13 @@ m_expand_body (const SCM forms, const SCM env)
/* FIXME: forms does not hold information about the file location. */ /* FIXME: forms does not hold information about the file location. */
letrec_expression = scm_cons_source (forms, scm_sym_letrec, letrec_tail); letrec_expression = scm_cons_source (forms, scm_sym_letrec, letrec_tail);
new_letrec_expression = scm_m_letrec (letrec_expression, env); new_letrec_expression = scm_m_letrec (letrec_expression, env);
new_body = scm_list_1 (new_letrec_expression); SCM_SETCAR (forms, new_letrec_expression);
return new_body; SCM_SETCDR (forms, SCM_EOL);
} }
else else
{ {
SCM_SETCAR (forms, SCM_CAR (sequence)); SCM_SETCAR (forms, SCM_CAR (sequence));
SCM_SETCDR (forms, SCM_CDR (sequence)); SCM_SETCDR (forms, SCM_CDR (sequence));
return forms;
} }
} }
@ -967,7 +967,8 @@ scm_m_expand_body (SCM exprs, SCM env)
{ {
scm_c_issue_deprecation_warning scm_c_issue_deprecation_warning
("`scm_m_expand_body' is deprecated."); ("`scm_m_expand_body' is deprecated.");
return m_expand_body (exprs, env); m_expand_body (exprs, env);
return exprs;
} }
#endif #endif
@ -2549,7 +2550,7 @@ scm_eval_body (SCM code, SCM env)
scm_rec_mutex_lock (&source_mutex); scm_rec_mutex_lock (&source_mutex);
/* check for race condition */ /* check for race condition */
if (SCM_ISYMP (SCM_CAR (code))) if (SCM_ISYMP (SCM_CAR (code)))
code = m_expand_body (code, env); m_expand_body (code, env);
scm_rec_mutex_unlock (&source_mutex); scm_rec_mutex_unlock (&source_mutex);
goto again; goto again;
} }
@ -2951,7 +2952,7 @@ dispatch:
scm_rec_mutex_lock (&source_mutex); scm_rec_mutex_lock (&source_mutex);
/* check for race condition */ /* check for race condition */
if (SCM_ISYMP (SCM_CAR (x))) if (SCM_ISYMP (SCM_CAR (x)))
x = m_expand_body (x, env); m_expand_body (x, env);
scm_rec_mutex_unlock (&source_mutex); scm_rec_mutex_unlock (&source_mutex);
goto nontoplevel_begin; goto nontoplevel_begin;
} }
@ -4604,7 +4605,7 @@ tail:
scm_rec_mutex_lock (&source_mutex); scm_rec_mutex_lock (&source_mutex);
/* check for race condition */ /* check for race condition */
if (SCM_ISYMP (SCM_CAR (proc))) if (SCM_ISYMP (SCM_CAR (proc)))
proc = m_expand_body (proc, args); m_expand_body (proc, args);
scm_rec_mutex_unlock (&source_mutex); scm_rec_mutex_unlock (&source_mutex);
goto again; goto again;
} }