From 61b1018760dd54b9a7f5c80ac7afb7fc6cf26258 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Mon, 15 Jul 2013 11:55:07 +0100
Subject: [PATCH 2/2] lazy initialization of dynlinked plugins

---
 otherlibs/dynlink/dynlink.ml    |   60 ++++++++++++++++++++++----------------
 otherlibs/dynlink/dynlink.mli   |    6 ++++
 otherlibs/dynlink/natdynlink.ml |   32 +++++++++++++--------
 3 files changed, 61 insertions(+), 37 deletions(-)

diff --git a/otherlibs/dynlink/dynlink.ml b/otherlibs/dynlink/dynlink.ml
index 89e21aa..45e1b26 100644
--- a/otherlibs/dynlink/dynlink.ml
+++ b/otherlibs/dynlink/dynlink.ml
@@ -224,13 +224,14 @@ let load_compunit ic file_name file_digest compunit =
   let digest = Digest.string (file_digest ^ compunit.cu_name) in
   register_code_fragment code code_size digest;
   begin try
-    ignore((Meta.reify_bytecode code code_size) ())
+    let f = Meta.reify_bytecode code code_size in
+    fun () -> ignore (f ())
   with exn ->
     Symtable.restore_state initial_symtable;
     raise exn
   end

-let loadfile file_name =
+let loadfile_lazy file_name =
   init();
   if not (Sys.file_exists file_name) then raise(Error (File_not_found file_name));
   let ic = open_in_bin file_name in
@@ -241,42 +242,51 @@ let loadfile file_name =
       try Misc.input_bytes ic (String.length Config.cmo_magic_number)
       with End_of_file -> raise (Error (Not_a_bytecode_file file_name))
     in
-    if buffer = Config.cmo_magic_number then begin
-      let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
-      seek_in ic compunit_pos;
-      let cu = (input_value ic : compilation_unit) in
-      load_compunit ic file_name file_digest cu
-    end else
-    if buffer = Config.cma_magic_number then begin
-      let toc_pos = input_binary_int ic in  (* Go to table of contents *)
-      seek_in ic toc_pos;
-      let lib = (input_value ic : library) in
-      begin try
-        Dll.open_dlls Dll.For_execution
-                      (List.map Dll.extract_dll_name lib.lib_dllibs)
-      with Failure reason ->
-        raise(Error(Cannot_open_dll reason))
-      end;
-      List.iter (load_compunit ic file_name file_digest) lib.lib_units
-    end else
-      raise(Error(Not_a_bytecode_file file_name));
-    close_in ic
+    let run =
+      if buffer = Config.cmo_magic_number then begin
+        let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
+        seek_in ic compunit_pos;
+        let cu = (input_value ic : compilation_unit) in
+        let f = load_compunit ic file_name file_digest cu in
+        Lazy.lazy_from_fun f
+      end else
+      if buffer = Config.cma_magic_number then begin
+        let toc_pos = input_binary_int ic in  (* Go to table of contents *)
+        seek_in ic toc_pos;
+        let lib = (input_value ic : library) in
+        begin try
+          Dll.open_dlls Dll.For_execution
+                        (List.map Dll.extract_dll_name lib.lib_dllibs)
+        with Failure reason ->
+          raise(Error(Cannot_open_dll reason))
+        end;
+        let l = List.map (load_compunit ic file_name file_digest) lib.lib_units in
+        lazy (List.iter (fun f -> f ()) l)
+      end else
+        raise(Error(Not_a_bytecode_file file_name));
+    in
+    close_in ic;
+    run
   with exc ->
     close_in ic; raise exc

-let loadfile_private file_name =
+let loadfile_private_lazy file_name =
   init();
   let initial_symtable = Symtable.current_state()
   and initial_crc = !crc_interfaces in
   try
-    loadfile file_name;
+    let run = loadfile_lazy file_name in
     Symtable.hide_additions initial_symtable;
