[uim-commit] r2825 - branches/r5rs/sigscheme

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-06 19:30:27 -0800 (Fri, 06 Jan 2006)
New Revision: 2825

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* sigscheme/sigschemeinternal.h
  - (scm_call_continuation): Add SCM_NORETURN attribute
* sigscheme/eval.c
  - (call_continuation):
    * New static function split from call()
    * Fix the wrong local variable name
  - (call): Split continuation calling off as call_continuation()


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2006-01-07 02:26:00 UTC (rev 2824)
+++ branches/r5rs/sigscheme/eval.c	2006-01-07 03:30:27 UTC (rev 2825)
@@ -64,6 +64,9 @@
 =======================================*/
 static ScmObj reduce(ScmObj (*func)(), ScmObj args, ScmObj env,
                      scm_bool suppress_eval);
+static void call_continuation(ScmObj cont, ScmObj args,
+                              ScmEvalState *eval_state,
+                              scm_bool suppress_eval) SCM_NORETURN;
 static ScmObj call_closure(ScmObj proc, ScmObj args, ScmEvalState *eval_state,
                            scm_bool suppress_eval);
 static ScmObj call(ScmObj proc, ScmObj args, ScmEvalState *eval_state,
@@ -169,6 +172,22 @@
     return (*func)(left, right, &state);
 }
 
+static void
+call_continuation(ScmObj cont, ScmObj args, ScmEvalState *eval_state,
+                  scm_bool suppress_eval)
+{
+    ScmObj ret;
+    DECLARE_INTERNAL_FUNCTION("call_continuation");
+
+    if (!LIST_1_P(args))
+        ERR("continuation takes exactly one argument");
+    ret = CAR(args);
+    if (!suppress_eval)
+        ret = EVAL(ret, eval_state->env);
+    scm_call_continuation(cont, ret);
+    /* NOTREACHED */
+}
+
 static ScmObj
 call_closure(ScmObj proc, ScmObj args, ScmEvalState *eval_state,
              scm_bool suppress_eval)
@@ -251,7 +270,7 @@
 call(ScmObj proc, ScmObj args, ScmEvalState *eval_state,
      scm_bool suppress_eval)
 {
-    ScmObj env, cont;
+    ScmObj env;
     ScmObj (*func)();
     enum ScmFuncTypeCode type;
     scm_bool syntaxp;
@@ -269,10 +288,7 @@
         if (CLOSUREP(proc))
             return call_closure(proc, args, eval_state, suppress_eval);
         if (CONTINUATIONP(proc)) {
-            if (!LIST_1_P(args))
-                ERR("continuation takes exactly one argument");
-            cont = (suppress_eval) ? CAR(args) : EVAL(CAR(args), env);
-            scm_call_continuation(proc, cont);
+            call_continuation(proc, args, eval_state, suppress_eval);
             /* NOTREACHED */
         }
         ERR("procedure or syntax required but got", proc);

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2006-01-07 02:26:00 UTC (rev 2824)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2006-01-07 03:30:27 UTC (rev 2825)
@@ -469,7 +469,7 @@
 void scm_destruct_continuation(ScmObj cont);
 ScmObj scm_call_with_current_continuation(ScmObj proc,
                                           ScmEvalState *eval_state);
-void scm_call_continuation(ScmObj cont, ScmObj ret);
+void scm_call_continuation(ScmObj cont, ScmObj ret) SCM_NORETURN;
 ScmObj scm_dynamic_wind(ScmObj before, ScmObj thunk, ScmObj after);
 void scm_push_trace_frame(ScmObj obj, ScmObj env);
 void scm_pop_trace_frame(void);