From cc4494d5f06b8e91d431248a855584f1558ba15a Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 23 Feb 2023 22:51:46 -0800 Subject: [PATCH 1/3] melange: interpret `melc --where` as a list of `:`-separated paths Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/melange/melange_binary.ml | 29 ++++++++++++++--------- src/dune_rules/melange/melange_binary.mli | 5 +--- src/dune_rules/merlin/merlin.ml | 17 +++++++++---- 3 files changed, 32 insertions(+), 19 deletions(-) diff --git a/src/dune_rules/melange/melange_binary.ml b/src/dune_rules/melange/melange_binary.ml index ad9d352363c..5e88d4b0d2f 100644 --- a/src/dune_rules/melange/melange_binary.ml +++ b/src/dune_rules/melange/melange_binary.ml @@ -13,20 +13,27 @@ let where = @@ Process.run_capture_line ~display:Quiet Process.Strict bin [ "--where" ] in - Path.of_string where + where in let memo = - Memo.create "melange-where" ~input:(module Path) ~cutoff:Path.equal impl + Memo.create "melange-where" ~input:(module Path) ~cutoff:String.equal impl in fun sctx ~loc ~dir -> let open Memo.O in let* env = Super_context.env_node sctx ~dir >>= Env_node.external_env in - match Env.get env "MELANGELIB" with - | Some p -> Memo.return (Some (Path.of_string p)) - | None -> ( - let* melc = melc sctx ~loc ~dir in - match melc with - | Error _ -> Memo.return None - | Ok melc -> - let+ res = Memo.exec memo melc in - Some res) + let+ melange_dirs = + match Env.get env "MELANGELIB" with + | Some p -> Memo.return (Some p) + | None -> ( + let* melc = melc sctx ~loc ~dir in + match melc with + | Error _ -> Memo.return None + | Ok melc -> + let+ res = Memo.exec memo melc in + Some res) + in + Option.map + ~f:(fun dirs -> + String.split ~on:Bin.path_sep dirs |> List.map ~f:Path.of_string) + melange_dirs + |> Option.value ~default:[] diff --git a/src/dune_rules/melange/melange_binary.mli b/src/dune_rules/melange/melange_binary.mli index 0ffd13a7351..17429d73ca0 100644 --- a/src/dune_rules/melange/melange_binary.mli +++ b/src/dune_rules/melange/melange_binary.mli @@ -7,7 +7,4 @@ val melc : -> Action.Prog.t Memo.t val where : - Super_context.t - -> loc:Loc.t option - -> dir:Path.Build.t - -> Path.t option Memo.t + Super_context.t -> loc:Loc.t option -> dir:Path.Build.t -> Path.t list Memo.t diff --git a/src/dune_rules/merlin/merlin.ml b/src/dune_rules/merlin/merlin.ml index e465f43e51a..bc2b75195ba 100644 --- a/src/dune_rules/merlin/merlin.ml +++ b/src/dune_rules/merlin/merlin.ml @@ -466,12 +466,18 @@ module Unprocessed = struct } as t) sctx ~dir ~more_src_dirs ~expander = let open Action_builder.O in let+ config = - let* stdlib_dir = + let* stdlib_dir, extra_obj_dirs = Action_builder.of_memo @@ match t.config.mode with - | `Ocaml -> Memo.return (Some stdlib_dir) - | `Melange -> Melange_binary.where sctx ~loc:None ~dir + | `Ocaml -> Memo.return (Some stdlib_dir, []) + | `Melange -> ( + let open Memo.O in + let+ dirs = Melange_binary.where sctx ~loc:None ~dir in + match dirs with + | [] -> (None, []) + | [ stdlib_dir ] -> (Some stdlib_dir, []) + | stdlib_dir :: extra_obj_dirs -> (Some stdlib_dir, extra_obj_dirs)) in let* flags = flags and* src_dirs, obj_dirs = @@ -481,7 +487,10 @@ module Unprocessed = struct let+ dirs = src_dirs sctx lib in (lib, dirs)) >>| List.fold_left - ~init:(Path.set_of_source_paths source_dirs, objs_dirs) + ~init: + ( Path.set_of_source_paths source_dirs + , Path.Set.union objs_dirs (Path.Set.of_list extra_obj_dirs) + ) ~f:(fun (src_dirs, obj_dirs) (lib, more_src_dirs) -> ( Path.Set.union src_dirs more_src_dirs , let public_cmi_dir = From 9340ec2c05f4da538d7d21114d9603d5ef340666 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 26 Feb 2023 14:13:24 -0800 Subject: [PATCH 2/3] refactor: Use Path.External.t Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/melange/melange_binary.ml | 3 ++- src/dune_rules/melange/melange_binary.mli | 5 ++++- src/dune_rules/merlin/merlin.ml | 6 ++++-- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/dune_rules/melange/melange_binary.ml b/src/dune_rules/melange/melange_binary.ml index 5e88d4b0d2f..f7816c5d9fa 100644 --- a/src/dune_rules/melange/melange_binary.ml +++ b/src/dune_rules/melange/melange_binary.ml @@ -34,6 +34,7 @@ let where = in Option.map ~f:(fun dirs -> - String.split ~on:Bin.path_sep dirs |> List.map ~f:Path.of_string) + String.split ~on:Bin.path_sep dirs + |> List.map ~f:Path.External.of_string) melange_dirs |> Option.value ~default:[] diff --git a/src/dune_rules/melange/melange_binary.mli b/src/dune_rules/melange/melange_binary.mli index 17429d73ca0..580b7cef29b 100644 --- a/src/dune_rules/melange/melange_binary.mli +++ b/src/dune_rules/melange/melange_binary.mli @@ -7,4 +7,7 @@ val melc : -> Action.Prog.t Memo.t val where : - Super_context.t -> loc:Loc.t option -> dir:Path.Build.t -> Path.t list Memo.t + Super_context.t + -> loc:Loc.t option + -> dir:Path.Build.t + -> Path.External.t list Memo.t diff --git a/src/dune_rules/merlin/merlin.ml b/src/dune_rules/merlin/merlin.ml index bc2b75195ba..c8f1ce842c4 100644 --- a/src/dune_rules/merlin/merlin.ml +++ b/src/dune_rules/merlin/merlin.ml @@ -476,8 +476,10 @@ module Unprocessed = struct let+ dirs = Melange_binary.where sctx ~loc:None ~dir in match dirs with | [] -> (None, []) - | [ stdlib_dir ] -> (Some stdlib_dir, []) - | stdlib_dir :: extra_obj_dirs -> (Some stdlib_dir, extra_obj_dirs)) + | [ stdlib_dir ] -> (Some (Path.external_ stdlib_dir), []) + | stdlib_dir :: extra_obj_dirs -> + ( Some (Path.external_ stdlib_dir) + , List.map ~f:Path.external_ extra_obj_dirs )) in let* flags = flags and* src_dirs, obj_dirs = From e6dc5c2ef42f83e79cc805d56a312b5023782a18 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 28 Feb 2023 14:25:01 -0600 Subject: [PATCH 3/3] _ Signed-off-by: Rudi Grinberg --- src/dune_rules/melange/melange_binary.ml | 9 +++------ src/dune_rules/melange/melange_binary.mli | 5 +---- src/dune_rules/merlin/merlin.ml | 6 ++---- 3 files changed, 6 insertions(+), 14 deletions(-) diff --git a/src/dune_rules/melange/melange_binary.ml b/src/dune_rules/melange/melange_binary.ml index f7816c5d9fa..a56a6e78048 100644 --- a/src/dune_rules/melange/melange_binary.ml +++ b/src/dune_rules/melange/melange_binary.ml @@ -32,9 +32,6 @@ let where = let+ res = Memo.exec memo melc in Some res) in - Option.map - ~f:(fun dirs -> - String.split ~on:Bin.path_sep dirs - |> List.map ~f:Path.External.of_string) - melange_dirs - |> Option.value ~default:[] + match melange_dirs with + | None -> [] + | Some dirs -> Bin.parse_path dirs diff --git a/src/dune_rules/melange/melange_binary.mli b/src/dune_rules/melange/melange_binary.mli index 580b7cef29b..17429d73ca0 100644 --- a/src/dune_rules/melange/melange_binary.mli +++ b/src/dune_rules/melange/melange_binary.mli @@ -7,7 +7,4 @@ val melc : -> Action.Prog.t Memo.t val where : - Super_context.t - -> loc:Loc.t option - -> dir:Path.Build.t - -> Path.External.t list Memo.t + Super_context.t -> loc:Loc.t option -> dir:Path.Build.t -> Path.t list Memo.t diff --git a/src/dune_rules/merlin/merlin.ml b/src/dune_rules/merlin/merlin.ml index c8f1ce842c4..bc2b75195ba 100644 --- a/src/dune_rules/merlin/merlin.ml +++ b/src/dune_rules/merlin/merlin.ml @@ -476,10 +476,8 @@ module Unprocessed = struct let+ dirs = Melange_binary.where sctx ~loc:None ~dir in match dirs with | [] -> (None, []) - | [ stdlib_dir ] -> (Some (Path.external_ stdlib_dir), []) - | stdlib_dir :: extra_obj_dirs -> - ( Some (Path.external_ stdlib_dir) - , List.map ~f:Path.external_ extra_obj_dirs )) + | [ stdlib_dir ] -> (Some stdlib_dir, []) + | stdlib_dir :: extra_obj_dirs -> (Some stdlib_dir, extra_obj_dirs)) in let* flags = flags and* src_dirs, obj_dirs =