mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 04:15:36 +02:00
Code Activity

no positions when reading psyntax-pp, validation in @/@@, cleanups

Browse source 
* module/ice-9/syncase.scm (old-debug): Re-disable position recording
  when reading psyntax-pp.

* libguile/eval.c (scm_m_at, scm_m_atat): More input validation.

* libguile/debug.c (scm_procedure_module): Use scm_env_module. Remove
  extraneous docstring.
This commit is contained in:
Andy Wingo 2009-04-15 17:02:33 +02:00
parent c5cc65ac0c
commit 69dd78d7c8
3 changed files with 6 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

20
libguile/debug.c
View file

@ -402,9 +402,7 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0,
SCM_DEFINE (scm_procedure_module, "procedure-module", 1, 0, 0, SCM_DEFINE (scm_procedure_module, "procedure-module", 1, 0, 0,
(SCM proc), (SCM proc),
"Return the module that was current when this procedure was defined.\n" "Return the module that was current when @var{proc} was defined.")
"Free variables in this procedure are resolved relative to the\n"
"procedure's module.")
#define FUNC_NAME s_scm_procedure_module #define FUNC_NAME s_scm_procedure_module
{ {
SCM_VALIDATE_PROC (SCM_ARG1, proc); SCM_VALIDATE_PROC (SCM_ARG1, proc);
@ -412,21 +410,7 @@ SCM_DEFINE (scm_procedure_module, "procedure-module", 1, 0, 0,
if (scm_is_true (scm_program_p (proc))) if (scm_is_true (scm_program_p (proc)))
return scm_program_module (proc); return scm_program_module (proc);
else else
{ return scm_env_module (scm_procedure_environment (proc));
SCM env = scm_procedure_environment (proc);
if (scm_is_null (env))
return SCM_BOOL_F;
else
{
for (; !scm_is_null (scm_cdr (env)); env = scm_cdr (env))
;
if (SCM_EVAL_CLOSURE_P (scm_car (env)))
return SCM_PACK (SCM_SMOB_DATA (scm_car (env)));
else
return SCM_BOOL_F;
}
}
} }
#undef FUNC_NAME #undef FUNC_NAME

2
libguile/eval.c
View file

@ -1988,6 +1988,7 @@ scm_m_at (SCM expr, SCM env SCM_UNUSED)
SCM mod, var; SCM mod, var;
ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr); ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr);
ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr); ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
ASSERT_SYNTAX (scm_is_symbol (scm_caddr (expr)), s_bad_expression, expr);
mod = scm_resolve_module (scm_cadr (expr)); mod = scm_resolve_module (scm_cadr (expr));
if (scm_is_false (mod)) if (scm_is_false (mod))
@ -2008,6 +2009,7 @@ scm_m_atat (SCM expr, SCM env SCM_UNUSED)
SCM mod, var; SCM mod, var;
ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr); ASSERT_SYNTAX (scm_ilength (expr) == 3, s_bad_expression, expr);
ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr); ASSERT_SYNTAX (scm_ilength (scm_cadr (expr)) > 0, s_bad_expression, expr);
ASSERT_SYNTAX (scm_is_symbol (scm_caddr (expr)), s_bad_expression, expr);
mod = scm_resolve_module (scm_cadr (expr)); mod = scm_resolve_module (scm_cadr (expr));
if (scm_is_false (mod)) if (scm_is_false (mod))

4
module/ice-9/syncase.scm
View file

@ -177,8 +177,8 @@
(set! old-debug (debug-options)) (set! old-debug (debug-options))
(set! old-read (read-options))) (set! old-read (read-options)))
(lambda () (lambda ()
;(debug-disable 'debug 'procnames) (debug-disable 'debug 'procnames)
;(read-disable 'positions) (read-disable 'positions)
(load-from-path "ice-9/psyntax-pp")) (load-from-path "ice-9/psyntax-pp"))
(lambda () (lambda ()
(debug-options old-debug) (debug-options old-debug)