guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 05/06: Simplify variable resolution in the evaluator


From: Andy Wingo
Subject: [Guile-commits] 05/06: Simplify variable resolution in the evaluator
Date: Mon, 08 Dec 2014 10:50:27 +0000

wingo pushed a commit to branch wip-closure-conversion
in repository guile.

commit e6a42e676528bf56c6535a7e0c79e936a6d2a818
Author: Andy Wingo <address@hidden>
Date:   Sun Dec 7 15:52:34 2014 +0100

    Simplify variable resolution in the evaluator
    
    * libguile/expand.c (convert_assignment): Handle creation of the default
      lambda-case body here.
    
    * libguile/eval.c (eval):
    * module/ice-9/eval.scm (primitive-eval):
    
    * libguile/memoize.h:
    * libguile/memoize.c (MAKMEMO_BOX_REF, MAKMEMO_BOX_SET):
      (MAKMEMO_TOP_BOX, MAKMEMO_MOD_BOX): Refactor all global var resolution
      to go through "resolve".  Add "box-ref" and "box-set!".  Rename
      memoize-variable-access! to %resolve-variable, and don't be
      destructive.
---
 libguile/eval.c       |   60 ++++---------
 libguile/expand.c     |   16 +++-
 libguile/memoize.c    |  236 ++++++++++++++++++++++---------------------------
 libguile/memoize.h    |   10 +--
 module/ice-9/eval.scm |   44 +++-------
 5 files changed, 155 insertions(+), 211 deletions(-)

diff --git a/libguile/eval.c b/libguile/eval.c
index 9f09557..b69b5b2 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -305,10 +305,6 @@ eval (SCM x, SCM env)
     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 ());
 
@@ -398,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 mod, var;
+
+          var = scm_sys_resolve_variable (mx, env_tail (env));
+          scm_set_cdr_x (x, var);
+
+          return var;
         }
 
     case SCM_M_CALL_WITH_PROMPT:
