Skip to content

Commit 5ff8b93

Browse files
voodoosvoodoos
committed
merlin: communicate index files and wrapped module name
Signed-off-by: Ulysse Gérard <[email protected]>
1 parent 02f0324 commit 5ff8b93

File tree

23 files changed

+896
-215
lines changed

23 files changed

+896
-215
lines changed

‎src/dune_rules/merlin/merlin.ml‎

Lines changed: 42 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -52,16 +52,18 @@ module Processed = struct
5252
; src_dirs : Path.Set.t
5353
; flags : string list
5454
; extensions : string option Ml_kind.Dict.t list
55+
; indexes : Path.t list
5556
}
5657

57-
let dyn_of_config { stdlib_dir; obj_dirs; src_dirs; flags; extensions } =
58+
let dyn_of_config { stdlib_dir; obj_dirs; src_dirs; flags; extensions; indexes } =
5859
let open Dyn in
5960
record
6061
[ "stdlib_dir", option Path.to_dyn stdlib_dir
6162
; "obj_dirs", Path.Set.to_dyn obj_dirs
6263
; "src_dirs", Path.Set.to_dyn src_dirs
6364
; "flags", list string flags
6465
; "extensions", list (Ml_kind.Dict.to_dyn (Dyn.option string)) extensions
66+
; "indexes", list Path.to_dyn indexes
6567
]
6668
;;
6769

@@ -100,7 +102,7 @@ module Processed = struct
100102
type nonrec t = t
101103

102104
let name = "merlin-conf"
103-
let version = 4
105+
let version = 5
104106
let to_dyn _ = Dyn.String "Use [dune ocaml dump-dot-merlin] instead"
105107

106108
let test_example () =
@@ -110,6 +112,7 @@ module Processed = struct
110112
; src_dirs = Path.Set.empty
111113
; flags = [ "-x" ]
112114
; extensions = [ { Ml_kind.Dict.intf = None; impl = Some "ext" } ]
115+
; indexes = []
113116
}
114117
; per_file_config = Path.Build.Map.empty
115118
; pp_config =
@@ -149,11 +152,18 @@ module Processed = struct
149152
| None, None -> None
150153
;;
151154

152-
let to_sexp ~opens ~pp ~reader { stdlib_dir; obj_dirs; src_dirs; flags; extensions } =
155+
let to_sexp
156+
~unit_name
157+
~opens
158+
~pp
159+
~reader
160+
{ stdlib_dir; obj_dirs; src_dirs; flags; extensions; indexes }
161+
=
153162
let make_directive tag value = Sexp.List [ Atom tag; value ] in
154163
let make_directive_of_path tag path =
155164
make_directive tag (Sexp.Atom (serialize_path path))
156165
in
166+
let index_files = List.map indexes ~f:(fun p -> make_directive_of_path "INDEX" p) in
157167
let stdlib_dir =
158168
match stdlib_dir with
159169
| None -> []
@@ -184,6 +194,7 @@ module Processed = struct
184194
(Sexp.List (Ocaml_flags.open_flags opens |> List.map ~f:(fun x -> Sexp.Atom x)))
185195
:: flags
186196
in
197+
let unit_name = [ make_directive "UNIT_NAME" (Sexp.Atom unit_name) ] in
187198
let suffixes =
188199
List.filter_map extensions ~f:(fun x ->
189200
let open Option.O in
@@ -199,7 +210,16 @@ module Processed = struct
199210
in
200211
Sexp.List
201212
(List.concat
202-
[ stdlib_dir; exclude_query_dir; obj_dirs; src_dirs; flags; suffixes; reader ])
213+
[ index_files
214+
; stdlib_dir
215+
; exclude_query_dir
216+
; obj_dirs
217+
; src_dirs
218+
; flags
219+
; unit_name
220+
; suffixes
221+
; reader
222+
])
203223
;;
204224

205225
let quote_for_dot_merlin s =
@@ -215,7 +235,7 @@ module Processed = struct
215235
if String.need_quoting s then Filename.quote s else s
216236
;;
217237

