diff options
| author | Andy Wingo <wingo@pobox.com> | 2009-04-15 17:02:33 +0200 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2009-04-17 15:20:19 +0200 |
| commit | 69dd78d7c85141463ae93e9901a70ed4d7136fbc (patch) | |
| tree | a87a2fd3092c69431cbe0b1125304e3471f2c8f8 | |
| parent | c5cc65ac0ce636f93572592c7a63f4ecea17dc4b (diff) | |
| download | guile-syncase.tar.gz | |
no positions when reading psyntax-pp, validation in @/@@, cleanupssyncase
* 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.
| -rw-r--r-- | libguile/debug.c | 20 | ||||
| -rw-r--r-- | libguile/eval.c | 2 | ||||
| -rw-r--r-- | module/ice-9/syncase.scm | 4 |
3 files changed, 6 insertions, 20 deletions
diff --git a/libguile/debug.c b/libguile/debug.c index fe54b64df..5042fbb73 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -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 proc), - "Return the module that was current when this procedure was defined.\n" - "Free variables in this procedure are resolved relative to the\n" - "procedure's module.") + "Return the module that was current when @var{proc} was defined.") #define FUNC_NAME s_scm_procedure_module { 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))) return scm_program_module (proc); else - { - 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; - } - } + return scm_env_module (scm_procedure_environment (proc)); } #undef FUNC_NAME diff --git a/libguile/eval.c b/libguile/eval.c index 12888c2fe..4c79b166c 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1988,6 +1988,7 @@ scm_m_at (SCM expr, SCM env SCM_UNUSED) SCM mod, var; 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_is_symbol (scm_caddr (expr)), s_bad_expression, expr); mod = scm_resolve_module (scm_cadr (expr)); if (scm_is_false (mod)) @@ -2008,6 +2009,7 @@ scm_m_atat (SCM expr, SCM env SCM_UNUSED) SCM mod, var; 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_is_symbol (scm_caddr (expr)), s_bad_expression, expr); mod = scm_resolve_module (scm_cadr (expr)); if (scm_is_false (mod)) diff --git a/module/ice-9/syncase.scm b/module/ice-9/syncase.scm index 79e98f993..a6bdaa4a9 100644 --- a/module/ice-9/syncase.scm +++ b/module/ice-9/syncase.scm @@ -177,8 +177,8 @@ (set! old-debug (debug-options)) (set! old-read (read-options))) (lambda () - ;(debug-disable 'debug 'procnames) - ;(read-disable 'positions) + (debug-disable 'debug 'procnames) + (read-disable 'positions) (load-from-path "ice-9/psyntax-pp")) (lambda () (debug-options old-debug) |