diff --git a/libguile/expand.c b/libguile/expand.c
index e1c6c18..91097c2 100644
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -1412,7 +1412,21 @@ convert_assignment (SCM exp, SCM assigned)
       return LAMBDA
         (REF (exp, LAMBDA, SRC),
          REF (exp, LAMBDA, META),
-         convert_assignment (REF (exp, LAMBDA, BODY), assigned));
+         scm_is_false (REF (exp, LAMBDA, BODY))
+         /* Give a body to case-lambda with no clauses.  */
+         ? LAMBDA_CASE (SCM_BOOL_F, SCM_EOL, SCM_EOL, SCM_BOOL_F, SCM_BOOL_F,
+                        SCM_EOL, SCM_EOL,
+                        PRIMCALL
+                        (SCM_BOOL_F,
+                         scm_from_latin1_symbol ("throw"),
+                         scm_list_5 (CONST_ (SCM_BOOL_F, scm_args_number_key),
+                                     CONST_ (SCM_BOOL_F, SCM_BOOL_F),
+                                     CONST_ (SCM_BOOL_F, scm_from_latin1_string
+                                             ("Wrong number of arguments")),
+                                     CONST_ (SCM_BOOL_F, SCM_EOL),
+                                     CONST_ (SCM_BOOL_F, SCM_BOOL_F))),
+                        SCM_BOOL_F)
+         : convert_assignment (REF (exp, LAMBDA, BODY), assigned));
 
     case SCM_EXPANDED_LAMBDA_CASE:
       {
diff --git a/libguile/memoize.c b/libguile/memoize.c
index 8ebc1a0..cefb269 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -131,8 +131,6 @@ scm_t_bits scm_tc16_memoized;
   MAKMEMO (SCM_M_LET, scm_cons (inits, body))
 #define MAKMEMO_QUOTE(exp) \
   MAKMEMO (SCM_M_QUOTE, exp)
-#define MAKMEMO_DEFINE(var, val) \
-  MAKMEMO (SCM_M_DEFINE, scm_cons (var, val))
 #define MAKMEMO_CAPTURE_MODULE(exp) \
   MAKMEMO (SCM_M_CAPTURE_MODULE, exp)
 #define MAKMEMO_APPLY(proc, args)\
@@ -147,14 +145,16 @@ scm_t_bits scm_tc16_memoized;
   MAKMEMO (SCM_M_LEXICAL_REF, pos)
 #define MAKMEMO_LEX_SET(pos, val)                                      \
   MAKMEMO (SCM_M_LEXICAL_SET, scm_cons (pos, val))
-#define MAKMEMO_TOP_REF(var) \
-  MAKMEMO (SCM_M_TOPLEVEL_REF, var)
-#define MAKMEMO_TOP_SET(var, val) \
-  MAKMEMO (SCM_M_TOPLEVEL_SET, scm_cons (var, val))
-#define MAKMEMO_MOD_REF(mod, var, public) \
-  MAKMEMO (SCM_M_MODULE_REF, scm_cons (mod, scm_cons (var, public)))
-#define MAKMEMO_MOD_SET(val, mod, var, public) \
-  MAKMEMO (SCM_M_MODULE_SET, scm_cons (val, scm_cons (mod, scm_cons (var, 
public))))
+#define MAKMEMO_BOX_REF(box) \
+  MAKMEMO (SCM_M_BOX_REF, box)
+#define MAKMEMO_BOX_SET(box, val)                                      \
+  MAKMEMO (SCM_M_BOX_SET, scm_cons (box, val))
+#define MAKMEMO_TOP_BOX(mode, var)               \
+  MAKMEMO (SCM_M_RESOLVE, scm_cons (SCM_I_MAKINUM (mode), var))
+#define MAKMEMO_MOD_BOX(mode, mod, var, public)                         \
+  MAKMEMO (SCM_M_RESOLVE, \
+           scm_cons (SCM_I_MAKINUM (mode),                              \
+                     scm_cons (mod, scm_cons (var, public))))
 #define MAKMEMO_CALL_WITH_PROMPT(tag, thunk, handler) \
   MAKMEMO (SCM_M_CALL_WITH_PROMPT, scm_cons (tag, scm_cons (thunk, handler)))
 
@@ -170,7 +170,6 @@ static const char *const memoized_tags[] =
   "capture-env",
   "let",
   "quote",
-  "define",
   "capture-module",
   "apply",
   "call/cc",
@@ -178,10 +177,9 @@ static const char *const memoized_tags[] =
   "call",
   "lexical-ref",
   "lexical-set!",
-  "toplevel-ref",
-  "toplevel-set!",
-  "module-ref",
-  "module-set!",
+  "box-ref",
+  "box-set!",
+  "resolve",
   "call-with-prompt",
 };
 
@@ -370,11 +368,14 @@ memoize (SCM exp, SCM env)
     case SCM_EXPANDED_PRIMITIVE_REF:
       if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
         return maybe_makmemo_capture_module
-          (MAKMEMO_TOP_REF (REF (exp, PRIMITIVE_REF, NAME)),
+          (MAKMEMO_BOX_REF (MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_REF,
+                                             REF (exp, PRIMITIVE_REF, NAME))),
            env);
       else
-        return MAKMEMO_MOD_REF (list_of_guile, REF (exp, PRIMITIVE_REF, NAME),
-                                SCM_BOOL_F);
+        return MAKMEMO_BOX_REF (MAKMEMO_MOD_BOX (SCM_EXPANDED_MODULE_REF,
+                                                 list_of_guile,
+                                                 REF (exp, PRIMITIVE_REF, 
NAME),
+                                                 SCM_BOOL_F));
                                 
     case SCM_EXPANDED_LEXICAL_REF:
       return MAKMEMO_LEX_REF (lookup (REF (exp, LEXICAL_REF, GENSYM), env));
@@ -384,30 +385,41 @@ memoize (SCM exp, SCM env)
                               memoize (REF (exp, LEXICAL_SET, EXP), env));
 
     case SCM_EXPANDED_MODULE_REF:
-      return MAKMEMO_MOD_REF (REF (exp, MODULE_REF, MOD),
-                              REF (exp, MODULE_REF, NAME),
-                              REF (exp, MODULE_REF, PUBLIC));
+      return MAKMEMO_BOX_REF (MAKMEMO_MOD_BOX
+                              (SCM_EXPANDED_MODULE_REF,
+                               REF (exp, MODULE_REF, MOD),
+                               REF (exp, MODULE_REF, NAME),
+                               REF (exp, MODULE_REF, PUBLIC)));
 
     case SCM_EXPANDED_MODULE_SET:
