mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 22:31:12 +02:00
* libguile/eval.c (s_macro_keyword): New static identifier.
(scm_m_define): Change order to first create binding and evaluating the expression afterwards. (scm_m_set_x): Memoize complete set! expression. Only leave symbols if no binding exists at memoization time. Throw error if assigning to a syntactic keyword. (lazy_memoize_variable): New function. (CEVAL): When execution set!, perform lazy memoization if unmemoized symbol is detected. * libguile/modules.c (module_variable): Return variables with unbound value. * libguile/tags.h: Fix comment. * test-suite/tests/syntax.test: Add test case to check the correct handling of define expressions.
This commit is contained in:
parent
da8bcb2f70
commit
36245b66c2
6 changed files with 84 additions and 13 deletions
|
@ -1,3 +1,24 @@
|
||||||
|
2004-04-22 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
|
||||||
|
|
||||||
|
* eval.c (s_macro_keyword): New static identifier.
|
||||||
|
|
||||||
|
(scm_m_define): Change order to first create binding and
|
||||||
|
evaluating the expression afterwards.
|
||||||
|
|
||||||
|
(scm_m_set_x): Memoize complete set! expression. Only leave
|
||||||
|
symbols if no binding exists at memoization time. Throw error if
|
||||||
|
assigning to a syntactic keyword.
|
||||||
|
|
||||||
|
(lazy_memoize_variable): New function.
|
||||||
|
|
||||||
|
(CEVAL): When execution set!, perform lazy memoization if
|
||||||
|
unmemoized symbol is detected.
|
||||||
|
|
||||||
|
* modules.c (module_variable): Return variables with unbound
|
||||||
|
value.
|
||||||
|
|
||||||
|
* tags.h: Fix comment.
|
||||||
|
|
||||||
2004-04-25 Kevin Ryde <user42@zip.com.au>
|
2004-04-25 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
* chars.c (scm_char_upcase, scm_char_downcase, scm_c_upcase,
|
* chars.c (scm_char_upcase, scm_char_downcase, scm_c_upcase,
|
||||||
|
@ -245,7 +266,6 @@
|
||||||
|
|
||||||
(copy_tree): Corrected typo in comment.
|
(copy_tree): Corrected typo in comment.
|
||||||
|
|
||||||
>>>>>>> 1.2042
|
|
||||||
2004-03-28 Han-Wen Nienhuys <hanwen@xs4all.nl>
|
2004-03-28 Han-Wen Nienhuys <hanwen@xs4all.nl>
|
||||||
|
|
||||||
* eval.c (s_scm_copy_tree): idem.
|
* eval.c (s_scm_copy_tree): idem.
|
||||||
|
|
|
@ -144,6 +144,10 @@ static const char s_mixed_body_forms[] = "Mixed definitions and expressions in";
|
||||||
* is signalled. */
|
* is signalled. */
|
||||||
static const char s_bad_define[] = "Bad define placement";
|
static const char s_bad_define[] = "Bad define placement";
|
||||||
|
|
||||||
|
/* If a macro keyword is detected in a place where macro keywords are not
|
||||||
|
* allowed, a 'Misplaced syntactic keyword' error is signalled. */
|
||||||
|
static const char s_macro_keyword[] = "Misplaced syntactic keyword";
|
||||||
|
|
||||||
/* Case or cond expressions must have at least one clause. If a case or cond
|
/* Case or cond expressions must have at least one clause. If a case or cond
|
||||||
* expression without any clauses is detected, a 'Missing clauses' error is
|
* expression without any clauses is detected, a 'Missing clauses' error is
|
||||||
* signalled. */
|
* signalled. */
|
||||||
|
@ -1194,6 +1198,10 @@ canonicalize_define (const SCM expr)
|
||||||
return expr;
|
return expr;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* According to section 5.2.1 of R5RS we first have to make sure that the
|
||||||
|
* variable is bound, and then perform the (set! variable expression)
|
||||||
|
* operation. This means, that within the expression we may already assign
|
||||||
|
* values to variable: (define foo (begin (set! foo 1) (+ foo 1))) */
|
||||||
SCM
|
SCM
|
||||||
scm_m_define (SCM expr, SCM env)
|
scm_m_define (SCM expr, SCM env)
|
||||||
{
|
{
|
||||||
|
@ -1203,10 +1211,10 @@ scm_m_define (SCM expr, SCM env)
|
||||||
const SCM canonical_definition = canonicalize_define (expr);
|
const SCM canonical_definition = canonicalize_define (expr);
|
||||||
const SCM cdr_canonical_definition = SCM_CDR (canonical_definition);
|
const SCM cdr_canonical_definition = SCM_CDR (canonical_definition);
|
||||||
const SCM variable = SCM_CAR (cdr_canonical_definition);
|
const SCM variable = SCM_CAR (cdr_canonical_definition);
|
||||||
const SCM body = SCM_CDR (cdr_canonical_definition);
|
const SCM location
|
||||||
const SCM value = scm_eval_car (body, env);
|
= scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_T);
|
||||||
|
const SCM value = scm_eval_car (SCM_CDR (cdr_canonical_definition), env);
|
||||||
|
|
||||||
SCM var;
|
|
||||||
if (SCM_REC_PROCNAMES_P)
|
if (SCM_REC_PROCNAMES_P)
|
||||||
{
|
{
|
||||||
SCM tmp = value;
|
SCM tmp = value;
|
||||||
|
@ -1218,8 +1226,7 @@ scm_m_define (SCM expr, SCM env)
|
||||||
scm_set_procedure_property_x (tmp, scm_sym_name, variable);
|
scm_set_procedure_property_x (tmp, scm_sym_name, variable);
|
||||||
}
|
}
|
||||||
|
|
||||||
var = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_T);
|
SCM_VARIABLE_SET (location, value);
|
||||||
SCM_VARIABLE_SET (var, value);
|
|
||||||
|
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
|
@ -1779,15 +1786,23 @@ SCM
|
||||||
scm_m_set_x (SCM expr, SCM env SCM_UNUSED)
|
scm_m_set_x (SCM expr, SCM env SCM_UNUSED)
|
||||||
{
|
{
|
||||||
SCM variable;
|
SCM variable;
|
||||||
|
SCM new_variable;
|
||||||
|
|
||||||
const SCM cdr_expr = SCM_CDR (expr);
|
const SCM cdr_expr = SCM_CDR (expr);
|
||||||
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
|
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
|
||||||
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr);
|
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr);
|
||||||
variable = SCM_CAR (cdr_expr);
|
variable = SCM_CAR (cdr_expr);
|
||||||
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable) || SCM_VARIABLEP (variable),
|
|
||||||
s_bad_variable, variable, expr);
|
/* Memoize the variable form. */
|
||||||
|
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
|
||||||
|
new_variable = lookup_symbol (variable, env);
|
||||||
|
ASSERT_SYNTAX (!SCM_MACROP (new_variable), s_macro_keyword, variable);
|
||||||
|
/* Leave the memoization of unbound symbols to lazy memoization: */
|
||||||
|
if (SCM_UNBNDP (new_variable))
|
||||||
|
new_variable = variable;
|
||||||
|
|
||||||
SCM_SETCAR (expr, SCM_IM_SET_X);
|
SCM_SETCAR (expr, SCM_IM_SET_X);
|
||||||
|
SCM_SETCAR (cdr_expr, new_variable);
|
||||||
return expr;
|
return expr;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -2612,6 +2627,22 @@ static SCM deval (SCM x, SCM env);
|
||||||
SCM_REC_MUTEX (source_mutex);
|
SCM_REC_MUTEX (source_mutex);
|
||||||
|
|
||||||
|
|
||||||
|
/* During execution, look up a symbol in the top level of the given local
|
||||||
|
* environment and return the corresponding variable object. If no binding
|
||||||
|
* for the symbol can be found, an 'Unbound variable' error is signalled. */
|
||||||
|
static SCM
|
||||||
|
lazy_memoize_variable (const SCM symbol, const SCM environment)
|
||||||
|
{
|
||||||
|
const SCM top_level = scm_env_top_level (environment);
|
||||||
|
const SCM variable = scm_sym2var (symbol, top_level, SCM_BOOL_F);
|
||||||
|
|
||||||
|
if (SCM_FALSEP (variable))
|
||||||
|
error_unbound_variable (symbol);
|
||||||
|
else
|
||||||
|
return variable;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_eval_car (SCM pair, SCM env)
|
scm_eval_car (SCM pair, SCM env)
|
||||||
{
|
{
|
||||||
|
@ -3327,8 +3358,13 @@ dispatch:
|
||||||
location = scm_ilookup (variable, env);
|
location = scm_ilookup (variable, env);
|
||||||
else if (SCM_VARIABLEP (variable))
|
else if (SCM_VARIABLEP (variable))
|
||||||
location = SCM_VARIABLE_LOC (variable);
|
location = SCM_VARIABLE_LOC (variable);
|
||||||
else /* (SCM_SYMBOLP (variable)) is known to be true */
|
else
|
||||||
location = scm_lookupcar (x, env, 1);
|
{
|
||||||
|
/* (SCM_SYMBOLP (variable)) is known to be true */
|
||||||
|
variable = lazy_memoize_variable (variable, env);
|
||||||
|
SCM_SETCAR (x, variable);
|
||||||
|
location = SCM_VARIABLE_LOC (variable);
|
||||||
|
}
|
||||||
x = SCM_CDR (x);
|
x = SCM_CDR (x);
|
||||||
*location = EVALCAR (x, env);
|
*location = EVALCAR (x, env);
|
||||||
}
|
}
|
||||||
|
|
|
@ -277,7 +277,7 @@ static SCM
|
||||||
module_variable (SCM module, SCM sym)
|
module_variable (SCM module, SCM sym)
|
||||||
{
|
{
|
||||||
#define SCM_BOUND_THING_P(b) \
|
#define SCM_BOUND_THING_P(b) \
|
||||||
(SCM_VARIABLEP (b) && !SCM_UNBNDP (SCM_VARIABLE_REF (b)))
|
(!SCM_FALSEP (b))
|
||||||
|
|
||||||
/* 1. Check module obarray */
|
/* 1. Check module obarray */
|
||||||
SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
|
SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
|
||||||
|
|
|
@ -325,8 +325,8 @@ typedef unsigned long scm_t_bits;
|
||||||
* tc8 (for objects with tc3==100):
|
* tc8 (for objects with tc3==100):
|
||||||
* 00000-100: special objects ('flags')
|
* 00000-100: special objects ('flags')
|
||||||
* 00001-100: characters
|
* 00001-100: characters
|
||||||
* 00010-100: evaluator byte codes ('ilocs')
|
* 00010-100: evaluator byte codes ('isyms')
|
||||||
* 00011-100: evaluator byte codes ('isyms')
|
* 00011-100: evaluator byte codes ('ilocs')
|
||||||
*
|
*
|
||||||
*
|
*
|
||||||
* Summary of type codes on the heap
|
* Summary of type codes on the heap
|
||||||
|
|
|
@ -1,3 +1,8 @@
|
||||||
|
2004-04-26 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
|
||||||
|
|
||||||
|
* tests/syntax.test: Add test case to check the correct handling
|
||||||
|
of define expressions.
|
||||||
|
|
||||||
2004-04-25 Kevin Ryde <user42@zip.com.au>
|
2004-04-25 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
* tests/socket.test: New file, exercising inet-ntop.
|
* tests/socket.test: New file, exercising inet-ntop.
|
||||||
|
|
|
@ -592,6 +592,16 @@
|
||||||
|
|
||||||
(with-test-prefix "top-level define"
|
(with-test-prefix "top-level define"
|
||||||
|
|
||||||
|
(pass-if "binding is created before expression is evaluated"
|
||||||
|
(= (eval '(begin
|
||||||
|
(define foo
|
||||||
|
(begin
|
||||||
|
(set! foo 1)
|
||||||
|
(+ foo 1)))
|
||||||
|
foo)
|
||||||
|
(interaction-environment))
|
||||||
|
2))
|
||||||
|
|
||||||
(with-test-prefix "currying"
|
(with-test-prefix "currying"
|
||||||
|
|
||||||
(pass-if "(define ((foo)) #f)"
|
(pass-if "(define ((foo)) #f)"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue