guile/guile-core/libguile eval.c dynwind.h dynw...

[Marius Vollmer]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Marius Vollmer <address@hidden> 01/08/25 09:08:13

Modified files:
        guile-core/libguile: eval.c dynwind.h dynwind.c 

Log message:
        * eval.c (scm_m_atbind): Redesigned to behvae like `let', but with
        dynamic scope.
        * dynwind.h (scm_swap_bindings): Declare.
        * dynwind.c (scm_swap_bindings): Make non-static.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/eval.c.diff?cvsroot=OldCVS&tr1=1.239&tr2=1.240&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/dynwind.h.diff?cvsroot=OldCVS&tr1=1.15&tr2=1.16&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/dynwind.c.diff?cvsroot=OldCVS&tr1=1.43&tr2=1.44&r1=text&r2=text

Patches:
Index: guile/guile-core/libguile/dynwind.c
diff -u guile/guile-core/libguile/dynwind.c:1.43 
guile/guile-core/libguile/dynwind.c:1.44
--- guile/guile-core/libguile/dynwind.c:1.43    Thu Jul 26 14:40:18 2001
+++ guile/guile-core/libguile/dynwind.c Sat Aug 25 09:08:13 2001
@@ -184,7 +184,7 @@
 #undef FUNC_NAME
 #endif
 
-static void
+void
 scm_swap_bindings (SCM vars, SCM vals)
 {
   SCM tmp;
Index: guile/guile-core/libguile/dynwind.h
diff -u guile/guile-core/libguile/dynwind.h:1.15 
guile/guile-core/libguile/dynwind.h:1.16
--- guile/guile-core/libguile/dynwind.h:1.15    Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/dynwind.h Sat Aug 25 09:08:13 2001
@@ -59,6 +59,8 @@
 extern void scm_dowinds (SCM to, long delta);
 extern void scm_init_dynwind (void);
 
+extern void scm_swap_bindings (SCM vars, SCM vals);
+
 #ifdef GUILE_DEBUG
 extern SCM scm_wind_chain (void);
 #endif /*GUILE_DEBUG*/
Index: guile/guile-core/libguile/eval.c
diff -u guile/guile-core/libguile/eval.c:1.239 
guile/guile-core/libguile/eval.c:1.240
--- guile/guile-core/libguile/eval.c:1.239      Mon Jul 30 11:55:50 2001
+++ guile/guile-core/libguile/eval.c    Sat Aug 25 09:08:13 2001
@@ -1112,32 +1112,53 @@
   return x;
 }
 
+/* (@bind ((var exp) ...) body ...)
+
+  This will assign the values of the `exp's to the global variables
+  named by `var's (symbols, not evaluated), creating them if they
+  don't exist, executes body, and then restores the previous values of
+  the `var's.  Additionally, whenever control leaves body, the values
+  of the `var's are saved and restored when control returns.  It is an
+  error when a symbol appears more than once among the `var's.
+  All `exp's are evaluated before any `var' is set.
+
+  This of this as `let' for dynamic scope.
+
+  It is memoized into (address@hidden ((var ...) . (reversed-val ...)) body 
...).
+
+  XXX - also implement address@hidden'.
+*/
+
 SCM_SYNTAX (s_atbind, "@bind", scm_makmmacro, scm_m_atbind);
 
 SCM
 scm_m_atbind (SCM xorig, SCM env)
 {
   SCM x = SCM_CDR (xorig);
-  SCM_ASSYNT (scm_ilength (x) > 1, scm_s_expression, "@bind");
+  SCM top_level = scm_env_top_level (env);
+  SCM vars = SCM_EOL;
+  SCM exps = SCM_EOL;
 
-  if (SCM_IMP (env))
-    env = SCM_BOOL_F;
-  else
-    {
-      while (SCM_NIMP (SCM_CDR (env)))
-       env = SCM_CDR (env);
-      env = SCM_CAR (env);
-      if (SCM_CONSP (env))
-       env = SCM_BOOL_F;
-    }
-  
+  SCM_ASSYNT (scm_ilength (x) > 1, scm_s_expression, s_atbind);
+
   x = SCM_CAR (x);
   while (SCM_NIMP (x))
     {
-      SCM_SETCAR (x, scm_sym2var (SCM_CAR (x), env, SCM_BOOL_T));
+      SCM rest;
+      SCM sym_exp = SCM_CAR (x);
+      SCM_ASSYNT (scm_ilength (sym_exp) == 2, scm_s_bindings, s_atbind);
+      SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (sym_exp)), scm_s_bindings, s_atbind);
       x = SCM_CDR (x);
+      for (rest = x; SCM_NIMP (rest); rest = SCM_CDR (rest))
+       if (SCM_EQ_P (SCM_CAR (sym_exp), SCM_CAR (SCM_CAR (rest))))
+         scm_misc_error (s_atbind, scm_s_duplicate_bindings, SCM_EOL);
+      vars = scm_cons (scm_sym2var (SCM_CAR (sym_exp), top_level, SCM_BOOL_T),
+                      vars);
+      exps = scm_cons (SCM_CADR (sym_exp), exps);
     }
-  return scm_cons (SCM_IM_BIND, SCM_CDR (xorig));
+  return scm_cons (SCM_IM_BIND,
+                  scm_cons (scm_cons (scm_reverse_x (vars, SCM_EOL), exps),
+                            SCM_CDDR (xorig)));
 }
 
 SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_makmmacro, 
scm_m_at_call_with_values);
@@ -2411,39 +2432,37 @@
                  : SCM_INUM0)
 
        case (SCM_ISYMNUM (SCM_IM_BIND)):
-         x = SCM_CDR (x);
+         {
+           SCM vars, exps, vals;
 
-         t.arg1 = SCM_CAR (x);
-         arg2 = SCM_CDAR (env);
-         while (SCM_NIMP (arg2))
-           {
-             proc = SCM_VARIABLE_REF (SCM_CAR (t.arg1));
-             SCM_VARIABLE_SET (SCM_CAR (t.arg1), SCM_CAR (arg2));
-             SCM_SETCAR (arg2, proc);
-             t.arg1 = SCM_CDR (t.arg1);
-             arg2 = SCM_CDR (arg2);
-           }
-         t.arg1 = SCM_CAR (x);
-         scm_dynwinds = scm_acons (t.arg1, SCM_CDAR (env), scm_dynwinds);
+           x = SCM_CDR (x);
+           vars = SCM_CAAR (x);
+           exps = SCM_CDAR (x);
+
+           vals = SCM_EOL;
+
+           while (SCM_NIMP (exps))
+             {
+               vals = scm_cons (EVALCAR (exps, env), vals);
+               exps = SCM_CDR (exps);
+             }
+           
+           scm_swap_bindings (vars, vals);
+           scm_dynwinds = scm_acons (vars, vals, scm_dynwinds);
          
-         arg2 = x = SCM_CDR (x);
-         while (!SCM_NULLP (arg2 = SCM_CDR (arg2)))
-           {
-             SIDEVAL (SCM_CAR (x), env);
-             x = arg2;
-           }
-         proc = EVALCAR (x, env);
+           arg2 = x = SCM_CDR (x);
+           while (!SCM_NULLP (arg2 = SCM_CDR (arg2)))
+             {
+               SIDEVAL (SCM_CAR (x), env);
+               x = arg2;
+             }
+           proc = EVALCAR (x, env);
          
-         scm_dynwinds = SCM_CDR (scm_dynwinds);
-         arg2 = SCM_CDAR (env);
-         while (SCM_NIMP (arg2))
-           {
-             SCM_VARIABLE_SET (SCM_CAR (t.arg1), SCM_CAR (arg2));
-             t.arg1 = SCM_CDR (t.arg1);
-             arg2 = SCM_CDR (arg2);
-           }
+           scm_dynwinds = SCM_CDR (scm_dynwinds);
+           scm_swap_bindings (vars, vals);
 
-         RETURN (proc);
+           RETURN (proc)
+         }
          
        case (SCM_ISYMNUM (SCM_IM_CALL_WITH_VALUES)):
          {