mlton-commit Mailing List for MLton

Fix syntax error introduced in r7227.
----------------------------------------------------------------------

U   mlton/trunk/basis-library/integer/int-inf.sml

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

Modified: mlton/trunk/basis-library/integer/int-inf.sml
===================================================================
--- mlton/trunk/basis-library/integer/int-inf.sml	2009-09-17 15:34:19 UTC (rev 7229)
+++ mlton/trunk/basis-library/integer/int-inf.sml	2009-09-17 19:09:12 UTC (rev 7230)
@@ -242,7 +242,7 @@
                     : (int, 'a) reader =
             let
                fun reader (s: 'a): (int * 'a) option =
-                  let val s = StringCvt.skipWS cread s
+                  let val s = StringCvt.skipWS cread s in
                   case cread s of
                      NONE => NONE
                    | SOME (ch, s') =>

Explicit type constraint to appease SML/NJ.
----------------------------------------------------------------------

U   mlton/trunk/mlton/ssa/combine-conversions.fun

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

Modified: mlton/trunk/mlton/ssa/combine-conversions.fun
===================================================================
--- mlton/trunk/mlton/ssa/combine-conversions.fun	2009-09-16 12:57:24 UTC (rev 7228)
+++ mlton/trunk/mlton/ssa/combine-conversions.fun	2009-09-17 15:34:19 UTC (rev 7229)
@@ -54,7 +54,11 @@
  *       because each conversion affects the result separately
  *)
 
-val { get, set, ... } =
+val { get : Var.t -> ((WordSize.t 
+                       * WordSize.t 
+                       * {signed:bool}) 
+                      * Var.t) option,
+      set, ... } =
    Property.getSetOnce (Var.plist, Property.initConst NONE)
 
 fun rules x3 (conversion as ((W2, W3, {signed=s2}), x2)) =

Unconditionally setCardMapAndCrossMap at then end of a major gc to
clear the card map and cross map (which are invalidated by the major
gc).  GC_pack invokes performGC without allowing a resize, so the card
map and cross map could be invalid after a GC_pack, leading to
bugs/assertions on subsequent minor gcs.
----------------------------------------------------------------------

U   mlton/trunk/runtime/gc/garbage-collection.c

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

Modified: mlton/trunk/runtime/gc/garbage-collection.c
===================================================================
--- mlton/trunk/runtime/gc/garbage-collection.c	2009-09-16 01:18:27 UTC (rev 7227)
+++ mlton/trunk/runtime/gc/garbage-collection.c	2009-09-16 12:57:24 UTC (rev 7228)
@@ -44,8 +44,8 @@
    */
   if (mayResize) {
     resizeHeap (s, s->lastMajorStatistics.bytesLive + bytesRequested);
-    setCardMapAndCrossMap (s);
   }
+  setCardMapAndCrossMap (s);
   resizeHeapSecondary (s);
   assert (s->heap.oldGenSize + bytesRequested <= s->heap.size);
 }

Fix bug in IntInf.scan (and IntInf.fromString) where leading spaces
were only accepted if the stream/string had an explicit sign
character.


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

U   mlton/trunk/basis-library/integer/int-inf.sml

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

