mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 19:50:24 +02:00
* eval.c (try_macro_lookup, expand_user_macros, is_system_macro_p,
m_expand_body, scm_m_expand_body): Grouped together with m_body. No further modifications.
This commit is contained in:
Dirk Herrmann
parent
c86c440b17
commit
910b512506
2 changed files with 216 additions and 210 deletions
|
|
@ -1,3 +1,9 @@
|
||||||
|
2003-11-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||||
|
|
||||||
|
* eval.c (try_macro_lookup, expand_user_macros, is_system_macro_p,
|
||||||
|
m_expand_body, scm_m_expand_body): Grouped together with m_body.
|
||||||
|
No further modifications.
|
||||||
|
|
||||||
2003-11-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
2003-11-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||||
|
|
||||||
* eval.c (s_mixed_body_forms): New static identifier.
|
* eval.c (s_mixed_body_forms): New static identifier.
|
||||||
|
|
|
||||||
420
libguile/eval.c
420
libguile/eval.c
|
|
@ -713,6 +713,216 @@ m_body (SCM op, SCM exprs)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/* 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. */
|
||||||
|
|
||||||
|
/* This is a helper function for m_expand_body. It helps to figure out whether
|
||||||
|
* an expression denotes a syntactic keyword. */
|
||||||
|
static SCM
|
||||||
|
try_macro_lookup (const SCM expr, const SCM env)
|
||||||
|
{
|
||||||
|
if (SCM_SYMBOLP (expr))
|
||||||
|
{
|
||||||
|
const SCM tmp_pair = scm_list_1 (expr);
|
||||||
|
const SCM value = *scm_lookupcar1 (tmp_pair, env, 0);
|
||||||
|
return value;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
return SCM_UNDEFINED;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* This is a helper function for m_expand_body. It expands user macros,
|
||||||
|
* because for the correct translation of a body we need to know whether they
|
||||||
|
* expand to a definition. */
|
||||||
|
static SCM
|
||||||
|
expand_user_macros (SCM expr, const SCM env)
|
||||||
|
{
|
||||||
|
while (SCM_CONSP (expr))
|
||||||
|
{
|
||||||
|
const SCM car_expr = SCM_CAR (expr);
|
||||||
|
const SCM new_car = expand_user_macros (car_expr, env);
|
||||||
|
const SCM value = try_macro_lookup (new_car, env);
|
||||||
|
|
||||||
|
if (SCM_MACROP (value) && SCM_MACRO_TYPE (value) == 2)
|
||||||
|
{
|
||||||
|
/* User macros transform code into code. */
|
||||||
|
expr = scm_call_2 (SCM_MACRO_CODE (value), expr, env);
|
||||||
|
/* We need to reiterate on the transformed code. */
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
/* No user macro: return. */
|
||||||
|
SCM_SETCAR (expr, new_car);
|
||||||
|
return expr;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return expr;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* This is a helper function for m_expand_body. It determines if a given form
|
||||||
|
* represents an application of a given built-in macro. The built-in macro to
|
||||||
|
* check for is identified by its syntactic keyword. The form is an
|
||||||
|
* application of the given macro if looking up the car of the form in the
|
||||||
|
* given environment actually returns the built-in macro. */
|
||||||
|
static int
|
||||||
|
is_system_macro_p (const SCM syntactic_keyword, const SCM form, const SCM env)
|
||||||
|
{
|
||||||
|
if (SCM_CONSP (form))
|
||||||
|
{
|
||||||
|
const SCM car_form = SCM_CAR (form);
|
||||||
|
const SCM value = try_macro_lookup (car_form, env);
|
||||||
|
if (SCM_BUILTIN_MACRO_P (value))
|
||||||
|
{
|
||||||
|
const SCM macro_name = scm_macro_name (value);
|
||||||
|
return SCM_EQ_P (macro_name, syntactic_keyword);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static SCM
|
||||||
|
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
|
||||||
|
* was prepended to the body by m_body. */
|
||||||
|
SCM cdr_forms = SCM_CDR (forms);
|
||||||
|
SCM form_idx = cdr_forms;
|
||||||
|
SCM definitions = SCM_EOL;
|
||||||
|
SCM sequence = SCM_EOL;
|
||||||
|
|
||||||
|
/* According to R5RS, the list of body forms consists of two parts: a number
|
||||||
|
* (maybe zero) of definitions, followed by a non-empty sequence of
|
||||||
|
* expressions. Each the definitions and the expressions may be grouped
|
||||||
|
* arbitrarily with begin, but it is not allowed to mix definitions and
|
||||||
|
* expressions. The task of the following loop therefore is to split the
|
||||||
|
* list of body forms into the list of definitions and the sequence of
|
||||||
|
* expressions. */
|
||||||
|
while (!SCM_NULLP (form_idx))
|
||||||
|
{
|
||||||
|
const SCM form = SCM_CAR (form_idx);
|
||||||
|
const SCM new_form = expand_user_macros (form, env);
|
||||||
|
if (is_system_macro_p (scm_sym_define, new_form, env))
|
||||||
|
{
|
||||||
|
definitions = scm_cons (new_form, definitions);
|
||||||
|
form_idx = SCM_CDR (form_idx);
|
||||||
|
}
|
||||||
|
else if (is_system_macro_p (scm_sym_begin, new_form, env))
|
||||||
|
{
|
||||||
|
/* We have encountered a group of forms. This has to be either a
|
||||||
|
* (possibly empty) group of (possibly further grouped) definitions,
|
||||||
|
* or a non-empty group of (possibly further grouped)
|
||||||
|
* expressions. */
|
||||||
|
const SCM grouped_forms = SCM_CDR (new_form);
|
||||||
|
unsigned int found_definition = 0;
|
||||||
|
unsigned int found_expression = 0;
|
||||||
|
SCM grouped_form_idx = grouped_forms;
|
||||||
|
while (!found_expression && !SCM_NULLP (grouped_form_idx))
|
||||||
|
{
|
||||||
|
const SCM inner_form = SCM_CAR (grouped_form_idx);
|
||||||
|
const SCM new_inner_form = expand_user_macros (inner_form, env);
|
||||||
|
if (is_system_macro_p (scm_sym_define, new_inner_form, env))
|
||||||
|
{
|
||||||
|
found_definition = 1;
|
||||||
|
definitions = scm_cons (new_inner_form, definitions);
|
||||||
|
grouped_form_idx = SCM_CDR (grouped_form_idx);
|
||||||
|
}
|
||||||
|
else if (is_system_macro_p (scm_sym_begin, new_inner_form, env))
|
||||||
|
{
|
||||||
|
const SCM inner_group = SCM_CDR (new_inner_form);
|
||||||
|
grouped_form_idx
|
||||||
|
= scm_append (scm_list_2 (inner_group,
|
||||||
|
SCM_CDR (grouped_form_idx)));
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
/* The group marks the start of the expressions of the body.
|
||||||
|
* We have to make sure that within the same group we have
|
||||||
|
* not encountered a definition before. */
|
||||||
|
ASSERT_SYNTAX (!found_definition, s_mixed_body_forms, form);
|
||||||
|
found_expression = 1;
|
||||||
|
grouped_form_idx = SCM_EOL;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* We have finished processing the group. If we have not yet
|
||||||
|
* encountered an expression we continue processing the forms of the
|
||||||
|
* body to collect further definition forms. Otherwise, the group
|
||||||
|
* marks the start of the sequence of expressions of the body. */
|
||||||
|
if (!found_expression)
|
||||||
|
{
|
||||||
|
form_idx = SCM_CDR (form_idx);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
sequence = form_idx;
|
||||||
|
form_idx = SCM_EOL;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
/* We have detected a form which is no definition. This marks the
|
||||||
|
* start of the sequence of expressions of the body. */
|
||||||
|
sequence = form_idx;
|
||||||
|
form_idx = SCM_EOL;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* FIXME: forms does not hold information about the file location. */
|
||||||
|
ASSERT_SYNTAX (SCM_CONSP (sequence), s_missing_body_expression, cdr_forms);
|
||||||
|
|
||||||
|
if (!SCM_NULLP (definitions))
|
||||||
|
{
|
||||||
|
SCM definition_idx;
|
||||||
|
SCM letrec_tail;
|
||||||
|
SCM letrec_expression;
|
||||||
|
SCM new_letrec_expression;
|
||||||
|
SCM new_body;
|
||||||
|
|
||||||
|
SCM bindings = SCM_EOL;
|
||||||
|
for (definition_idx = definitions;
|
||||||
|
!SCM_NULLP (definition_idx);
|
||||||
|
definition_idx = SCM_CDR (definition_idx))
|
||||||
|
{
|
||||||
|
const SCM definition = SCM_CAR (definition_idx);
|
||||||
|
const SCM canonical_definition = canonicalize_define (definition);
|
||||||
|
const SCM binding = SCM_CDR (canonical_definition);
|
||||||
|
bindings = scm_cons (binding, bindings);
|
||||||
|
};
|
||||||
|
|
||||||
|
letrec_tail = scm_cons (bindings, sequence);
|
||||||
|
/* 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;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
SCM_SETCAR (forms, SCM_CAR (sequence));
|
||||||
|
SCM_SETCDR (forms, SCM_CDR (sequence));
|
||||||
|
return forms;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
#if (SCM_ENABLE_DEPRECATED == 1)
|
||||||
|
|
||||||
|
/* Deprecated in guile 1.7.0 on 2003-11-09. */
|
||||||
|
SCM
|
||||||
|
scm_m_expand_body (SCM exprs, SCM env)
|
||||||
|
{
|
||||||
|
scm_c_issue_deprecation_warning
|
||||||
|
("`scm_m_expand_body' is deprecated.");
|
||||||
|
return m_expand_body (exprs, env);
|
||||||
|
}
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
/* Start of the memoizers for the standard R5RS builtin macros. */
|
/* Start of the memoizers for the standard R5RS builtin macros. */
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1836,216 +2046,6 @@ scm_m_undefine (SCM expr, SCM env)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|
||||||
/* 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. */
|
|
||||||
|
|
||||||
/* This is a helper function for m_expand_body. It helps to figure out whether
|
|
||||||
* an expression denotes a syntactic keyword. */
|
|
||||||
static SCM
|
|
||||||
try_macro_lookup (const SCM expr, const SCM env)
|
|
||||||
{
|
|
||||||
if (SCM_SYMBOLP (expr))
|
|
||||||
{
|
|
||||||
const SCM tmp_pair = scm_list_1 (expr);
|
|
||||||
const SCM value = *scm_lookupcar1 (tmp_pair, env, 0);
|
|
||||||
return value;
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
return SCM_UNDEFINED;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* This is a helper function for m_expand_body. It expands user macros,
|
|
||||||
* because for the correct translation of a body we need to know whether they
|
|
||||||
* expand to a definition. */
|
|
||||||
static SCM
|
|
||||||
expand_user_macros (SCM expr, const SCM env)
|
|
||||||
{
|
|
||||||
while (SCM_CONSP (expr))
|
|
||||||
{
|
|
||||||
const SCM car_expr = SCM_CAR (expr);
|
|
||||||
const SCM new_car = expand_user_macros (car_expr, env);
|
|
||||||
const SCM value = try_macro_lookup (new_car, env);
|
|
||||||
|
|
||||||
if (SCM_MACROP (value) && SCM_MACRO_TYPE (value) == 2)
|
|
||||||
{
|
|
||||||
/* User macros transform code into code. */
|
|
||||||
expr = scm_call_2 (SCM_MACRO_CODE (value), expr, env);
|
|
||||||
/* We need to reiterate on the transformed code. */
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
/* No user macro: return. */
|
|
||||||
SCM_SETCAR (expr, new_car);
|
|
||||||
return expr;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
return expr;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* This is a helper function for m_expand_body. It determines if a given form
|
|
||||||
* represents an application of a given built-in macro. The built-in macro to
|
|
||||||
* check for is identified by its syntactic keyword. The form is an
|
|
||||||
* application of the given macro if looking up the car of the form in the
|
|
||||||
* given environment actually returns the built-in macro. */
|
|
||||||
static int
|
|
||||||
is_system_macro_p (const SCM syntactic_keyword, const SCM form, const SCM env)
|
|
||||||
{
|
|
||||||
if (SCM_CONSP (form))
|
|
||||||
{
|
|
||||||
const SCM car_form = SCM_CAR (form);
|
|
||||||
const SCM value = try_macro_lookup (car_form, env);
|
|
||||||
if (SCM_BUILTIN_MACRO_P (value))
|
|
||||||
{
|
|
||||||
const SCM macro_name = scm_macro_name (value);
|
|
||||||
return SCM_EQ_P (macro_name, syntactic_keyword);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
static SCM
|
|
||||||
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
|
|
||||||
* was prepended to the body by m_body. */
|
|
||||||
SCM cdr_forms = SCM_CDR (forms);
|
|
||||||
SCM form_idx = cdr_forms;
|
|
||||||
SCM definitions = SCM_EOL;
|
|
||||||
SCM sequence = SCM_EOL;
|
|
||||||
|
|
||||||
/* According to R5RS, the list of body forms consists of two parts: a number
|
|
||||||
* (maybe zero) of definitions, followed by a non-empty sequence of
|
|
||||||
* expressions. Each the definitions and the expressions may be grouped
|
|
||||||
* arbitrarily with begin, but it is not allowed to mix definitions and
|
|
||||||
* expressions. The task of the following loop therefore is to split the
|
|
||||||
* list of body forms into the list of definitions and the sequence of
|
|
||||||
* expressions. */
|
|
||||||
while (!SCM_NULLP (form_idx))
|
|
||||||
{
|
|
||||||
const SCM form = SCM_CAR (form_idx);
|
|
||||||
const SCM new_form = expand_user_macros (form, env);
|
|
||||||
if (is_system_macro_p (scm_sym_define, new_form, env))
|
|
||||||
{
|
|
||||||
definitions = scm_cons (new_form, definitions);
|
|
||||||
form_idx = SCM_CDR (form_idx);
|
|
||||||
}
|
|
||||||
else if (is_system_macro_p (scm_sym_begin, new_form, env))
|
|
||||||
{
|
|
||||||
/* We have encountered a group of forms. This has to be either a
|
|
||||||
* (possibly empty) group of (possibly further grouped) definitions,
|
|
||||||
* or a non-empty group of (possibly further grouped)
|
|
||||||
* expressions. */
|
|
||||||
const SCM grouped_forms = SCM_CDR (new_form);
|
|
||||||
unsigned int found_definition = 0;
|
|
||||||
unsigned int found_expression = 0;
|
|
||||||
SCM grouped_form_idx = grouped_forms;
|
|
||||||
while (!found_expression && !SCM_NULLP (grouped_form_idx))
|
|
||||||
{
|
|
||||||
const SCM inner_form = SCM_CAR (grouped_form_idx);
|
|
||||||
const SCM new_inner_form = expand_user_macros (inner_form, env);
|
|
||||||
if (is_system_macro_p (scm_sym_define, new_inner_form, env))
|
|
||||||
{
|
|
||||||
found_definition = 1;
|
|
||||||
definitions = scm_cons (new_inner_form, definitions);
|
|
||||||
grouped_form_idx = SCM_CDR (grouped_form_idx);
|
|
||||||
}
|
|
||||||
else if (is_system_macro_p (scm_sym_begin, new_inner_form, env))
|
|
||||||
{
|
|
||||||
const SCM inner_group = SCM_CDR (new_inner_form);
|
|
||||||
grouped_form_idx
|
|
||||||
= scm_append (scm_list_2 (inner_group,
|
|
||||||
SCM_CDR (grouped_form_idx)));
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
/* The group marks the start of the expressions of the body.
|
|
||||||
* We have to make sure that within the same group we have
|
|
||||||
* not encountered a definition before. */
|
|
||||||
ASSERT_SYNTAX (!found_definition, s_mixed_body_forms, form);
|
|
||||||
found_expression = 1;
|
|
||||||
grouped_form_idx = SCM_EOL;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* We have finished processing the group. If we have not yet
|
|
||||||
* encountered an expression we continue processing the forms of the
|
|
||||||
* body to collect further definition forms. Otherwise, the group
|
|
||||||
* marks the start of the sequence of expressions of the body. */
|
|
||||||
if (!found_expression)
|
|
||||||
{
|
|
||||||
form_idx = SCM_CDR (form_idx);
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
sequence = form_idx;
|
|
||||||
form_idx = SCM_EOL;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
/* We have detected a form which is no definition. This marks the
|
|
||||||
* start of the sequence of expressions of the body. */
|
|
||||||
sequence = form_idx;
|
|
||||||
form_idx = SCM_EOL;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* FIXME: forms does not hold information about the file location. */
|
|
||||||
ASSERT_SYNTAX (SCM_CONSP (sequence), s_missing_body_expression, cdr_forms);
|
|
||||||
|
|
||||||
if (!SCM_NULLP (definitions))
|
|
||||||
{
|
|
||||||
SCM definition_idx;
|
|
||||||
SCM letrec_tail;
|
|
||||||
SCM letrec_expression;
|
|
||||||
SCM new_letrec_expression;
|
|
||||||
SCM new_body;
|
|
||||||
|
|
||||||
SCM bindings = SCM_EOL;
|
|
||||||
for (definition_idx = definitions;
|
|
||||||
!SCM_NULLP (definition_idx);
|
|
||||||
definition_idx = SCM_CDR (definition_idx))
|
|
||||||
{
|
|
||||||
const SCM definition = SCM_CAR (definition_idx);
|
|
||||||
const SCM canonical_definition = canonicalize_define (definition);
|
|
||||||
const SCM binding = SCM_CDR (canonical_definition);
|
|
||||||
bindings = scm_cons (binding, bindings);
|
|
||||||
};
|
|
||||||
|
|
||||||
letrec_tail = scm_cons (bindings, sequence);
|
|
||||||
/* 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;
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
SCM_SETCAR (forms, SCM_CAR (sequence));
|
|
||||||
SCM_SETCDR (forms, SCM_CDR (sequence));
|
|
||||||
return forms;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
#if (SCM_ENABLE_DEPRECATED == 1)
|
|
||||||
|
|
||||||
/* Deprecated in guile 1.7.0 on 2003-11-09. */
|
|
||||||
SCM
|
|
||||||
scm_m_expand_body (SCM exprs, SCM env)
|
|
||||||
{
|
|
||||||
scm_c_issue_deprecation_warning
|
|
||||||
("`scm_m_expand_body' is deprecated.");
|
|
||||||
return m_expand_body (exprs, env);
|
|
||||||
}
|
|
||||||
|
|
||||||
#endif
|
|
||||||
|
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_macroexp (SCM x, SCM env)
|
scm_macroexp (SCM x, SCM env)
|
||||||
{
|
{
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue