[uim-commit] r3053 - branches/r5rs/sigscheme/src

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-31 16:40:14 -0800 (Tue, 31 Jan 2006)
New Revision: 3053

Modified:
   branches/r5rs/sigscheme/src/eval.c
   branches/r5rs/sigscheme/src/main.c
   branches/r5rs/sigscheme/src/module-srfi34.c
   branches/r5rs/sigscheme/src/sigscheme.h
Log:
* sigscheme/src/sigscheme.h
  - (SCM_FINISH_TAILREC_CALL): New macro
* sigscheme/src/eval.c
  - (scm_call): Simplify with the new macro
* sigscheme/src/module-srfi34.c
  - (guard_handler, guard_body): Ditto
* sigscheme/src/main.c
  - (repl_loop): Ditto


Modified: branches/r5rs/sigscheme/src/eval.c
===================================================================
--- branches/r5rs/sigscheme/src/eval.c	2006-02-01 00:15:18 UTC (rev 3052)
+++ branches/r5rs/sigscheme/src/eval.c	2006-02-01 00:40:14 UTC (rev 3053)
@@ -126,9 +126,7 @@
     SCM_EVAL_STATE_INIT2(state, SCM_INTERACTION_ENV, SCM_VALTYPE_AS_IS);
 
     ret = call(proc, args, &state, SCM_VALTYPE_AS_IS);
-    if (state.ret_type == SCM_VALTYPE_NEED_EVAL)
-        ret = EVAL(ret, state.env);
-    return ret;
+    return SCM_FINISH_TAILREC_CALL(ret, &state);
 }
 
 /* ARGS should NOT have been evaluated yet. */

Modified: branches/r5rs/sigscheme/src/main.c
===================================================================
--- branches/r5rs/sigscheme/src/main.c	2006-02-01 00:15:18 UTC (rev 3052)
+++ branches/r5rs/sigscheme/src/main.c	2006-02-01 00:40:14 UTC (rev 3053)
@@ -124,8 +124,7 @@
         sexp = scm_s_srfi34_guard(cond_catch,
                                   LIST_1(LIST_2(proc_read, scm_in)),
                                   &eval_state);
-        if (eval_state.ret_type == SCM_VALTYPE_NEED_EVAL)
-            sexp = EVAL(sexp, eval_state.env);
+        sexp = SCM_FINISH_TAILREC_CALL(sexp, &eval_state);
         if (EOFP(sexp))
             break;
 
@@ -161,8 +160,7 @@
                                                   LIST_2(SYM_QUOTE, sexp),
                                                   SCM_INTERACTION_ENV)),
                                     &eval_state);
-        if (eval_state.ret_type == SCM_VALTYPE_NEED_EVAL)
-            result = EVAL(result, eval_state.env);
+        result = SCM_FINISH_TAILREC_CALL(result, &eval_state);
 
         if (!EQ(result, err)) {
             SCM_WRITE_SS(scm_out, result);

Modified: branches/r5rs/sigscheme/src/module-srfi34.c
===================================================================
--- branches/r5rs/sigscheme/src/module-srfi34.c	2006-02-01 00:15:18 UTC (rev 3052)
+++ branches/r5rs/sigscheme/src/module-srfi34.c	2006-02-01 00:40:14 UTC (rev 3053)
@@ -313,10 +313,7 @@
                        LIST_1(LIST_2(syn_guard_handler_body, sym_handler_k)),
                        eval_state->env);
     ret = scm_call_with_current_continuation(handler_body, eval_state);
-    if (eval_state->ret_type == SCM_VALTYPE_NEED_EVAL) {
-        ret = EVAL(ret, eval_state->env);
-        eval_state->ret_type = SCM_VALTYPE_AS_IS;
-    }
+    ret = SCM_FINISH_TAILREC_CALL(ret, eval_state);
     return scm_call(ret, SCM_NULL);
 }
 
@@ -388,9 +385,7 @@
     /* evaluate the body */
     SCM_EVAL_STATE_INIT1(lex_eval_state, lex_env);
     result = scm_s_body(body, &lex_eval_state);
-    if (lex_eval_state.ret_type == SCM_VALTYPE_NEED_EVAL)
-        result = EVAL(result, lex_env);
-    eval_state->ret_type = SCM_VALTYPE_AS_IS;
+    result = SCM_FINISH_TAILREC_CALL(result, &lex_eval_state);
 
     scm_call_continuation(guard_k, delay(result, lex_env));
     /* NOTREACHED */

Modified: branches/r5rs/sigscheme/src/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.h	2006-02-01 00:15:18 UTC (rev 3052)
+++ branches/r5rs/sigscheme/src/sigscheme.h	2006-02-01 00:40:14 UTC (rev 3053)
@@ -928,6 +928,12 @@
         (state).ret_type = (_ret_type);                                      \
     } while (/* CONSTCOND */ 0)
 
+#define SCM_FINISH_TAILREC_CALL(obj, eval_state)                             \
+    (((eval_state)->ret_type == SCM_VALTYPE_NEED_EVAL)                       \
+     ? ((eval_state)->ret_type = SCM_VALTYPE_AS_IS,                          \
+        EVAL((obj), (eval_state)->env))                                      \
+     : (obj))
+
 /*=======================================
    Variable Declarations
 =======================================*/