From 0d971e59189f85f19b97496a0ef310a2e9ce76ef Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Tue, 15 Nov 2022 10:20:08 +0000 Subject: [PATCH 01/16] fix(melange): run melc ppx with merlin Signed-off-by: Javier Chavarri --- src/dune_rules/merlin.ml | 47 ++++++++++++++----- .../test-cases/melange/merlin.t | 13 +++++ 2 files changed, 47 insertions(+), 13 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index bec01745107..b0551416e5c 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -33,6 +33,7 @@ module Processed = struct ; src_dirs : Path.Set.t ; flags : string list ; extensions : string Ml_kind.Dict.t list + ; mode : [ `Ocaml | `Melange ] } (* ...but modules can have different preprocessing specifications*) @@ -68,7 +69,7 @@ module Processed = struct let serialize_path = Path.to_absolute_filename - let to_sexp ~pp { stdlib_dir; obj_dirs; src_dirs; flags; extensions } = + let to_sexp ~pp { stdlib_dir; obj_dirs; src_dirs; flags; extensions; mode } = let make_directive tag value = Sexp.List [ Atom tag; value ] in let make_directive_of_path tag path = make_directive tag (Sexp.Atom (serialize_path path)) @@ -94,11 +95,20 @@ module Processed = struct (Sexp.List (List.map ~f:(fun s -> Sexp.Atom s) flags)) ] in - match pp with - | None -> flags - | Some { flag; args } -> + let flags = + match pp with + | None -> flags + | Some { flag; args } -> + make_directive "FLG" + (Sexp.List [ Atom (Pp_kind.to_flag flag); Atom args ]) + :: flags + in + match mode with + | `Ocaml -> flags + | `Melange -> make_directive "FLG" - (Sexp.List [ Atom (Pp_kind.to_flag flag); Atom args ]) + (Sexp.List + [ Atom (Pp_kind.to_flag Ppx); Atom "melc -as-ppx -bs-jsx 3" ]) :: flags in let suffixes = @@ -120,7 +130,8 @@ module Processed = struct in if String.need_quoting s then Filename.quote s else s - let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions = + let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions + (* TODO print melange flag *) _mode = let b = Buffer.create 256 in let printf = Printf.bprintf b in let print = Buffer.add_string b in @@ -184,7 +195,7 @@ module Processed = struct | Error msg -> Printf.eprintf "%s\n" msg | Ok [] -> Printf.eprintf "No merlin configuration found.\n" | Ok (init :: tl) -> - let pp_configs, obj_dirs, src_dirs, flags, extensions = + let pp_configs, obj_dirs, src_dirs, flags, extensions, mode = (* We merge what is easy to merge and ignore the rest *) List.fold_left tl ~init: @@ -192,24 +203,34 @@ module Processed = struct , init.config.obj_dirs , init.config.src_dirs , [ init.config.flags ] - , init.config.extensions ) + , init.config.extensions + , init.config.mode ) ~f:(fun - (acc_pp, acc_obj, acc_src, acc_flags, acc_ext) + (acc_pp, acc_obj, acc_src, acc_flags, acc_ext, acc_mode) { modules = _ ; pp_config ; config = - { stdlib_dir = _; obj_dirs; src_dirs; flags; extensions } + { stdlib_dir = _ + ; obj_dirs + ; src_dirs + ; flags + ; extensions + ; mode + } } -> ( pp_config :: acc_pp , Path.Set.union acc_obj obj_dirs , Path.Set.union acc_src src_dirs , flags :: acc_flags - , extensions @ acc_ext )) + , extensions @ acc_ext + , match acc_mode with + | `Melange -> `Melange + | `Ocaml -> mode )) in Printf.printf "%s\n" (to_dot_merlin init.config.stdlib_dir pp_configs flags obj_dirs src_dirs - extensions) + extensions mode) end let obj_dir_of_lib kind mode obj_dir = @@ -414,7 +435,7 @@ module Unprocessed = struct Path.Set.union src_dirs (Path.Set.of_list_map ~f:Path.source more_src_dirs) in - { Processed.stdlib_dir; src_dirs; obj_dirs; flags; extensions } + { Processed.stdlib_dir; src_dirs; obj_dirs; flags; extensions; mode } and+ pp_config = pp_config t sctx ~expander in let modules = (* And copy for each module the resulting pp flags *) diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index efb709b24a9..847130651d3 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -10,6 +10,7 @@ > (library > (name $lib) > (private_modules bar) + > (flags :standard -bs-jsx 3) > (modes melange)) > EOF @@ -25,6 +26,13 @@ $TESTCASE_ROOT/_build/default/.foo.objs/melange) Foo__ +All 3 entries (Foo, Foo__ and Bar) contain a ppx directive + + $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "ppx" + (FLG (-ppx "melc -as-ppx -bs-jsx 3")) + (FLG (-ppx "melc -as-ppx -bs-jsx 3")) + (FLG (-ppx "melc -as-ppx -bs-jsx 3")) + $ target=output $ cat >dune < (melange.emit @@ -37,3 +45,8 @@ $ dune build @check $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "$target" $TESTCASE_ROOT/_build/default/.output.mobjs/melange) + +The melange.emit entry contains a ppx directive + + $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "ppx" + (FLG (-ppx "melc -as-ppx -bs-jsx 3")) From 5de07976baefcbd1879a67b6f900f65727f2670f Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Wed, 16 Nov 2022 09:46:07 +0000 Subject: [PATCH 02/16] pass compiler flags to ppx directive Signed-off-by: Javier Chavarri --- src/dune_rules/merlin.ml | 5 +- .../test-cases/melange/merlin.t | 65 +++++++++++++------ 2 files changed, 49 insertions(+), 21 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index b0551416e5c..a68d115a544 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -87,6 +87,7 @@ module Processed = struct Path.Set.to_list_map src_dirs ~f:(make_directive_of_path "S") in let flags = + let compiler_flags = flags in let flags = match flags with | [] -> [] @@ -108,7 +109,9 @@ module Processed = struct | `Melange -> make_directive "FLG" (Sexp.List - [ Atom (Pp_kind.to_flag Ppx); Atom "melc -as-ppx -bs-jsx 3" ]) + (Atom (Pp_kind.to_flag Ppx) + :: Atom "melc" :: Atom "-as-ppx" + :: List.map ~f:(fun s -> Sexp.Atom s) compiler_flags)) :: flags in let suffixes = diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index 847130651d3..0bc9426b66b 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -6,38 +6,55 @@ > EOF $ lib=foo - $ cat >dune <$lib/dune < (library > (name $lib) > (private_modules bar) - > (flags :standard -bs-jsx 3) + > (flags -bs-jsx 3) > (modes melange)) > EOF - $ touch bar.ml $lib.ml + $ touch $lib/bar.ml $lib/$lib.ml $ dune build @check - $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "$lib" - Foo - $TESTCASE_ROOT/_build/default/.foo.objs/melange) - Foo__ - $TESTCASE_ROOT/_build/default/.foo.objs/melange) - Foo__ - Foo__ - $TESTCASE_ROOT/_build/default/.foo.objs/melange) - Foo__ -All 3 entries (Foo, Foo__ and Bar) contain a ppx directive +All library entries contain a ppx directive - $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "ppx" - (FLG (-ppx "melc -as-ppx -bs-jsx 3")) - (FLG (-ppx "melc -as-ppx -bs-jsx 3")) - (FLG (-ppx "melc -as-ppx -bs-jsx 3")) + $ dune ocaml-merlin --dump-config="$(pwd)/$lib" + Foo + ((STDLIB /home/me/code/dune/_opam/lib/melange) + (EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/foo/.foo.objs/melange) + (S + $TESTCASE_ROOT/foo) + (FLG (-ppx melc -as-ppx -open Foo__ -bs-jsx 3)) + (FLG (-open Foo__ -bs-jsx 3))) + Bar + ((STDLIB /home/me/code/dune/_opam/lib/melange) + (EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/foo/.foo.objs/melange) + (S + $TESTCASE_ROOT/foo) + (FLG (-ppx melc -as-ppx -open Foo__ -bs-jsx 3)) + (FLG (-open Foo__ -bs-jsx 3))) + Foo__ + ((STDLIB /home/me/code/dune/_opam/lib/melange) + (EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/foo/.foo.objs/melange) + (S + $TESTCASE_ROOT/foo) + (FLG (-ppx melc -as-ppx -open Foo__ -bs-jsx 3)) + (FLG (-open Foo__ -bs-jsx 3))) $ target=output $ cat >dune < (melange.emit > (target "$target") > (entries main) + > (flags -foo bar) > (module_system commonjs)) > EOF @@ -46,7 +63,15 @@ All 3 entries (Foo, Foo__ and Bar) contain a ppx directive $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "$target" $TESTCASE_ROOT/_build/default/.output.mobjs/melange) -The melange.emit entry contains a ppx directive +The melange.emit entry contains a ppx directive, but no -bs-jsx flag - $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "ppx" - (FLG (-ppx "melc -as-ppx -bs-jsx 3")) + $ dune ocaml-merlin --dump-config="$(pwd)" + Main + ((STDLIB /home/me/code/dune/_opam/lib/melange) + (EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/.output.mobjs/melange) + (S + $TESTCASE_ROOT) + (FLG (-ppx melc -as-ppx -foo bar)) + (FLG (-foo bar))) From 993c0ffbb5f8a1e0b9f5dacd9867d712df9ed965 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Wed, 16 Nov 2022 10:17:16 +0000 Subject: [PATCH 03/16] Revert "pass compiler flags to ppx directive" This reverts commit 5de07976baefcbd1879a67b6f900f65727f2670f. --- src/dune_rules/merlin.ml | 5 +- .../test-cases/melange/merlin.t | 65 ++++++------------- 2 files changed, 21 insertions(+), 49 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index a68d115a544..b0551416e5c 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -87,7 +87,6 @@ module Processed = struct Path.Set.to_list_map src_dirs ~f:(make_directive_of_path "S") in let flags = - let compiler_flags = flags in let flags = match flags with | [] -> [] @@ -109,9 +108,7 @@ module Processed = struct | `Melange -> make_directive "FLG" (Sexp.List - (Atom (Pp_kind.to_flag Ppx) - :: Atom "melc" :: Atom "-as-ppx" - :: List.map ~f:(fun s -> Sexp.Atom s) compiler_flags)) + [ Atom (Pp_kind.to_flag Ppx); Atom "melc -as-ppx -bs-jsx 3" ]) :: flags in let suffixes = diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index 0bc9426b66b..847130651d3 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -6,55 +6,38 @@ > EOF $ lib=foo - $ mkdir $lib - $ cat >$lib/dune <dune < (library > (name $lib) > (private_modules bar) - > (flags -bs-jsx 3) + > (flags :standard -bs-jsx 3) > (modes melange)) > EOF - $ touch $lib/bar.ml $lib/$lib.ml + $ touch bar.ml $lib.ml $ dune build @check - -All library entries contain a ppx directive - - $ dune ocaml-merlin --dump-config="$(pwd)/$lib" + $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "$lib" Foo - ((STDLIB /home/me/code/dune/_opam/lib/melange) - (EXCLUDE_QUERY_DIR) - (B - $TESTCASE_ROOT/_build/default/foo/.foo.objs/melange) - (S - $TESTCASE_ROOT/foo) - (FLG (-ppx melc -as-ppx -open Foo__ -bs-jsx 3)) - (FLG (-open Foo__ -bs-jsx 3))) - Bar - ((STDLIB /home/me/code/dune/_opam/lib/melange) - (EXCLUDE_QUERY_DIR) - (B - $TESTCASE_ROOT/_build/default/foo/.foo.objs/melange) - (S - $TESTCASE_ROOT/foo) - (FLG (-ppx melc -as-ppx -open Foo__ -bs-jsx 3)) - (FLG (-open Foo__ -bs-jsx 3))) + $TESTCASE_ROOT/_build/default/.foo.objs/melange) + Foo__ + $TESTCASE_ROOT/_build/default/.foo.objs/melange) + Foo__ Foo__ - ((STDLIB /home/me/code/dune/_opam/lib/melange) - (EXCLUDE_QUERY_DIR) - (B - $TESTCASE_ROOT/_build/default/foo/.foo.objs/melange) - (S - $TESTCASE_ROOT/foo) - (FLG (-ppx melc -as-ppx -open Foo__ -bs-jsx 3)) - (FLG (-open Foo__ -bs-jsx 3))) + $TESTCASE_ROOT/_build/default/.foo.objs/melange) + Foo__ + +All 3 entries (Foo, Foo__ and Bar) contain a ppx directive + + $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "ppx" + (FLG (-ppx "melc -as-ppx -bs-jsx 3")) + (FLG (-ppx "melc -as-ppx -bs-jsx 3")) + (FLG (-ppx "melc -as-ppx -bs-jsx 3")) $ target=output $ cat >dune < (melange.emit > (target "$target") > (entries main) - > (flags -foo bar) > (module_system commonjs)) > EOF @@ -63,15 +46,7 @@ All library entries contain a ppx directive $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "$target" $TESTCASE_ROOT/_build/default/.output.mobjs/melange) -The melange.emit entry contains a ppx directive, but no -bs-jsx flag +The melange.emit entry contains a ppx directive - $ dune ocaml-merlin --dump-config="$(pwd)" - Main - ((STDLIB /home/me/code/dune/_opam/lib/melange) - (EXCLUDE_QUERY_DIR) - (B - $TESTCASE_ROOT/_build/default/.output.mobjs/melange) - (S - $TESTCASE_ROOT) - (FLG (-ppx melc -as-ppx -foo bar)) - (FLG (-foo bar))) + $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "ppx" + (FLG (-ppx "melc -as-ppx -bs-jsx 3")) From 4acd9e1e11639e22b808239e38d1e92108146147 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Thu, 24 Nov 2022 22:21:57 +0000 Subject: [PATCH 04/16] use dune ocaml merlin dump-config /home/me/code/dune Signed-off-by: Javier Chavarri --- test/blackbox-tests/test-cases/melange/merlin.t | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index f666d9a1829..2a008a27778 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -28,7 +28,7 @@ All 3 entries (Foo, Foo__ and Bar) contain a ppx directive - $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "ppx" + $ dune ocaml merlin dump-config $PWD | grep -i "ppx" (FLG (-ppx "melc -as-ppx -bs-jsx 3")) (FLG (-ppx "melc -as-ppx -bs-jsx 3")) (FLG (-ppx "melc -as-ppx -bs-jsx 3")) @@ -43,10 +43,10 @@ All 3 entries (Foo, Foo__ and Bar) contain a ppx directive $ touch main.ml $ dune build @check - $ dune ocaml merlin dump-config "$PWD" | grep -i "$target" + $ dune ocaml merlin dump-config $PWD | grep -i "$target" $TESTCASE_ROOT/_build/default/.output.mobjs/melange) The melange.emit entry contains a ppx directive - $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "ppx" + $ dune ocaml merlin dump-config $PWD | grep -i "ppx" (FLG (-ppx "melc -as-ppx -bs-jsx 3")) From 858dac6666a97ce0b573c5dd8b6499175efd3480 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Thu, 24 Nov 2022 22:22:18 +0000 Subject: [PATCH 05/16] remove flags from dune file Signed-off-by: Javier Chavarri --- test/blackbox-tests/test-cases/melange/merlin.t | 1 - 1 file changed, 1 deletion(-) diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index 2a008a27778..d64fa56516a 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -10,7 +10,6 @@ > (library > (name $lib) > (private_modules bar) - > (flags :standard -bs-jsx 3) > (modes melange)) > EOF From c4a6d2bb8cf844268f9b930b746387b8f64f3a18 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Thu, 24 Nov 2022 23:29:57 +0000 Subject: [PATCH 06/16] fix dump-dot-merlin Signed-off-by: Javier Chavarri --- src/dune_rules/merlin.ml | 7 ++++++- test/blackbox-tests/test-cases/melange/merlin.t | 8 ++++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index da282eee569..349b0f0e973 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -131,7 +131,7 @@ module Processed = struct if String.need_quoting s then Filename.quote s else s let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions - (* TODO print melange flag *) _mode = + mode = let b = Buffer.create 256 in let printf = Printf.bprintf b in let print = Buffer.add_string b in @@ -156,6 +156,11 @@ module Processed = struct print "# FLG"; List.iter flags ~f:(fun f -> printf " %s" (quote_for_dot_merlin f)); print "\n"); + let () = + match mode with + | `Ocaml -> () + | `Melange -> print "# FLG -ppx melc -as-ppx -bs-jsx 3\n" + in Buffer.contents b let get { modules; pp_config; config } ~filename = diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index d64fa56516a..902730b52bf 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -49,3 +49,11 @@ The melange.emit entry contains a ppx directive $ dune ocaml merlin dump-config $PWD | grep -i "ppx" (FLG (-ppx "melc -as-ppx -bs-jsx 3")) + + $ dune ocaml dump-dot-merlin $PWD + EXCLUDE_QUERY_DIR + STDLIB /home/me/code/dune/_opam/lib/melange + B $TESTCASE_ROOT/_build/default/.output.mobjs/melange + S $TESTCASE_ROOT + # FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62@67@69-40 -strict-sequence -strict-formats -short-paths -keep-locs + # FLG -ppx melc -as-ppx -bs-jsx 3 From 5c34973f817c0dab8da113fcb6849b3898eb0520 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Thu, 24 Nov 2022 23:38:25 +0000 Subject: [PATCH 07/16] quote melc ppx flag Signed-off-by: Javier Chavarri --- src/dune_rules/merlin.ml | 8 +++++--- test/blackbox-tests/test-cases/melange/merlin.t | 2 +- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 349b0f0e973..b378ad601f3 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -69,6 +69,8 @@ module Processed = struct let serialize_path = Path.to_absolute_filename + let melc_ppx_flg = "melc -as-ppx -bs-jsx 3" + let to_sexp ~pp { stdlib_dir; obj_dirs; src_dirs; flags; extensions; mode } = let make_directive tag value = Sexp.List [ Atom tag; value ] in let make_directive_of_path tag path = @@ -107,8 +109,7 @@ module Processed = struct | `Ocaml -> flags | `Melange -> make_directive "FLG" - (Sexp.List - [ Atom (Pp_kind.to_flag Ppx); Atom "melc -as-ppx -bs-jsx 3" ]) + (Sexp.List [ Atom (Pp_kind.to_flag Ppx); Atom melc_ppx_flg ]) :: flags in let suffixes = @@ -159,7 +160,8 @@ module Processed = struct let () = match mode with | `Ocaml -> () - | `Melange -> print "# FLG -ppx melc -as-ppx -bs-jsx 3\n" + | `Melange -> + print ("# FLG -ppx " ^ quote_for_dot_merlin melc_ppx_flg ^ "\n") in Buffer.contents b diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index 902730b52bf..f96fdd63b3a 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -56,4 +56,4 @@ The melange.emit entry contains a ppx directive B $TESTCASE_ROOT/_build/default/.output.mobjs/melange S $TESTCASE_ROOT # FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62@67@69-40 -strict-sequence -strict-formats -short-paths -keep-locs - # FLG -ppx melc -as-ppx -bs-jsx 3 + # FLG -ppx 'melc -as-ppx -bs-jsx 3' From f2b7a96ca56d1afbab69c3c2ab50982736c1805d Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Mon, 28 Nov 2022 15:50:10 +0000 Subject: [PATCH 08/16] fix test Signed-off-by: Javier Chavarri --- test/blackbox-tests/test-cases/melange/merlin.t | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index f96fdd63b3a..0bf0e0bb563 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -1,5 +1,8 @@ Temporary special merlin support for melange only libs + $ melc_where="$(melc -where)" + $ export BUILD_PATH_PREFIX_MAP="/MELC_WHERE=$melc_where:$BUILD_PATH_PREFIX_MAP" + $ cat >dune-project < (lang dune 3.6) > (using melange 0.1) @@ -52,8 +55,9 @@ The melange.emit entry contains a ppx directive $ dune ocaml dump-dot-merlin $PWD EXCLUDE_QUERY_DIR - STDLIB /home/me/code/dune/_opam/lib/melange + STDLIB /MELC_WHERE B $TESTCASE_ROOT/_build/default/.output.mobjs/melange S $TESTCASE_ROOT # FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62@67@69-40 -strict-sequence -strict-formats -short-paths -keep-locs # FLG -ppx 'melc -as-ppx -bs-jsx 3' + From c6e8bd64566396880daf728501160d9aa6fa677b Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Tue, 29 Nov 2022 08:32:43 +0000 Subject: [PATCH 09/16] merlin: print absolute path to melc Signed-off-by: Javier Chavarri --- src/dune_rules/merlin.ml | 39 ++++++++++++++----- .../test-cases/melange/merlin.t | 10 +++-- 2 files changed, 36 insertions(+), 13 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index b378ad601f3..f6c813a176d 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -34,6 +34,7 @@ module Processed = struct ; flags : string list ; extensions : string Ml_kind.Dict.t list ; mode : [ `Ocaml | `Melange ] + ; melc_compiler : Action.Prog.t } (* ...but modules can have different preprocessing specifications*) @@ -69,9 +70,9 @@ module Processed = struct let serialize_path = Path.to_absolute_filename - let melc_ppx_flg = "melc -as-ppx -bs-jsx 3" - - let to_sexp ~pp { stdlib_dir; obj_dirs; src_dirs; flags; extensions; mode } = + let to_sexp ~pp + { stdlib_dir; obj_dirs; src_dirs; flags; extensions; mode; melc_compiler } + = let make_directive tag value = Sexp.List [ Atom tag; value ] in let make_directive_of_path tag path = make_directive tag (Sexp.Atom (serialize_path path)) @@ -107,10 +108,19 @@ module Processed = struct in match mode with | `Ocaml -> flags - | `Melange -> - make_directive "FLG" - (Sexp.List [ Atom (Pp_kind.to_flag Ppx); Atom melc_ppx_flg ]) - :: flags + | `Melange -> ( + match melc_compiler with + | Error _ -> flags + | Ok path -> + make_directive "FLG" + (Sexp.List + [ Atom (Pp_kind.to_flag Ppx) + ; Atom (serialize_path path) + ; Atom "-as-ppx" + ; Atom "-bs-jsx" + ; Atom "3" + ]) + :: flags) in let suffixes = List.map extensions ~f:(fun { Ml_kind.Dict.impl; intf } -> @@ -161,7 +171,8 @@ module Processed = struct match mode with | `Ocaml -> () | `Melange -> - print ("# FLG -ppx " ^ quote_for_dot_merlin melc_ppx_flg ^ "\n") + print + ("# FLG -ppx " ^ quote_for_dot_merlin "melc -as-ppx -bs-jsx 3" ^ "\n") in Buffer.contents b @@ -222,6 +233,7 @@ module Processed = struct ; flags ; extensions ; mode + ; melc_compiler = _ } } -> @@ -441,12 +453,21 @@ module Unprocessed = struct obj_dir_of_lib `Public mode (Lib_info.obj_dir info) in Path.Set.add obj_dirs public_cmi_dir ))) + and+ melc_compiler = + Action_builder.of_memo (Melange_binary.melc sctx ~dir) in let src_dirs = Path.Set.union src_dirs (Path.Set.of_list_map ~f:Path.source more_src_dirs) in - { Processed.stdlib_dir; src_dirs; obj_dirs; flags; extensions; mode } + { Processed.stdlib_dir + ; src_dirs + ; obj_dirs + ; flags + ; extensions + ; mode + ; melc_compiler + } and+ pp_config = pp_config t sctx ~expander in let modules = (* And copy for each module the resulting pp flags *) diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index 0bf0e0bb563..4ff9e82fcdf 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -2,6 +2,8 @@ $ melc_where="$(melc -where)" $ export BUILD_PATH_PREFIX_MAP="/MELC_WHERE=$melc_where:$BUILD_PATH_PREFIX_MAP" + $ melc_compiler="$(which melc)" + $ export BUILD_PATH_PREFIX_MAP="/MELC_COMPILER=$melc_compiler:$BUILD_PATH_PREFIX_MAP" $ cat >dune-project < (lang dune 3.6) @@ -31,9 +33,9 @@ All 3 entries (Foo, Foo__ and Bar) contain a ppx directive $ dune ocaml merlin dump-config $PWD | grep -i "ppx" - (FLG (-ppx "melc -as-ppx -bs-jsx 3")) - (FLG (-ppx "melc -as-ppx -bs-jsx 3")) - (FLG (-ppx "melc -as-ppx -bs-jsx 3")) + (FLG (-ppx /MELC_COMPILER -as-ppx -bs-jsx 3)) + (FLG (-ppx /MELC_COMPILER -as-ppx -bs-jsx 3)) + (FLG (-ppx /MELC_COMPILER -as-ppx -bs-jsx 3)) $ target=output $ cat >dune < Date: Tue, 29 Nov 2022 08:46:49 +0000 Subject: [PATCH 10/16] merlin: lift melc_flags to Processed.config Signed-off-by: Javier Chavarri --- src/dune_rules/merlin.ml | 72 +++++++++---------- .../test-cases/melange/merlin.t | 2 +- 2 files changed, 37 insertions(+), 37 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index f6c813a176d..74370824bb5 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -33,8 +33,7 @@ module Processed = struct ; src_dirs : Path.Set.t ; flags : string list ; extensions : string Ml_kind.Dict.t list - ; mode : [ `Ocaml | `Melange ] - ; melc_compiler : Action.Prog.t + ; melc_flags : string list option } (* ...but modules can have different preprocessing specifications*) @@ -71,8 +70,7 @@ module Processed = struct let serialize_path = Path.to_absolute_filename let to_sexp ~pp - { stdlib_dir; obj_dirs; src_dirs; flags; extensions; mode; melc_compiler } - = + { stdlib_dir; obj_dirs; src_dirs; flags; extensions; melc_flags } = let make_directive tag value = Sexp.List [ Atom tag; value ] in let make_directive_of_path tag path = make_directive tag (Sexp.Atom (serialize_path path)) @@ -106,21 +104,12 @@ module Processed = struct (Sexp.List [ Atom (Pp_kind.to_flag flag); Atom args ]) :: flags in - match mode with - | `Ocaml -> flags - | `Melange -> ( - match melc_compiler with - | Error _ -> flags - | Ok path -> - make_directive "FLG" - (Sexp.List - [ Atom (Pp_kind.to_flag Ppx) - ; Atom (serialize_path path) - ; Atom "-as-ppx" - ; Atom "-bs-jsx" - ; Atom "3" - ]) - :: flags) + match melc_flags with + | None -> flags + | Some melc_flags -> + make_directive "FLG" + (Sexp.List (List.map ~f:(fun s -> Sexp.Atom s) melc_flags)) + :: flags in let suffixes = List.map extensions ~f:(fun { Ml_kind.Dict.impl; intf } -> @@ -142,7 +131,7 @@ module Processed = struct if String.need_quoting s then Filename.quote s else s let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions - mode = + melc_flags = let b = Buffer.create 256 in let printf = Printf.bprintf b in let print = Buffer.add_string b in @@ -168,11 +157,12 @@ module Processed = struct List.iter flags ~f:(fun f -> printf " %s" (quote_for_dot_merlin f)); print "\n"); let () = - match mode with - | `Ocaml -> () - | `Melange -> - print - ("# FLG -ppx " ^ quote_for_dot_merlin "melc -as-ppx -bs-jsx 3" ^ "\n") + match melc_flags with + | None -> () + | Some melc_flags -> + print "# FLG"; + List.iter melc_flags ~f:(fun f -> printf " %s" (quote_for_dot_merlin f)); + print "\n" in Buffer.contents b @@ -212,7 +202,7 @@ module Processed = struct | Error msg -> Printf.eprintf "%s\n" msg | Ok [] -> Printf.eprintf "No merlin configuration found.\n" | Ok (init :: tl) -> - let pp_configs, obj_dirs, src_dirs, flags, extensions, mode = + let pp_configs, obj_dirs, src_dirs, flags, extensions, melc_flags = (* We merge what is easy to merge and ignore the rest *) List.fold_left tl ~init: @@ -221,9 +211,9 @@ module Processed = struct , init.config.src_dirs , [ init.config.flags ] , init.config.extensions - , init.config.mode ) + , init.config.melc_flags ) ~f:(fun - (acc_pp, acc_obj, acc_src, acc_flags, acc_ext, acc_mode) + (acc_pp, acc_obj, acc_src, acc_flags, acc_ext, acc_melc_flags) { modules = _ ; pp_config ; config = @@ -232,8 +222,7 @@ module Processed = struct ; src_dirs ; flags ; extensions - ; mode - ; melc_compiler = _ + ; melc_flags } } -> @@ -242,13 +231,13 @@ module Processed = struct , Path.Set.union acc_src src_dirs , flags :: acc_flags , extensions @ acc_ext - , match acc_mode with - | `Melange -> `Melange - | `Ocaml -> mode )) + , match acc_melc_flags with + | Some _ -> acc_melc_flags + | None -> melc_flags )) in Printf.printf "%s\n" (to_dot_merlin init.config.stdlib_dir pp_configs flags obj_dirs src_dirs - extensions mode) + extensions melc_flags) end let obj_dir_of_lib kind mode obj_dir = @@ -460,13 +449,24 @@ module Unprocessed = struct Path.Set.union src_dirs (Path.Set.of_list_map ~f:Path.source more_src_dirs) in + let melc_flags = + match melc_compiler with + | Error _ -> None + | Ok path -> + Some + [ Processed.Pp_kind.to_flag Ppx + ; Processed.serialize_path path + ; "-as-ppx" + ; "-bs-jsx" + ; "3" + ] + in { Processed.stdlib_dir ; src_dirs ; obj_dirs ; flags ; extensions - ; mode - ; melc_compiler + ; melc_flags } and+ pp_config = pp_config t sctx ~expander in let modules = diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index 4ff9e82fcdf..1b28075ad2e 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -61,5 +61,5 @@ The melange.emit entry contains a ppx directive B $TESTCASE_ROOT/_build/default/.output.mobjs/melange S $TESTCASE_ROOT # FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62@67@69-40 -strict-sequence -strict-formats -short-paths -keep-locs - # FLG -ppx 'melc -as-ppx -bs-jsx 3' + # FLG -ppx /MELC_COMPILER -as-ppx -bs-jsx 3 From e759821a6ce2b519d81b8c704311fd41485c00f1 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Tue, 29 Nov 2022 08:59:03 +0000 Subject: [PATCH 11/16] merlin: fix after breakage upstream Signed-off-by: Javier Chavarri --- src/dune_rules/merlin.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index a4ea2bf5462..08ba6d97455 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -443,7 +443,7 @@ module Unprocessed = struct in Path.Set.add obj_dirs public_cmi_dir ))) and+ melc_compiler = - Action_builder.of_memo (Melange_binary.melc sctx ~dir) + Action_builder.of_memo (Melange_binary.melc sctx ~loc:None ~dir) in let src_dirs = Path.Set.union src_dirs From 97c0115a578fa423f358cf1b3b49b7401b8f8d77 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 29 Nov 2022 11:50:38 -0500 Subject: [PATCH 12/16] _ Signed-off-by: Rudi Grinberg --- src/dune_rules/merlin.ml | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 08ba6d97455..26569f126f4 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -130,8 +130,7 @@ module Processed = struct in if String.need_quoting s then Filename.quote s else s - let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions - melc_flags = + let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions = let b = Buffer.create 256 in let printf = Printf.bprintf b in let print = Buffer.add_string b in @@ -156,14 +155,6 @@ module Processed = struct print "# FLG"; List.iter flags ~f:(fun f -> printf " %s" (quote_for_dot_merlin f)); print "\n"); - let () = - match melc_flags with - | None -> () - | Some melc_flags -> - print "# FLG"; - List.iter melc_flags ~f:(fun f -> printf " %s" (quote_for_dot_merlin f)); - print "\n" - in Buffer.contents b let get { modules; pp_config; config } ~filename = @@ -235,9 +226,14 @@ module Processed = struct | Some _ -> acc_melc_flags | None -> melc_flags )) in + let flags = + match melc_flags with + | None -> flags + | Some melc -> melc :: flags + in Printf.printf "%s\n" (to_dot_merlin init.config.stdlib_dir pp_configs flags obj_dirs src_dirs - extensions melc_flags) + extensions) end let obj_dir_of_lib kind mode obj_dir = From 437fabd9ae8254af1b62cdec23b6d091c90d6c94 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Tue, 29 Nov 2022 17:18:28 +0000 Subject: [PATCH 13/16] merlin: fix tests Signed-off-by: Javier Chavarri --- test/blackbox-tests/test-cases/melange/merlin.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index 1b28075ad2e..ab0fc641d3e 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -60,6 +60,6 @@ The melange.emit entry contains a ppx directive STDLIB /MELC_WHERE B $TESTCASE_ROOT/_build/default/.output.mobjs/melange S $TESTCASE_ROOT - # FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62@67@69-40 -strict-sequence -strict-formats -short-paths -keep-locs # FLG -ppx /MELC_COMPILER -as-ppx -bs-jsx 3 + # FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62@67@69-40 -strict-sequence -strict-formats -short-paths -keep-locs From dfff493f13a12a6802f826f4a9e56fde49385d5c Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Tue, 29 Nov 2022 17:34:05 +0000 Subject: [PATCH 14/16] merlin: remove opt Signed-off-by: Javier Chavarri --- src/dune_rules/merlin.ml | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 26569f126f4..ae6efe1c7aa 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -33,7 +33,7 @@ module Processed = struct ; src_dirs : Path.Set.t ; flags : string list ; extensions : string Ml_kind.Dict.t list - ; melc_flags : string list option + ; melc_flags : string list } (* ...but modules can have different preprocessing specifications*) @@ -105,8 +105,8 @@ module Processed = struct :: flags in match melc_flags with - | None -> flags - | Some melc_flags -> + | [] -> flags + | melc_flags -> make_directive "FLG" (Sexp.List (List.map ~f:(fun s -> Sexp.Atom s) melc_flags)) :: flags @@ -223,13 +223,13 @@ module Processed = struct , flags :: acc_flags , extensions @ acc_ext , match acc_melc_flags with - | Some _ -> acc_melc_flags - | None -> melc_flags )) + | [] -> melc_flags + | acc_melc_flags -> acc_melc_flags )) in let flags = match melc_flags with - | None -> flags - | Some melc -> melc :: flags + | [] -> flags + | melc -> melc :: flags in Printf.printf "%s\n" (to_dot_merlin init.config.stdlib_dir pp_configs flags obj_dirs src_dirs @@ -447,15 +447,14 @@ module Unprocessed = struct in let melc_flags = match melc_compiler with - | Error _ -> None + | Error _ -> [] | Ok path -> - Some - [ Processed.Pp_kind.to_flag Ppx - ; Processed.serialize_path path - ; "-as-ppx" - ; "-bs-jsx" - ; "3" - ] + [ Processed.Pp_kind.to_flag Ppx + ; Processed.serialize_path path + ; "-as-ppx" + ; "-bs-jsx" + ; "3" + ] in { Processed.stdlib_dir ; src_dirs From dadc8962e9560cde6a1bc49f01cce76b15cd7fe4 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Wed, 30 Nov 2022 08:40:30 +0000 Subject: [PATCH 15/16] merlin: don't add melange flags to ocaml builds Signed-off-by: Javier Chavarri --- src/dune_rules/merlin.ml | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index ae6efe1c7aa..c2101dfb686 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -422,8 +422,8 @@ module Unprocessed = struct | `Ocaml -> Memo.return (Some stdlib_dir) | `Melange -> Melange_binary.where sctx ~loc:None ~dir in - let+ flags = flags - and+ src_dirs, obj_dirs = + let* flags = flags + and* src_dirs, obj_dirs = Action_builder.of_memo (let open Memo.O in Memo.parallel_map (Lib.Set.to_list requires) ~f:(fun lib -> @@ -438,23 +438,27 @@ module Unprocessed = struct obj_dir_of_lib `Public mode (Lib_info.obj_dir info) in Path.Set.add obj_dirs public_cmi_dir ))) - and+ melc_compiler = - Action_builder.of_memo (Melange_binary.melc sctx ~loc:None ~dir) in let src_dirs = Path.Set.union src_dirs (Path.Set.of_list_map ~f:Path.source more_src_dirs) in - let melc_flags = - match melc_compiler with - | Error _ -> [] - | Ok path -> - [ Processed.Pp_kind.to_flag Ppx - ; Processed.serialize_path path - ; "-as-ppx" - ; "-bs-jsx" - ; "3" - ] + let+ melc_flags = + match t.config.mode with + | `Ocaml -> Action_builder.return [] + | `Melange -> ( + let+ melc_compiler = + Action_builder.of_memo (Melange_binary.melc sctx ~loc:None ~dir) + in + match melc_compiler with + | Error _ -> [] + | Ok path -> + [ Processed.Pp_kind.to_flag Ppx + ; Processed.serialize_path path + ; "-as-ppx" + ; "-bs-jsx" + ; "3" + ]) in { Processed.stdlib_dir ; src_dirs From 8bacbb765277a1a45e5ca313663bb7f01be35bec Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Wed, 30 Nov 2022 15:07:38 +0000 Subject: [PATCH 16/16] merlin: pass all flags at once Signed-off-by: Javier Chavarri --- src/dune_rules/merlin.ml | 5 +---- test/blackbox-tests/test-cases/melange/merlin.t | 10 +++++----- 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index c2101dfb686..d7c45918c92 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -454,10 +454,7 @@ module Unprocessed = struct | Error _ -> [] | Ok path -> [ Processed.Pp_kind.to_flag Ppx - ; Processed.serialize_path path - ; "-as-ppx" - ; "-bs-jsx" - ; "3" + ; Processed.serialize_path path ^ " -as-ppx -bs-jsx 3" ]) in { Processed.stdlib_dir diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index ab0fc641d3e..292c63e2ed0 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -33,9 +33,9 @@ All 3 entries (Foo, Foo__ and Bar) contain a ppx directive $ dune ocaml merlin dump-config $PWD | grep -i "ppx" - (FLG (-ppx /MELC_COMPILER -as-ppx -bs-jsx 3)) - (FLG (-ppx /MELC_COMPILER -as-ppx -bs-jsx 3)) - (FLG (-ppx /MELC_COMPILER -as-ppx -bs-jsx 3)) + (FLG (-ppx "/MELC_COMPILER -as-ppx -bs-jsx 3")) + (FLG (-ppx "/MELC_COMPILER -as-ppx -bs-jsx 3")) + (FLG (-ppx "/MELC_COMPILER -as-ppx -bs-jsx 3")) $ target=output $ cat >dune <