-      return MAKMEMO_MOD_SET (memoize (REF (exp, MODULE_SET, EXP), env),
-                              REF (exp, MODULE_SET, MOD),
-                              REF (exp, MODULE_SET, NAME),
-                              REF (exp, MODULE_SET, PUBLIC));
+      return MAKMEMO_BOX_SET (MAKMEMO_MOD_BOX
+                              (SCM_EXPANDED_MODULE_SET,
+                               REF (exp, MODULE_SET, MOD),
+                               REF (exp, MODULE_SET, NAME),
+                               REF (exp, MODULE_SET, PUBLIC)),
+                              memoize (REF (exp, MODULE_SET, EXP), env));
 
     case SCM_EXPANDED_TOPLEVEL_REF:
       return maybe_makmemo_capture_module
-        (MAKMEMO_TOP_REF (REF (exp, TOPLEVEL_REF, NAME)), env);
+        (MAKMEMO_BOX_REF (MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_REF,
+                                           REF (exp, TOPLEVEL_REF, NAME))),
+         env);
 
     case SCM_EXPANDED_TOPLEVEL_SET:
       return maybe_makmemo_capture_module
-        (MAKMEMO_TOP_SET (REF (exp, TOPLEVEL_SET, NAME),
+        (MAKMEMO_BOX_SET (MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_SET,
+                                           REF (exp, TOPLEVEL_SET, NAME)),
                           memoize (REF (exp, TOPLEVEL_SET, EXP),
                                    capture_env (env))),
          env);
 
     case SCM_EXPANDED_TOPLEVEL_DEFINE:
-      return MAKMEMO_DEFINE (REF (exp, TOPLEVEL_DEFINE, NAME),
-                             memoize (REF (exp, TOPLEVEL_DEFINE, EXP), env));
+      return maybe_makmemo_capture_module
+        (MAKMEMO_BOX_SET (MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_DEFINE,
+                                           REF (exp, TOPLEVEL_DEFINE, NAME)),
+                          memoize (REF (exp, TOPLEVEL_DEFINE, EXP),
+                                   capture_env (env))),
+         env);
 
     case SCM_EXPANDED_CONDITIONAL:
       return MAKMEMO_IF (memoize (REF (exp, CONDITIONAL, TEST), env),
@@ -450,6 +462,14 @@ memoize (SCM exp, SCM env)
                  && scm_is_eq (name,
                                scm_from_latin1_symbol ("call-with-values")))
           return MAKMEMO_CALL_WITH_VALUES (CAR (args), CADR (args));
+        else if (nargs == 1
+                 && scm_is_eq (name,
+                               scm_from_latin1_symbol ("variable-ref")))
+          return MAKMEMO_BOX_REF (CAR (args));
+        else if (nargs == 2
+                 && scm_is_eq (name,
+                               scm_from_latin1_symbol ("variable-set!")))
+          return MAKMEMO_BOX_SET (CAR (args), CADR (args));
         else if (nargs == 2
                  && scm_is_eq (name, scm_from_latin1_symbol ("wind")))
           return MAKMEMO_CALL (MAKMEMO_QUOTE (wind), 2, args);
@@ -464,11 +484,17 @@ memoize (SCM exp, SCM env)
           return MAKMEMO_CALL (MAKMEMO_QUOTE (pop_fluid), 0, SCM_EOL);
         else if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
           return MAKMEMO_CALL (maybe_makmemo_capture_module
-                               (MAKMEMO_TOP_REF (name), env),
+                               (MAKMEMO_BOX_REF
+                                (MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_REF,
+                                                  name)),
+                                env),
                                nargs, args);
         else
-          return MAKMEMO_CALL (MAKMEMO_MOD_REF (list_of_guile, name,
-                                                SCM_BOOL_F),
+          return MAKMEMO_CALL (MAKMEMO_BOX_REF
+                               (MAKMEMO_MOD_BOX (SCM_EXPANDED_MODULE_REF,
+                                                 list_of_guile,
+                                                 name,
+                                                 SCM_BOOL_F)),
                                nargs,
                                args);
       }
