From 67445d8257c9af5b17767efe728cf2210a50e9ad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Fri, 14 Jan 2022 14:12:05 +0100 Subject: [PATCH 1/7] [Ctypes] Add deps field for fixing dependencies on local files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: François Bobot --- doc/foreign-code.rst | 5 +++++ src/dune_rules/ctypes_rules.ml | 33 +++++++++++++++++++++----------- src/dune_rules/ctypes_stanza.ml | 4 ++++ src/dune_rules/ctypes_stanza.mli | 1 + 4 files changed, 32 insertions(+), 11 deletions(-) diff --git a/doc/foreign-code.rst b/doc/foreign-code.rst index fc8830c00fb..3500b29411f 100644 --- a/doc/foreign-code.rst +++ b/doc/foreign-code.rst @@ -257,6 +257,11 @@ descriptions by referencing them as the module specified in optional - ``(headers (preamble )`` adds directly the preamble. Variables can be used in ```` such as ``%{read: }``. +- Since the Dune's ctypes features is still experimental, it could be useful to + add additionnal dependencies in order for example to make sure that local + headers or libraries are available: ``(deps )``. See the + :ref:`deps-field` section for more details. + ```` are: - ``(concurrency )`` tells ``ctypes diff --git a/src/dune_rules/ctypes_rules.ml b/src/dune_rules/ctypes_rules.ml index 65c9e1f4dd1..6ed100e57e0 100644 --- a/src/dune_rules/ctypes_rules.ml +++ b/src/dune_rules/ctypes_rules.ml @@ -335,8 +335,7 @@ let rule ?(deps = []) ?stdout_to ?(args = []) ?(targets = []) ~exe ~sctx ~dir () in Super_context.add_rule sctx ~dir build -let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope - ~cflags_sexp ~output () = +let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope ~cflags_sexp ~output ~deps () = let ctx = Super_context.context sctx in let open Memo.Build.O in let* exe = @@ -364,11 +363,15 @@ let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope let source_file_deps = List.map source_files ~f:(Path.relative (Path.build dir)) |> Dep.Set.of_files + in let foreign_archives_deps = List.map foreign_archives_deps ~f:Path.build |> Dep.Set.of_files in - Dep.Set.union source_file_deps foreign_archives_deps + let open Action_builder.O in + let* () = Dep.Set.union source_file_deps foreign_archives_deps + |> Action_builder.deps in + deps in let build = let cflags_args = @@ -402,7 +405,7 @@ let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope let action = let open Action_builder.O in let* include_args = Resolve.Build.read include_args in - Action_builder.deps deps + deps >>> Action_builder.map cflags_args ~f:(fun cflags_args -> let source_files = List.map source_files ~f:absolute_path_hack in let output = absolute_path_hack output in @@ -445,7 +448,7 @@ let program_of_module_and_dir ~dir program = ; loc = Loc.in_file (Path.relative build_dir program) } -let exe_build_and_link ?libraries ?(modules = []) ~scope ~loc ~dir ~cctx program +let exe_build_and_link ?libraries ?(modules = []) ~scope ~loc ~dir ~cctx ~sandbox program = let open Memo.Build.O in let* cctx = @@ -454,12 +457,18 @@ let exe_build_and_link ?libraries ?(modules = []) ~scope ~loc ~dir ~cctx program in let program = program_of_module_and_dir ~dir program in Exe.build_and_link ~program ~linkages:[ Exe.Linkage.native ] ~promote:None +~sandbox cctx -let exe_link_only ~dir ~shared_cctx program = +let exe_link_only ~dir ~shared_cctx ~sandbox program ~deps = + let link_args = + let open Action_builder.O in + let+ () = deps in + Command.Args.empty + in let program = program_of_module_and_dir ~dir program in - Exe.link_many ~programs:[ program ] ~linkages:[ Exe.Linkage.native ] - ~promote:None shared_cctx + Exe.link_many ~link_args ~programs:[ program ] ~linkages:[ Exe.Linkage.native ] + ~promote:None shared_cctx ~sandbox let write_osl_to_sexp_file ~sctx ~dir ~filename osl = let build = @@ -506,6 +515,8 @@ let gen_rules ~cctx ~buildable ~loc ~scope ~dir ~sctx = ; Foreign.Archive.dll_file ~archive ~dir ~ext_dll ]) in + let* expander = Super_context.expander sctx ~dir in + let deps, sandbox = Dep_conf_eval.unnamed ~expander ctypes.deps in let* () = write_c_types_includer_module ~sctx ~dir ~filename:(ml_of_module_name c_types_includer_module) @@ -536,7 +547,7 @@ let gen_rules ~cctx ~buildable ~loc ~scope ~dir ~sctx = ~cflags_sexp ~c_library_flags_sexp ~external_library_name in let* () = - exe_build_and_link ~scope ~loc ~dir ~cctx + exe_build_and_link ~scope ~loc ~dir ~cctx ~sandbox ~libraries:[ "dune.configurator" ] discover_script in rule @@ -545,7 +556,7 @@ let gen_rules ~cctx ~buildable ~loc ~scope ~dir ~sctx = in let generated_entry_module = Stanza_util.entry_module ctypes in let headers = ctypes.Ctypes.headers in - let exe_link_only = exe_link_only ~dir ~shared_cctx:cctx in + let exe_link_only = exe_link_only ~deps ~dir ~shared_cctx:cctx ~sandbox in (* Type_gen produces a .c file, taking your type description module above as an input. The .c file is compiled into an .exe. The .exe, when run produces an .ml file. The .ml file is compiled into a module that will have the @@ -573,7 +584,7 @@ let gen_rules ~cctx ~buildable ~loc ~scope ~dir ~sctx = let* () = build_c_program ~foreign_archives_deps ~sctx ~dir ~scope ~cflags_sexp ~source_files:[ c_generated_types_cout_c ] - ~output:c_generated_types_cout_exe () + ~output:c_generated_types_cout_exe ~deps () in rule ~stdout_to:(c_generated_types_module |> ml_of_module_name) diff --git a/src/dune_rules/ctypes_stanza.ml b/src/dune_rules/ctypes_stanza.ml index 18dfe7f1e68..7e15e2a3e0f 100644 --- a/src/dune_rules/ctypes_stanza.ml +++ b/src/dune_rules/ctypes_stanza.ml @@ -111,6 +111,7 @@ type t = ; function_description : Function_description.t list ; generated_types : Module_name.t ; generated_entry_point : Module_name.t + ; deps : Dep_conf.t list } let name = "ctypes" @@ -134,6 +135,8 @@ let decode = and+ generated_types = field_o "generated_types" Module_name.decode and+ generated_entry_point = field "generated_entry_point" Module_name.decode + and+ deps = + field_o "deps" (repeat Dep_conf.decode) in { external_library_name ; build_flags_resolver = @@ -145,6 +148,7 @@ let decode = Option.value generated_types ~default:(Module_name.of_string "Types_generated") ; generated_entry_point + ; deps = Option.value ~default:[] deps }) let () = diff --git a/src/dune_rules/ctypes_stanza.mli b/src/dune_rules/ctypes_stanza.mli index f7aa6c73d9d..9b5f1fce6ea 100644 --- a/src/dune_rules/ctypes_stanza.mli +++ b/src/dune_rules/ctypes_stanza.mli @@ -51,6 +51,7 @@ type t = ; function_description : Function_description.t list ; generated_types : Module_name.t ; generated_entry_point : Module_name.t + ; deps : Dep_conf.t list } type Stanza.t += T of t From 9a141c1eb7366f619d2bae843bce32cf03ff9d7d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Sun, 16 Jan 2022 21:24:22 +0100 Subject: [PATCH 2/7] [Ctypes] expand the c_flags and c_library_flags MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit before writing them to sexp Signed-off-by: François Bobot --- doc/dune-files.rst | 3 ++- doc/foreign-code.rst | 4 +++- src/dune_rules/ctypes_rules.ml | 27 +++++++++++++++------------ 3 files changed, 20 insertions(+), 14 deletions(-) diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 49498e462ee..a618ec194e4 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -400,7 +400,8 @@ adding the following field to the ``dune-project`` file: In this mode, Dune will populate the ``:standard`` set of C flags with the content of ``ocamlc_cflags`` and ``ocamlc_cppflags``. These flags can be -completed or overridden using the :ref:`ordered-set-language`. +completed or overridden using the :ref:`ordered-set-language`. The value +``true`` is the default for Dune 3.0. accept_alternative_dune_file_name --------------------------------- diff --git a/doc/foreign-code.rst b/doc/foreign-code.rst index 3500b29411f..3d3ebfb28e5 100644 --- a/doc/foreign-code.rst +++ b/doc/foreign-code.rst @@ -275,7 +275,9 @@ descriptions by referencing them as the module specified in optional - ``(vendored (c_flags ) (c_library_flags ))`` provide the build and link flags for binding your vendored code. You must also provide instructions in your ``dune`` file on how to build the vendored foreign - library; see the :ref:`foreign_library` stanza. + library; see the :ref:`foreign_library` stanza. Usually the ```` should + contain ``:standard`` in order to add the default flags used by the OCaml + compiler for C files :ref:`always-add-cflags`. .. _foreign-sandboxing: diff --git a/src/dune_rules/ctypes_rules.ml b/src/dune_rules/ctypes_rules.ml index 6ed100e57e0..ade8a228fef 100644 --- a/src/dune_rules/ctypes_rules.ml +++ b/src/dune_rules/ctypes_rules.ml @@ -470,20 +470,18 @@ let exe_link_only ~dir ~shared_cctx ~sandbox program ~deps = Exe.link_many ~link_args ~programs:[ program ] ~linkages:[ Exe.Linkage.native ] ~promote:None shared_cctx ~sandbox -let write_osl_to_sexp_file ~sctx ~dir ~filename osl = +let write_osl_to_sexp_file ~sctx ~dir ~filename ~expand_flag flags = let build = - let path = Path.Build.relative dir filename in - let sexp = - let encoded = - match Ordered_set_lang.Unexpanded.encode osl with - | [ s ] -> s - | _lst -> - User_error.raise - [ Pp.textf "expected %s to contain a list of atoms" filename ] - in - Dune_lang.to_string encoded + let sexp = + let open Action_builder.O in + let* expander = + Action_builder.memo_build @@ Super_context.expander sctx ~dir in + let+ flags = expand_flag ~expander flags in + let sexp = Sexp.List (List.map ~f:(fun x -> Sexp.Atom x) flags) in + Sexp.to_string sexp in - Action_builder.write_file path sexp + let path = Path.Build.relative dir filename in + Action_builder.write_file_dyn path sexp in Super_context.add_rule ~loc:Loc.none sctx ~dir build @@ -536,9 +534,14 @@ let gen_rules ~cctx ~buildable ~loc ~scope ~dir ~sctx = | Vendored { c_flags; c_library_flags } -> let* () = write_osl_to_sexp_file ~sctx ~dir ~filename:cflags_sexp c_flags + ~expand_flag:(fun ~expander flags -> Super_context.foreign_flags + sctx ~dir ~expander ~flags ~language:C) in write_osl_to_sexp_file ~sctx ~dir ~filename:c_library_flags_sexp c_library_flags + ~expand_flag:(fun ~expander flags -> + Expander.expand_and_eval_set expander flags + ~standard:(Action_builder.return [])) | Pkg_config -> let cflags_sexp = Stanza_util.cflags_sexp ctypes in let discover_script = Stanza_util.discover_script ctypes in From 7044bb8234260cffc6281b53c36b2c753e5a36fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Mon, 17 Jan 2022 13:00:40 +0100 Subject: [PATCH 3/7] [Doc] Some precisions about -fpic and .so MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: François Bobot --- doc/foreign-code.rst | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/doc/foreign-code.rst b/doc/foreign-code.rst index 3d3ebfb28e5..2f6a4fba71e 100644 --- a/doc/foreign-code.rst +++ b/doc/foreign-code.rst @@ -299,6 +299,12 @@ To do that, follow the following procedure: - depends on this directory recursively via :ref:`source_tree ` - invokes the external build system + - copies the generated files + - the C archive ``.a`` must be built with ``-fpic`` + - the ``libfoo.so`` must be copied as ``dllfoo.so``, and no ``libfoo.so`` + should appear otherwise the dynamic linking of the C library will be + attempted, but usually fails because the ``libfoo.so`` is not available at + the time of the execution. - *Attach* the C archive files to an OCaml library via :ref:`foreign-archives`. For instance, let's assume that you want to build a C library From 205c92e54fc7f151d25c5e1676b8469c024da7f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 9 Feb 2022 19:59:37 +0100 Subject: [PATCH 4/7] Update doc/foreign-code.rst Co-authored-by: Christine Rose --- doc/foreign-code.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/foreign-code.rst b/doc/foreign-code.rst index 2f6a4fba71e..9a8672ee658 100644 --- a/doc/foreign-code.rst +++ b/doc/foreign-code.rst @@ -257,7 +257,7 @@ descriptions by referencing them as the module specified in optional - ``(headers (preamble )`` adds directly the preamble. Variables can be used in ```` such as ``%{read: }``. -- Since the Dune's ctypes features is still experimental, it could be useful to +- Since the Dune's ``ctypes`` features is still experimental, it could be useful to add additionnal dependencies in order for example to make sure that local headers or libraries are available: ``(deps )``. See the :ref:`deps-field` section for more details. From 26f0b436c62003a5a7aeae403be127d7d14d2748 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 9 Feb 2022 19:59:47 +0100 Subject: [PATCH 5/7] Update doc/foreign-code.rst Co-authored-by: Christine Rose --- doc/foreign-code.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/foreign-code.rst b/doc/foreign-code.rst index 9a8672ee658..8ecd02f1cab 100644 --- a/doc/foreign-code.rst +++ b/doc/foreign-code.rst @@ -258,7 +258,7 @@ descriptions by referencing them as the module specified in optional can be used in ```` such as ``%{read: }``. - Since the Dune's ``ctypes`` features is still experimental, it could be useful to - add additionnal dependencies in order for example to make sure that local + add additional dependencies in order to make sure that local headers or libraries are available: ``(deps )``. See the :ref:`deps-field` section for more details. From ea3a1d9c91349eac388dc8f46141f9b614da2b5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 23 Feb 2022 11:10:33 +0100 Subject: [PATCH 6/7] Fix doc wording Co-authored-by: Christine Rose --- doc/foreign-code.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/foreign-code.rst b/doc/foreign-code.rst index 8ecd02f1cab..729364d6d64 100644 --- a/doc/foreign-code.rst +++ b/doc/foreign-code.rst @@ -257,7 +257,7 @@ descriptions by referencing them as the module specified in optional - ``(headers (preamble )`` adds directly the preamble. Variables can be used in ```` such as ``%{read: }``. -- Since the Dune's ``ctypes`` features is still experimental, it could be useful to +- Since the Dune's ``ctypes`` feature is still experimental, it could be useful to add additional dependencies in order to make sure that local headers or libraries are available: ``(deps )``. See the :ref:`deps-field` section for more details. From 5c25ecfe97c41fe35bbb9216dbd7aa636e2b3693 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Wed, 23 Feb 2022 11:10:58 +0100 Subject: [PATCH 7/7] Fix doc wording Co-authored-by: Christine Rose --- doc/foreign-code.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/foreign-code.rst b/doc/foreign-code.rst index 729364d6d64..9cb2c96103f 100644 --- a/doc/foreign-code.rst +++ b/doc/foreign-code.rst @@ -302,8 +302,8 @@ To do that, follow the following procedure: - copies the generated files - the C archive ``.a`` must be built with ``-fpic`` - the ``libfoo.so`` must be copied as ``dllfoo.so``, and no ``libfoo.so`` - should appear otherwise the dynamic linking of the C library will be - attempted, but usually fails because the ``libfoo.so`` is not available at + should appear, otherwise the dynamic linking of the C library will be + attempted. However, this usually fails because the ``libfoo.so`` isn't available at the time of the execution. - *Attach* the C archive files to an OCaml library via :ref:`foreign-archives`.