diff options
author | Andy Wingo <wingo@pobox.com> | 2008-09-26 12:03:36 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-09-26 12:03:36 +0200 |
commit | 107139eaadab946e9713748cdeacd07b22a181db (patch) | |
tree | 21461e1e7cac758cda42199a52c1aa1fbc3787f7 /libguile/debug.c | |
parent | 99b1dd09ccba248261b679657519e6a5b2b76560 (diff) | |
download | guile-107139eaadab946e9713748cdeacd07b22a181db.tar.gz |
actually compile start-stack to something useful
* ice-9/boot-9.scm (start-stack): Define as a defmacro instead of an acro
in C. We have a way to delay evaluation of the exp, after all: putting
it in a thunk is sufficient.
* libguile/debug.h:
* libguile/debug.c (scm_sys_start_stack): Renamed from scm_start_stack,
and exposed to the user. Takes a thunk instead of an expression +
environment.
(scm_m_start_stack): Remove this acro.
* module/language/scheme/translate.scm (custom-transformer-table): Remove
the start-stack special case.
Diffstat (limited to 'libguile/debug.c')
-rw-r--r-- | libguile/debug.c | 23 |
1 files changed, 5 insertions, 18 deletions
diff --git a/libguile/debug.c b/libguile/debug.c index 1f2acc9e6..27e9a10bc 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -445,8 +445,10 @@ scm_reverse_lookup (SCM env, SCM data) return SCM_BOOL_F; } -SCM -scm_start_stack (SCM id, SCM exp, SCM env) +SCM_DEFINE (scm_sys_start_stack, "%start-stack", 2, 0, 0, + (SCM id, SCM thunk), + "Call @var{thunk} on an evaluator stack tagged with @var{id}.") +#define FUNC_NAME s_scm_sys_start_stack { SCM answer; scm_t_debug_frame vframe; @@ -456,27 +458,12 @@ scm_start_stack (SCM id, SCM exp, SCM env) vframe.vect = &vframe_vect_body; vframe.vect[0].id = id; scm_i_set_last_debug_frame (&vframe); - answer = scm_i_eval (exp, env); + answer = scm_call_0 (thunk); scm_i_set_last_debug_frame (vframe.prev); return answer; } - -SCM_SYNTAX(s_start_stack, "start-stack", scm_makacro, scm_m_start_stack); - -static SCM -scm_m_start_stack (SCM exp, SCM env) -#define FUNC_NAME s_start_stack -{ - exp = SCM_CDR (exp); - if (!scm_is_pair (exp) - || !scm_is_pair (SCM_CDR (exp)) - || !scm_is_null (SCM_CDDR (exp))) - SCM_WRONG_NUM_ARGS (); - return scm_start_stack (scm_eval_car (exp, env), SCM_CADR (exp), env); -} #undef FUNC_NAME - /* {Debug Objects} * * The debugging evaluator throws these on frame traps. |