@@ -478,35 +504,15 @@ memoize (SCM exp, SCM env)
                           memoize (REF (exp, SEQ, TAIL), env));
 
     case SCM_EXPANDED_LAMBDA:
-      /* The body will be a lambda-case or #f. */
+      /* The body will be a lambda-case. */
       {
        SCM meta, body, proc, new_env;
 
        meta = REF (exp, LAMBDA, META);
         body = REF (exp, LAMBDA, BODY);
         new_env = push_flat_link (capture_env (env));
-
-        if (scm_is_false (body))
-          /* Give a body to case-lambda with no clauses.  */
-          proc = MAKMEMO_LAMBDA
-            (MAKMEMO_CALL
-             (MAKMEMO_MOD_REF (list_of_guile,
-                               scm_from_latin1_symbol ("throw"),
-                               SCM_BOOL_F),
-              5,
-              scm_list_5 (MAKMEMO_QUOTE (scm_args_number_key),
-                          MAKMEMO_QUOTE (SCM_BOOL_F),
-                          MAKMEMO_QUOTE (scm_from_latin1_string
-                                         ("Wrong number of arguments")),
-                          MAKMEMO_QUOTE (SCM_EOL),
-                          MAKMEMO_QUOTE (SCM_BOOL_F))),
-             FIXED_ARITY (0),
-             meta);
-        else
-          {
-            proc = memoize (body, new_env);
-            SCM_SETCAR (SCM_CDR (SCM_MEMOIZED_ARGS (proc)), meta);
-          }
+        proc = memoize (body, new_env);
+        SCM_SETCAR (SCM_CDR (SCM_MEMOIZED_ARGS (proc)), meta);
 
        return maybe_makmemo_capture_module (capture_flat_env (proc, new_env),
                                              env);
@@ -677,8 +683,6 @@ unmemoize (const SCM expr)
     case SCM_M_CALL_WITH_VALUES:
       return scm_list_3 (scm_from_latin1_symbol ("call-with-values"),
                          unmemoize (CAR (args)), unmemoize (CDR (args)));
-    case SCM_M_DEFINE:
-      return scm_list_3 (scm_sym_define, CAR (args), unmemoize (CDR (args)));
     case SCM_M_CAPTURE_MODULE:
       return scm_list_2 (scm_from_latin1_symbol ("capture-module"),
                          unmemoize (args));
@@ -738,23 +742,18 @@ unmemoize (const SCM expr)
     case SCM_M_LEXICAL_SET:
       return scm_list_3 (scm_sym_set_x, unmemoize_lexical (CAR (args)),
                          unmemoize (CDR (args)));
-    case SCM_M_TOPLEVEL_REF:
-      return args;
-    case SCM_M_TOPLEVEL_SET:
-      return scm_list_3 (scm_sym_set_x, CAR (args), unmemoize (CDR (args)));
-    case SCM_M_MODULE_REF:
-      return SCM_VARIABLEP (args) ? args
+    case SCM_M_BOX_REF:
+      return scm_list_2 (scm_from_latin1_symbol ("variable-ref"),
+                         unmemoize (args));
+    case SCM_M_BOX_SET:
+      return scm_list_3 (scm_from_latin1_symbol ("variable-set!"),
+                         unmemoize (CAR (args)),
+                         unmemoize (CDR (args)));
+    case SCM_M_RESOLVE:
+      return (SCM_VARIABLEP (args) || scm_is_symbol (args)) ? args
         : scm_list_3 (scm_is_true (CDDR (args)) ? scm_sym_at : scm_sym_atat,
                       scm_i_finite_list_copy (CAR (args)),
                       CADR (args));
-    case SCM_M_MODULE_SET:
-      return scm_list_3 (scm_sym_set_x,
-                         SCM_VARIABLEP (CDR (args)) ? CDR (args)
-                         : scm_list_3 (scm_is_true (CDDDR (args))
-                                       ? scm_sym_at : scm_sym_atat,
-                                       scm_i_finite_list_copy (CADR (args)),
-                                       CADDR (args)),
-                         unmemoize (CAR (args)));
     case SCM_M_CALL_WITH_PROMPT:
       return scm_list_4 (scm_from_latin1_symbol ("call-with-prompt"),
                          unmemoize (CAR (args)),
@@ -802,78 +801,53 @@ static void error_unbound_variable (SCM symbol)
             scm_list_1 (symbol), SCM_BOOL_F);
 }
 
-SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 
0, 
-            (SCM m, SCM mod),
-           "Look up and cache the variable that @var{m} will access, returning 
the variable.")
-#define FUNC_NAME s_scm_memoize_variable_access_x
+SCM_DEFINE (scm_sys_resolve_variable, "%resolve-variable", 2, 0, 0,
+            (SCM loc, SCM mod),
+           "Look up and return the variable for @var{loc}.")
+#define FUNC_NAME s_scm_sys_resolve_variable
 {
-  SCM mx = SCM_MEMOIZED_ARGS (m);
+  int mode;
 
   if (scm_is_false (mod))
     mod = scm_the_root_module ();
 
-  switch (SCM_MEMOIZED_TAG (m))
-    {
-    case SCM_M_TOPLEVEL_REF:
-      if (SCM_VARIABLEP (mx))
-        return mx;
-      else
-        {
-          SCM var = scm_module_variable (mod, mx);
-          if (scm_is_false (var) || scm_is_false (scm_variable_bound_p (var)))
-            error_unbound_variable (mx);
-          SCM_SETCDR (m, var);
-          return var;
-        }
+  mode = scm_to_int (scm_car (loc));
+  loc = scm_cdr (loc);
 
-    case SCM_M_TOPLEVEL_SET:
+  switch (mode)
+    {
+    case SCM_EXPANDED_TOPLEVEL_REF:
+    case SCM_EXPANDED_TOPLEVEL_SET:
       {
-        SCM var = CAR (mx);
-        if (SCM_VARIABLEP (var))
-          return var;
-        else
-          {
-            var = scm_module_variable (mod, var);
-            if (scm_is_false (var))
-              error_unbound_variable (CAR (mx));
-            SCM_SETCAR (mx, var);
-            return var;
-          }
+        SCM var = scm_module_variable (mod, loc);
+        if (scm_is_false (var)
+            || (mode == SCM_EXPANDED_TOPLEVEL_REF
+                && scm_is_false (scm_variable_bound_p (var))))
+          error_unbound_variable (loc);
+        return var;
       }
 
-    case SCM_M_MODULE_REF:
-      if (SCM_VARIABLEP (mx))
-        return mx;
-      else
-        {
-          SCM var;
-          mod = scm_resolve_module (CAR (mx));
-          if (scm_is_true (CDDR (mx)))
-            mod = scm_module_public_interface (mod);
-          var = scm_module_lookup (mod, CADR (mx));
-          if (scm_is_false (scm_variable_bound_p (var)))
-            error_unbound_variable (CADR (mx));
-          SCM_SETCDR (m, var);
-          return var;
-        }
+    case SCM_EXPANDED_TOPLEVEL_DEFINE:
+      {
+        return scm_module_ensure_local_variable (mod, loc);
+      }
 
-    case SCM_M_MODULE_SET:
-      /* FIXME: not quite threadsafe */
-      if (SCM_VARIABLEP (CDR (mx)))
-        return CDR (mx);
-      else
-        {
-          SCM var;
-          mod = scm_resolve_module (CADR (mx));
-          if (scm_is_true (CDDDR (mx)))
-            mod = scm_module_public_interface (mod);
-          var = scm_module_lookup (mod, CADDR (mx));
-          SCM_SETCDR (mx, var);
-          return var;
-        }
+    case SCM_EXPANDED_MODULE_REF:
+    case SCM_EXPANDED_MODULE_SET:
+      {
+        SCM var;
+        mod = scm_resolve_module (scm_car (loc));
+        if (scm_is_true (scm_cddr (loc)))
+          mod = scm_module_public_interface (mod);
+        var = scm_module_lookup (mod, scm_cadr (loc));
+        if (mode == SCM_EXPANDED_MODULE_SET
+            && scm_is_false (scm_variable_bound_p (var)))
+          error_unbound_variable (scm_cadr (loc));
+        return var;
+      }
 
     default:
-      scm_wrong_type_arg (FUNC_NAME, 1, m);
+      scm_wrong_type_arg (FUNC_NAME, 1, loc);
       return SCM_BOOL_F;
     }
 }
diff --git a/libguile/memoize.h b/libguile/memoize.h
index f0dab57..23c0306 100644
--- a/libguile/memoize.h
+++ b/libguile/memoize.h
@@ -69,7 +69,6 @@ enum
     SCM_M_CAPTURE_ENV,
     SCM_M_LET,
     SCM_M_QUOTE,
-    SCM_M_DEFINE,
     SCM_M_CAPTURE_MODULE,
     SCM_M_APPLY,
     SCM_M_CONT,
@@ -77,10 +76,9 @@ enum
     SCM_M_CALL,
     SCM_M_LEXICAL_REF,
     SCM_M_LEXICAL_SET,
-    SCM_M_TOPLEVEL_REF,
-    SCM_M_TOPLEVEL_SET,
-    SCM_M_MODULE_REF,
-    SCM_M_MODULE_SET,
+    SCM_M_BOX_REF,
+    SCM_M_BOX_SET,
+    SCM_M_RESOLVE,
     SCM_M_CALL_WITH_PROMPT
   };
 
