temporarily disable elisp exception tests

[bpt/guile.git] / libguile / eval.c

diff --git a/libguile/eval.c b/libguile/eval.c
index d76fbd3..735e6c0 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -280,13 +280,31 @@ eval (SCM x, SCM env)
     case SCM_M_LAMBDA:
       RETURN_BOOT_CLOSURE (mx, env);
 
+    case SCM_M_CAPTURE_ENV:
+      {
+        SCM locs = CAR (mx);
+        SCM new_env;
+        int i;
+
+        new_env = make_env (VECTOR_LENGTH (locs), SCM_BOOL_F, env);
+        for (i = 0; i < VECTOR_LENGTH (locs); i++)
+          {
+            SCM loc = VECTOR_REF (locs, i);
+            int depth, width;
+
+            depth = SCM_I_INUM (CAR (loc));
+            width = SCM_I_INUM (CDR (loc));
+            env_set (new_env, 0, i, env_ref (env, depth, width));
+          }
+
+        env = new_env;
+        x = CDR (mx);
+        goto loop;
+      }
+
     case SCM_M_QUOTE:
       return mx;
 
-    case SCM_M_DEFINE:
-      scm_define (CAR (mx), EVAL1 (CDR (mx), env));
-      return SCM_UNSPECIFIED;
-
     case SCM_M_CAPTURE_MODULE:
       return eval (mx, scm_current_module ());
 
@@ -310,8 +328,8 @@ eval (SCM x, SCM env)
     case SCM_M_CALL:
       /* Evaluate the procedure to be applied.  */
       proc = EVAL1 (CAR (mx), env);
-      argc = SCM_I_INUM (CADR (mx));
-      mx = CDDR (mx);
+      argc = scm_ilength (CDR (mx));
+      mx = CDR (mx);
 
       if (BOOT_CLOSURE_P (proc))
         {
@@ -376,51 +394,31 @@ eval (SCM x, SCM env)
         return SCM_UNSPECIFIED;
       }
 
-    case SCM_M_TOPLEVEL_REF:
-      if (SCM_VARIABLEP (mx))
-        return SCM_VARIABLE_REF (mx);
-      else
-        {
-          env = env_tail (env);
-          return SCM_VARIABLE_REF (scm_memoize_variable_access_x (x, env));
-        }
+    case SCM_M_BOX_REF:
+      {
+        SCM box = mx;
 
-    case SCM_M_TOPLEVEL_SET:
+        return scm_variable_ref (EVAL1 (box, env));
+      }
+
+    case SCM_M_BOX_SET:
       {
-        SCM var = CAR (mx);
-        SCM val = EVAL1 (CDR (mx), env);
-        if (SCM_VARIABLEP (var))
-          {
-            SCM_VARIABLE_SET (var, val);
-            return SCM_UNSPECIFIED;
-          }
-        else
-          {
-            env = env_tail (env);
-            SCM_VARIABLE_SET (scm_memoize_variable_access_x (x, env), val);
-            return SCM_UNSPECIFIED;
-          }
+        SCM box = CAR (mx), val = CDR (mx);
+
+        return scm_variable_set_x (EVAL1 (box, env), EVAL1 (val, env));
       }
 
-    case SCM_M_MODULE_REF:
+    case SCM_M_RESOLVE:
       if (SCM_VARIABLEP (mx))
-        return SCM_VARIABLE_REF (mx);
-      else
-        return SCM_VARIABLE_REF
-          (scm_memoize_variable_access_x (x, SCM_BOOL_F));
-
-    case SCM_M_MODULE_SET:
-      if (SCM_VARIABLEP (CDR (mx)))
-        {
-          SCM_VARIABLE_SET (CDR (mx), EVAL1 (CAR (mx), env));
-          return SCM_UNSPECIFIED;
-        }
+        return mx;
       else
         {
-          SCM_VARIABLE_SET
-            (scm_memoize_variable_access_x (x, SCM_BOOL_F),
-             EVAL1 (CAR (mx), env));
-          return SCM_UNSPECIFIED;
+          SCM var;
+
+          var = scm_sys_resolve_variable (mx, env_tail (env));
+          scm_set_cdr_x (x, var);
+
+          return var;
         }
 
     case SCM_M_CALL_WITH_PROMPT: