Re: [Caml-list] Dependencies between plugins

["François Bobot" <francois.bobot@cea.fr>]

[-- Attachment #1: Type: text/plain, Size: 3269 bytes --]

On 03/03/2015 15:55, Gerd Stolpmann wrote:
> Am Dienstag, den 03.03.2015, 14:15 +0100 schrieb François Bobot:
>> Gerd, do you think that something that does that could be added to ocamlfind? One tricky thing is to
>> know the library statically linked (ie. `Ocsigen_config.builtin_packages`), perhaps ocamlfind can
>> during linking add this information.
>
> I think so. For toploops, there is already code that tracks libraries
> already linked into the executable (i.e. if you ocamlmktop your
> toploop).

All was already in place indeed! It was easy to add. I kept caml-list in CC for discussing the big 
picture in order to get comments from people. Is mail still your preferred way of receiving patch?

I kept it simple, no hack (no automatic: cmxa -> cmxs) because I prefer problems in library META to 
be found than to be paper over.

The first patch adds:
- A library `findlib.dynlink` that depends on `findlib` and `dynlink`
- During linking (using `ocamlfind ocaml*`) if `-package findlib.dynlink` and `-linkpkg` are used 
then a module `Findlib_initl...` is linked after all packages and it stores the names of packages 
linked in `Findlib.linked_packages`.
- In the main program `Fl_dynlink.load_packages ["yojson"]` can be used to dynlink packages

The second patch forbids to run `Fl_dynlink.load_packages` during the initialization of packages 
(statically or dynamically linked), because `Findlib_initl...` is not yet run and because if you 
want to load a package that depend on a statically linked package not yet initialized, there is no 
sane semantic.

Problems:
- The package is named `findlib.dynlink`, the archive `findlib_dynlink.cm*` and the module 
`Fl_dynlink` ...
- If you don't use `-linkall` static packages could only be partially linked, and you can't link the 
remaining part later. So perhaps `-linkall` must be automatically added if `findlib.dynlink` is used.
- If you define `archive(native)` and not `archive(native,plugin)` the error is not nice (in 
Dynlink.Error). Perhaps I should add a `Package_not_dynamically_loadable of string` error, that 
should catch the loading of something else than `*.cmxs`.
- Often you link your binary with your own library without using `-package` (the library is not yet 
installed), and plugins for your tools depend on your library. Currently you should do before any 
`Fl_dynlink.load_packages`: `Findlib.linked_packages := "mylib"::Findlib.linked_packages`. For 
simplicity, I don't know if I should add a function `Fl_dynlink.add_linked_packages`, or an option 
to ocamlfind `-additional-package-statically-linked `.
- During the initialization of your own library (linked without -package) you should not use 
`Fl_dynlink.load_packages`, but the library doesn't protect you against this error.

Choices:
- If you don't link with `findlib.dynlink` or use `create_toploop`, the variables 
`Findlib.linked_packages` and `Findlib.linked_predicates` are empty because I don't wanted to add 
backward change by adding `Findlib_initl...` when `findlib` is linked.


Remains to do:
- Fix problems
- Documentations (add `plugin` in the list of standard predicates, ...)


Gerg, what do you think of this first version of the patch? Of the way to fix the problems?

Thanks,

Regards,

-- 
François

[-- Attachment #2: 0001-Dynlink-add-utilities-for-dynamic-linking-packages.patch --]
[-- Type: text/x-diff, Size: 7795 bytes --]

From ce9c7aab9b883a7130ce1b350583c79365e82423 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= <francois.bobot@cea.fr>
Date: Tue, 3 Mar 2015 23:50:00 +0100
Subject: [PATCH 1/2] [Dynlink] add utilities for dynamic linking packages

---
 src/findlib/META.in        | 10 ++++++++++
 src/findlib/Makefile       | 19 ++++++++++++++++---
 src/findlib/findlib.ml     |  4 ++++
 src/findlib/findlib.mli    |  7 +++++++
 src/findlib/fl_dynlink.ml  | 25 +++++++++++++++++++++++++
 src/findlib/fl_dynlink.mli |  9 +++++++++
 src/findlib/frontend.ml    | 13 ++++++++-----
 7 files changed, 79 insertions(+), 8 deletions(-)
 create mode 100644 src/findlib/fl_dynlink.ml
 create mode 100644 src/findlib/fl_dynlink.mli

diff --git a/src/findlib/META.in b/src/findlib/META.in
index e19bcad..859bcc7 100644
--- a/src/findlib/META.in
+++ b/src/findlib/META.in
@@ -6,3 +6,13 @@ archive(byte) = "findlib.cma"
 archive(byte,toploop) = "findlib.cma findlib_top.cma"
 archive(byte,create_toploop) = "findlib.cma findlib_top.cma"
 archive(native) = "findlib.cmxa"
+
+package "dynlink" (
+  description = "Package manager dynamic linker"
+  requires = "findlib dynlink"
+  archive(byte) = "findlib_dynlink.cma"
+  archive(native) = "findlib_dynlink.cmxa"
+#Even if it strange and discouraged to dynlink this package
+  archive(byte,plugin) = "findlib_dynlink.cma"
+  archive(native,plugin) = "findlib_dynlink.cmxs"
+)
\ No newline at end of file
diff --git a/src/findlib/Makefile b/src/findlib/Makefile
index bdd7f14..cbfec7b 100644
--- a/src/findlib/Makefile
+++ b/src/findlib/Makefile
@@ -28,14 +28,18 @@ TOBJECTS       = topfind.cmo
 
 XOBJECTS       = $(OBJECTS:.cmo=.cmx)
 
+OBJECTS_DYNLINK  = fl_dynlink.cmo
+XOBJECTS_DYNLINK = $(OBJECTS_DYNLINK:.cmo=.cmx)
+
 OCAMLFIND_OBJECTS = ocaml_args.cmo frontend.cmo
 OCAMLFIND_XOBJECTS = ocaml_args.cmx frontend.cmx
 
 NUMTOP_OBJECTS = num_top_printers.cmo num_top.cmo
 
-all: ocamlfind$(EXEC_SUFFIX) findlib.cma findlib_top.cma topfind num_top.cma
+all: ocamlfind$(EXEC_SUFFIX) findlib.cma findlib_top.cma topfind num_top.cma \
+     findlib_dynlink.cma
 
-opt: ocamlfind_opt$(EXEC_SUFFIX) findlib.cmxa topfind
+opt: ocamlfind_opt$(EXEC_SUFFIX) findlib.cmxa findlib_dynlink.cmxa topfind
 
 ocamlfind$(EXEC_SUFFIX): findlib.cma $(OCAMLFIND_OBJECTS)
 	$(OCAMLC) $(CUSTOM) -o ocamlfind$(EXEC_SUFFIX) -g findlib.cma unix.cma \
@@ -60,6 +64,15 @@ findlib.cmxa: $(XOBJECTS)
 	    $(OCAMLOPT) -shared -o findlib.cmxs $(XOBJECTS); \
 	fi
 
+findlib_dynlink.cma: $(OBJECTS_DYNLINK)
+	$(OCAMLC) -a -o $@ $(OBJECTS_DYNLINK)
+
+findlib_dynlink.cmxa: $(XOBJECTS_DYNLINK)
+	$(OCAMLOPT) -a -o $@ $(XOBJECTS_DYNLINK)
+	if [ $(HAVE_NATDYNLINK) -gt 0 ]; then \
+	    $(OCAMLOPT) -shared -o findlib_dynlink.cmxs $(XOBJECTS_DYNLINK); \
+	fi
+
 findlib_config.ml: findlib_config.mlp $(TOP)/Makefile.config
 	USE_CYGPATH="$(USE_CYGPATH)"; \
 	export USE_CYGPATH; \
@@ -100,7 +113,7 @@ install: all
 	mkdir -p "$(prefix)$(OCAML_SITELIB)/$(NAME)"
 	mkdir -p "$(prefix)$(OCAMLFIND_BIN)"
 	test $(INSTALL_TOPFIND) -eq 0 || cp topfind "$(prefix)$(OCAML_CORE_STDLIB)"
-	files=`$(TOP)/tools/collect_files $(TOP)/Makefile.config findlib.cmi findlib.mli findlib.cma topfind.cmi topfind.mli fl_package_base.mli fl_package_base.cmi fl_metascanner.mli fl_metascanner.cmi fl_metatoken.cmi findlib_top.cma findlib.cmxa findlib.a findlib.cmxs META` && \
+	files=`$(TOP)/tools/collect_files $(TOP)/Makefile.config findlib.cmi findlib.mli findlib.cma topfind.cmi topfind.mli fl_package_base.mli fl_package_base.cmi fl_metascanner.mli fl_metascanner.cmi fl_metatoken.cmi findlib_top.cma findlib.cmxa findlib.a findlib.cmxs findlib_dynlink.cma findlib_dynlink.cmxa findlib_dynlink.a findlib_dynlink.cmxs fl_dynlink.mli fl_dynlink.cmi META` && \
 	cp $$files "$(prefix)$(OCAML_SITELIB)/$(NAME)"
 	f="ocamlfind$(EXEC_SUFFIX)"; { test -f ocamlfind_opt$(EXEC_SUFFIX) && f="ocamlfind_opt$(EXEC_SUFFIX)"; }; \
 	cp $$f "$(prefix)$(OCAMLFIND_BIN)/ocamlfind$(EXEC_SUFFIX)"
diff --git a/src/findlib/findlib.ml b/src/findlib/findlib.ml
index 2b1aa2c..75e2ae1 100644
--- a/src/findlib/findlib.ml
+++ b/src/findlib/findlib.ml
@@ -427,3 +427,7 @@ let list_packages ?(tab = 20) ?(descr = false) ch =
     )
     packages_sorted
 ;;
+
+
+let linked_packages = ref []
+let linked_predicates = ref []
diff --git a/src/findlib/findlib.mli b/src/findlib/findlib.mli
index d435a84..6ef5cc9 100644
--- a/src/findlib/findlib.mli
+++ b/src/findlib/findlib.mli
@@ -193,3 +193,10 @@ val list_packages : ?tab:int -> ?descr:bool -> out_channel -> unit
    * @param tab The tabulator width, by default 20
    * @param descr Whether package descriptions are printed. Default: false
    *)
+
+val linked_packages : string list ref
+ (** The list of currently linked packages.
+     The packages can be absent of the database *)
+
+val linked_predicates : string list ref
+(** The list of predicates used during linking (eg. native, byte, mt, ...) *)
diff --git a/src/findlib/fl_dynlink.ml b/src/findlib/fl_dynlink.ml
new file mode 100644
index 0000000..b64b617
--- /dev/null
+++ b/src/findlib/fl_dynlink.ml
@@ -0,0 +1,25 @@
+
+(** Utilities for loading dynamically packages *)
+
+let load_pkg pkg =
+  if not (List.mem pkg !Findlib.linked_packages) then
+    (* Determine the package directory: *)
+    let d = Findlib.package_directory pkg in
+    (* Determine the 'archive(plugin,...)' property: *)
+    let archive =
+      try
+        Findlib.package_property ("plugin"::!Findlib.linked_predicates) pkg "archive"
+      with Not_found -> "" in
+    (* Split the 'archive' property and resolve the files: *)
+    let files = Fl_split.in_words archive in
+    List.iter (fun file ->
+        let file = Findlib.resolve_path ~base:d file in
+        Dynlink.loadfile file
+      ) files;
+    Findlib.linked_packages := pkg::!Findlib.linked_packages
+
+let load_packages pkgs =
+  let eff_pkglist =
+    Findlib.package_deep_ancestors !Findlib.linked_predicates pkgs in
+  List.iter load_pkg eff_pkglist
+
diff --git a/src/findlib/fl_dynlink.mli b/src/findlib/fl_dynlink.mli
new file mode 100644
index 0000000..1109442
--- /dev/null
+++ b/src/findlib/fl_dynlink.mli
@@ -0,0 +1,9 @@
+(* $Id$
+ * ----------------------------------------------------------------------
+ *
+ *)
+
+(** Utilities for loading dynamically packages *)
+
+val load_packages : string list -> unit
+(** Dynlink the given packages and all their dependencies *)
diff --git a/src/findlib/frontend.ml b/src/findlib/frontend.ml
index 2e00ccd..82b95b6 100644
--- a/src/findlib/frontend.ml
+++ b/src/findlib/frontend.ml
@@ -1148,8 +1148,11 @@ let ocamlc which () =
   let threads_dir = Filename.concat stdlibdir "threads" in
   let vmthreads_dir = Filename.concat stdlibdir "vmthreads" in
 