@@ -90,7 +88,7 @@ enum
 SCM_INTERNAL SCM scm_memoize_expression (SCM exp);
 SCM_INTERNAL SCM scm_unmemoize_expression (SCM memoized);
 SCM_INTERNAL SCM scm_memoized_typecode (SCM sym);
-SCM_INTERNAL SCM scm_memoize_variable_access_x (SCM memoized, SCM module);
+SCM_INTERNAL SCM scm_sys_resolve_variable (SCM loc, SCM module);
 
 SCM_INTERNAL void scm_init_memoize (void);
 
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index aa1ab2e..f3f0899 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -463,11 +463,15 @@
          (let ((proc (eval f env)))
            (call eval proc nargs args env)))
         
-        (('toplevel-ref var-or-sym)
-         (variable-ref
-          (if (variable? var-or-sym)
-              var-or-sym
-              (memoize-variable-access! exp (env-toplevel env)))))
+        (('box-ref box)
+         (variable-ref (eval box env)))
+
+        (('resolve var-or-loc)
+         (if (variable? var-or-loc)
+             var-or-loc
+             (let ((var (%resolve-variable var-or-loc (env-toplevel env))))
+               (set-cdr! exp var)
+               var)))
 
         (('if (test consequent . alternate))
          (if (eval test env)
@@ -515,6 +519,9 @@
            (eval head env)
            (eval tail env)))
         
+        (('box-set! (box . val))
+         (variable-set! (eval box env) (eval val env)))
+
         (('lexical-set! ((depth . width) . x))
          (env-set! env depth width (eval x env)))
         
@@ -525,27 +532,9 @@
         (('apply (f args))
          (apply (eval f env) (eval args env)))
 
-        (('module-ref var-or-spec)
-         (variable-ref
-          (if (variable? var-or-spec)
-              var-or-spec
-              (memoize-variable-access! exp #f))))
-
-        (('define (name . x))
-         (begin
-           (define! name (eval x env))
-           (if #f #f)))
-
         (('capture-module x)
          (eval x (current-module)))
 
-        (('toplevel-set! (var-or-sym . x))
-         (variable-set!
-          (if (variable? var-or-sym)
-              var-or-sym
-              (memoize-variable-access! exp (env-toplevel env)))
-          (eval x env)))
-      
         (('call-with-prompt (tag thunk . handler))
          (call-with-prompt
           (eval tag env)
@@ -553,14 +542,7 @@
           (eval handler env)))
         
         (('call/cc proc)
-         (call/cc (eval proc env)))
-
-        (('module-set! (x . var-or-spec))
-         (variable-set!
-          (if (variable? var-or-spec)
-              var-or-spec
-              (memoize-variable-access! exp #f))
-          (eval x env)))))
+         (call/cc (eval proc env)))))
   
     ;; primitive-eval
     (lambda (exp)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]