[MLton-commit] r6258

[Matthew Fluet]

Fix broken maxShift for IntInf_lshift constant folding
----------------------------------------------------------------------

U   mlton/trunk/mlton/atoms/prim.fun

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

Modified: mlton/trunk/mlton/atoms/prim.fun
===================================================================
--- mlton/trunk/mlton/atoms/prim.fun	2007-12-09 21:41:27 UTC (rev 6257)
+++ mlton/trunk/mlton/atoms/prim.fun	2007-12-09 22:11:15 UTC (rev 6258)
@@ -1253,6 +1253,10 @@
             IntInf.< (ii, minIntInf)
             orelse IntInf.> (ii, maxIntInf)
       end
+      val intInfTooBig =
+         Trace.trace 
+         ("Prim.intInfTooBig", IntInf.layout, Bool.layout)
+         intInfTooBig
       fun intInf (ii:  IntInf.t): ('a, 'b) ApplyResult.t =
          if intInfTooBig ii
             then ApplyResult.Unknown
@@ -1316,7 +1320,7 @@
                IntInf_neg => intInf (IntInf.~ i1)
              | IntInf_notb => intInf (IntInf.notb i1)
              | _ => ApplyResult.Unknown
-      fun intInfSharyOrToString (i1, w2) =
+      fun intInfShiftOrToString (i1, w2) =
          if intInfTooBig i1
             then ApplyResult.Unknown
          else 
@@ -1326,9 +1330,7 @@
              | IntInf_lshift =>
                   let
                      val maxShift =
-                        WordX.lshift
-                        (WordX.one WordSize.shiftArg,
-                         WordX.fromIntInf (128, WordSize.shiftArg))
+                        WordX.fromIntInf (128, WordSize.shiftArg)
                   in
                      if WordX.lt (w2, maxShift, {signed = false})
                         then intInf (IntInf.<< (i1, Word.fromIntInf (WordX.toIntInf w2)))
@@ -1372,7 +1374,7 @@
                     NONE => ApplyResult.Unknown
                   | SOME w => word w)
            | (_, [IntInf i1, IntInf i2, _]) => intInfBinary (i1, i2)
-           | (_, [IntInf i1, Word w2, _]) => intInfSharyOrToString (i1, w2)
+           | (_, [IntInf i1, Word w2, _]) => intInfShiftOrToString (i1, w2)
            | (_, [IntInf i1, _]) => intInfUnary (i1)
            | (Vector_length, [WordVector v]) =>
                  seqIndexConst (IntInf.fromInt (WordXVector.length v))
@@ -1616,7 +1618,7 @@
              | (_, [Const (IntInf i1), Const (IntInf i2), _]) => 
                   intInfBinary (i1, i2)
              | (_, [Const (IntInf i1), Const (Word w2), _]) => 
-                  intInfSharyOrToString (i1, w2)
+                  intInfShiftOrToString (i1, w2)
              | (_, [Const (IntInf i1), _]) => intInfUnary (i1)
              | (_, [Var x, Const (IntInf i), Var space]) =>
                   varIntInf (x, i, space, true)