-  let initl_file_needed =
+  let create_toploop =
     List.mem "create_toploop" !predicates && List.mem "findlib" eff_link in
+  let initl_file_needed =
+    create_toploop || List.mem "findlib.dynlink" eff_link
+  in
 
   let initl_file_name =
     if initl_file_needed then
@@ -1170,19 +1173,19 @@ let ocamlc which () =
 		  initl_file_name in
     try
       output_string initl
-	("Topfind.don't_load [" ^
+	("Findlib.linked_packages := [" ^
 	 String.concat ";"
 	   (List.map
 	      (fun pkg -> "\"" ^ String.escaped pkg ^ "\"")
 	      eff_link) ^
 	 "];;\n");
+      let predicates = List.filter (fun p -> p <> "create_toploop") !predicates in
       output_string initl
-	("Topfind.predicates := [" ^
+	("Findlib.linked_predicates := [" ^
 	 String.concat ";"
 	   (List.map
 	      (fun pred -> "\"" ^ String.escaped pred ^ "\"")
-	      ("toploop" :: 
-		 (List.filter (fun p -> p <> "create_toploop") !predicates))) ^
+	      (if create_toploop then "toploop" :: predicates else predicates)) ^
 	 "];;\n");
       close_out initl;
     with
-- 
2.1.4


[-- Attachment #3: 0002-Dynlink-forbid-package-loading-when-we-are-currently.patch --]
[-- Type: text/x-diff, Size: 2868 bytes --]

From 5015566e762420fb4bfcdce1ba22f1bbbaff4212 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= <francois.bobot@cea.fr>
Date: Wed, 4 Mar 2015 09:49:11 +0100
Subject: [PATCH 2/2] [Dynlink] forbid package loading when we are currently   
        initializing a package

---
 src/findlib/fl_dynlink.ml  | 28 ++++++++++++++++++++++++----
 src/findlib/fl_dynlink.mli | 13 ++++++++++++-
 2 files changed, 36 insertions(+), 5 deletions(-)

diff --git a/src/findlib/fl_dynlink.ml b/src/findlib/fl_dynlink.ml
index b64b617..78c688c 100644
--- a/src/findlib/fl_dynlink.ml
+++ b/src/findlib/fl_dynlink.ml
@@ -1,6 +1,15 @@
 
 (** Utilities for loading dynamically packages *)
 
+exception Package_loading
+
+let package_loading = ref false
+let is_package_loading () =
+  (** At least "findlib.dynlink" should be in the list if Findlib_initl has
+      been run. Otherwise we are running statically linked package  *)
+  !Findlib.linked_packages = []
+  || !package_loading
+
 let load_pkg pkg =
   if not (List.mem pkg !Findlib.linked_packages) then
     (* Determine the package directory: *)
@@ -8,7 +17,8 @@ let load_pkg pkg =
     (* Determine the 'archive(plugin,...)' property: *)
     let archive =
       try
-        Findlib.package_property ("plugin"::!Findlib.linked_predicates) pkg "archive"
+        Findlib.package_property
+          ("plugin"::!Findlib.linked_predicates) pkg "archive"
       with Not_found -> "" in
     (* Split the 'archive' property and resolve the files: *)
     let files = Fl_split.in_words archive in
@@ -19,7 +29,17 @@ let load_pkg pkg =
     Findlib.linked_packages := pkg::!Findlib.linked_packages
 
 let load_packages pkgs =
-  let eff_pkglist =
-    Findlib.package_deep_ancestors !Findlib.linked_predicates pkgs in
-  List.iter load_pkg eff_pkglist
+  if is_package_loading () then
+    raise Package_loading
+  else begin
+    package_loading := true;
+    try
+      let eff_pkglist =
+        Findlib.package_deep_ancestors !Findlib.linked_predicates pkgs in
+      List.iter load_pkg eff_pkglist ;
+      package_loading := false;
+    with exn ->
+      package_loading := false;
+      raise exn
+  end
 
diff --git a/src/findlib/fl_dynlink.mli b/src/findlib/fl_dynlink.mli
index 1109442..a615486 100644
--- a/src/findlib/fl_dynlink.mli
+++ b/src/findlib/fl_dynlink.mli
@@ -5,5 +5,16 @@
 
 (** Utilities for loading dynamically packages *)
 
+exception Package_loading
+(** Indicate that during the loading of a package the loading of another
+    package have been requested *)
+
 val load_packages : string list -> unit
-(** Dynlink the given packages and all their dependencies *)
+(** Dynlink the given packages and all their dependencies;
+    Call can't be nested.
+    @raise Package_loading
+*)
+
+
+val is_package_loading: unit -> bool
+(** Indicate if we are currently loading a package *)
-- 
2.1.4