-    crc_interfaces := initial_crc
+    crc_interfaces := initial_crc;
+    run
   with exn ->
     Symtable.hide_additions initial_symtable;
     crc_interfaces := initial_crc;
     raise exn

+let loadfile filename = Lazy.force (loadfile_lazy filename)
+let loadfile_private filename = Lazy.force (loadfile_private_lazy filename)
+
 (* Error report *)

 let error_message = function
diff --git a/otherlibs/dynlink/dynlink.mli b/otherlibs/dynlink/dynlink.mli
index 4ced876..1a26b51 100644
--- a/otherlibs/dynlink/dynlink.mli
+++ b/otherlibs/dynlink/dynlink.mli
@@ -36,6 +36,12 @@ val loadfile_private : string -> unit
     are hidden (cannot be referenced) from other modules dynamically
     loaded afterwards. *)

+val loadfile_lazy : string -> unit Lazy.t
+(** Same as [loadfile], except that the initialization of the module is deferred. It will
+    be performed when the returned lazy value is forced. *)
+
+val loadfile_private_lazy : string -> unit Lazy.t
+
 val adapt_filename : string -> string
 (** In bytecode, the identity function. In native code, replace the last
     extension with [.cmxs]. *)
diff --git a/otherlibs/dynlink/natdynlink.ml b/otherlibs/dynlink/natdynlink.ml
index fd06d7c..886e5e7 100644
--- a/otherlibs/dynlink/natdynlink.ml
+++ b/otherlibs/dynlink/natdynlink.ml
@@ -71,7 +71,7 @@ let read_file filename priv =
 module StrMap = Map.Make(String)

 type implem_state =
-  | Loaded
+  | Loaded of unit Lazy.t
   | Check_inited of int

 type state = {
@@ -153,12 +153,20 @@ let check_implems filename ui implems =
            | Check_inited i ->
                if ndl_globals_inited() < i
                then raise(Error(Unavailable_unit name))
-           | Loaded -> ()
+           | Loaded init ->
+               if not (Lazy.is_val init)
+               then raise(Error(Unavailable_unit name))
        with Not_found ->
          raise (Error(Unavailable_unit name))
     ) ui.dynu_imports_cmx

 let loadunits filename handle units state =
+  let defines = List.flatten (List.map (fun ui -> ui.dynu_defines) units) in
+  let run = lazy (
+    ndl_run handle "_shared_startup";
+    List.iter (ndl_run handle) defines;
+  ) in
+
   let new_ifaces =
     List.fold_left
       (fun accu ui -> add_check_ifaces !allow_extension filename ui accu)
@@ -167,23 +175,23 @@ let loadunits filename handle units state =
     List.fold_left
       (fun accu ui ->
          check_implems filename ui accu;
-         StrMap.add ui.dynu_name (ui.dynu_crc,filename,Loaded) accu)
+         StrMap.add ui.dynu_name (ui.dynu_crc,filename,Loaded run) accu)
       state.implems units in

-  let defines = List.flatten (List.map (fun ui -> ui.dynu_defines) units) in
-
-  ndl_run handle "_shared_startup";
-  List.iter (ndl_run handle) defines;
-  { implems = new_implems; ifaces = new_ifaces }
+  (run, { implems = new_implems; ifaces = new_ifaces })

 let load priv filename =
   init();
   let (filename,handle,units) = read_file filename priv in
-  let nstate = loadunits filename handle units !global_state in
-  if not priv then global_state := nstate
+  let run, nstate = loadunits filename handle units !global_state in
+  if not priv then global_state := nstate;
+  run
+
+let loadfile_lazy filename = load false filename
+let loadfile_private_lazy filename = load true filename

-let loadfile filename = load false filename
-let loadfile_private filename = load true filename
+let loadfile filename = Lazy.force (loadfile_lazy filename)
+let loadfile_private filename = Lazy.force (loadfile_private_lazy filename)

 let allow_only names =
   init();
--
1.7.1