[MLton-commit] r6755

Matthew Fluet fluet at mlton.org
Tue Aug 19 15:15:09 PDT 2008


SSA to SSA2 translation erroneously drops variables of unit type.

The variable bound to an Array_update, Ref_assign, or Profile
expression in an SSA IL program was not being bound to any expression
in the SSA2 IL program; the forms became Update or Profile statements.
This could leave unbound variables in the SSA2 IL program.
----------------------------------------------------------------------

U   mlton/trunk/mlton/ssa/ssa-to-ssa2.fun
U   mlton/trunk/mlton/ssa/ssa-tree2.fun
U   mlton/trunk/mlton/ssa/ssa-tree2.sig

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

Modified: mlton/trunk/mlton/ssa/ssa-to-ssa2.fun
===================================================================
--- mlton/trunk/mlton/ssa/ssa-to-ssa2.fun	2008-08-19 22:15:00 UTC (rev 6754)
+++ mlton/trunk/mlton/ssa/ssa-to-ssa2.fun	2008-08-19 22:15:08 UTC (rev 6755)
@@ -81,6 +81,15 @@
             val ty = convertType ty
             fun simple (exp: S2.Exp.t): S2.Statement.t vector =
                Vector.new1 (S2.Statement.Bind {exp = exp, ty = ty, var = var})
+            fun maybeBindUnit (stmt: S2.Statement.t): S2.Statement.t vector =
+               case var of
+                  NONE => Vector.new1 stmt
+                | SOME _ =>
+                     Vector.new2
+                     (S2.Statement.Bind {var = var,
+                                         ty = ty,
+                                         exp = S2.Exp.unit},
+                      stmt)
          in
             case exp of
                S.Exp.ConApp {args, con} =>
@@ -134,17 +143,18 @@
                             end
                        | Array_sub => sub ()
                        | Array_update =>
-                            Vector.new1
+                            maybeBindUnit
                             (S2.Statement.Update
                              {base = Base.VectorSub {index = arg 1,
                                                      vector = arg 0},
                               offset = 0,
                               value = arg 2})
                        | Ref_assign =>
-                            Vector.new1 (S2.Statement.Update
-                                         {base = Base.Object (arg 0),
-                                          offset = 0,
-                                          value = arg 1})
+                            maybeBindUnit
+                            (S2.Statement.Update
+                             {base = Base.Object (arg 0),
+                              offset = 0,
+                              value = arg 1})
                        | Ref_deref =>
                             simple (S2.Exp.Select {base = Base.Object (arg 0),
                                                    offset = 0})
@@ -159,7 +169,7 @@
                             simple (S2.Exp.PrimApp {args = args,
                                                     prim = convertPrim prim})
                    end
-             | S.Exp.Profile e => Vector.new1 (S2.Statement.Profile e)
+             | S.Exp.Profile e => maybeBindUnit (S2.Statement.Profile e)
              | S.Exp.Select {offset, tuple} =>
                   simple (S2.Exp.Select {base = Base.Object tuple,
                                          offset = offset})

Modified: mlton/trunk/mlton/ssa/ssa-tree2.fun
===================================================================
--- mlton/trunk/mlton/ssa/ssa-tree2.fun	2008-08-19 22:15:00 UTC (rev 6754)
+++ mlton/trunk/mlton/ssa/ssa-tree2.fun	2008-08-19 22:15:08 UTC (rev 6755)
@@ -539,6 +539,8 @@
                     offset: int}
        | Var of Var.t
 
+      val unit = Object {con = NONE, args = Vector.new0 ()}
+
       fun foreachVar (e, v) =
          let
             fun vs xs = Vector.foreach (xs, v)

Modified: mlton/trunk/mlton/ssa/ssa-tree2.sig
===================================================================
--- mlton/trunk/mlton/ssa/ssa-tree2.sig	2008-08-19 22:15:00 UTC (rev 6754)
+++ mlton/trunk/mlton/ssa/ssa-tree2.sig	2008-08-19 22:15:08 UTC (rev 6755)
@@ -123,6 +123,7 @@
             val layout: t -> Layout.t
             val maySideEffect: t -> bool
             val replaceVar: t * (Var.t -> Var.t) -> t
+            val unit: t
          end
 
       structure Statement:




More information about the MLton-commit mailing list