misc tuning and clarification;
authorwenzelm
Wed, 20 Feb 2019 20:03:42 +0100
changeset 69824 29c13d8813cb
parent 69823 93784805c6c5
child 69825 183c345b063e
misc tuning and clarification;
src/Pure/Concurrent/event_timer.ML
--- a/src/Pure/Concurrent/event_timer.ML	Wed Feb 20 13:58:52 2019 +0100
+++ b/src/Pure/Concurrent/event_timer.ML	Wed Feb 20 20:03:42 2019 +0100
@@ -9,7 +9,8 @@
 
 signature EVENT_TIMER =
 sig
-  eqtype request
+  type request
+  val eq_request: request * request -> bool
   val request: Time.time -> (unit -> unit) -> request
   val cancel: request -> bool
   val future: Time.time -> unit future
@@ -21,45 +22,50 @@
 
 (* type request *)
 
-val request_counter = Counter.make ();
-datatype request = Request of int;
-fun new_request () = Request (request_counter ());
+val request_id = Counter.make ();
+
+datatype request = Request of {id: int, event: unit -> unit};
+
+fun new_request event = Request {id = request_id (), event = event};
+
+fun eq_request (Request {id = id1, ...}, Request {id = id2, ...}) = id1 = id2;
 
 
 (* type requests *)
 
 structure Requests = Table(type key = Time.time val ord = Time.compare);
-type requests = (request * (unit -> unit)) list Requests.table;
+type requests = request list Requests.table;
 
-fun add_request time entry (requests: requests) =
-  Requests.cons_list (time, entry) requests;
+fun add req_time req (requests: requests) =
+  Requests.cons_list (req_time, req) requests;
 
-fun del_request req (requests: requests) =
+fun del req (requests: requests) =
   let
-    val old_request =
-      requests |> Requests.get_first (fn (key, entries) =>
-        entries |> get_first (fn entry => if fst entry = req then SOME (key, entry) else NONE));
+    val old =
+      requests |> Requests.get_first (fn (key, reqs) =>
+        reqs |> get_first (fn req' =>
+          if eq_request (req', req) then SOME (key, req') else NONE));
   in
-    (case old_request of
+    (case old of
       NONE => (false, requests)
-    | SOME old => (true, Requests.remove_list (eq_fst op =) old requests))
+    | SOME req' => (true, Requests.remove_list eq_request req' requests))
   end;
 
-fun next_request_time (requests: requests) =
-  Option.map fst (Requests.min requests);
+fun next_time (requests: requests) =
+  Option.map #1 (Requests.min requests);
 
-fun next_request_event time (requests: requests) =
+fun next_event time (requests: requests) =
   (case Requests.min requests of
     NONE => NONE
-  | SOME (request_time, entries) =>
-      if time < request_time then NONE
+  | SOME (req_time, reqs) =>
+      if time < req_time then NONE
       else
         let
-          val (rest, (_, event)) = split_last entries;
+          val (reqs', Request {event, ...}) = split_last reqs;
           val requests' =
-            if null rest
-            then Requests.delete request_time requests
-            else Requests.update (request_time, rest) requests;
+            if null reqs'
+            then Requests.delete req_time requests
+            else Requests.update (req_time, reqs') requests;
         in SOME (event, requests') end);
 
 
@@ -89,9 +95,9 @@
 
 fun manager_loop () =
   if Synchronized.timed_access state
-    (fn State {requests, ...} => next_request_time requests)
+    (fn State {requests, ...} => next_time requests)
     (fn st as State {requests, status, manager} =>
-      (case next_request_event (Time.now ()) requests of
+      (case next_event (Time.now ()) requests of
         SOME (event, requests') =>
           let
             val _ = Exn.capture event ();
@@ -133,25 +139,24 @@
 fun request time event =
   Synchronized.change_result state (fn State {requests, status, manager} =>
     let
-      val req = new_request ();
-      val requests' = add_request time (req, event) requests;
+      val req = new_request event;
+      val requests' = add time req requests;
       val manager' = manager_check manager;
     in (req, make_state (requests', status, manager')) end);
 
 fun cancel req =
   Synchronized.change_result state (fn State {requests, status, manager} =>
     let
-      val (canceled, requests') = del_request req requests;
+      val (canceled, requests') = del req requests;
       val manager' = manager_check manager;
     in (canceled, make_state (requests', status, manager')) end);
 
 val future = Thread_Attributes.uninterruptible (fn _ => fn time =>
   let
-    val req: request Single_Assignment.var = Single_Assignment.var "request";
+    val req: request Single_Assignment.var = Single_Assignment.var "req";
     fun abort () = ignore (cancel (Single_Assignment.await req));
     val promise: unit future = Future.promise_name "event_timer" abort;
     val _ = Single_Assignment.assign req (request time (Future.fulfill promise));
   in promise end);
 
 end;
-