more engine compat

Author: raphael-proust

src/unix/lwt_engine.ml

@@ -38,12 +38,14 @@ let _fake_event = {
 let fake_event = ref _fake_event
 
 type engine_id = ..
+type engine_id += Engine_id__other
 
 (* +-----------------------------------------------------------------+
    | Engines                                                         |
    +-----------------------------------------------------------------+ *)
 
 class virtual abstract = object(self)
+  method id = Engine_id__other
   method virtual iter : bool -> unit
   method virtual private cleanup : unit
   method virtual private register_readable : Unix.file_descr -> (unit -> unit) -> unit Lazy.t
@@ -174,9 +176,12 @@ external ev_io_stop : ev_loop -> ev_io -> unit = "lwt_libev_io_stop"
 external ev_timer_init : ev_loop -> float -> bool -> (unit -> unit) -> ev_timer = "lwt_libev_timer_init"
 external ev_timer_stop : ev_loop -> ev_timer -> unit  = "lwt_libev_timer_stop"
 
+type engine_id += Engine_id__libev of Ev_backend.t
 class libev ?(backend=Ev_backend.default) () = object
   inherit abstract
 
+  method! id = Engine_id__libev backend
+
   val loop = ev_init backend
   method loop = loop
 
@@ -332,9 +337,12 @@ class virtual select_or_poll_based = object
          if Lwt_sequence.is_empty actions then wait_writable <- Fd_map.remove fd wait_writable)
 end
 
+type engine_id += Engine_id__select
 class virtual select_based = object(self)
   inherit select_or_poll_based
 
+  method! id = Engine_id__select
+
   method private virtual select : Unix.file_descr list -> Unix.file_descr list -> float -> Unix.file_descr list * Unix.file_descr list
 
   method iter block =
@@ -367,9 +375,12 @@ class virtual select_based = object(self)
     List.iter (fun fd -> invoke_actions fd wait_writable) fds_w
 end
 
+type engine_id += Engine_id__poll
 class virtual poll_based = object(self)
   inherit select_or_poll_based
 
+  method! id = Engine_id__select
+
   method private virtual poll : (Unix.file_descr * bool * bool) list -> float -> (Unix.file_descr * bool * bool) list
 
   method iter block =
@@ -431,6 +442,7 @@ let set ?(transfer=true) ?(destroy=true) engine =
   if destroy then !current#destroy;
   current := (engine : #t :> t)
 
+let id () = !current#id
 let iter block = !current#iter block
 let on_readable fd f = !current#on_readable fd f
 let on_writable fd f = !current#on_writable fd f

src/unix/lwt_engine.mli

@@ -67,8 +67,11 @@ val forwards_signal : int -> bool
 
 type engine_id = ..
 
+val id : unit -> engine_id
+
 (** Abstract class for engines. *)
 class virtual abstract : object
+  method id : engine_id
   method destroy : unit
     (** Destroy the engine, remove all its events and free its
         associated resources. *)
@@ -144,6 +147,8 @@ end
 
   (** Type of libev loops. *)
 
+type engine_id += Engine_id__libev of Ev_backend.t
+
 (** Engine based on libev. If not compiled with libev support, the
     creation of the class will raise {!Lwt_sys.Not_available}. *)
 class libev : ?backend:Ev_backend.t -> unit -> object
@@ -160,6 +165,8 @@ class libev : ?backend:Ev_backend.t -> unit -> object
 end
 
 (** Engine based on {!Unix.select}. *)
+type engine_id += Engine_id__select
+type engine_id += Engine_id__poll
 class select : t
 
 (** Abstract class for engines based on a select-like function. *)