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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-10-05 17:48:13 -0700 (Wed, 05 Oct 2005)
New Revision: 1814

Modified:
   branches/r5rs/sigscheme/eval.c
Log:
* sigscheme/eval.c
  - (call, map_eval): Add strict error check for multiple values


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-10-06 00:02:36 UTC (rev 1813)
+++ branches/r5rs/sigscheme/eval.c	2005-10-06 00:48:13 UTC (rev 1814)
@@ -398,6 +398,10 @@
         argbuf[i] = MUST_POP_ARG(args);
         if (!suppress_eval)
             argbuf[i] = EVAL(argbuf[i], env);
+#if SCM_STRICT_R5RS
+        if (VALUEPACKETP((ScmObj)argbuf[i]))
+            SigScm_Error("multiple values are not allowed here");
+#endif
     }
 
     if (type & SCM_FUNCTYPE_VARIADIC) {
@@ -553,6 +557,7 @@
     return val;
 }
 
+/* FIXME: Simplify */
 static ScmObj map_eval(ScmObj args, ScmObj env)
 {
     ScmObj result  = SCM_NULL;
@@ -566,10 +571,18 @@
 
     /* eval each element of args */
     result  = CONS(EVAL(CAR(args), env), SCM_NULL);
+#if SCM_STRICT_R5RS
+    if (VALUEPACKETP(CAR(result)))
+        SigScm_Error("multiple values are not allowed here");
+#endif
     tail    = result;
     newtail = SCM_NULL;
     for (args = CDR(args); !NULLP(args); args = CDR(args)) {
         newtail = CONS(EVAL(CAR(args), env), SCM_NULL);
+#if SCM_STRICT_R5RS
+    if (VALUEPACKETP(CAR(newtail)))
+        SigScm_Error("multiple values are not allowed here");
+#endif
         SET_CDR(tail, newtail);
         tail = newtail;
     }