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

[kzk at freedesktop.org]

Author: kzk
Date: 2005-12-01 11:10:49 -0800 (Thu, 01 Dec 2005)
New Revision: 2311

Modified:
   branches/r5rs/sigscheme/eval.c
Log:
* sigscheme/eval.c
  - (ScmExp_let, ScmExp_letstar, ScmExp_letrec, ScmExp_define): not to
    use SCM_SHIFT* macro. But I don't use POP_ARG macro basically for
    more kinder error messages.

  - (ScmExp_do): initialize "vars" and "vals" with SCM_NULL


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-12-01 19:02:05 UTC (rev 2310)
+++ branches/r5rs/sigscheme/eval.c	2005-12-01 19:10:49 UTC (rev 2311)
@@ -1003,14 +1003,18 @@
                      (<variable2> <init2>)
                      ...)
     ========================================================================*/
-    if (!SCM_SHIFT_RAW(bindings, args))
-        SigScm_Error("let : syntax error");
 
+    if (NULLP(args))
+        SigScm_Error("let : invalid form");
+    bindings = POP_ARG(args);
+
     /* named let */
     if (SYMBOLP(bindings)) {
         named_let_sym = bindings;
-        if (!SCM_SHIFT_RAW(bindings, args))
-            SigScm_Error("let : syntax error");
+
+        if (NULLP(args))
+            SigScm_Error("let : invalid named let form");
+        bindings = POP_ARG(args);
     }
 
     body = args;
@@ -1018,13 +1022,17 @@
     for (; CONSP(bindings); bindings = CDR(bindings)) {
         binding = CAR(bindings);
 
-#if SCM_COMPAT_SIOD_BUGS
         if (NULLP(binding) || !SYMBOLP(var = CAR(binding)))
             ERR_OBJ("invalid binding form", binding);
+
+#if SCM_COMPAT_SIOD_BUGS
         val = (!CONSP(CDR(binding))) ? SCM_FALSE : CADR(binding);
 #else
-        if (!NULLP(SCM_SHIFT_RAW_2(var, val, binding)) || !SYMBOLP(var))
+        if (!CONSP(CDR(binding)))
             ERR_OBJ("invalid binding form", binding);
+        val = CADR(binding);
+        if (!NULLP(CDDR(binding)))
+            ERR_OBJ("invalid binding form (superfluous object)", binding);
 #endif
 
         vars = CONS(var, vars);
@@ -1032,7 +1040,7 @@
     }
 
     if (!NULLP(bindings))
-        SigScm_Error("let : invalid bindings form");
+        ERR_OBJ("invalid bindings form", bindings);
 
 #if 1
     /* current implementation Scm_ExtendEnvironment() contains unnecessary
@@ -1069,17 +1077,22 @@
     if (!CONSP(bindings) && !NULLP(bindings))
         SigScm_Error("let* : syntax error");
 
-    for (; !NULLP(bindings); bindings = CDR(bindings)) {
+    for (; CONSP(bindings); bindings = CDR(bindings)) {
         binding = CAR(bindings);
 
-#if SCM_COMPAT_SIOD_BUGS
         if (NULLP(binding) || !SYMBOLP(var = CAR(binding)))
             ERR_OBJ("invalid binding form", binding);
+
+#if SCM_COMPAT_SIOD_BUGS
         val = (!CONSP(CDR(binding))) ? SCM_FALSE : CADR(binding);
 #else
-        if (!NULLP(SCM_SHIFT_RAW_2(var, val, binding)) || !SYMBOLP(var))
+        if (!CONSP(CDR(binding)))
             ERR_OBJ("invalid binding form", binding);
+        val = CADR(binding);
+        if (!NULLP(CDDR(binding)))
+            ERR_OBJ("invalid binding form (superfluous object)", binding);
 #endif
+
         val = EVAL(val, env);
 
         /* extend env for each variable */
@@ -1093,6 +1106,9 @@
 #endif
     }
 
+    if (!NULLP(bindings))
+        ERR_OBJ("invalid bindings form", bindings);
+
     eval_state->env = env;
 
     /* evaluate body */
@@ -1124,16 +1140,20 @@
     env = CONS(frame, env);
     eval_state->env = env;
 
-    for (; !NULLP(bindings); bindings = CDR(bindings)) {
+    for (; CONSP(bindings); bindings = CDR(bindings)) {
         binding = CAR(bindings);
 
-#if SCM_COMPAT_SIOD_BUGS
         if (NULLP(binding) || !SYMBOLP(var = CAR(binding)))
             ERR_OBJ("invalid binding form", binding);
+
+#if SCM_COMPAT_SIOD_BUGS
         val = (!CONSP(CDR(binding))) ? SCM_FALSE : CADR(binding);
 #else
-        if (!NULLP(SCM_SHIFT_RAW_2(var, val, binding)) || !SYMBOLP(var))
+        if (!CONSP(CDR(binding)))
             ERR_OBJ("invalid binding form", binding);
+        val = CADR(binding);
+        if (!NULLP(CDDR(binding)))
+            ERR_OBJ("invalid binding form (superfluous object)", binding);
 #endif
 
         /* construct vars and vals list: any <init> must not refer a
@@ -1142,6 +1162,9 @@
         vals = CONS(EVAL(val, env), vals);
     }
 
+    if (!NULLP(bindings))
+        ERR_OBJ("invalid bindings form", bindings);
+
     /* fill the placeholder frame */
     SET_CAR(frame, vars);
     SET_CDR(frame, vals);
@@ -1186,8 +1209,8 @@
     ScmObj binding    = SCM_FALSE;
     ScmObj var        = SCM_FALSE;
     ScmObj val        = SCM_FALSE;
-    ScmObj vars       = SCM_FALSE;
-    ScmObj vals       = SCM_FALSE;
+    ScmObj vars       = SCM_NULL;
+    ScmObj vals       = SCM_NULL;
     ScmObj steps      = SCM_NULL;
     ScmObj test       = SCM_FALSE;
     ScmObj expression = SCM_FALSE;
@@ -1203,6 +1226,7 @@
             ERR("invalid bindings");
 
         var = MUST_POP_ARG(binding);
+        ASSERT_SYMBOLP(var);
         val = MUST_POP_ARG(binding);
 
         vars = CONS(var, vars);
@@ -1500,7 +1524,6 @@
 
 ScmObj ScmExp_define(ScmObj var, ScmObj rest, ScmObj env)
 {
-    ScmObj exp      = SCM_FALSE;
     ScmObj procname = SCM_FALSE;
     ScmObj body     = SCM_FALSE;
     ScmObj formals  = SCM_FALSE;
@@ -1510,10 +1533,10 @@
       (define <variable> <expression>)
     ========================================================================*/
     if (SYMBOLP(var)) {
-        if (!NULLP(SCM_SHIFT_RAW_1(exp, rest)))
+        if (NULLP(rest))
             SigScm_Error("define : missing expression");
 
-        define_internal(var, exp, env);
+        define_internal(var, POP_ARG(rest), env);
     }
 
     /*========================================================================