tentative fluid-let patch

[Per Bothner <per at bothner dot com>]

This is a preliminary patch that fixes a few problems with fluid
bindings.  It fixes Dean's test-case from Monday, and it also
fixes Savannah bug #11859.  I.e. fluid-let works on lexical
bindings, in a I-think reasonable manner.

I think the basic concept is solid, but it probably needs a little
bit of cleaning up and more testing.
--
	--Per Bothner
per@bothner.com   http://per.bothner.com/

? .classpath
? .project
? A.class
? B.class
? LOG.ALL
? LOG.CHECK
? LOG.CONF
? LOG.CVS
? Launch.class
? ModA.class
? ModB.class
? MyDate.class
? MyFunc.class
? MyModule.class
? MySAXApp.class
? MyTimestamp.class
? SafeRecursiveWriter.class
? SafeRecursiveWriter.java
? SimpleB.class
? Start.class
? caller.class
? caller.java
? fl.class
? futuretest.scm
? futuretest2.scm
? kawa-zip-dump-1.zip
? mod1.class
? mod2.class
? tmp
? tools
? doc/kawa.xml
? gnu/LOG.ALL
? gnu/LOG.CVS
? gnu/bytecode/LOG.CONF
? gnu/jemacs/lang/ELisp.patch
? gnu/kawa/slib/junit-runner.scm
Index: doc/kawa.texi
===================================================================
RCS file: /cvs/kawa/kawa/doc/kawa.texi,v
retrieving revision 1.157
diff -u -r1.157 kawa.texi
--- doc/kawa.texi	9 May 2005 15:04:10 -0000	1.157
+++ doc/kawa.texi	11 May 2005 19:59:16 -0000
@@ -187,6 +187,8 @@
 SRFI 28: Basic Format Strings - @pxref{Format}.
 @item
 SRFI 30: Nested Multi-line Comments.
+@item
+SRFI 37: args-fold
 @end itemize
 
 @node Getting Kawa, Installation, Features, Top
Index: gnu/expr/FindCapturedVars.java
===================================================================
RCS file: /cvs/kawa/kawa/gnu/expr/FindCapturedVars.java,v
retrieving revision 1.41
diff -u -r1.41 FindCapturedVars.java
--- gnu/expr/FindCapturedVars.java	21 Apr 2005 22:43:55 -0000	1.41
+++ gnu/expr/FindCapturedVars.java	11 May 2005 19:59:16 -0000
@@ -107,9 +107,12 @@
   {
     for (Declaration decl = exp.firstDecl(); decl != null; decl = decl.nextDecl())
       {
-	Declaration bind = allocUnboundDecl(decl.getSymbol(), false);
-	capture(bind);
-	decl.base = bind;
+        if (decl.base == null)
+          {
+            Declaration bind = allocUnboundDecl(decl.getSymbol(), false);
+            capture(bind);
+            decl.base = bind;
+          }
       }
     return super.walkLetExp(exp);
   }
Index: gnu/expr/FindTailCalls.java
===================================================================
RCS file: /cvs/kawa/kawa/gnu/expr/FindTailCalls.java,v
retrieving revision 1.34
diff -u -r1.34 FindTailCalls.java
--- gnu/expr/FindTailCalls.java	21 Apr 2005 22:43:56 -0000	1.34
+++ gnu/expr/FindTailCalls.java	11 May 2005 19:59:16 -0000
@@ -106,6 +106,11 @@
       {
         decl.setCanRead(true);
         decl.setCanWrite(true);
+        if (decl.base != null)
+          {
+            decl.base.setCanRead(true);
+            decl.base.setCanWrite(true);
+          }
       }
     boolean save = inTailContext;
     inTailContext = false;
Index: gnu/expr/LambdaExp.java
===================================================================
RCS file: /cvs/kawa/kawa/gnu/expr/LambdaExp.java,v
retrieving revision 1.104
diff -u -r1.104 LambdaExp.java
--- gnu/expr/LambdaExp.java	21 Apr 2005 01:41:32 -0000	1.104
+++ gnu/expr/LambdaExp.java	11 May 2005 19:59:16 -0000
@@ -1117,7 +1117,11 @@
 		  break;
 		mname = dname + '_' + ++i;
 	      }
+            // FIXME combine this with makeField.
 	    Type ftype = decl.getType().getImplementationType();
