Skip to content

Commit

Permalink
Preserve flags ordering in Merlin configuration files.
Browse files Browse the repository at this point in the history
Fixes ocaml/merlin#1900

Signed-off-by: Ulysse Gérard <[email protected]>
  • Loading branch information
voodoos committed Feb 25, 2025
1 parent cd00c2a commit 58bb8ea
Showing 1 changed file with 18 additions and 14 deletions.
32 changes: 18 additions & 14 deletions src/dune_rules/merlin/merlin.ml
Original file line number Diff line number Diff line change
Expand Up @@ -214,26 +214,30 @@ module Processed = struct
Path.Set.to_list_map hidden_src_dirs ~f:(make_directive_of_path "SH")
in
let flags =
let flags =
match flags with
(* Order matters here. The flags should be communicated to Merlin in the
same order that they are passed to the compiler: user flags, pp flags
and then opens *)
let open_flags =
match opens with
| [] -> []
| flags ->
[ make_directive "FLG" (Sexp.List (List.map ~f:(fun s -> Sexp.Atom s) flags)) ]
| opens ->
let open_flags =
Ocaml_flags.open_flags opens |> List.map ~f:(fun x -> Sexp.Atom x)
in
[ make_directive "FLG" (Sexp.List open_flags) ]
in
let flags =
let other_flags =
match pp with
| None -> flags
| None -> open_flags
| Some { flag; args } ->
make_directive "FLG" (Sexp.List [ Atom (Pp_kind.to_flag flag); Atom args ])
:: flags
:: open_flags
in
match opens with
| [] -> flags
| opens ->
make_directive
"FLG"
(Sexp.List (Ocaml_flags.open_flags opens |> List.map ~f:(fun x -> Sexp.Atom x)))
:: flags
match flags with
| [] -> other_flags
| flags ->
make_directive "FLG" (Sexp.List (List.map ~f:(fun s -> Sexp.Atom s) flags))
:: other_flags
in
let unit_name = [ make_directive "UNIT_NAME" (Sexp.Atom unit_name) ] in
let suffixes =
Expand Down

0 comments on commit 58bb8ea

Please sign in to comment.