Skip to content

Commit

Permalink
Merge branch 'main' into melange/fix-melc-ppx
Browse files Browse the repository at this point in the history
* main:
  test: formatting of alternative dune files (ocaml#6567)
  refactor: remove Modules.is_empty (ocaml#6564)
  refactor: module kinds (ocaml#6562)
  refactor(coq): resolve lack of coqc properly
  Cache file contents in action builder by name. (ocaml#6555)
  fix: re-enable dune on older macos sdk's (ocaml#6515)
  fix: do not hide lib interface module (ocaml#6549)
  test: remove pkg-config output for reproducibility (ocaml#6543)
  melange: add test for ocaml flags (ocaml#6548)
  fix: improve virtual library error messages
  test: virtual library and impl locations
  test: alias module regression (ocaml#6544)
  refactor(merlin): dump config sub command (ocaml#6547)
  • Loading branch information
jchavarri committed Nov 24, 2022
2 parents 4fd850e + 62997eb commit 7abc35c
Show file tree
Hide file tree
Showing 36 changed files with 292 additions and 140 deletions.
5 changes: 5 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
@@ -1,6 +1,11 @@
Unreleased
----------

- Do not shadow library interface modules (#6549, fixes #6545, @rgrinberg)

- Move `$ dune ocaml-merlin -dump-config=$dir` to `$ dune ocaml merlin
dump-config $dir`. (#6547, @rgrinberg)

- Allow compilation rules to be impacted by `(env ..)` stanzas that modify the
environment or set binaries. (#6527, @rgrinberg)

Expand Down
1 change: 1 addition & 0 deletions bin/ocaml_cmd.ml
Original file line number Diff line number Diff line change
Expand Up @@ -9,4 +9,5 @@ let group =
; Ocaml_merlin.Dump_dot_merlin.command
; Top.command
; Top.module_command
; Ocaml_merlin.group
]
51 changes: 31 additions & 20 deletions bin/ocaml_merlin.ml
Original file line number Diff line number Diff line change
Expand Up @@ -173,6 +173,25 @@ end = struct
main ()
end

module Dump_config = struct
let info =
Cmd.info
~doc:
"Prints the entire content of the merlin configuration for the given \
folder in a user friendly form. This is for testing and debugging \
purposes only and should not be considered as a stable output."
"dump-config"

let term =
let+ common = Common.term
and+ dir = Arg.(value & pos 0 dir "" & info [] ~docv:"PATH") in
let common = Common.forbid_builds common in
let config = Common.init ~log_file:No_log_file common in
Scheduler.go ~common ~config (fun () -> Server.dump dir)

let command = Cmd.v info term
end

let doc = "Start a merlin configuration server"

let man =
Expand All @@ -185,29 +204,15 @@ let man =
; Common.footer
]

let info = Cmd.info "ocaml-merlin" ~doc ~man

let term =
let+ common = Common.term
and+ dump_config =
Arg.(
value
& opt ~vopt:(Some ".") (some string) None
& info [ "dump-config" ]
~doc:
"Prints the entire content of the merlin configuration for the \
given folder in a user friendly form. This is for testing and \
debugging purposes only and should not be considered as a stable \
output.")
in
let start_session_info name = Cmd.info name ~doc ~man

let start_session_term =
let+ common = Common.term in
let common = Common.forbid_builds common in
let config = Common.init common ~log_file:No_log_file in
Scheduler.go ~common ~config (fun () ->
match dump_config with
| Some s -> Server.dump s
| None -> Server.start ())
Scheduler.go ~common ~config Server.start

let command = Cmd.v info term
let command = Cmd.v (start_session_info "ocaml-merlin") start_session_term

module Dump_dot_merlin = struct
let doc = "Print Merlin configuration"
Expand Down Expand Up @@ -245,3 +250,9 @@ module Dump_dot_merlin = struct

let command = Cmd.v info term
end

let group =
Cmdliner.Cmd.group (Cmd.info "merlin")
[ Dump_config.command
; Cmd.v (start_session_info "start-session") start_session_term
]
2 changes: 2 additions & 0 deletions bin/ocaml_merlin.mli
Original file line number Diff line number Diff line change
Expand Up @@ -5,3 +5,5 @@ val command : unit Cmd.t
module Dump_dot_merlin : sig
val command : unit Cmd.t
end

val group : unit Cmd.t
2 changes: 1 addition & 1 deletion doc/usage.rst
Original file line number Diff line number Diff line change
Expand Up @@ -558,7 +558,7 @@ purposes:

::

$ dune ocaml-merlin --dump-config
$ dune ocaml merlin dump-config

This command prints the distinct configuration of each module present in the
current directory. This directory must be in a Dune workspace and the project
Expand Down
10 changes: 9 additions & 1 deletion src/dune_engine/action_builder.ml
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,7 @@ let env_var s = deps (Dep.Set.singleton (Dep.env s))

let alias a = dep (Dep.alias a)

let contents p =
let contents_impl p =
of_thunk
{ f =
(fun _mode ->
Expand All @@ -85,6 +85,14 @@ let contents p =
(x, Dep.Map.empty))
}

let contents =
let memo =
create_memo "file-contents"
~input:(module Path)
~cutoff:String.equal contents_impl
in
fun path -> exec_memo memo path

let lines_of p =
of_thunk
{ f =
Expand Down
75 changes: 41 additions & 34 deletions src/dune_rules/coq_config.ml
Original file line number Diff line number Diff line change
Expand Up @@ -103,21 +103,24 @@ module Version = struct
let version_memo =
Memo.create "coq-and-ocaml-version" ~input:(module Path) impl_version

let make ~bin =
let open Memo.O in
let+ coq_and_ocaml_version = Memo.exec version_memo bin in
let sbin = Path.to_string bin in
let open Result.O in
let* version_string, ocaml_version_string =
String.lsplit2 ~on:' ' coq_and_ocaml_version |> function
| Some (version_string, ocaml_version_string) ->
Result.ok (version_string, ocaml_version_string)
| None ->
Result.Error
Pp.(textf "Unable to parse output of %s --print-version." sbin)
in
let* version_num = Num.make version_string in
Result.ok { version_num; version_string; ocaml_version_string }
let make ~(coqc : Action.Prog.t) =
match coqc with
| Ok coqc_path ->
let open Memo.O in
let+ coq_and_ocaml_version = Memo.exec version_memo coqc_path in
let sbin = Path.to_string coqc_path in
let open Result.O in
let* version_string, ocaml_version_string =
String.lsplit2 ~on:' ' coq_and_ocaml_version |> function
| Some (version_string, ocaml_version_string) ->
Result.ok (version_string, ocaml_version_string)
| None ->
Result.Error
Pp.(textf "Unable to parse output of %s --print-version." sbin)
in
let* version_num = Num.make version_string in
Result.ok { version_num; version_string; ocaml_version_string }
| Error e -> Action.Prog.Not_found.raise e

let by_name t name =
match t with
Expand Down Expand Up @@ -147,30 +150,34 @@ let impl_config bin =

let config_memo = Memo.create "coq-config" ~input:(module Path) impl_config

let version ~bin =
let version ~coqc =
let open Memo.O in
let+ t = Version.make ~bin in
let+ t = Version.make ~coqc in
let open Result.O in
let+ t = t in
t.version_string

let make ~bin =
let open Memo.O in
let+ config_lines = Memo.exec config_memo bin
and+ version_info = Version.make ~bin in
match Vars.of_lines config_lines with
| Error msg ->
User_error.raise
Pp.
[ textf "cannot parse output of %S --config:" (Path.to_string bin)
; msg
]
| Ok vars ->
let coqlib = Vars.get_path vars "COQLIB" in
let coq_native_compiler_default =
Vars.get vars "COQ_NATIVE_COMPILER_DEFAULT"
in
{ version_info; coqlib; coq_native_compiler_default }
let make ~(coqc : Action.Prog.t) =
match coqc with
| Ok coqc_path -> (
let open Memo.O in
let+ config_lines = Memo.exec config_memo coqc_path
and+ version_info = Version.make ~coqc in
match Vars.of_lines config_lines with
| Ok vars ->
let coqlib = Vars.get_path vars "COQLIB" in
let coq_native_compiler_default =
Vars.get vars "COQ_NATIVE_COMPILER_DEFAULT"
in
{ version_info; coqlib; coq_native_compiler_default }
| Error msg ->
User_error.raise
Pp.
[ textf "cannot parse output of %S --config:"
(Path.to_string coqc_path)
; msg
])
| Error e -> Action.Prog.Not_found.raise e

let by_name { version_info; coqlib; coq_native_compiler_default } name =
match name with
Expand Down
5 changes: 3 additions & 2 deletions src/dune_rules/coq_config.mli
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,10 @@ open Import

type t

val version : bin:Path.t -> (string, User_message.Style.t Pp.t) Result.t Memo.t
val version :
coqc:Action.Prog.t -> (string, User_message.Style.t Pp.t) Result.t Memo.t

val make : bin:Path.t -> t Memo.t
val make : coqc:Action.Prog.t -> t Memo.t

val by_name :
t -> string -> [> `Int of int | `Path of Path.t | `String of string ] option
2 changes: 1 addition & 1 deletion src/dune_rules/coq_rules.ml
Original file line number Diff line number Diff line change
Expand Up @@ -191,7 +191,7 @@ let select_native_mode ~sctx ~dir (buildable : Coq_stanza.Buildable.t) =
else if buildable.coq_lang_version < (0, 7) then Memo.return Coq_mode.VoOnly
else
let* coqc = resolve_program sctx ~dir ~loc:buildable.loc "coqc" in
let+ config = Coq_config.make ~bin:(Action.Prog.ok_exn coqc) in
let+ config = Coq_config.make ~coqc in
match Coq_config.by_name config "coq_native_compiler_default" with
| Some (`String "yes") | Some (`String "ondemand") -> Coq_mode.Native
| _ -> Coq_mode.VoOnly)
Expand Down
14 changes: 11 additions & 3 deletions src/dune_rules/dir_contents.ml
Original file line number Diff line number Diff line change
Expand Up @@ -207,7 +207,15 @@ end = struct
let hash = Tuple.T2.hash Super_context.hash Path.Build.hash
end

let lookup_vlib sctx ~dir = Load.get sctx ~dir >>= ocaml
let lookup_vlib sctx ~current_dir ~loc ~dir =
match Path.Build.equal current_dir dir with
| true ->
User_error.raise ~loc
[ Pp.text
"Virtual library and its implementation(s) cannot be defined in \
the same directory"
]
| false -> Load.get sctx ~dir >>= ocaml

let collect_group ~st_dir ~dir =
let rec walk st_dir ~dir ~local =
Expand Down Expand Up @@ -302,7 +310,7 @@ end = struct
let dirs = [ (dir, [], files) ] in
let ml =
Memo.lazy_ (fun () ->
let lookup_vlib = lookup_vlib sctx in
let lookup_vlib = lookup_vlib sctx ~current_dir:dir in
let loc = loc_of_dune_file st_dir in
let* scope = Scope.DB.find_by_dir dir in
Ml_sources.make d ~dir ~scope ~lib_config ~loc
Expand Down Expand Up @@ -372,7 +380,7 @@ end = struct
let dirs = (dir, [], files) :: subdirs in
let ml =
Memo.lazy_ (fun () ->
let lookup_vlib = lookup_vlib sctx in
let lookup_vlib = lookup_vlib sctx ~current_dir:dir in
let* scope = Scope.DB.find_by_dir dir in
Ml_sources.make d ~dir ~scope ~lib_config ~loc ~lookup_vlib
~include_subdirs ~dirs)
Expand Down
27 changes: 12 additions & 15 deletions src/dune_rules/expander.ml
Original file line number Diff line number Diff line change
Expand Up @@ -616,23 +616,20 @@ let expand_pform_gen ~(context : Context.t) ~bindings ~dir ~source
(fun t ->
Without
(let open Memo.O in
let* bin =
let* coqc =
Artifacts.Bin.binary t.bin_artifacts_host ~loc:None "coqc"
in
match bin with
| Ok bin -> (
let+ t = Coq_config.make ~bin in
match Coq_config.by_name t s with
| None ->
User_error.raise
~loc:(Dune_lang.Template.Pform.loc source)
[ Pp.textf "Unknown Coq configuration variable %S" s ]
| Some v -> (
match v with
| `Int x -> string (string_of_int x)
| `String x -> string x
| `Path x -> Value.L.paths [ x ]))
| Error _ -> User_error.raise Pp.[ textf "coqc not found." ]))))
let+ t = Coq_config.make ~coqc in
match Coq_config.by_name t s with
| None ->
User_error.raise
~loc:(Dune_lang.Template.Pform.loc source)
[ Pp.textf "Unknown Coq configuration variable %S" s ]
| Some v -> (
match v with
| `Int x -> string (string_of_int x)
| `String x -> string x
| `Path x -> Value.L.paths [ x ])))))

(* Make sure to delay exceptions *)
let expand_pform_gen ~context ~bindings ~dir ~source pform =
Expand Down
5 changes: 3 additions & 2 deletions src/dune_rules/ml_sources.ml
Original file line number Diff line number Diff line change
Expand Up @@ -217,7 +217,7 @@ let modules t ~for_ = modules_and_obj_dir t ~for_ |> fst

let find_origin (t : t) name = Module_name.Map.find t.modules.rev_map name

let virtual_modules lookup_vlib vlib =
let virtual_modules ~lookup_vlib vlib =
let info = Lib.info vlib in
let+ modules =
match Option.value_exn (Lib_info.virtual_ info) with
Expand Down Expand Up @@ -277,7 +277,7 @@ let make_lib_modules ~dir ~libs ~lookup_vlib ~(lib : Library.t) ~modules =
let* wrapped = Lib.wrapped resolved in
let wrapped = Option.value_exn wrapped in
let* main_module_name = Lib.main_module_name resolved in
let+ impl = Resolve.Memo.lift_memo (virtual_modules lookup_vlib vlib) in
let+ impl = Resolve.Memo.lift_memo (virtual_modules ~lookup_vlib vlib) in
let kind : Modules_field_evaluator.kind = Implementation impl in
(kind, main_module_name, wrapped)
in
Expand Down Expand Up @@ -335,6 +335,7 @@ let modules_of_stanzas dune_file ~dir ~scope ~lookup_vlib ~modules =
the library is not built. We should change this to carry the
[Or_exn.t] a bit longer. *)
let+ modules =
let lookup_vlib = lookup_vlib ~loc:lib.buildable.loc in
make_lib_modules ~dir ~libs:(Scope.libs scope) ~lookup_vlib ~modules
~lib
>>= Resolve.read_memo
Expand Down
2 changes: 1 addition & 1 deletion src/dune_rules/ml_sources.mli
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ val make :
-> scope:Scope.t
-> lib_config:Lib_config.t
-> loc:Loc.t
-> lookup_vlib:(dir:Path.Build.t -> t Memo.t)
-> lookup_vlib:(loc:Loc.t -> dir:Path.Build.t -> t Memo.t)
-> include_subdirs:Loc.t * Dune_file.Include_subdirs.t
-> dirs:(Path.Build.t * 'a list * String.Set.t) list
-> t Memo.t
31 changes: 14 additions & 17 deletions src/dune_rules/module.ml
Original file line number Diff line number Diff line change
Expand Up @@ -31,30 +31,27 @@ module Kind = struct
| Wrapped_compat
| Root

let to_string = function
| Intf_only -> "intf_only"
| Virtual -> "virtual"
| Impl -> "impl"
| Alias -> "alias"
| Impl_vmodule -> "impl_vmodule"
| Wrapped_compat -> "wrapped_compat"
| Root -> "root"
let all =
[ (Intf_only, "intf_only")
; (Virtual, "virtual")
; (Impl, "impl")
; (Alias, "alias")
; (Impl_vmodule, "impl_vmodule")
; (Wrapped_compat, "wrapped_compat")
; (Root, "root")
]

let rev_all = List.rev_map ~f:(fun (x, y) -> (y, x)) all

let to_string s = Option.value_exn (List.assoc all s)

let to_dyn t = Dyn.string (to_string t)

let encode t = Dune_lang.Encoder.string (to_string t)

let decode =
let open Dune_lang.Decoder in
enum
[ ("intf_only", Intf_only)
; ("virtual", Virtual)
; ("impl", Impl)
; ("alias", Alias)
; ("impl_vmodule", Impl_vmodule)
; ("wrapped_compat", Wrapped_compat)
; ("root", Root)
]
enum rev_all

let has_impl = function
| Alias | Impl_vmodule | Wrapped_compat | Root | Impl -> true
Expand Down

0 comments on commit 7abc35c

Please sign in to comment.