1798 |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
1799 |
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr); |
1800 |
variable = SCM_CAR (cdr_expr); |
variable = SCM_CAR (cdr_expr); |
1801 |
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr); |
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable) || SCM_VARIABLEP (variable), |
1802 |
|
s_bad_variable, variable, expr); |
1803 |
|
|
1804 |
SCM_SETCAR (expr, SCM_IM_SET_X); |
SCM_SETCAR (expr, SCM_IM_SET_X); |
1805 |
return expr; |
return expr; |
1931 |
SCM_SYMBOL (scm_sym_setter, "setter"); |
SCM_SYMBOL (scm_sym_setter, "setter"); |
1932 |
|
|
1933 |
SCM |
SCM |
1934 |
scm_m_generalized_set_x (SCM expr, SCM env SCM_UNUSED) |
scm_m_generalized_set_x (SCM expr, SCM env) |
1935 |
{ |
{ |
1936 |
SCM target; |
SCM target, exp_target; |
1937 |
|
|
1938 |
const SCM cdr_expr = SCM_CDR (expr); |
const SCM cdr_expr = SCM_CDR (expr); |
1939 |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
1948 |
else |
else |
1949 |
{ |
{ |
1950 |
/* (set! (foo bar ...) baz) becomes ((setter foo) bar ... baz) */ |
/* (set! (foo bar ...) baz) becomes ((setter foo) bar ... baz) */ |
1951 |
|
/* Macroexpanding the target might return things of the form |
1952 |
const SCM setter_proc_tail = scm_list_1 (SCM_CAR (target)); |
(begin <atom>). In that case, <atom> must be a symbol or a |
1953 |
const SCM setter_proc = scm_cons_source (expr, scm_sym_setter, setter_proc_tail); |
variable and we memoize to (set! <atom> ...). |
1954 |
|
*/ |
1955 |
const SCM cddr_expr = SCM_CDR (cdr_expr); |
exp_target = scm_macroexp (target, env); |
1956 |
const SCM setter_args = scm_append_x (scm_list_2 (SCM_CDR (target), cddr_expr)); |
if (SCM_EQ_P (SCM_CAR (exp_target), SCM_IM_BEGIN) |
1957 |
|
&& !SCM_NULLP (SCM_CDR (exp_target)) |
1958 |
SCM_SETCAR (expr, setter_proc); |
&& SCM_NULLP (SCM_CDDR (exp_target))) |
1959 |
SCM_SETCDR (expr, setter_args); |
{ |
1960 |
return expr; |
exp_target= SCM_CADR (exp_target); |
1961 |
|
SCM_ASSYNT (SCM_SYMBOLP (exp_target) || SCM_VARIABLEP (exp_target), |
1962 |
|
s_bad_variable, s_set_x); |
1963 |
|
return scm_cons (SCM_IM_SET_X, scm_cons (exp_target, |
1964 |
|
SCM_CDR (cdr_expr))); |
1965 |
|
} |
1966 |
|
else |
1967 |
|
{ |
1968 |
|
const SCM setter_proc_tail = scm_list_1 (SCM_CAR (target)); |
1969 |
|
const SCM setter_proc = scm_cons_source (expr, scm_sym_setter, |
1970 |
|
setter_proc_tail); |
1971 |
|
|
1972 |
|
const SCM cddr_expr = SCM_CDR (cdr_expr); |
1973 |
|
const SCM setter_args = scm_append_x (scm_list_2 (SCM_CDR (target), |
1974 |
|
cddr_expr)); |
1975 |
|
|
1976 |
|
SCM_SETCAR (expr, setter_proc); |
1977 |
|
SCM_SETCDR (expr, setter_args); |
1978 |
|
return expr; |
1979 |
|
} |
1980 |
} |
} |
1981 |
} |
} |
1982 |
|
|