[MLton-commit] r7544

[Matthew Fluet]

Fixed bug in translation from SSA2 to RSSA with case expressions over non-primitive-sized words.

Word constants in a case expression should be rounded up to
primitive-sized words during the SSA to RSSA conversion.
----------------------------------------------------------------------

U   mlton/trunk/doc/changelog
U   mlton/trunk/mlton/backend/ssa-to-rssa.fun

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

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2011-06-10 19:46:10 UTC (rev 7543)
+++ mlton/trunk/doc/changelog	2011-06-10 19:46:13 UTC (rev 7544)
@@ -1,6 +1,8 @@
 Here are the changes from version 2010608 to version YYYYMMDD.
 
 * 2011-06-10
+   - Fixed bug in translation from SSA2 to RSSA with case expressions
+     over non-primitive-sized words.
    - Fixed bug in SSA/SSA2 type checking of case expressions over
      words.
 

Modified: mlton/trunk/mlton/backend/ssa-to-rssa.fun
===================================================================
--- mlton/trunk/mlton/backend/ssa-to-rssa.fun	2011-06-10 19:46:10 UTC (rev 7543)
+++ mlton/trunk/mlton/backend/ssa-to-rssa.fun	2011-06-10 19:46:13 UTC (rev 7544)
@@ -599,12 +599,18 @@
              src = Operand.word (WordX.one cardElemSize)}]
    end
 
+fun convertWordSize (ws: WordSize.t): WordSize.t =
+   WordSize.roundUpToPrim ws
+
+fun convertWordX (w: WordX.t): WordX.t =
+   WordX.resize (w, convertWordSize (WordX.size w))
+
 fun convertConst (c: Const.t): Const.t =
    let
       datatype z = datatype Const.t
    in
       case c of
-         Word w => Word (WordX.resize (w, WordSize.roundUpToPrim (WordX.size w)))
+         Word w => Word (convertWordX w)
        | _ => c
    end
 
@@ -688,16 +694,21 @@
                                 (ss, t)
                              end
                         | _ => Error.bug "SsaToRssa.translateCase: strange type"))
-          | S.Cases.Word (s, cs) =>
-               ([],
-                Switch
-                (Switch.T
-                 {cases = (QuickSort.sortVector
-                           (cs, fn ((w, _), (w', _)) =>
-                            WordX.le (w, w', {signed = false}))),
-                  default = default,
-                  size = s,
-                  test = varOp test}))
+          | S.Cases.Word (s, cases) =>
+               let
+                  val cases =
+                     QuickSort.sortVector
+                     (Vector.map (cases, fn (w, l) => (convertWordX w, l)),
+                      fn ((w, _), (w', _)) => WordX.le (w, w', {signed = false}))
+               in
+                  ([],
+                   Switch
+                   (Switch.T
+                    {cases = cases,
+                     default = default,
+                     size = convertWordSize s,
+                     test = varOp test}))
+               end
       fun eta (l: Label.t, kind: Kind.t): Label.t =
          let
             val {args, ...} = labelInfo l