mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

* eval.c (scm_m_letstar): Create memoized code in place to

Browse source 
minimize consing.
This commit is contained in:
Dirk Herrmann 2003-11-16 13:32:02 +00:00
parent 6f81708ae0
commit 461bffb131
2 changed files with 27 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/ChangeLog
View file

@ -1,3 +1,8 @@
2003-11-16 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (scm_m_letstar): Create memoized code in place to
minimize consing.
2003-11-16 Dirk Herrmann <D.Herrmann@tu-bs.de> 2003-11-16 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (s_splicing): Commented and reformulated. * eval.c (s_splicing): Commented and reformulated.

28
libguile/eval.c
View file

@ -1585,7 +1585,6 @@ SCM
scm_m_letstar (SCM expr, SCM env SCM_UNUSED) scm_m_letstar (SCM expr, SCM env SCM_UNUSED)
{ {
SCM binding_idx; SCM binding_idx;
SCM new_bindings = SCM_EOL;
SCM new_body; SCM new_body;
const SCM cdr_expr = SCM_CDR (expr); const SCM cdr_expr = SCM_CDR (expr);
@ -1595,17 +1594,34 @@ scm_m_letstar (SCM expr, SCM env SCM_UNUSED)
binding_idx = SCM_CAR (cdr_expr); binding_idx = SCM_CAR (cdr_expr);
check_bindings (binding_idx, expr); check_bindings (binding_idx, expr);
for (; !SCM_NULLP (binding_idx); binding_idx = SCM_CDR (binding_idx)) /* Transform ((v1 i1) (v2 i2) ...) into (v1 i1 v2 i2 ...). The
* transformation is done in place. At the beginning of one iteration of
* the loop the variable binding_idx holds the form
* P1:( (vn . P2:(in . ())) . P3:( (vn+1 in+1) ... ) ),
* where P1, P2 and P3 indicate the pairs, that are relevant for the
* transformation. P1 and P2 are modified in the loop, P3 remains
* untouched. After the execution of the loop, P1 will hold
* P1:( vn . P2:(in . P3:( (vn+1 in+1) ... )) )
* and binding_idx will hold P3. */
while (!SCM_NULLP (binding_idx))
{ {
const SCM cdr_binding_idx = SCM_CDR (binding_idx); /* remember P3 */
const SCM binding = SCM_CAR (binding_idx); const SCM binding = SCM_CAR (binding_idx);
const SCM name = SCM_CAR (binding); const SCM name = SCM_CAR (binding);
const SCM init = SCM_CADR (binding); const SCM cdr_binding = SCM_CDR (binding);
new_bindings = scm_cons2 (init, name, new_bindings);
SCM_SETCDR (cdr_binding, cdr_binding_idx); /* update P2 */
SCM_SETCAR (binding_idx, name); /* update P1 */
SCM_SETCDR (binding_idx, cdr_binding); /* update P1 */
binding_idx = cdr_binding_idx; /* continue with P3 */
} }
new_bindings = scm_reverse_x (new_bindings, SCM_UNDEFINED);
new_body = m_body (SCM_IM_LETSTAR, SCM_CDR (cdr_expr)); new_body = m_body (SCM_IM_LETSTAR, SCM_CDR (cdr_expr));
return scm_cons2 (SCM_IM_LETSTAR, new_bindings, new_body); SCM_SETCAR (expr, SCM_IM_LETSTAR);
/* the bindings have been changed in place */
SCM_SETCDR (cdr_expr, new_body);
return expr;
} }