[MLton-commit] r6616

[Matthew Fluet]

Drop all but final implementation of isolate

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

U   mlton/trunk/basis-library/mlton/cont.sml

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

Modified: mlton/trunk/basis-library/mlton/cont.sml
===================================================================
--- mlton/trunk/basis-library/mlton/cont.sml	2008-05-10 11:42:47 UTC (rev 6615)
+++ mlton/trunk/basis-library/mlton/cont.sml	2008-05-10 11:42:52 UTC (rev 6616)
@@ -69,160 +69,8 @@
 
 fun prepend (k, f) v = throw' (k, f o v)
 
-
-(* ********** *)
-val isolate: ('a -> unit) -> 'a t =
-   fn (f: 'a -> unit) =>
-   callcc
-   (fn k1 =>
-    let
-       val x = callcc (fn k2 => throw (k1, k2))
-       val _ = (f x ; Exit.topLevelSuffix ())
-               handle exn => MLtonExn.topLevelHandler exn
-    in
-       raise Fail "MLton.Cont.isolate: return from (wrapped) func"
-    end)
-
-(* ********** *)
 local
-val base: (unit -> unit) t =
-   callcc
-   (fn k1 =>
-    let
-       val th = callcc (fn k2 => throw (k1, k2))
-       val _ = (th () ; Exit.topLevelSuffix ())
-               handle exn => MLtonExn.topLevelHandler exn
-    in
-       raise Fail "MLton.Cont.isolate: return from (wrapped) func"
-    end)
-in
-val isolate: ('a -> unit) -> 'a t =
-   fn (f: 'a -> unit) =>
-   callcc
-   (fn k1 =>
-    let
-       val x = callcc (fn k2 => throw (k1, k2))
-    in
-       throw (base, fn () => f x)
-    end)
-end
-
-(* ********** *)
-local
-val base: (unit -> unit) t =
-   callcc
-   (fn k1 =>
-    let
-       val th = callcc (fn k2 => throw (k1, k2))
-       val _ = (th () ; Exit.topLevelSuffix ())
-               handle exn => MLtonExn.topLevelHandler exn
-    in
-       raise Fail "MLton.Cont.isolate: return from (wrapped) func"
-    end)
-in
-val isolate: ('a -> unit) -> 'a t =
-   fn (f: 'a -> unit) =>
-   callcc
-   (fn k1 =>
-    throw (base, fn () =>
-           let
-              val x = callcc (fn k2 => throw (k1, k2))
-           in
-              throw (base, fn () => f x)
-           end))
-end
-
-(* ********** *)
-local
-val base: (unit -> unit) option t =
-   let
-      val baseRef: (unit -> unit) option t option ref = ref NONE
-      val th = callcc (fn k => (baseRef := SOME k; NONE))
-   in
-      case th of
-         NONE => (case !baseRef of
-                     NONE => raise Fail "MLton.Cont.isolate: missing base"
-                   | SOME base => base)
-       | SOME th => let
-                       val _ = (th () ; Exit.topLevelSuffix ())
-                               handle exn => MLtonExn.topLevelHandler exn
-                    in
-                       raise Fail "MLton.Cont.isolate: return from (wrapped) func"
-                    end
-   end
-in
-val isolate: ('a -> unit) -> 'a t =
-   fn (f: 'a -> unit) =>
-   callcc
-   (fn k1 =>
-    throw (base, SOME (fn () =>
-           let
-              val x = callcc (fn k2 => throw (k1, k2))
-           in
-              throw (base, SOME (fn () => f x))
-           end)))
-end
-
-(* ********** *)
-local
-val base: (unit -> unit) option t =
-   let
-      val baseRef: (unit -> unit) option t ref =
-         ref (fn _ => raise Fail "MLton.Cont.isolate: missing base")
-      val th = callcc (fn k => (baseRef := k; NONE))
-   in
-      case th of
-         NONE => !baseRef
-       | SOME th => let
-                       val _ = (th () ; Exit.topLevelSuffix ())
-                               handle exn => MLtonExn.topLevelHandler exn
-                    in
-                       raise Fail "MLton.Cont.isolate: return from (wrapped) func"
-                    end
-   end
-in
-val isolate: ('a -> unit) -> 'a t =
-   fn (f: 'a -> unit) =>
-   fn (v: unit -> 'a) =>
-   throw (base, SOME (f o v))
-end
-
-(* ********** *)
-local
 val thRef: (unit -> unit) option ref = ref NONE
-val base: unit t =
-   let
-      val baseRef: unit t ref =
-         ref (fn _ => raise Fail "MLton.Cont.isolate: missing base")
-      val () = callcc (fn k => baseRef := k)
-   in
-      case !thRef of
-         NONE => !baseRef
-       | SOME th =>
-            let
-               val _ = thRef := NONE
-               val _ = Thread.atomicEnd () (* Match 1 *)
-               val _ = (th () ; Exit.topLevelSuffix ())
-                       handle exn => MLtonExn.topLevelHandler exn
-            in
-               raise Fail "MLton.Cont.isolate: return from (wrapped) func"
-            end
-   end
-in
-val isolate: ('a -> unit) -> 'a t =
-   fn (f: 'a -> unit) =>
-   fn (v: unit -> 'a) =>
-   let
-      val _ = Thread.atomicBegin () (* Match 1 *)
-      val () = thRef := SOME (f o v)
-   in
-      throw (base, ())
-   end
-end
-
-(* ********** *)
-local
-val thRef: (unit -> unit) option ref = ref NONE
 val base: Thread.preThread =
    let
       val () = Thread.copyCurrent ()
@@ -253,67 +101,4 @@
    end
 end
 
-(* ********** *)
-local
-val thRef: (unit -> unit) option ref = ref NONE
-val base: Thread.preThread =
-   let
-      val () = Thread.copyCurrent ()
-   in
-      case !thRef of
-         NONE => Thread.savedPre ()
-       | SOME th =>
-            let
-               val () = thRef := NONE
-               val _ = (th () ; Exit.topLevelSuffix ())
-                       handle exn => MLtonExn.topLevelHandler exn
-            in
-               raise Fail "MLton.Cont.isolate: return from (wrapped) func"
-            end
-   end
-in
-val isolate: ('a -> unit) -> 'a t =
-   fn (f: 'a -> unit) =>
-   fn (v: unit -> 'a) =>
-   let
-      val () = thRef := SOME (f o v)
-      val new = Thread.copy base
-   in
-      Thread.switchTo new
-   end
 end
-
-(* ********** *)
-local
-val thRef: (unit -> unit) option ref = ref NONE
-val base: Thread.preThread =
-   let
-      val () = Thread.copyCurrent ()
-   in
-      case !thRef of
-         NONE => Thread.savedPre ()
-       | SOME th =>
-            let
-               val () = thRef := NONE
-               val () = Thread.atomicEnd () (* Match 1 *)
-               val _ = (th () ; Exit.topLevelSuffix ())
-                       handle exn => MLtonExn.topLevelHandler exn
-            in
-               raise Fail "MLton.Cont.isolate: return from (wrapped) func"
-            end
-   end
-in
-val isolate: ('a -> unit) -> 'a t =
-   fn (f: 'a -> unit) =>
-   fn (v: unit -> 'a) =>
-   let
-      val _ = Thread.atomicBegin () (* Match 1 *)
-      val _ = Thread.atomicBegin () (* Match 2 *)
-      val () = thRef := SOME (f o v)
-      val new = Thread.copy base
-   in
-      Thread.switchTo new (* Match 2 *)
-   end
-end
-
-end