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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-09-28 01:48:29 -0700 (Wed, 28 Sep 2005)
New Revision: 1638

Modified:
   branches/r5rs/sigscheme/operations-srfi2.c
Log:
* sigscheme/test/test-srfi2.scm
  - Fix invalid tests that takes non-symbol for <bound-variable>
* sigscheme/operations-srfi2.c
  - (ScmOp_SRFI2_and_let_star): Add lacking invalid form check
  - (handle_claw):
    * Reject other than symbol for <bound-variable>. Sorry, the tests
      I wrote is invalid
    * Make static
    * Add lacking invalid form checks
    * Modify the error message for (<variable> <expression>) style
      claw since (<variable>) form is not a 'superfulous'


Modified: branches/r5rs/sigscheme/operations-srfi2.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi2.c	2005-09-28 08:48:03 UTC (rev 1637)
+++ branches/r5rs/sigscheme/operations-srfi2.c	2005-09-28 08:48:29 UTC (rev 1638)
@@ -57,7 +57,7 @@
 /*=======================================
   File Local Function Declarations
 =======================================*/
-ScmObj handle_claw(ScmObj claw, ScmObj *envp);
+static ScmObj handle_claw(ScmObj claw, ScmObj *envp);
 
 /*=======================================
   Function Implementations
@@ -72,14 +72,16 @@
 
       <claws> ::= '() | (cons <claw> <claws>)
     ========================================================================*/
-    if (!NULLP(claws)) {
+    if (CONSP(claws)) {
         for (; !NULLP(claws); claws = CDR(claws)) {
             val = handle_claw(CAR(claws), &env);
             if (FALSEP(val))
                 return SCM_FALSE;
         }
+    } else if (NULLP(claws)) {
+        env = extend_environment(SCM_NULL, SCM_NULL, env);
     } else {
-        env = extend_environment(SCM_NULL, SCM_NULL, env);
+        SigScm_ErrorObj("and-let* : invalid claws form : ", claws);
     }
 
     eval_state->env = env;
@@ -87,13 +89,12 @@
     return ScmExp_begin(body, eval_state);
 }
 
-ScmObj handle_claw(ScmObj claw, ScmObj *envp)
+static ScmObj handle_claw(ScmObj claw, ScmObj *envp)
 {
     ScmObj env = *envp;
     ScmObj var = SCM_FALSE;
     ScmObj val = SCM_FALSE;
     ScmObj exp = SCM_FALSE;
-    ScmObj ret = SCM_FALSE;
 
     /*========================================================================
       <claw>  ::=  (<variable> <expression>) | (<expression>)
@@ -102,25 +103,29 @@
     if (CONSP(claw)) {
         if (SYMBOLP(CAR(claw))) {
             /* (<variable> <expression>) */
-            if (!NULLP(SCM_SHIFT_RAW_2(var, val, claw)))
-                SigScm_ErrorObj("and-let* : superflous arguments: ", claw);
-            val = EVAL(val, env);
+            if (!NULLP(SCM_SHIFT_RAW_2(var, exp, claw)))
+                goto err;
+            val = EVAL(exp, env);
             env = extend_environment(LIST_1(var), LIST_1(val), env);
-            ret = val;
+            *envp = env;
         } else if (NULLP(CDR(claw))) {
             /* (<expression>) */
             exp = CAR(claw);
-            ret = EVAL(exp, env);
-        } 
-    } else if (SYMBOLP(claw) || NFALSEP(claw) || FALSEP(claw)) {
+            val = EVAL(exp, env);
+        } else {
+            goto err;
+        }
+    } else if (SYMBOLP(claw)) {
         /* <bound-variable> */
-        ret = EVAL(claw, env);
+        val = EVAL(claw, env);
     } else {
-        SigScm_ErrorObj("and-let* : invalid claw form : ", claw);
+        goto err;
     }
 
-    /* set new env */
-    *envp = env;
+    return val;
 
-    return ret;
+ err:
+    SigScm_ErrorObj("and-let* : invalid claw form : ", claw);
+    /* NOTREACHED */
+    return SCM_FALSE;
 }