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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-09-30 17:27:49 -0700 (Fri, 30 Sep 2005)
New Revision: 1716

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/sigschemetype.h
Log:
* sigscheme/sigschemetype.h
  - (enum ScmReturnType): Add SCM_RETTYPE_NEED_CALL_AS_IS
* sigscheme/eval.c
  - (ScmOp_eval): Add SCM_RETTYPE_NEED_CALL_AS_IS handlings


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-10-01 00:25:32 UTC (rev 1715)
+++ branches/r5rs/sigscheme/eval.c	2005-10-01 00:27:49 UTC (rev 1716)
@@ -461,6 +461,7 @@
 {
     ScmObj ret  = SCM_NULL;
     ScmEvalState state = {0};
+    int suppress_eval = 0;
 
 #if SCM_DEBUG
     struct trace_frame frame;
@@ -485,9 +486,18 @@
         break;
 
     case ScmCons:
-        obj = call(CAR(obj), CDR(obj), &state, 0);
-        if (state.ret_type == SCM_RETTYPE_NEED_EVAL)
+        suppress_eval = 0;
+    call_loop:
+        obj = call(CAR(obj), CDR(obj), &state, suppress_eval);
+        switch (state.ret_type) {
+        case SCM_RETTYPE_NEED_EVAL:
             goto eval_loop;
+        case SCM_RETTYPE_NEED_CALL_AS_IS:
+            suppress_eval = 1;
+            goto call_loop;
+        default:
+            break;
+        }
         /* FALLTHROUGH */
     default:
         ret = obj;

Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h	2005-10-01 00:25:32 UTC (rev 1715)
+++ branches/r5rs/sigscheme/sigschemetype.h	2005-10-01 00:27:49 UTC (rev 1716)
@@ -195,7 +195,8 @@
 
 enum ScmReturnType {
     SCM_RETTYPE_AS_IS           = 0,
-    SCM_RETTYPE_NEED_EVAL       = 1
+    SCM_RETTYPE_NEED_EVAL       = 1,
+    SCM_RETTYPE_NEED_CALL_AS_IS = 2
 };
 
 /* The evaluator's state */