Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

melange: interpret melc --where as a list of :-separated paths #7176

Merged
merged 3 commits into from
Feb 28, 2023
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
30 changes: 19 additions & 11 deletions src/dune_rules/melange/melange_binary.ml
Original file line number Diff line number Diff line change
Expand Up @@ -13,20 +13,28 @@ 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.External.of_string)
melange_dirs
|> Option.value ~default:[]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This would be more readable (imo) and consistent with code style above without Option functions:

match melange_dirs with
| None -> []
| Some dirs ->
  String.split ~on:Bin.path_sep dirs
  |> List.map ~f:Path.External.of_string

2 changes: 1 addition & 1 deletion src/dune_rules/melange/melange_binary.mli
Original file line number Diff line number Diff line change
Expand Up @@ -10,4 +10,4 @@ val where :
Super_context.t
-> loc:Loc.t option
-> dir:Path.Build.t
-> Path.t option Memo.t
-> Path.External.t list Memo.t
19 changes: 15 additions & 4 deletions src/dune_rules/merlin/merlin.ml
Original file line number Diff line number Diff line change
Expand Up @@ -466,12 +466,20 @@ 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 (Path.external_ stdlib_dir), [])
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If we are converting to Path.t here using external_ in this line and 482 below, would it make sense to just return Path.t list Memo.t from Melange_binary.where directly?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Actually, Bin.parse_sep doesn't allow external paths either.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I changed it to use Bin.parse_sep.

| stdlib_dir :: extra_obj_dirs ->
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is it a little weird that the first directory is being special cased?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I agree, and it might not necessarily be the stdlib if we're not careful, I think that might not matter though?

( Some (Path.external_ stdlib_dir)
, List.map ~f:Path.external_ extra_obj_dirs ))
in
let* flags = flags
and* src_dirs, obj_dirs =
Expand All @@ -481,7 +489,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 =
Expand Down