/[guile]/guile/guile-core/libguile/eval.c
ViewVC logotype

Diff of /guile/guile-core/libguile/eval.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.346 by dirk, Sun Nov 16 13:32:02 2003 UTC revision 1.347 by mvo, Mon Nov 17 00:24:48 2003 UTC
# Line 1798  scm_m_set_x (SCM expr, SCM env SCM_UNUSE Line 1798  scm_m_set_x (SCM expr, SCM env SCM_UNUSE
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;
# Line 1930  SCM_SYNTAX (s_gset_x, "set!", scm_i_makb Line 1931  SCM_SYNTAX (s_gset_x, "set!", scm_i_makb
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);
# Line 1947  scm_m_generalized_set_x (SCM expr, SCM e Line 1948  scm_m_generalized_set_x (SCM expr, SCM e
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    

Legend:
Removed from v.1.346  
changed lines
  Added in v.1.347

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26