diff options
author | Marius Vollmer <mvo@zagadka.de> | 2003-11-17 00:24:48 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2003-11-17 00:24:48 +0000 |
commit | 7893dbbf456efdbecd42746458d462bbffeccac7 (patch) | |
tree | 8780971617fd6632246f5341362786d6ee02604d /libguile | |
parent | 8b31d75b34c98ead99d76cd6752d167430c60065 (diff) | |
download | guile-7893dbbf456efdbecd42746458d462bbffeccac7.tar.gz |
(scm_m_generalized_set_x): Macroexpand the target when it is a list.
This allows (@ ...) to work with set!.
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/eval.c | 42 |
1 files changed, 31 insertions, 11 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index 50a5663eb..c8a534501 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1798,7 +1798,8 @@ scm_m_set_x (SCM expr, SCM env SCM_UNUSED) ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr); variable = SCM_CAR (cdr_expr); - ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr); + ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable) || SCM_VARIABLEP (variable), + s_bad_variable, variable, expr); SCM_SETCAR (expr, SCM_IM_SET_X); return expr; @@ -1930,9 +1931,9 @@ SCM_SYNTAX (s_gset_x, "set!", scm_i_makbimacro, scm_m_generalized_set_x); SCM_SYMBOL (scm_sym_setter, "setter"); SCM -scm_m_generalized_set_x (SCM expr, SCM env SCM_UNUSED) +scm_m_generalized_set_x (SCM expr, SCM env) { - SCM target; + SCM target, exp_target; const SCM cdr_expr = SCM_CDR (expr); ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); @@ -1947,16 +1948,35 @@ scm_m_generalized_set_x (SCM expr, SCM env SCM_UNUSED) else { /* (set! (foo bar ...) baz) becomes ((setter foo) bar ... baz) */ + /* Macroexpanding the target might return things of the form + (begin <atom>). In that case, <atom> must be a symbol or a + variable and we memoize to (set! <atom> ...). + */ + exp_target = scm_macroexp (target, env); + if (SCM_EQ_P (SCM_CAR (exp_target), SCM_IM_BEGIN) + && !SCM_NULLP (SCM_CDR (exp_target)) + && SCM_NULLP (SCM_CDDR (exp_target))) + { + exp_target= SCM_CADR (exp_target); + SCM_ASSYNT (SCM_SYMBOLP (exp_target) || SCM_VARIABLEP (exp_target), + s_bad_variable, s_set_x); + return scm_cons (SCM_IM_SET_X, scm_cons (exp_target, + SCM_CDR (cdr_expr))); + } + else + { + const SCM setter_proc_tail = scm_list_1 (SCM_CAR (target)); + const SCM setter_proc = scm_cons_source (expr, scm_sym_setter, + setter_proc_tail); - const SCM setter_proc_tail = scm_list_1 (SCM_CAR (target)); - const SCM setter_proc = scm_cons_source (expr, scm_sym_setter, setter_proc_tail); - - const SCM cddr_expr = SCM_CDR (cdr_expr); - const SCM setter_args = scm_append_x (scm_list_2 (SCM_CDR (target), cddr_expr)); + const SCM cddr_expr = SCM_CDR (cdr_expr); + const SCM setter_args = scm_append_x (scm_list_2 (SCM_CDR (target), + cddr_expr)); - SCM_SETCAR (expr, setter_proc); - SCM_SETCDR (expr, setter_args); - return expr; + SCM_SETCAR (expr, setter_proc); + SCM_SETCDR (expr, setter_args); + return expr; + } } } |