218-
let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions =
238+
let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions indexes =
219239
let b = Buffer.create 256 in
220240
let printf = Printf.bprintf b in
221241
let print = Buffer.add_string b in
@@ -224,6 +244,7 @@ module Processed = struct
224244
printf "STDLIB %s\n" (serialize_path stdlib_dir));
225245
Path.Set.iter obj_dirs ~f:(fun p -> printf "B %s\n" (serialize_path p));
226246
Path.Set.iter src_dirs ~f:(fun p -> printf "S %s\n" (serialize_path p));
247+
List.iter indexes ~f:(fun p -> printf "INDEX %s\n" (serialize_path p));
227248
List.iter extensions ~f:(fun x ->
228249
Option.iter (get_ext x) ~f:(fun (impl, intf) ->
229250
printf "SUFFIX %s" (Printf.sprintf "%s %s" impl intf)));
@@ -265,7 +286,8 @@ module Processed = struct
265286
Path.Build.Map.find per_file_config (remove_extension file))
266287
in
267288
let pp = Module_name.Per_item.get pp_config (Module.name module_) in
268-
to_sexp ~opens ~pp ~reader config
289+
let unit_name = Module_name.Unique.to_string (Module.obj_name module_) in
290+
to_sexp ~unit_name ~opens ~pp ~reader config
269291
;;
270292

271293
let print_file path =
@@ -275,8 +297,9 @@ module Processed = struct
275297
let pp_one (source, { module_; opens; reader }) =
276298
let open Pp.O in
277299
let name = Module.name module_ in
300+
let unit_name = Module_name.Unique.to_string (Module.obj_name module_) in
278301
let pp = Module_name.Per_item.get pp_config name in
279-
let sexp = to_sexp ~reader ~opens ~pp config in
302+
let sexp = to_sexp ~unit_name ~reader ~opens ~pp config in
280303
Pp.hvbox
281304
(Pp.textf "%s: %s" (Module_name.to_string name) (Path.Build.to_string source))
282305
++ Pp.newline
@@ -295,7 +318,7 @@ module Processed = struct
295318
| Error msg -> Printf.eprintf "%s\n" msg
296319
| Ok [] -> Printf.eprintf "No merlin configuration found.\n"
297320
| Ok (init :: tl) ->
298-
let pp_configs, obj_dirs, src_dirs, flags, extensions =
321+
let pp_configs, obj_dirs, src_dirs, flags, extensions, indexes =
299322
(* We merge what is easy to merge and ignore the rest *)
300323
List.fold_left
301324
tl
@@ -304,20 +327,23 @@ module Processed = struct
304327
, init.config.obj_dirs
305328
, init.config.src_dirs
306329
, [ init.config.flags ]
307-
, init.config.extensions )
330+
, init.config.extensions
331+
, init.config.indexes )
308332
~f:
309333
(fun
310-
(acc_pp, acc_obj, acc_src, acc_flags, acc_ext)
334+
(acc_pp, acc_obj, acc_src, acc_flags, acc_ext, acc_indexes)
311335
{ per_file_config = _
312336
; pp_config
313-
; config = { stdlib_dir = _; obj_dirs; src_dirs; flags; extensions }
337+
; config =
338+
{ stdlib_dir = _; obj_dirs; src_dirs; flags; extensions; indexes }
314339
}
315340
->
316341
( pp_config :: acc_pp
317342
, Path.Set.union acc_obj obj_dirs
318343
, Path.Set.union acc_src src_dirs
319344
, flags :: acc_flags
320-
, extensions @ acc_ext ))
345+
, extensions @ acc_ext
346+
, indexes @ acc_indexes ))
321347
in
322348
Printf.printf
323349
"%s\n"
@@ -327,7 +353,8 @@ module Processed = struct
327353
flags
328354
obj_dirs
329355
src_dirs
330-
extensions)
356+
extensions
357+
indexes)
331358
;;
332359
end
333360

