[MLton-commit] r4399
Matthew Fluet
MLton@mlton.org
Tue, 18 Apr 2006 19:46:50 -0700
Manually ported basis Library implementation changes to basis refactoring
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array2.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-vector.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/vector.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/one.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig 2006-04-19 02:46:47 UTC (rev 4399)
@@ -51,5 +51,5 @@
val concat: 'a array list -> 'a array
val duplicate: 'a array -> 'a array
val toList: 'a array -> 'a list
- val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b array
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a array * 'b
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array2.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array2.sml 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array2.sml 2006-04-19 02:46:47 UTC (rev 4399)
@@ -298,74 +298,12 @@
fun modify trv f a = modifyi trv (f o #3) (wholeRegion a)
fun tabulate trv (rows, cols, f) =
-(*
- if !Primitive.usesCallcc
- then
- (* All this mess is careful to construct a list representing
- * the array and then convert the list to the array after all
- * the calls to f have been made, in case f uses callcc.
- *)
- let
- val size =
- if Primitive.safe andalso (rows < 0 orelse cols < 0)
- then raise Size
- else rows * cols handle Overflow => raise Size
- val (rows', cols', f) =
- case trv of
- RowMajor => (rows, cols, f)
- | ColMajor => (cols, rows, fn (c, r) => f (r, c))
- fun loopr (r, l) =
- if r >= rows'
- then l
- else
- let
- fun loopc (c, l) =
- if c >= cols'
- then l
- else loopc (c + 1, f (r, c) :: l)
- in loopr (r + 1, loopc (0, l))
- end
- val l = loopr (0, [])
- val a = Primitive.Array.array size
- in case trv of
- RowMajor =>
- (* The list holds the elements in row major order,
- * but reversed.
- *)
- let
- val _ =
- List.foldl (fn (x, i) =>
- (Primitive.Array.update (a, i, x)
- ; i -? 1))
- (size -? 1) l
- in
- ()
- end
- | ColMajor =>
- (* The list holds the elements in column major order,
- * but reversed.
- *)
- let
- val _ =
- List.foldl (fn (x, (spot, r)) =>
- (Primitive.Array.update (a, spot, x)
- ; if r = 0
- then (spot -? 1 +? size -? cols,
- rows -? 1)
- else (spot -? cols, r -? 1)))
- (size -? 1, rows -? 1)
- l
- in
- ()
- end
- ; {rows = rows, cols = cols, array = a}
- end
- else
-*)
- let val a = arrayUninit (rows, cols)
- in modifyi trv (fn (r, c, _) => f (r, c)) (wholeRegion a)
- ; a
- end
+ let
+ val a = arrayUninit (rows, cols)
+ val () = modifyi trv (fn (r, c, _) => f (r, c)) (wholeRegion a)
+ in
+ a
+ end
fun copy {src = src as {base, ...}: 'a region,
dst, dst_row, dst_col} =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig 2006-04-19 02:46:47 UTC (rev 4399)
@@ -44,7 +44,7 @@
val fromPoly: elem Array.array -> array
val toList: array -> elem list
val toPoly: array -> elem Array.array
- val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> array
+ val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> array * 'a
val unsafeSub: array * int -> elem
val unsafeUpdate: array * int * elem -> unit
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-vector.sig 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-vector.sig 2006-04-19 02:46:47 UTC (rev 4399)
@@ -41,7 +41,7 @@
val toList: vector -> elem list
val tokens: (elem -> bool) -> vector -> vector list
val translate: (elem -> vector) -> vector -> vector
- val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> vector
+ val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> vector * 'a
val unsafeSub: vector * int -> elem
val vector: int * elem -> vector
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun 2006-04-19 02:46:47 UTC (rev 4399)
@@ -35,6 +35,8 @@
fun wrap1 f = fn (i) => f (SeqIndex.toIntUnsafe i)
fun wrap2 f = fn (i, x) => f (SeqIndex.toIntUnsafe i, x)
fun wrap3 f = fn (i, x, y) => f (SeqIndex.toIntUnsafe i, x, y)
+ fun unwrap1 f = fn (i) => f (SeqIndex.fromIntUnsafe i)
+ fun unwrap2 f = fn (i, x) => f (SeqIndex.fromIntUnsafe i, x)
type 'a sequence = 'a S.sequence
type 'a elt = 'a S.elt
@@ -90,30 +92,70 @@
fun seq0 () = S.fromArray (arrayUninit' 0)
+ fun generate' (n, f) =
+ let
+ val a = arrayUninit' n
+ val subLim = ref 0
+ fun sub i =
+ if Primitive.Controls.safe andalso geu (i, !subLim)
+ then raise Subscript
+ else Array.subUnsafe (a, i)
+ val updateLim = ref 0
+ fun update (i, x) =
+ if Primitive.Controls.safe andalso geu (i, !updateLim)
+ then raise Subscript
+ else Array.updateUnsafe (a, i, x)
+ val (tab, finish) = f {sub = sub, update = update}
+ fun loop i =
+ if i >= n
+ then ()
+ else let
+ val () = Array.updateUnsafe (a, i, tab i)
+ val () = subLim := i +? 1
+ val () = updateLim := i +? 1
+ in
+ loop (i +? 1)
+ end
+ val () = loop 0
+ val () = finish ()
+ val () = updateLim := 0
+ in
+ S.fromArray a
+ end
+ fun generate (n, f) =
+ generate' (fromIntForLength n,
+ fn {sub, update} =>
+ let
+ val (tab, finish) =
+ f {sub = unwrap1 sub, update = unwrap2 update}
+ in
+ (wrap1 tab, finish)
+ end)
+
fun unfoldi' (n, b, f) =
let
val a = arrayUninit' n
fun loop (i, b) =
if i >= n
- then ()
+ then b
else
let
val (x, b') = f (i, b)
- val _ = Array.updateUnsafe (a, i, x)
+ val () = Array.updateUnsafe (a, i, x)
in
loop (i +? 1, b')
end
- val _ = loop (0, b)
+ val b = loop (0, b)
in
- S.fromArray a
+ (S.fromArray a, b)
end
fun unfoldi (n, b, f) = unfoldi' (fromIntForLength n, b, wrap2 f)
fun unfold (n, b, f) = unfoldi (n, b, f o #2)
fun tabulate' (n, f) =
- unfoldi' (n, (), fn (i, ()) => (f i, ()))
+ #1 (unfoldi' (n, (), fn (i, ()) => (f i, ())))
fun tabulate (n, f) =
- unfoldi (n, (), fn (i, ()) => (f i, ()))
+ #1 (unfoldi (n, (), fn (i, ()) => (f i, ())))
fun new' (n, x) = tabulate' (n, fn _ => x)
fun new (n, x) = tabulate (n, fn _ => x)
@@ -328,13 +370,13 @@
val l2 = length' sl2
val n = (l1 + l2) handle Overflow => raise Size
in
- unfoldi' (n, (0, sl1),
- fn (_, (i, sl)) =>
- if SeqIndex.< (i, length' sl)
- then (unsafeSub' (sl, i),
- (i +? 1, sl))
- else (unsafeSub' (sl2, 0),
- (1, sl2)))
+ #1 (unfoldi'
+ (n, (0, sl1), fn (_, (i, sl)) =>
+ if SeqIndex.< (i, length' sl)
+ then (unsafeSub' (sl, i),
+ (i +? 1, sl))
+ else (unsafeSub' (sl2, 0),
+ (1, sl2))))
end
fun concat (sls: 'a slice list): 'a sequence =
case sls of
@@ -346,18 +388,18 @@
(List.foldl (fn (sl, s) => s +? length' sl) 0 sls')
handle Overflow => raise Size
in
- unfoldi' (n, (0, sl, sls),
- fn (_, ac) =>
- let
- fun loop (i, sl, sls) =
- if SeqIndex.< (i, length' sl)
- then (unsafeSub' (sl, i),
- (i +? 1, sl, sls))
- else case sls of
- [] => raise Fail "Sequence.Slice.concat"
- | sl :: sls => loop (0, sl, sls)
- in loop ac
- end)
+ #1 (unfoldi'
+ (n, (0, sl, sls), fn (_, ac) =>
+ let
+ fun loop (i, sl, sls) =
+ if SeqIndex.< (i, length' sl)
+ then (unsafeSub' (sl, i),
+ (i +? 1, sl, sls))
+ else case sls of
+ [] => raise Fail "Sequence.Slice.concat"
+ | sl :: sls => loop (0, sl, sls)
+ in loop ac
+ end))
end
fun concatWith (sep: 'a sequence) (sls: 'a slice list): 'a sequence =
let val sep = full sep
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig 2006-04-19 02:46:47 UTC (rev 4399)
@@ -80,12 +80,22 @@
val create: (SeqIndex.int * (SeqIndex.int -> 'b elt) -> 'c) ->
('a elt -> 'b elt) -> 'a sequence -> 'c
val duplicate: 'a sequence -> 'a sequence
+ val generate':
+ SeqIndex.int * ({sub: SeqIndex.int -> 'a elt,
+ update: SeqIndex.int * 'a elt -> unit}
+ -> (SeqIndex.int -> 'a elt) * (unit -> unit))
+ -> 'a sequence
+ val generate:
+ int * ({sub: int -> 'a elt,
+ update: int * 'a elt -> unit}
+ -> (int -> 'a elt) * (unit -> unit))
+ -> 'a sequence
val newUninit': SeqIndex.int -> 'a sequence
val newUninit: int -> 'a sequence
val new': SeqIndex.int * 'a elt -> 'a sequence
val new: int * 'a elt -> 'a sequence
val toList: 'a sequence -> 'a elt list
- val unfoldi': SeqIndex.int * 'a * (SeqIndex.int * 'a -> 'b elt * 'a) -> 'b sequence
- val unfoldi: int * 'a * (int * 'a -> 'b elt * 'a) -> 'b sequence
- val unfold: int * 'a * ('a -> 'b elt * 'a) -> 'b sequence
+ val unfoldi': SeqIndex.int * 'b * (SeqIndex.int * 'b -> 'a elt * 'b) -> 'a sequence * 'b
+ val unfoldi: int * 'b * (int * 'b -> 'a elt * 'b) -> 'a sequence * 'b
+ val unfold: int * 'b * ('b -> 'a elt * 'b) -> 'a sequence * 'b
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sig 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sig 2006-04-19 02:46:47 UTC (rev 4399)
@@ -47,9 +47,13 @@
val fields: ('a -> bool) -> 'a vector -> 'a vector list
val append: 'a vector * 'a vector -> 'a vector
+ val create:
+ int * ({sub: int -> 'a, update: int * 'a -> unit}
+ -> (int -> 'a) * (unit -> unit))
+ -> 'a vector
val duplicate: 'a vector -> 'a vector
val tabulate': SeqIndex.int * (SeqIndex.int -> 'a) -> 'a vector
val toList: 'a vector -> 'a list
- val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b vector
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a vector * 'b
val vector: int * 'a -> 'a vector
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sml 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sml 2006-04-19 02:46:47 UTC (rev 4399)
@@ -60,6 +60,8 @@
val fromArray = Primitive.Vector.fromArray
val vector = new
+
+ fun create (n, f) = generate (n, f)
end
structure VectorSlice: VECTOR_SLICE_EXTRA = Vector.VectorSlice
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-19 02:46:47 UTC (rev 4399)
@@ -65,6 +65,7 @@
end end
../general/general.sig
../general/general.sml
+ ../util/one.sml
../general/option.sig
../general/option.sml
../list/list.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml 2006-04-19 02:46:47 UTC (rev 4399)
@@ -60,9 +60,11 @@
* The most that will be required is for minInt in binary.
*)
val maxNumDigits = Int.+ (precision', 1)
- val buf = CharArray.array (maxNumDigits, #"\000")
+ val oneBuf = One.make (fn () => CharArray.array (maxNumDigits, #"\000"))
in
fun fmt radix (n: int): string =
+ One.use
+ (oneBuf, fn buf =>
let
val radix = fromInt (StringCvt.radixToInt radix)
fun loop (q, i: Int.int) =
@@ -93,7 +95,7 @@
end
in
loop (if n < zero then n else ~? n, Int.- (maxNumDigits, 1))
- end
+ end)
end
val toString = fmt StringCvt.DEC
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/array.sig 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/array.sig 2006-04-19 02:46:47 UTC (rev 4399)
@@ -10,5 +10,5 @@
signature MLTON_ARRAY =
sig
- val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a array
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a array * 'b
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml 2006-04-19 02:46:47 UTC (rev 4399)
@@ -24,42 +24,41 @@
type 'a t = (unit -> 'a) -> unit
fun callcc (f: 'a t -> 'a): 'a =
- (dummy ()
- ; if MLtonThread.amInSignalHandler ()
- then die "callcc can not be used in a signal handler\n"
- else
- let
- datatype 'a state =
- Original of 'a t -> 'a
- | Copy of unit -> 'a
- | Clear
- val r: 'a state ref = ref (Original f)
- val _ = Thread.atomicBegin () (* Match 1 *)
- val _ = Thread.copyCurrent ()
- in
- case (!r before r := Clear) of
- Clear => raise Fail "callcc saw Clear"
- | Copy v => (Thread.atomicEnd () (* Match 2 *)
- ; v ())
- | Original f =>
- let
- val t = Thread.savedPre gcState
- in
- Thread.atomicEnd () (* Match 1 *)
- ; f (fn v =>
- let
- val _ = Thread.atomicBegin () (* Match 2 *)
- val _ = r := Copy v
- val new = Thread.copy t
- (* The following Thread.atomicBegin ()
- * is matched by Thread.switchTo.
- *)
- val _ = Thread.atomicBegin ()
- in
- Thread.switchTo new
- end)
- end
- end)
+ if MLtonThread.amInSignalHandler ()
+ then die "callcc can not be used in a signal handler\n"
+ else
+ let
+ datatype 'a state =
+ Original of 'a t -> 'a
+ | Copy of unit -> 'a
+ | Clear
+ val r: 'a state ref = ref (Original f)
+ val _ = Thread.atomicBegin () (* Match 1 *)
+ val _ = Thread.copyCurrent ()
+ in
+ case (!r before r := Clear) of
+ Clear => raise Fail "callcc saw Clear"
+ | Copy v => (Thread.atomicEnd () (* Match 2 *)
+ ; v ())
+ | Original f =>
+ let
+ val t = Thread.savedPre gcState
+ in
+ Thread.atomicEnd () (* Match 1 *)
+ ; f (fn v =>
+ let
+ val _ = Thread.atomicBegin () (* Match 2 *)
+ val _ = r := Copy v
+ val new = Thread.copy t
+ (* The following Thread.atomicBegin ()
+ * is matched by Thread.switchTo.
+ *)
+ val _ = Thread.atomicBegin ()
+ in
+ Thread.switchTo new
+ end)
+ end
+ end)
fun ('a, 'b) throw' (k: 'a t, v: unit -> 'a): 'b =
(k v; raise Fail "throw bug")
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/vector.sig 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/vector.sig 2006-04-19 02:46:47 UTC (rev 4399)
@@ -10,6 +10,10 @@
signature MLTON_VECTOR =
sig
- val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a vector
+ val create:
+ int * ({sub: int -> 'a, update: int * 'a -> unit}
+ -> (int -> 'a) * (unit -> unit))
+ -> 'a vector
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a vector * 'b
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-04-19 02:37:13 UTC (rev 4398)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-04-19 02:46:47 UTC (rev 4399)
@@ -31,11 +31,6 @@
val gcState = #1 _symbol "gcStateAddress": t GetSet.t; ()
end
-
-structure Callcc =
- struct
- val usesCallcc: bool ref = ref false
- end
structure CallStack =
struct
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/one.sml (from rev 4397, mlton/branches/on-20050822-x86_64-branch/basis-library/misc/one.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/misc/one.sml 2006-04-19 01:19:31 UTC (rev 4397)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/one.sml 2006-04-19 02:46:47 UTC (rev 4399)
@@ -0,0 +1,40 @@
+(* Copyright (C) 2006-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+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.MLton.Thread.atomicBegin ()
+ val b = ! staticIsInUse
+ val d =
+ if b then
+ (Primitive.MLton.Thread.atomicEnd ();
+ more ())
+ else
+ (staticIsInUse := true;
+ Primitive.MLton.Thread.atomicEnd ();
+ static)
+ in
+ DynamicWind.wind (fn () => f d,
+ fn () => if b then () else staticIsInUse := false)
+ end
+ end