+            if (decl.isIndirectBinding()
+                && ! ftype.isSubtype(Compilation.typeLocation))
+              ftype = Compilation.typeLocation;
 	    decl.field = frameType.addField (mname, ftype, fflags);
 	  }
       }
Index: gnu/expr/LetExp.java
===================================================================
RCS file: /cvs/kawa/kawa/gnu/expr/LetExp.java,v
retrieving revision 1.25
diff -u -r1.25 LetExp.java
--- gnu/expr/LetExp.java	25 Feb 2005 09:18:58 -0000	1.25
+++ gnu/expr/LetExp.java	11 May 2005 19:59:16 -0000
@@ -39,10 +39,8 @@
 		  {
 		    decl.pushIndirectBinding(comp);
 		  }
-		code.emitStore(decl.getVariable());
 	      }
-	    else
-	      decl.compileStore(comp);
+            decl.compileStore(comp);
 	  }
       }
   }
Index: gnu/kawa/reflect/FieldLocation.java
===================================================================
RCS file: /cvs/kawa/kawa/gnu/kawa/reflect/FieldLocation.java,v
retrieving revision 1.7
diff -u -r1.7 FieldLocation.java
--- gnu/kawa/reflect/FieldLocation.java	20 Apr 2005 17:21:19 -0000	1.7
+++ gnu/kawa/reflect/FieldLocation.java	11 May 2005 19:59:16 -0000
@@ -8,8 +8,8 @@
 {
   Declaration decl;
   /** The cached location of the field, if final.
-   * This is the value of this Location, exception if isIndirectLocation(),
-   * we need to do an extra indirection. */
+   * This is the value of this Location.  Howeve, if INDIRECT_LOCATION is
+   * set and CONSTANT is cleared, then we need to do an extra indirection. */
   Object value;
   static final int SETUP_DONE = 1; // FIXME - do we still need this?
 
Index: gnu/kawa/reflect/StaticFieldLocation.java
===================================================================
RCS file: /cvs/kawa/kawa/gnu/kawa/reflect/StaticFieldLocation.java,v
retrieving revision 1.6
diff -u -r1.6 StaticFieldLocation.java
--- gnu/kawa/reflect/StaticFieldLocation.java	12 Mar 2005 06:13:50 -0000	1.6
+++ gnu/kawa/reflect/StaticFieldLocation.java	11 May 2005 19:59:16 -0000
@@ -23,11 +23,10 @@
 
   public Object get (Object defaultValue)
   {
-    if (value == null)
-      value = super.get(defaultValue);
-    if (value instanceof kawa.lang.Macro)
+    Object val = super.get(defaultValue);
+    if (val instanceof kawa.lang.Macro)
       getDeclaration();
-    return value;
+    return val;
   }
 
   public static StaticFieldLocation
Index: gnu/mapping/Location.java
===================================================================
RCS file: /cvs/kawa/kawa/gnu/mapping/Location.java,v
retrieving revision 1.9
diff -u -r1.9 Location.java
--- gnu/mapping/Location.java	13 Feb 2005 02:23:04 -0000	1.9
+++ gnu/mapping/Location.java	11 May 2005 19:59:16 -0000
@@ -143,8 +143,13 @@
   // The compiler emits calls to this method.
   public static Location make (Object init, String name)
   {
+    ThreadLocation loc = new ThreadLocation(name);
+    loc.setGlobal(init);
+    return loc;
+    /*
     Symbol sym = Namespace.EmptyNamespace.getSymbol(name.intern());
     return new PlainLocation(sym, null, init);
+    */
   }
 
   // The compiler emits calls to this method.
Index: kawa/standard/fluid_let.java
===================================================================
RCS file: /cvs/kawa/kawa/kawa/standard/fluid_let.java,v
retrieving revision 1.9
diff -u -r1.9 fluid_let.java
--- kawa/standard/fluid_let.java	21 Mar 2005 04:25:57 -0000	1.9
+++ kawa/standard/fluid_let.java	11 May 2005 19:59:16 -0000
@@ -73,6 +73,13 @@
 	else
 	  return tr.syntaxError("invalid " + getName() + " syntax");
 	Declaration decl = let.addDeclaration(name);
+        Declaration found = tr.lexical.lookup(name, false);
+        if (found != null)
+          {
+            if (found.isLexical())
+              found.setIndirectBinding(true);
+            decl.base = found;
+          }
 	decl.setFluid(true);
 	decl.setIndirectBinding(true);
 	if (value == null)