[MLton-commit] r5731

[Matthew Fluet]

Fixed a *very* long-standing bug in the monomorphisation pass,
reported by Vesa Karvonen.  (AFAICT, the bug has been present since
the original mlton-19990319 release.)

Unlike value variables, type variables are not uniquified by the
front-end passes.  Hence, it is entirely possible for a type variable
in the XML IL (that is a symbol with an associated property list) to
be used as a type variable for multiple polymorphic variables.
Indeed, since explicit type variables in the source derive their
identity from the corresponding source type variable (as a textual
name), there are often many uses of the "'a" type variable throughout
the XML IL program, though with different scopes.

The monomorphisation pass works by setting (via a property) a
monomorphic instantiation for a type variable, which is meant to
persist for the scope of the type variable.  Unfortunately, by
monomorphising a sub-expression, we may end up setting a different
monomorphic instantiation for the same type variable (but
corresponding to a different scope).  There are occasions where the
monomorphisation pass returns from monomorphising a sub-expression to
monomorphise a type.  If the monomorphisation of the sub-expression
set a type variable used by the type, then the type is monomorphised
under the wrong monomorphic instantiation.

It turns out that monomorphising a type never results in setting a
type variable's monomorphic instantation.  Hence, for a PolyVal, it
suffices to monomorphise the type before monomorphising the
expression.  (This change suffices for Vesa's code.)

For a Fun (i.e., a recursive collection of polymorphic functions),
however, there are multiple calls to monomorphise a lambda, each of
which may reset a type variable's monomorphic instantiation.  Hence,
the proper monomorphic instantiation must be esablished for each
lambda.  (This wasn't triggered by Vesa's code.)


----------------------------------------------------------------------

U   mlton/trunk/doc/changelog
U   mlton/trunk/mlton/xml/monomorphise.fun

----------------------------------------------------------------------

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2007-07-06 21:27:53 UTC (rev 5730)
+++ mlton/trunk/doc/changelog	2007-07-06 22:19:35 UTC (rev 5731)
@@ -1,5 +1,9 @@
 Here are the changes since version 20051202.
 
+* 2007-07-6
+   - Fixed a long-standing bug in monomorphisation pass.  Thanks to
+     Vesa Karvonen for the bug report.
+
 * 2007-05-18
    - Native amd64 code generator for amd64-* targets.
    - Eliminate native option from -codegen flag.
@@ -13,7 +17,7 @@
    - Added real/word casts in MLton structure.
 
 * 2007-04-12
-   - Added primitivs for bit cast of word to/from real.
+   - Added primitives for bit cast of word to/from real.
    - Implement PackReal<N>{Big,Little} using PackWord<N>{Big,Little}
      and bit casts.
 
@@ -1299,7 +1303,7 @@
 * 2001-9-21
   - Fixed MLton.World.{load,save} so that the saved world does not store the
     max heap size.  Instead, the max heap size is computed upon load world in
-    exactly the same way as at program startup.  This fixes a long standing (but
+    exactly the same way as at program startup.  This fixes a long-standing (but
     only recently noticed) problem in which mlton (which uses a saved world)
     would attempt to use as much memory as was on the machine used to build
     world.mlton.

Modified: mlton/trunk/mlton/xml/monomorphise.fun
===================================================================
--- mlton/trunk/mlton/xml/monomorphise.fun	2007-07-06 21:27:53 UTC (rev 5730)
+++ mlton/trunk/mlton/xml/monomorphise.fun	2007-07-06 22:19:35 UTC (rev 5731)
@@ -371,13 +371,15 @@
                    fn () =>
                    List.fold
                    (Cache.toList cache, [], fn ((ts, ve), decs) =>
-                    (setTyvars (tyvars, ts)
+                    (setVar (var, fn _ => ve)
                      ; let 
+                          val _ = setTyvars (tyvars, ts)
+                          val ty = monoType ty
                           val {decs = decs', result} = Sexp.dest (monoExp exp)
                        in 
                           decs'
                           @ (Sdec.MonoVal {var = SvarExp.var ve,
-                                           ty = monoType ty,
+                                           ty = ty,
                                            exp = SprimExp.Var result} :: decs)
                        end))
                 end
@@ -398,16 +400,21 @@
                    fn () =>
                    List.revMap
                    (Cache.toList cache, fn (ts, xs) =>
-                    (setTyvars (tyvars, ts)
-                     ; Vector.foreach2 (decs, xs, fn ({var, ...}, var') =>
-                                        setVar (var, fn _ => var'))
+                    (Vector.foreach2 (decs, xs, fn ({var, ...}, ve) =>
+                                      setVar (var, fn _ => ve))
                      ; (Sdec.Fun
                         {tyvars = Vector.new0 (),
                          decs = (Vector.map2
                                  (decs, xs, fn ({ty, lambda, ...}, ve) =>
-                                  {var = SvarExp.var ve,
-                                   ty = monoType ty,
-                                   lambda = monoLambda lambda}))})))
+                                  let
+                                     val _ = setTyvars (tyvars, ts)
+                                     val ty = monoType ty
+                                     val lambda = monoLambda lambda
+                                  in
+                                     {var = SvarExp.var ve,
+                                      ty = ty,
+                                      lambda = lambda}
+                                  end))})))
                 end
            | Xdec.Exception {con, arg} =>
                 let