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

Fri Sep 30 04:03:29 PDT 2005

Author: yamaken
Date: 2005-09-30 04:03:22 -0700 (Fri, 30 Sep 2005)
New Revision: 1682

Modified:
   branches/r5rs/sigscheme/eval.c
Log:
* sigscheme/eval.c
  - (ScmExp_letrec):
    * Simplify
    * Rewrite (letrec ((foo)) #t) handling as SCM_COMPAT_SIOD_BUGS
      since it is an invalid R5RS form rather than strict arg check


Modified: branches/r5rs/sigscheme/eval.c
===================================================================

--- branches/r5rs/sigscheme/eval.c	2005-09-30 10:48:04 UTC (rev 1681)
+++ branches/r5rs/sigscheme/eval.c	2005-09-30 11:03:22 UTC (rev 1682)
@@ -1174,17 +1174,15 @@
     return ScmExp_begin(body, eval_state);
 }
 
-/* TODO: Simplify and optimize with SCM_SHIFT_*() macro */
 ScmObj ScmExp_letrec(ScmObj bindings, ScmObj body, ScmEvalState *eval_state)
 {
     ScmObj env      = eval_state->env;
     ScmObj frame    = SCM_FALSE;
     ScmObj vars     = SCM_NULL;
     ScmObj vals     = SCM_NULL;
-    ScmObj rest_vals = SCM_FALSE;
-    ScmObj binding  = SCM_NULL;
-    ScmObj var      = SCM_NULL;
-    ScmObj val      = SCM_NULL;
+    ScmObj binding  = SCM_FALSE;
+    ScmObj var      = SCM_FALSE;
+    ScmObj val      = SCM_FALSE;
 
     /*========================================================================
       (letrec <bindings> <body>)
@@ -1192,40 +1190,39 @@
                      (<variable2> <init2>)
                      ...)
     ========================================================================*/
-    if (CONSP(bindings) || NULLP(bindings)) {
-        /* extend env by placeholder frame for subsequent lambda evaluations */
-        frame = CONS(SCM_NULL, SCM_NULL);
-        env = CONS(frame, env);
-        eval_state->env = env;
+    if (!CONSP(bindings) && !NULLP(bindings))
+        SigScm_Error("letrec : syntax error");
 
-        for (; !NULLP(bindings); bindings = CDR(bindings)) {
-            binding = CAR(bindings);
+    /* extend env by placeholder frame for subsequent lambda evaluations */
+    frame = CONS(SCM_NULL, SCM_NULL);
+    env = CONS(frame, env);
+    eval_state->env = env;
 
-#if SCM_STRICT_ARGCHECK
-            if (NULLP(binding) || NULLP(CDR(binding)))
-                SigScm_ErrorObj("letrec : invalid binding form : ", binding);
+    for (; !NULLP(bindings); bindings = CDR(bindings)) {
+        binding = CAR(bindings);
+
+#if SCM_COMPAT_SIOD_BUGS
+        if (NULLP(binding))
+            SigScm_ErrorObj("letrec : invalid binding form : ", binding);
+        var = CAR(binding);
+        val = (!CONSP(CDR(binding))) ? SCM_FALSE : CADR(binding);
 #else
-            if (NULLP(CDR(binding)))
-                SET_CDR(binding, CONS(SCM_NULL, SCM_NULL));
+        if (!NULLP(SCM_SHIFT_RAW_2(var, val, binding)))
+            SigScm_ErrorObj("letrec : invalid binding form : ", binding);
 #endif
-            SCM_SHIFT_RAW_2(var, val, binding);
 
-            /* construct vars and vals list: any <init> must not refer a
-               <variable> at this time */
-            vars = CONS(var, vars);
-            vals = CONS(EVAL(val, env), vals);
-        }
-
-        /* fill placeholders */
-        SET_CAR(frame, vars);
-        SET_CDR(frame, vals);
-
-        /* evaluate body */
-        return ScmExp_begin(body, eval_state);
+        /* construct vars and vals list: any <init> must not refer a
+           <variable> at this time */
+        vars = CONS(var, vars);
+        vals = CONS(EVAL(val, env), vals);
     }
 
-    SigScm_Error("letrec : syntax error");
-    return SCM_UNDEF;
+    /* fill placeholders */
+    SET_CAR(frame, vars);
+    SET_CDR(frame, vals);
+
+    /* evaluate body */
+    return ScmExp_begin(body, eval_state);
 }
 
 