@@ -579,11 +606,11 @@ module Unprocessed = struct
579606
obj_dir_of_lib `Public mode (Lib_info.obj_dir info)
580607
in
581608
Path.Set.add obj_dirs public_cmi_dir )))
582-
in
609+
and+ indexes = Action_builder.of_memo (Ocaml_index.context_indexes sctx) in
583610
let src_dirs =
584611
Path.Set.union src_dirs (Path.Set.of_list_map ~f:Path.source more_src_dirs)
585612
in
586-
{ Processed.stdlib_dir; src_dirs; obj_dirs; flags; extensions }
613+
{ Processed.stdlib_dir; src_dirs; obj_dirs; flags; extensions; indexes }
587614
and+ pp_config = pp_config t (Super_context.context sctx) ~expander in
588615
let per_file_config =
589616
(* And copy for each module the resulting pp flags *)

‎test/blackbox-tests/test-cases/github2206.t/run.t‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,15 @@ copy_files would break the generation of the preprocessing flags
22
$ dune build copy_files/.merlin-conf/exe-foo
33
$ dune ocaml merlin dump-config $PWD/copy_files |
44
> grep -B 1 -A 0 "pp"
5+
((INDEX
6+
$TESTCASE_ROOT/_build/default/.pp.eobjs/cctx.ocaml-index)
7+
--
58
(FLG
69
(-pp
710
$TESTCASE_ROOT/_build/default/pp.exe))
11+
--
12+
((INDEX
13+
$TESTCASE_ROOT/_build/default/.pp.eobjs/cctx.ocaml-index)
814
--
915
(FLG
1016
(-pp

‎test/blackbox-tests/test-cases/melange/merlin-compile-flags.t‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -18,12 +18,12 @@ Show that the merlin config knows about melange.compile_flags
1818
$ dune build @check
1919

2020
$ dune ocaml merlin dump-config "$PWD" | grep -i "+42"
21-
+42)))
22-
+42)))
23-
+42)))
24-
+42)))
25-
+42)))
26-
+42)))
21+
+42))
22+
+42))
23+
+42))
24+
+42))
25+
+42))
26+
+42))
2727

2828
$ cat >dune <<EOF
2929
> (melange.emit
@@ -35,10 +35,10 @@ Show that the merlin config knows about melange.compile_flags
3535
$ dune build @check
3636

3737
$ dune ocaml merlin dump-config "$PWD" | grep -i "+42"
38-
+42)))
39-
+42)))
40-
+42)))
41-
+42)))
42-
+42)))
43-
+42)))
38+
+42))
39+
+42))
40+
+42))
41+
+42))
42+
+42))
43+
+42))
4444

‎test/blackbox-tests/test-cases/melange/merlin.t‎

Lines changed: 54 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -23,20 +23,32 @@
2323
$ touch bar.ml $lib.ml
2424
$ dune build @check
2525
$ dune ocaml merlin dump-config "$PWD" | grep -i "$lib"
26+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
2627
$TESTCASE_ROOT/_build/default/.foo.objs/melange)
2728
(FLG (-open Foo__))
29+
(UNIT_NAME foo__Bar))
30+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
2831
$TESTCASE_ROOT/_build/default/.foo.objs/melange)
2932
(FLG (-open Foo__))
33+
(UNIT_NAME foo__Bar))
3034
Foo: _build/default/foo
35+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
3136
$TESTCASE_ROOT/_build/default/.foo.objs/melange)
3237
(FLG (-open Foo__))
38+
(UNIT_NAME foo))
3339
Foo: _build/default/foo.ml
40+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
3441
$TESTCASE_ROOT/_build/default/.foo.objs/melange)
3542
(FLG (-open Foo__))
43+
(UNIT_NAME foo))
3644
Foo__: _build/default/foo__
45+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
3746
$TESTCASE_ROOT/_build/default/.foo.objs/melange)
47+
(UNIT_NAME foo__))
3848
Foo__: _build/default/foo__.ml-gen
49+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
3950
$TESTCASE_ROOT/_build/default/.foo.objs/melange)
51+
(UNIT_NAME foo__))
4052
4153
Paths to Melange stdlib appear in B and S entries without melange.emit stanza
4254
@@ -111,7 +123,11 @@ User ppx flags should appear in merlin config
111123
112124
$ dune ocaml merlin dump-config $PWD | grep -v "(B " | grep -v "(S "
113125
Bar: _build/default/bar
114-
((STDLIB /MELC_STDLIB/melange)
126+
((INDEX
127+
$TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index)
128+
(INDEX
129+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
130+
(STDLIB /MELC_STDLIB/melange)
115131
(EXCLUDE_QUERY_DIR)
116132
(B
117133
$TESTCASE_ROOT/_build/default/.foo.objs/melange)
@@ -131,9 +147,14 @@ User ppx flags should appear in merlin config
131147
-strict-formats
132148
-short-paths
133149
-keep-locs
134-
-g)))
150+
-g))
151+
(UNIT_NAME foo__Bar))
135152
Bar: _build/default/bar.ml
136-
((STDLIB /MELC_STDLIB/melange)
153+
((INDEX
154+
$TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index)
155+
(INDEX
156+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
157+
(STDLIB /MELC_STDLIB/melange)
137158
(EXCLUDE_QUERY_DIR)
138159
(B
139160
$TESTCASE_ROOT/_build/default/.foo.objs/melange)
@@ -153,9 +174,14 @@ User ppx flags should appear in merlin config
153174
-strict-formats
154175
-short-paths
155176
-keep-locs
156-
-g)))
177+
-g))
178+
(UNIT_NAME foo__Bar))
157179
Foo: _build/default/foo
158-
((STDLIB /MELC_STDLIB/melange)
180+
((INDEX
181+
$TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index)
182+
(INDEX
183+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
184+
(STDLIB /MELC_STDLIB/melange)
159185
(EXCLUDE_QUERY_DIR)
160186
(B
161187
$TESTCASE_ROOT/_build/default/.foo.objs/melange)
@@ -174,9 +200,14 @@ User ppx flags should appear in merlin config
174200
-strict-formats
175201
-short-paths
176202
-keep-locs
177-
-g)))
203+
-g))
204+
(UNIT_NAME foo))
178205
Foo: _build/default/foo.ml-gen
179-
((STDLIB /MELC_STDLIB/melange)
206+
((INDEX
207+
$TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index)
208+
(INDEX
209+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
210+
(STDLIB /MELC_STDLIB/melange)
180211
(EXCLUDE_QUERY_DIR)
181212
(B
182213
$TESTCASE_ROOT/_build/default/.foo.objs/melange)
@@ -195,9 +226,14 @@ User ppx flags should appear in merlin config
195226
-strict-formats
196227
-short-paths
197228
-keep-locs
198-
-g)))
229+
-g))
230+
(UNIT_NAME foo))
199231
Fooppx: _build/default/fooppx
200-
((STDLIB /OCAMLC_WHERE)
232+
((INDEX
233+
$TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index)
234+
(INDEX
235+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
236+
(STDLIB /OCAMLC_WHERE)
201237
(EXCLUDE_QUERY_DIR)
202238
(B
203239
$TESTCASE_ROOT/_build/default/.fooppx.objs/byte)
@@ -210,9 +246,14 @@ User ppx flags should appear in merlin config
210246
-strict-formats
211247
-short-paths
212248
-keep-locs
213-
-g)))
249+
-g))
250+
(UNIT_NAME fooppx))
214251
Fooppx: _build/default/fooppx.ml
215-
((STDLIB /OCAMLC_WHERE)
252+
((INDEX
253+
$TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index)
254+
(INDEX
255+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
256+
(STDLIB /OCAMLC_WHERE)
216257
(EXCLUDE_QUERY_DIR)
217258
(B
218259
$TESTCASE_ROOT/_build/default/.fooppx.objs/byte)
@@ -225,4 +266,5 @@ User ppx flags should appear in merlin config
225266
-strict-formats
226267
-short-paths
227268
-keep-locs
228-
-g)))
269+
-g))
270+
(UNIT_NAME fooppx))

‎test/blackbox-tests/test-cases/merlin/alt-context.t‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -66,12 +66,16 @@ Request config for file in alt context without using --context
6666
Request config for file in alt context using --context
6767

6868
$ printf '(4:File%d:%s)' ${#FILE2} $FILE2 | dune ocaml-merlin --context alt | dune format-dune-file | grep -i "$lib2" | sed 's/^[^:]*:[^:]*://'
69+
$TESTCASE_ROOT/_build/alt/.bar.objs/cctx.ocaml-index)
6970
$TESTCASE_ROOT/_build/alt/.bar.objs/byte)
71+
bar))
7072

7173
Request config for default context without using --context
7274

7375
$ printf '(4:File%d:%s)' ${#FILE1} $FILE1 | dune ocaml-merlin | dune format-dune-file | grep -i "$lib1" | sed 's/^[^:]*:[^:]*://'
76+
$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)
7477
$TESTCASE_ROOT/_build/default/.foo.objs/byte)
78+
foo))
7579

7680
Request config for default context using --context
7781

0 commit comments

Comments
 (0)