tuned signature (again);
authorwenzelm
Fri, 19 Aug 2011 17:39:37 +0200
changeset 44301 65f60d9ac4bf
parent 44300 349cc426d929
child 44302 0a1934c5c104
tuned signature (again); tuned;
src/Pure/Concurrent/future.ML
src/Pure/PIDE/document.ML
src/Pure/PIDE/isar_document.ML
--- a/src/Pure/Concurrent/future.ML	Fri Aug 19 16:13:26 2011 +0200
+++ b/src/Pure/Concurrent/future.ML	Fri Aug 19 17:39:37 2011 +0200
@@ -52,6 +52,9 @@
   val peek: 'a future -> 'a Exn.result option
   val is_finished: 'a future -> bool
   val get_finished: 'a future -> 'a
+  val interruptible_task: ('a -> 'b) -> 'a -> 'b
+  val cancel_group: group -> task list
+  val cancel: 'a future -> task list
   type fork_params =
     {name: string, group: group option, deps: task list, pri: int, interrupts: bool}
   val forks: fork_params -> (unit -> 'a) list -> 'a future list
@@ -60,12 +63,10 @@
   val join_results: 'a future list -> 'a Exn.result list
   val join_result: 'a future -> 'a Exn.result
   val join: 'a future -> 'a
+  val join_tasks: task list -> unit
   val value_result: 'a Exn.result -> 'a future
   val value: 'a -> 'a future
   val map: ('a -> 'b) -> 'a future -> 'b future
-  val cancel_group: group -> unit future
-  val cancel: 'a future -> unit future
-  val interruptible_task: ('a -> 'b) -> 'a -> 'b
   val cond_forks: fork_params -> (unit -> 'a) list -> 'a future list
   val promise_group: group -> (unit -> unit) -> 'a future
   val promise: (unit -> unit) -> 'a future
@@ -191,6 +192,17 @@
   broadcast scheduler_event);
 
 
+fun interruptible_task f x =
+  (if Multithreading.available then
+    Multithreading.with_attributes
+      (if is_some (worker_task ())
+       then Multithreading.private_interrupts
+       else Multithreading.public_interrupts)
+      (fn _ => f x)
+   else interruptible f x)
+  before Multithreading.interrupted ();
+
+
 (* worker threads *)
 
 fun worker_exec (task, jobs) =
@@ -386,7 +398,13 @@
   if scheduler_active () then ()
   else scheduler := SOME (Simple_Thread.fork false scheduler_loop));
 
-fun scheduler_cancel group = SYNCHRONIZED "scheduler_cancel" (fn () =>
+
+
+(** futures **)
+
+(* cancel *)
+
+fun cancel_group group = SYNCHRONIZED "cancel_group" (fn () =>
   let
     val running = cancel_now group;
     val _ =
@@ -394,9 +412,8 @@
       else (cancel_later group; signal work_available; scheduler_check ());
   in running end);
 
-
+fun cancel x = cancel_group (Task_Queue.group_of_task (task_of x));
 
-(** futures **)
 
 (* future jobs *)
 
@@ -467,7 +484,7 @@
     end;
 
 fun fork_pri pri e =
-  singleton (forks {name = "", group = NONE, deps = [], pri = pri, interrupts = true}) e;
+  (singleton o forks) {name = "fork", group = NONE, deps = [], pri = pri, interrupts = true} e;
 
 fun fork e = fork_pri 0 e;
 
@@ -519,6 +536,13 @@
 fun join_result x = singleton join_results x;
 fun join x = Exn.release (join_result x);
 
+fun join_tasks [] = ()
+  | join_tasks tasks =
+      (singleton o forks)
+        {name = "join_tasks", group = SOME (new_group NONE),
+          deps = tasks, pri = 0, interrupts = false} I
+      |> join;
+
 
 (* fast-path versions -- bypassing task queue *)
 
@@ -545,9 +569,9 @@
   in
     if extended then Future {promised = false, task = task, result = result}
     else
-      singleton
-        (forks {name = "Future.map", group = SOME group, deps = [task],
-          pri = Task_Queue.pri_of_task task, interrupts = true})
+      (singleton o forks)
+        {name = "map_future", group = SOME group, deps = [task],
+          pri = Task_Queue.pri_of_task task, interrupts = true}
         (fn () => f (join x))
   end;
 
@@ -556,29 +580,6 @@
   else map (fn e => value_result (Exn.interruptible_capture e ())) es;
 
 
-(* cancel *)
-
-fun cancel_group group =
-  (case scheduler_cancel group of
-    [] => value ()
-  | running =>
-      singleton
-        (forks {name = "cancel_group", group = SOME (new_group NONE),
-          deps = running, pri = 0, interrupts = false}) I);
-
-fun cancel x = cancel_group (Task_Queue.group_of_task (task_of x));
-
-fun interruptible_task f x =
-  (if Multithreading.available then
-    Multithreading.with_attributes
-      (if is_some (worker_task ())
-       then Multithreading.private_interrupts
-       else Multithreading.public_interrupts)
-      (fn _ => f x)
-   else interruptible f x)
-  before Multithreading.interrupted ();
-
-
 (* promised futures -- fulfilled by external means *)
 
 fun promise_group group abort : 'a future =
--- a/src/Pure/PIDE/document.ML	Fri Aug 19 16:13:26 2011 +0200
+++ b/src/Pure/PIDE/document.ML	Fri Aug 19 17:39:37 2011 +0200
@@ -24,7 +24,7 @@
   type state
   val init_state: state
   val join_commands: state -> unit
-  val cancel_execution: state -> unit future
+  val cancel_execution: state -> Future.task list
   val define_command: command_id -> string -> state -> state
   val edit: version_id -> version_id -> edit list -> state -> (command_id * exec_id) list * state
   val execute: version_id -> state -> state
--- a/src/Pure/PIDE/isar_document.ML	Fri Aug 19 16:13:26 2011 +0200
+++ b/src/Pure/PIDE/isar_document.ML	Fri Aug 19 17:39:37 2011 +0200
@@ -30,9 +30,9 @@
                   fn ([a], []) => Document.Header (Exn.Exn (ERROR a))]))
             end;
 
-      val cancellation = Document.cancel_execution state;
+      val running = Document.cancel_execution state;
       val (updates, state') = Document.edit old_id new_id edits state;
-      val _ = Future.join cancellation;
+      val _ = Future.join_tasks running;
       val _ = Document.join_commands state';
       val _ =
         Output.status (Markup.markup (Markup.assign new_id)