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

* eval.c (scm_m_body, scm_m_lambda): Documentation strings are not

Browse source 
handled in scm_m_body any more, but rather in scm_m_lambda.

	(scm_m_body, memoize_named_let, scm_m_let, scm_m_letstar,
	scm_m_letrec, scm_m_expand_body): Check for validity is done by
	calling functions of scm_m_body.

	(scm_m_lambda): Avoid unnecessary consing when creating the
	memoized code.
This commit is contained in:
Dirk Herrmann 2003-11-01 10:21:15 +00:00
parent 89bff2fc10
commit 34adf7eaf2
2 changed files with 56 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

12
libguile/ChangeLog
View file

@ -1,3 +1,15 @@
2003-11-01 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (scm_m_body, scm_m_lambda): Documentation strings are not
handled in scm_m_body any more, but rather in scm_m_lambda.
(scm_m_body, memoize_named_let, scm_m_let, scm_m_letstar,
scm_m_letrec, scm_m_expand_body): Check for validity is done by
calling functions of scm_m_body.
(scm_m_lambda): Avoid unnecessary consing when creating the
memoized code.
2003-11-01 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (s_expression): Added comment.

83
libguile/eval.c
View file

@ -672,38 +672,25 @@ SCM_GLOBAL_SYMBOL (scm_sym_exit_frame, "exit-frame");
SCM_GLOBAL_SYMBOL (scm_sym_trace, "trace");
/* Check that the body denoted by XORIG is valid and rewrite it into
its internal form. The internal form of a body is just the body
itself, but prefixed with an ISYM that denotes to what kind of
outer construct this body belongs. A lambda body starts with
SCM_IM_LAMBDA, for example, a body of a let starts with SCM_IM_LET,
etc. The one exception is a body that belongs to a letrec that has
been formed by rewriting internal defines: it starts with
SCM_IM_DEFINE. */
/* XXX - Besides controlling the rewriting of internal defines, the
additional ISYM could be used for improved error messages.
This is not done yet. */
/* Rewrite the body (which is given as the list of expressions forming the
* body) into its internal form. The internal form of a body (<expr> ...) is
* just the body itself, but prefixed with an ISYM that denotes to what kind
* of outer construct this body belongs: (<ISYM> <expr> ...). A lambda body
* starts with SCM_IM_LAMBDA, for example, a body of a let starts with
* SCM_IM_LET, etc. The one exception is a body that belongs to a letrec that
* has been formed by rewriting internal defines: It starts with SCM_IM_DEFINE
* (instead of SCM_IM_LETREC).
*
* It is assumed that the calling expression has already made sure that the
* body is a proper list. */
static SCM
scm_m_body (SCM op, SCM xorig, const char *what)
scm_m_body (SCM op, SCM exprs)
{
SCM_ASSYNT (scm_ilength (xorig) >= 1, s_body, what);
/* Don't add another ISYM if one is present already. */
if (SCM_ISYMP (SCM_CAR (xorig)))
return xorig;
/* Retain possible doc string. */
if (!SCM_CONSP (SCM_CAR (xorig)))
{
if (!SCM_NULLP (SCM_CDR (xorig)))
return scm_cons (SCM_CAR (xorig),
scm_m_body (op, SCM_CDR (xorig), what));
return xorig;
}
return scm_cons (op, xorig);
if (SCM_ISYMP (SCM_CAR (exprs)))
return exprs;
else
return scm_cons (op, exprs);
}
@ -1101,6 +1088,10 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED)
{
SCM formals;
SCM formals_idx;
SCM cddr_expr;
int documentation;
SCM body;
SCM new_body;
const SCM cdr_expr = SCM_CDR (expr);
const long length = scm_ilength (cdr_expr);
@ -1136,8 +1127,22 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED)
ASSERT_SYNTAX_2 (SCM_NULLP (formals_idx) || SCM_SYMBOLP (formals_idx),
s_bad_formal, formals_idx, expr);
return scm_cons2 (SCM_IM_LAMBDA, SCM_CAR (cdr_expr),
scm_m_body (SCM_IM_LAMBDA, SCM_CDR (cdr_expr), s_lambda));
/* Memoize the body. Keep a potential documentation string. */
/* Dirk:FIXME:: We should probably extract the documentation string to
* some external database. Otherwise it will slow down execution, since
* the documentation string will have to be skipped with every execution
* of the closure. */
cddr_expr = SCM_CDR (cdr_expr);
documentation = (length >= 3 && SCM_STRINGP (SCM_CAR (cddr_expr)));
body = documentation ? SCM_CDR (cddr_expr) : cddr_expr;
new_body = scm_m_body (SCM_IM_LAMBDA, body);
SCM_SETCAR (expr, SCM_IM_LAMBDA);
if (documentation)
SCM_SETCDR (cddr_expr, new_body);
else
SCM_SETCDR (cdr_expr, new_body);
return expr;
}
@ -1220,13 +1225,13 @@ memoize_named_let (const SCM expr, const SCM env SCM_UNUSED)
{
const SCM let_body = SCM_CDR (cddr_expr);
const SCM lambda_body = scm_m_body (SCM_IM_LET, let_body, "let");
const SCM lambda_body = scm_m_body (SCM_IM_LET, let_body);
const SCM lambda_tail = scm_cons (variables, lambda_body);
const SCM lambda_form = scm_cons_source (expr, scm_sym_lambda, lambda_tail);
const SCM rvar = scm_list_1 (name);
const SCM init = scm_list_1 (lambda_form);
const SCM body = scm_m_body (SCM_IM_LET, scm_list_1 (name), "let");
const SCM body = scm_m_body (SCM_IM_LET, scm_list_1 (name));
const SCM letrec_tail = scm_cons (rvar, scm_cons (init, body));
const SCM letrec_form = scm_cons_source (expr, SCM_IM_LETREC, letrec_tail);
return scm_cons_source (expr, letrec_form, inits);
@ -1256,7 +1261,7 @@ scm_m_let (SCM expr, SCM env)
if (SCM_NULLP (bindings) || SCM_NULLP (SCM_CDR (bindings)))
{
/* Special case: no bindings or single binding => let* is faster. */
const SCM body = scm_m_body (SCM_IM_LET, SCM_CDR (cdr_expr), s_let);
const SCM body = scm_m_body (SCM_IM_LET, SCM_CDR (cdr_expr));
return scm_m_letstar (scm_cons2 (SCM_CAR (expr), bindings, body), env);
}
else
@ -1267,7 +1272,7 @@ scm_m_let (SCM expr, SCM env)
transform_bindings (bindings, expr, &rvariables, &inits);
{
const SCM new_body = scm_m_body (SCM_IM_LET, SCM_CDR (cdr_expr), "let");
const SCM new_body = scm_m_body (SCM_IM_LET, SCM_CDR (cdr_expr));
const SCM new_tail = scm_cons2 (rvariables, inits, new_body);
SCM_SETCAR (expr, SCM_IM_LET);
SCM_SETCDR (expr, new_tail);
@ -1305,7 +1310,7 @@ scm_m_letstar (SCM expr, SCM env SCM_UNUSED)
}
new_bindings = scm_reverse_x (new_bindings, SCM_UNDEFINED);
new_body = scm_m_body (SCM_IM_LETSTAR, SCM_CDR (cdr_expr), s_letstar);
new_body = scm_m_body (SCM_IM_LETSTAR, SCM_CDR (cdr_expr));
return scm_cons2 (SCM_IM_LETSTAR, new_bindings, new_body);
}
@ -1326,7 +1331,7 @@ scm_m_letrec (SCM expr, SCM env)
if (SCM_NULLP (bindings))
{
/* no bindings, let* is executed faster */
SCM body = scm_m_body (SCM_IM_LETREC, SCM_CDR (cdr_expr), s_letrec);
SCM body = scm_m_body (SCM_IM_LETREC, SCM_CDR (cdr_expr));
return scm_m_letstar (scm_cons2 (SCM_CAR (expr), SCM_EOL, body), env);
}
else
@ -1337,7 +1342,7 @@ scm_m_letrec (SCM expr, SCM env)
check_bindings (bindings, expr);
transform_bindings (bindings, expr, &rvariables, &inits);
new_body = scm_m_body (SCM_IM_LETREC, SCM_CDR (cdr_expr), "letrec");
new_body = scm_m_body (SCM_IM_LETREC, SCM_CDR (cdr_expr));
return scm_cons2 (SCM_IM_LETREC, rvariables, scm_cons (inits, new_body));
}
}
@ -1841,7 +1846,7 @@ scm_m_expand_body (SCM xorig, SCM env)
SCM rvars, inits, body, letrec;
check_bindings (defs, xorig);
transform_bindings (defs, xorig, &rvars, &inits);
body = scm_m_body (SCM_IM_DEFINE, x, what);
body = scm_m_body (SCM_IM_DEFINE, x);
letrec = scm_cons2 (SCM_IM_LETREC, rvars, scm_cons (inits, body));
SCM_SETCAR (xorig, letrec);
SCM_SETCDR (xorig, SCM_EOL);