diff options
-rw-r--r-- | ice-9/boot-9.scm | 8 | ||||
-rw-r--r-- | libguile/debug.c | 23 | ||||
-rw-r--r-- | libguile/debug.h | 2 | ||||
-rw-r--r-- | module/language/scheme/translate.scm | 4 |
4 files changed, 14 insertions, 23 deletions
diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index daf8e49b8..bde0b852a 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -750,6 +750,14 @@ +;;; {The interpreter stack} +;;; + +(defmacro start-stack (tag exp) + `(%start-stack ,tag (lambda () ,exp))) + + + ;;; {Loading by paths} ;;; 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. diff --git a/libguile/debug.h b/libguile/debug.h index 607716230..4e94b3c15 100644 --- a/libguile/debug.h +++ b/libguile/debug.h @@ -138,7 +138,7 @@ SCM_API scm_t_bits scm_tc16_memoized; SCM_API SCM scm_debug_object_p (SCM obj); SCM_API SCM scm_local_eval (SCM exp, SCM env); SCM_API SCM scm_reverse_lookup (SCM env, SCM data); -SCM_API SCM scm_start_stack (SCM info_id, SCM exp, SCM env); +SCM_API SCM scm_sys_start_stack (SCM info_id, SCM thunk); SCM_API SCM scm_procedure_environment (SCM proc); SCM_API SCM scm_procedure_source (SCM proc); SCM_API SCM scm_procedure_name (SCM proc); diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm index 20164b72a..799e67c23 100644 --- a/module/language/scheme/translate.scm +++ b/module/language/scheme/translate.scm @@ -303,10 +303,6 @@ runtime))) (else (syntax-error l "bad eval-case clause" (car in)))))))))))) - ;; FIXME: make this actually do something - (start-stack - ((,tag ,expr) (retrans expr))) - ;; FIXME: not hygienic, relies on @apply not being shadowed (apply (,args (retrans `(@apply ,@args)))) |