mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 05:50:26 +02:00
* libguile/eval.c (scm_m_cont, scm_m_at_call_with_values,
scm_m_generalized_set_x): Use ASSERT_SYNTAX to signal syntax errors. Avoid unnecessary consing when creating the memoized code. (scm_m_generalized_set_x): Let scm_m_set_x handle the R5RS standard case. Make sure line and file information are copied to every created expression. * test-suite/tests/syntax.test (exception:bad-var): Removed. Adapted tests for 'set!' to the new way of error reporting.
This commit is contained in:
Dirk Herrmann
parent
82b3e2c612
commit
da48db629c
4 changed files with 68 additions and 32 deletions
|
|
@ -1,3 +1,14 @@
|
|||
2003-10-18 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* eval.c (scm_m_cont, scm_m_at_call_with_values,
|
||||
scm_m_generalized_set_x): Use ASSERT_SYNTAX to signal syntax
|
||||
errors. Avoid unnecessary consing when creating the memoized
|
||||
code.
|
||||
|
||||
(scm_m_generalized_set_x): Let scm_m_set_x handle the R5RS
|
||||
standard case. Make sure line and file information are copied to
|
||||
every created expression.
|
||||
|
||||
2003-10-18 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* eval.c (scm_m_set_x, scm_m_apply, scm_m_atbind): Use
|
||||
|
|
@ -55,7 +66,7 @@
|
|||
specific about the kind of error that was detected. Prepare for
|
||||
easier integration of changes for separated memoization.
|
||||
|
||||
2003-10-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
2003-10-12 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* eval.c (s_duplicate_binding): New static identifier.
|
||||
|
||||
|
|
@ -77,7 +88,7 @@
|
|||
|
||||
(SCM_CEVAL): Simplified handling of SCM_IM_IF forms.
|
||||
|
||||
2003-10-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
2003-10-12 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* eval.c (s_bad_bindings, s_bad_binding, s_bad_exit_clause): New
|
||||
static identifiers.
|
||||
|
|
@ -88,7 +99,7 @@
|
|||
code, this way also making sure that file name, line number
|
||||
information etc. remain available.
|
||||
|
||||
2003-10-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
2003-10-12 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* eval.c (memoize_as_thunk_prototype): New static function.
|
||||
|
||||
|
|
|
|||
|
|
@ -1579,13 +1579,15 @@ scm_m_atbind (SCM expr, SCM env)
|
|||
SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_i_makbimacro, scm_m_cont);
|
||||
SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc);
|
||||
|
||||
|
||||
SCM
|
||||
scm_m_cont (SCM xorig, SCM env SCM_UNUSED)
|
||||
scm_m_cont (SCM expr, SCM env SCM_UNUSED)
|
||||
{
|
||||
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1,
|
||||
s_expression, s_atcall_cc);
|
||||
return scm_cons (SCM_IM_CONT, SCM_CDR (xorig));
|
||||
const SCM cdr_expr = SCM_CDR (expr);
|
||||
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
|
||||
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
|
||||
|
||||
SCM_SETCAR (expr, SCM_IM_CONT);
|
||||
return expr;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -1593,11 +1595,14 @@ SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_i_makbimacro, scm_m_
|
|||
SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values);
|
||||
|
||||
SCM
|
||||
scm_m_at_call_with_values (SCM xorig, SCM env SCM_UNUSED)
|
||||
scm_m_at_call_with_values (SCM expr, SCM env SCM_UNUSED)
|
||||
{
|
||||
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2,
|
||||
s_expression, s_at_call_with_values);
|
||||
return scm_cons (SCM_IM_CALL_WITH_VALUES, SCM_CDR (xorig));
|
||||
const SCM cdr_expr = SCM_CDR (expr);
|
||||
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
|
||||
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr);
|
||||
|
||||
SCM_SETCAR (expr, SCM_IM_CALL_WITH_VALUES);
|
||||
return expr;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -1622,17 +1627,34 @@ 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 xorig, SCM env SCM_UNUSED)
|
||||
scm_m_generalized_set_x (SCM expr, SCM env SCM_UNUSED)
|
||||
{
|
||||
SCM x = SCM_CDR (xorig);
|
||||
SCM_ASSYNT (2 == scm_ilength (x), s_expression, s_set_x);
|
||||
if (SCM_SYMBOLP (SCM_CAR (x)))
|
||||
return scm_cons (SCM_IM_SET_X, x);
|
||||
else if (SCM_CONSP (SCM_CAR (x)))
|
||||
return scm_cons (scm_list_2 (scm_sym_setter, SCM_CAAR (x)),
|
||||
scm_append (scm_list_2 (SCM_CDAR (x), SCM_CDR (x))));
|
||||
SCM target;
|
||||
|
||||
const SCM cdr_expr = SCM_CDR (expr);
|
||||
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
|
||||
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr);
|
||||
|
||||
target = SCM_CAR (cdr_expr);
|
||||
if (!SCM_CONSP (target))
|
||||
{
|
||||
/* R5RS usage */
|
||||
return scm_m_set_x (expr, env);
|
||||
}
|
||||
else
|
||||
scm_misc_error (s_set_x, s_variable, SCM_EOL);
|
||||
{
|
||||
/* (set! (foo bar ...) baz) becomes ((setter foo) bar ... baz) */
|
||||
|
||||
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));
|
||||
|
||||
SCM_SETCAR (expr, setter_proc);
|
||||
SCM_SETCDR (expr, setter_args);
|
||||
return expr;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
2003-10-18 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* tests/syntax.test (exception:bad-var): Removed.
|
||||
|
||||
Adapted tests for 'set!' to the new way of error reporting.
|
||||
|
||||
2003-10-18 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* tests/dynamic-scope.test (exception:missing-expr): Introduced
|
||||
|
|
|
|||
|
|
@ -59,9 +59,6 @@
|
|||
(define exception:bad-cond-clause
|
||||
(cons 'syntax-error "Bad cond clause"))
|
||||
|
||||
(define exception:bad-var
|
||||
(cons 'misc-error "^bad variable"))
|
||||
|
||||
|
||||
(with-test-prefix "expressions"
|
||||
|
||||
|
|
@ -611,44 +608,44 @@
|
|||
(with-test-prefix "missing or extra expressions"
|
||||
|
||||
(pass-if-exception "(set!)"
|
||||
exception:missing/extra-expr-misc
|
||||
exception:missing/extra-expr
|
||||
(eval '(set!)
|
||||
(interaction-environment)))
|
||||
|
||||
(pass-if-exception "(set! 1)"
|
||||
exception:missing/extra-expr-misc
|
||||
exception:missing/extra-expr
|
||||
(eval '(set! 1)
|
||||
(interaction-environment)))
|
||||
|
||||
(pass-if-exception "(set! 1 2 3)"
|
||||
exception:missing/extra-expr-misc
|
||||
exception:missing/extra-expr
|
||||
(eval '(set! 1 2 3)
|
||||
(interaction-environment))))
|
||||
|
||||
(with-test-prefix "bad variable"
|
||||
|
||||
(pass-if-exception "(set! \"\" #t)"
|
||||
exception:bad-var
|
||||
exception:bad-variable
|
||||
(eval '(set! "" #t)
|
||||
(interaction-environment)))
|
||||
|
||||
(pass-if-exception "(set! 1 #t)"
|
||||
exception:bad-var
|
||||
exception:bad-variable
|
||||
(eval '(set! 1 #t)
|
||||
(interaction-environment)))
|
||||
|
||||
(pass-if-exception "(set! #t #f)"
|
||||
exception:bad-var
|
||||
exception:bad-variable
|
||||
(eval '(set! #t #f)
|
||||
(interaction-environment)))
|
||||
|
||||
(pass-if-exception "(set! #f #t)"
|
||||
exception:bad-var
|
||||
exception:bad-variable
|
||||
(eval '(set! #f #t)
|
||||
(interaction-environment)))
|
||||
|
||||
(pass-if-exception "(set! #\space #f)"
|
||||
exception:bad-var
|
||||
exception:bad-variable
|
||||
(eval '(set! #\space #f)
|
||||
(interaction-environment)))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue