[MLton-commit] r4379

[Stephen Weeks]

Made Int.{fmt,toString} thread safe.

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

U   mlton/trunk/basis-library/integer/int.sml
U   mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb
A   mlton/trunk/basis-library/misc/one.sml

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

Modified: mlton/trunk/basis-library/integer/int.sml
===================================================================
--- mlton/trunk/basis-library/integer/int.sml	2006-03-13 00:42:43 UTC (rev 4378)
+++ mlton/trunk/basis-library/integer/int.sml	2006-03-13 22:27:22 UTC (rev 4379)
@@ -119,40 +119,42 @@
     * The most that will be required is for minInt in binary.
     *)
    val maxNumDigits = PI.+ (precision', 1)
-   val buf = CharArray.array (maxNumDigits, #"\000")
+   val one = One.make (fn () => CharArray.array (maxNumDigits, #"\000"))
 in
    fun fmt radix (n: int): string =
-      let
-         val radix = fromInt (StringCvt.radixToInt radix)
-         fun loop (q, i: Int.int) =
-            let
-               val _ =
-                  CharArray.update
-                  (buf, i, StringCvt.digitToChar (toInt (~? (rem (q, radix)))))
-               val q = quot (q, radix)
-            in
-               if q = zero
-                  then
-                     let
-                        val start =
-                           if n < zero
-                              then
-                                 let
-                                    val i = PI.- (i, 1)
-                                    val () = CharArray.update (buf, i, #"~")
-                                 in
-                                    i
-                                 end
-                           else i
-                     in
-                        CharArraySlice.vector
-                        (CharArraySlice.slice (buf, start, NONE))
-                     end
-               else loop (q, PI.- (i, 1))
-            end
-      in
-         loop (if n < zero then n else ~? n, PI.- (maxNumDigits, 1))
-      end
+      One.use
+      (one, fn buf =>
+       let
+          val radix = fromInt (StringCvt.radixToInt radix)
+          fun loop (q, i: Int.int) =
+             let
+                val _ =
+                   CharArray.update
+                   (buf, i, StringCvt.digitToChar (toInt (~? (rem (q, radix)))))
+                val q = quot (q, radix)
+             in
+                if q = zero
+                   then
+                      let
+                         val start =
+                            if n < zero
+                               then
+                                  let
+                                     val i = PI.- (i, 1)
+                                     val () = CharArray.update (buf, i, #"~")
+                                  in
+                                     i
+                                  end
+                            else i
+                      in
+                         CharArraySlice.vector
+                         (CharArraySlice.slice (buf, start, NONE))
+                      end
+                else loop (q, PI.- (i, 1))
+             end
+       in
+          loop (if n < zero then n else ~? n, PI.- (maxNumDigits, 1))
+       end)
 end      
 
 val toString = fmt StringCvt.DEC

Modified: mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb	2006-03-13 00:42:43 UTC (rev 4378)
+++ mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb	2006-03-13 22:27:22 UTC (rev 4379)
@@ -20,6 +20,7 @@
       ../../misc/dynamic-wind.sml
       ../../general/general.sig
       ../../general/general.sml
+      ../../misc/one.sml
       ../../misc/util.sml
       ../../general/option.sig
       ../../general/option.sml

Added: mlton/trunk/basis-library/misc/one.sml
===================================================================
--- mlton/trunk/basis-library/misc/one.sml	2006-03-13 00:42:43 UTC (rev 4378)
+++ mlton/trunk/basis-library/misc/one.sml	2006-03-13 22:27:22 UTC (rev 4379)
@@ -0,0 +1,35 @@
+structure One:
+   sig
+      type 'a t
+
+      val make: (unit -> 'a) -> 'a t
+      val use: 'a t * ('a -> 'b) -> 'b
+   end =
+   struct
+      datatype 'a t = T of {more: unit -> 'a,
+                            static: 'a,
+                            staticIsInUse: bool ref}
+
+      fun make f = T {more = f,
+                      static = f (),
+                      staticIsInUse = ref false}
+
+      fun use (T {more, static, staticIsInUse}, f) =
+         let
+            val () = Primitive.Thread.atomicBegin ()
+            val b = ! staticIsInUse
+            val d =
+               if b then
+                  (Primitive.Thread.atomicEnd ();
+                   more ())
+               else
+                  (staticIsInUse := true;
+                   Primitive.Thread.atomicEnd ();
+                   static)
+        in
+           DynamicWind.wind (fn () => f d,
+                             fn () => if b then () else staticIsInUse := false)
+        end
+
+   end
+