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.

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index daf8e49..bde0b85 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -750,6 +750,14 @@
 
 \f
 
+;;; {The interpreter stack}
+;;;
+
+(defmacro start-stack (tag exp)
+  `(%start-stack ,tag (lambda () ,exp)))
+
+\f
+
 ;;; {Loading by paths}
 ;;;
 

diff --git a/libguile/debug.c b/libguile/debug.c
index 1f2acc9..27e9a10 100644 (file)
--- 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 6077162..4e94b3c 100644 (file)
--- 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 20164b7..799e67c 100644 (file)
--- 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))))