diff --git a/doc/advanced/variables-artifacts.rst b/doc/advanced/variables-artifacts.rst index 025fb46e6b9..09afa0d528f 100644 --- a/doc/advanced/variables-artifacts.rst +++ b/doc/advanced/variables-artifacts.rst @@ -23,10 +23,18 @@ interpreted relative to the current directory: ```` should be the name of a module as specified in a ``(modules)`` field. -- ``cma:`` and ``cmxa:`` expands to the corresponding - artifact's path for the library specified by ````. The basename of ```` +- ``cma:`` and ``cmxa:`` expands to the corresponding artifact's + path for the library specified by ````. The basename of ```` should be the name of the library as specified in the ``(name)`` field of a ``library`` stanza (*not* its public name). +- ``cmt:`` and ``cmti:`` expand to the corresponding compiled + annotation files for the module specified by ````. These files contain + the typed abstract syntax tree with precise location information and type + annotations, generated with the ``-bin-annot`` flag. They are particularly + useful for IDE tools to provide tooltips and type information. + + .. versionadded:: 3.21 + In each case, the expansion of the variable is a path pointing inside the build context (i.e., ``_build/``). diff --git a/doc/changes/added/12634.md b/doc/changes/added/12634.md new file mode 100644 index 00000000000..aa031ef02d4 --- /dev/null +++ b/doc/changes/added/12634.md @@ -0,0 +1,3 @@ +- Add support for `%{cmt:...}` and `%{cmti:...}` variables to reference + compiled annotation files (.cmt and .cmti) containing typed abstract syntax + trees with location and type information. (#12634, grants #12633, @Alizter) diff --git a/src/dune_lang/pform.ml b/src/dune_lang/pform.ml index fec3272e9dd..d7c1b39a975 100644 --- a/src/dune_lang/pform.ml +++ b/src/dune_lang/pform.ml @@ -219,32 +219,60 @@ end module Artifact = struct open Ocaml + type mod_ = + | Cm_kind of Ocaml.Cm_kind.t + | Cmt + | Cmti + + let dyn_of_mod_ = + let open Dyn in + function + | Cm_kind x -> Ocaml.Cm_kind.to_dyn x + | Cmt -> variant "Cmt" [] + | Cmti -> variant "Cmti" [] + ;; + type t = - | Mod of Cm_kind.t + | Mod of mod_ | Lib of Mode.t + let compare_mod x y = + match x, y with + | Cm_kind x, Cm_kind y -> Ocaml.Cm_kind.compare x y + | Cm_kind _, _ -> Lt + | _, Cm_kind _ -> Gt + | Cmt, Cmt -> Eq + | Cmt, _ -> Lt + | _, Cmt -> Gt + | Cmti, Cmti -> Eq + ;; + let compare x y = match x, y with - | Mod x, Mod y -> Cm_kind.compare x y + | Mod x, Mod y -> compare_mod x y | Mod _, _ -> Lt | _, Mod _ -> Gt | Lib x, Lib y -> Mode.compare x y ;; let ext = function - | Mod cm_kind -> Cm_kind.ext cm_kind + | Mod Cmt -> ".cmt" + | Mod Cmti -> ".cmti" + | Mod (Cm_kind cm_kind) -> Cm_kind.ext cm_kind | Lib mode -> Mode.compiled_lib_ext mode ;; let all = - List.map ~f:(fun kind -> Mod kind) Cm_kind.all - @ List.map ~f:(fun mode -> Lib mode) Mode.all + Mod Cmt + :: Mod Cmti + :: (List.map ~f:(fun kind -> Mod (Cm_kind kind)) Cm_kind.all + @ List.map ~f:(fun mode -> Lib mode) Mode.all) ;; let to_dyn a = let open Dyn in match a with - | Mod cm_kind -> variant "Mod" [ Cm_kind.to_dyn cm_kind ] + | Mod cm_kind -> variant "Mod" [ dyn_of_mod_ cm_kind ] | Lib mode -> variant "Lib" [ Mode.to_dyn mode ] ;; end @@ -610,7 +638,13 @@ module Env = struct let macros = let macro (x : Macro.t) = No_info x in let artifact x = - String.drop (Artifact.ext x) 1, since ~version:(2, 0) (Macro.Artifact x) + let name = String.drop (Artifact.ext x) 1 in + let version = + match x with + | Mod Cmt | Mod Cmti -> 3, 21 + | _ -> 2, 0 + in + name, since ~version (Macro.Artifact x) in String.Map.of_list_exn ([ "exe", macro Exe diff --git a/src/dune_lang/pform.mli b/src/dune_lang/pform.mli index 8cfd60b441b..92f4ceb0b99 100644 --- a/src/dune_lang/pform.mli +++ b/src/dune_lang/pform.mli @@ -101,8 +101,13 @@ module Var : sig end module Artifact : sig + type mod_ = + | Cm_kind of Ocaml.Cm_kind.t + | Cmt + | Cmti + type t = - | Mod of Ocaml.Cm_kind.t + | Mod of mod_ | Lib of Ocaml.Mode.t val compare : t -> t -> Ordering.t diff --git a/src/dune_rules/expander.ml b/src/dune_rules/expander.ml index e19a34283e8..6e1ef2db0a6 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -191,7 +191,12 @@ let expand_artifact ~source t artifact arg = (match Artifacts_obj.lookup_module artifacts name with | None -> does_not_exist ~what:"Module" (Module_name.to_string name) | Some (t, m) -> - (match Obj_dir.Module.cm_file t m ~kind:(Ocaml kind) with + (match + match kind with + | Cm_kind kind -> Obj_dir.Module.cm_file t m ~kind:(Ocaml kind) + | Cmt -> Obj_dir.Module.cmt_file t m ~cm_kind:(Ocaml Cmi) ~ml_kind:Impl + | Cmti -> Some (Obj_dir.Module.cmti_file t m ~cm_kind:(Ocaml Cmi)) + with | None -> Action_builder.return [ Value.String "" ] | Some path -> dep (Path.build path))) | Lib mode -> diff --git a/src/ocaml/cm_kind.ml b/src/ocaml/cm_kind.ml index b7077aa358c..499486f6d08 100644 --- a/src/ocaml/cm_kind.ml +++ b/src/ocaml/cm_kind.ml @@ -27,6 +27,14 @@ let choose cmi cmo cmx = function let ext = choose ".cmi" ".cmo" ".cmx" let source = choose Ml_kind.Intf Impl Impl +let to_dyn = + let open Dyn in + function + | Cmi -> variant "cmi" [] + | Cmo -> variant "cmo" [] + | Cmx -> variant "cmx" [] +;; + module Dict = struct type 'a t = { cmi : 'a @@ -43,11 +51,3 @@ module Dict = struct let of_func f = { cmi = f ~cm_kind:Cmi; cmo = f ~cm_kind:Cmo; cmx = f ~cm_kind:Cmx } let make_all x = { cmi = x; cmo = x; cmx = x } end - -let to_dyn = - let open Dyn in - function - | Cmi -> variant "cmi" [] - | Cmo -> variant "cmo" [] - | Cmx -> variant "cmx" [] -;; diff --git a/test/blackbox-tests/test-cases/variables-for-artifacts/cmt-cmti.t b/test/blackbox-tests/test-cases/variables-for-artifacts/cmt-cmti.t new file mode 100644 index 00000000000..20d31cf392c --- /dev/null +++ b/test/blackbox-tests/test-cases/variables-for-artifacts/cmt-cmti.t @@ -0,0 +1,167 @@ +Test that %{cmt:...} and %{cmti:...} variables work correctly. + + $ cat > dune-project < (lang dune 3.20) + > EOF + +Create a library with both .ml and .mli files: + + $ cat > mylib.mli < val hello : string + > EOF + + $ cat > mylib.ml < let hello = "world" + > EOF + + $ cat > dune < (library + > (name mylib)) + > + > (rule + > (alias show-cmt) + > (deps %{cmt:mylib}) + > (action + > (echo "cmt file: %{cmt:mylib}\n"))) + > + > (rule + > (alias show-cmti) + > (deps %{cmti:mylib}) + > (action + > (echo "cmti file: %{cmti:mylib}\n"))) + > EOF + +This feature is guarded behind dune lang 3.21: + + $ dune build @show-cmt @show-cmti + File "dune", line 6, characters 7-19: + 6 | (deps %{cmt:mylib}) + ^^^^^^^^^^^^ + Error: %{cmt:..} is only available since version 3.21 of the dune language. + Please update your dune-project file to have (lang dune 3.21). + [1] + + $ cat > dune-project < (lang dune 3.21) + > EOF + +Build and check that cmt and cmti files are found: + + $ dune build @show-cmt + cmt file: .mylib.objs/byte/mylib.cmt + + $ dune build @show-cmti + cmti file: .mylib.objs/byte/mylib.cmti + +Test with a module that has only implementation (no interface): + + $ cat > only_impl.ml < let x = 42 + > EOF + + $ cat >> dune < (rule + > (alias show-impl-only-cmt) + > (deps %{cmt:only_impl}) + > (action + > (echo "impl-only cmt: %{cmt:only_impl}\n"))) + > + > (rule + > (alias show-impl-only-cmti) + > (deps %{cmti:only_impl}) + > (action + > (echo "impl-only cmti: %{cmti:only_impl}\n"))) + > EOF + + $ dune build @show-impl-only-cmt + impl-only cmt: .mylib.objs/byte/mylib__Only_impl.cmt + + $ dune build @show-impl-only-cmti + impl-only cmti: .mylib.objs/byte/mylib__Only_impl.cmt + +Test with a module that has only interface (no implementation): + + $ cat > only_intf.mli < val y : int + > EOF + + $ cat > dune < (library + > (name mylib) + > (modules_without_implementation only_intf)) + > + > (rule + > (alias show-intf-only-cmt) + > (deps %{cmt:only_intf}) + > (action + > (echo "intf-only cmt: %{cmt:only_intf}\n"))) + > + > (rule + > (alias show-intf-only-cmti) + > (deps %{cmti:only_intf}) + > (action + > (echo "intf-only cmti: %{cmti:only_intf}\n"))) + > EOF + + $ dune build @show-intf-only-cmt + Error: No rule found for . + -> required by alias show-intf-only-cmt in dune:5 + [1] + + $ dune build @show-intf-only-cmti + intf-only cmti: .mylib.objs/byte/mylib__Only_intf.cmti + +Test error when module does not exist: + + $ cat >> dune < (alias + > (name test-nonexistent) + > (deps %{cmt:nonexistent})) + > EOF + + $ dune build @test-nonexistent + File "dune", line 18, characters 7-25: + 18 | (deps %{cmt:nonexistent})) + ^^^^^^^^^^^^^^^^^^ + Error: Module Nonexistent does not exist. + [1] + +Test with native-only library (bytecode disabled): + + $ cat > native_lib.ml < let z = 100 + > EOF + + $ cat > dune < (library + > (name native_lib) + > (modules native_lib) + > (modes native)) + > + > (rule + > (alias show-native-cmt) + > (deps %{cmt:native_lib}) + > (action + > (echo "native-lib cmt: %{cmt:native_lib}\n"))) + > EOF + + $ dune build @show-native-cmt --display short + ocamlc .native_lib.objs/byte/native_lib.{cmi,cmo,cmt} + native-lib cmt: .native_lib.objs/byte/native_lib.cmt + + $ cat > native_lib.mli < val z : int + > EOF + + $ cat >> dune < (rule + > (alias show-native-cmti) + > (deps %{cmti:native_lib}) + > (action + > (echo "native-lib cmti: %{cmti:native_lib}\n"))) + > EOF + + $ dune build @show-native-cmti --display short + ocamlc .native_lib.objs/byte/native_lib.{cmi,cmti} + native-lib cmti: .native_lib.objs/byte/native_lib.cmti +