Modified: mlton/trunk/basis-library/integer/int-inf.sml
===================================================================
--- mlton/trunk/basis-library/integer/int-inf.sml	2009-09-15 12:30:23 UTC (rev 7226)
+++ mlton/trunk/basis-library/integer/int-inf.sml	2009-09-16 01:18:27 UTC (rev 7227)
@@ -242,7 +242,8 @@
                     : (int, 'a) reader =
             let
                fun reader (s: 'a): (int * 'a) option =
-                  case cread (StringCvt.skipWS cread s) of
+                  let val s = StringCvt.skipWS cread s
+                  case cread s of
                      NONE => NONE
                    | SOME (ch, s') =>
                        let
@@ -259,6 +260,7 @@
                                    | SOME (abs, s''') => SOME (~ abs, s''')
                              else uread s''
                        end
+                  end
             in
                reader
             end

Escape the $ from the Makefile


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

U   mlton/trunk/package/mingw/Makefile

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

Modified: mlton/trunk/package/mingw/Makefile
===================================================================
--- mlton/trunk/package/mingw/Makefile	2009-09-15 12:20:37 UTC (rev 7225)
+++ mlton/trunk/package/mingw/Makefile	2009-09-15 12:30:23 UTC (rev 7226)
@@ -37,7 +37,7 @@
 	echo "x86_64-w64-mingw32 amd64 mingw" >> staging/lib/mlton/target-map
 	rm staging/lib/mlton/x86_64-w64-mingw32/*-gdb.a
 	rm -rf ../../runtime.x64
-	sed "s@'/lib/mlton'@\`cd \"\$dir/lib/mlton\" \&\& pwd\`@" < staging/bin/mlton > staging/mlton
+	sed "s@'/lib/mlton'@\`cd \"\$$dir/lib/mlton\" \&\& pwd\`@" < staging/bin/mlton > staging/mlton
 	./staging/mlton -target x86_64-w64-mingw32 -build-constants true > staging/w64-constants.c
 	./staging/mlton -target x86_64-w64-mingw32 -verbose 1 staging/w64-constants.c
 	./staging/w64-constants > staging/lib/mlton/x86_64-w64-mingw32/constants

Build constants using new cross compiler


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

U   mlton/trunk/package/mingw/Makefile

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

Modified: mlton/trunk/package/mingw/Makefile
===================================================================
--- mlton/trunk/package/mingw/Makefile	2009-09-14 20:05:31 UTC (rev 7224)
+++ mlton/trunk/package/mingw/Makefile	2009-09-15 12:20:37 UTC (rev 7225)
@@ -34,12 +34,13 @@
 	mkdir -p staging/lib/mlton/x86_64-w64-mingw32/include
 	cp ../../runtime.x64/gen/c-types.h staging/lib/mlton/x86_64-w64-mingw32/include
 	cp ../../runtime.x64/gen/sizes ../../runtime.x64/*.a staging/lib/mlton/x86_64-w64-mingw32
+	echo "x86_64-w64-mingw32 amd64 mingw" >> staging/lib/mlton/target-map
 	rm staging/lib/mlton/x86_64-w64-mingw32/*-gdb.a
-	rm -rf ../../runtime.x64
-	$(MLTON) -target x86_64-w64-mingw32 -build-constants true > staging/w64-constants.c
-	$(MLTON) -target x86_64-w64-mingw32 -verbose 1 staging/w64-constants.c
+	rm -rf ../../runtime.x64
+	sed "s@'/lib/mlton'@\`cd \"\$dir/lib/mlton\" \&\& pwd\`@" < staging/bin/mlton > staging/mlton
+	./staging/mlton -target x86_64-w64-mingw32 -build-constants true > staging/w64-constants.c
+	./staging/mlton -target x86_64-w64-mingw32 -verbose 1 staging/w64-constants.c
 	./staging/w64-constants > staging/lib/mlton/x86_64-w64-mingw32/constants
-	echo "x86_64-w64-mingw32 amd64 mingw" >> staging/lib/mlton/target-map
 	cd staging; find lib/mlton/x86_64-w64-mingw32 lib/mlton/sml/basis/config/c/amd64-mingw -type f > ../$@.tmp
 	mv $@.tmp $@
 

The applyPrim function incorrectly optimized rol/ror.
Here is an example of the problem:

fun id 0w0 = 0w0
  | id x = id (x - 0w1) + 0w1

val x = valOf (Word64.fromString "1234567890abcdef")
val y = MLton.Word64.ror (x, id 0w32)
val z = MLton.Word64.ror (x, 0w32)

val () = print (Word64.toString y ^ "\n")
val () = print (Word64.toString z ^ "\n")

Output:
1234567890ABCDEF
90ABCDEF12345678

Expected output:
90ABCDEF12345678
90ABCDEF12345678

The problem stems from confusing the wordsize of the left and right arguments.

The optimization should check if the rol/ror is a multiple of the left 
wordsize, replacing the rol/ror by identity. However, as it incorrectly took
the right wordsize, a shift by 32 was considered identity for a 64 bit value.


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

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

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

Modified: mlton/trunk/mlton/atoms/prim.fun
===================================================================
--- mlton/trunk/mlton/atoms/prim.fun	2009-09-05 11:39:52 UTC (rev 7223)
+++ mlton/trunk/mlton/atoms/prim.fun	2009-09-14 20:05:31 UTC (rev 7224)
@@ -1861,23 +1861,19 @@
                                 then Var x
                              else Apply (neg s, [x])
                      else Unknown
-                  fun ro () =
+                  fun ro s =
                      if inOrder
                         then
-                           let
-                              val s = WordX.size w
-                           in
-                              if WordX.isZero
-                                 (WordX.rem
-                                  (w,
-                                   WordX.fromIntInf
-                                   (IntInf.fromInt
-                                    (Bits.toInt (WordSize.bits s)),
-                                    s),
-                                   {signed = false}))
-                                 then Var x
-                              else Unknown
-                           end
+                           if WordX.isZero
+                              (WordX.rem
+                               (w,
+                                WordX.fromIntInf
+                                (IntInf.fromInt
+                                 (Bits.toInt (WordSize.bits s)),
+                                 WordX.size w),
+                                {signed = false}))
+                              then Var x
+                           else Unknown
                      else
                         if WordX.isZero w orelse WordX.isAllOnes w
                            then word w
@@ -1944,8 +1940,8 @@
                                     orelse signed andalso WordX.isNegOne w)
                            then zero s
                         else Unknown
-                   | Word_rol _ => ro ()
-                   | Word_ror _ => ro ()
+                   | Word_rol s => ro s
+                   | Word_ror s => ro s
                    | Word_rshift (s, {signed}) =>
                         if signed
                            then

Where there is a "to", there should be a "from".

Converting an intinf to/from a byte-stream is a pretty important operation 
in cryptography. The basis library doesn't provide a way to convert to bytes
aside from >> and WordX.fromLargeInt. It is not possible to convert an integer
to bytes in linear time with these operations. Therefore, this patch extends
the MLton extension to converts IntInf to/from it's underlying representation.


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

U   mlton/trunk/basis-library/integer/int-inf.sig
U   mlton/trunk/basis-library/integer/int-inf0.sml
U   mlton/trunk/basis-library/mlton/int-inf.sig

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

Modified: mlton/trunk/basis-library/integer/int-inf.sig
===================================================================
--- mlton/trunk/basis-library/integer/int-inf.sig	2009-08-21 15:18:46 UTC (rev 7222)
+++ mlton/trunk/basis-library/integer/int-inf.sig	2009-09-05 11:39:52 UTC (rev 7223)
@@ -29,6 +29,7 @@
          Big of BigWord.word Vector.vector
        | Small of SmallInt.int
       val rep: int -> rep
+      val fromRep: rep -> int option
 
       val zero: int
       val one: int

Modified: mlton/trunk/basis-library/integer/int-inf0.sml
===================================================================
--- mlton/trunk/basis-library/integer/int-inf0.sml	2009-08-21 15:18:46 UTC (rev 7222)
+++ mlton/trunk/basis-library/integer/int-inf0.sml	2009-09-05 11:39:52 UTC (rev 7223)
@@ -24,6 +24,7 @@
          Big of C_MPLimb.word vector
        | Small of ObjptrInt.int
       val rep: int -> rep
+      val fromRep: rep -> int option
 
       structure Prim : 
          sig
@@ -423,6 +424,24 @@
          if isSmall i
             then Small (dropTagCoerceInt i)
             else Big (Prim.toVector i)
+      
+      fun fromRep r =
+         case r of
+            Big v => 
+               let
+                  val ok =
+                     SeqIndex.> (Vector.length v, 1) andalso
+                     W.<= (V.subUnsafe (v, 0), 0w1)
+               in
+                  if ok then SOME (Prim.fromVector v) else NONE
+               end
+          | Small i => 
+                let
+                   val out = addTagCoerceInt i
+                   val undo = dropTagCoerceInt out
+                in
+                   if i = undo then SOME out else NONE
+                end
 
       local
          fun 'a make {zextdToMPLimb: 'a -> MPLimb.word,

Modified: mlton/trunk/basis-library/mlton/int-inf.sig
===================================================================
--- mlton/trunk/basis-library/mlton/int-inf.sig	2009-08-21 15:18:46 UTC (rev 7222)
+++ mlton/trunk/basis-library/mlton/int-inf.sig	2009-09-05 11:39:52 UTC (rev 7223)
@@ -19,4 +19,5 @@
          Big of BigWord.word vector
        | Small of SmallInt.int
       val rep: t -> rep
+      val fromRep: rep -> t option
    end