future-syntax: do not confuse merlin by an AST produced by a -pp (oca…

…ml#2236)

Do not confuse merlin by having a -pp preprocessor return an AST

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>

CHANGES.md

@@ -3,6 +3,10 @@ unreleased
 
 * Run `refmt` from the context's root directory. This improves error messages in
   case of syntax errors. (#2223, @rgrinberg)
+
+- In .merlin files, don't pass `-dump-ast` to the `future_syntax` preprocessor.
+  Merlin doesn't seem to like it when binary AST is generated by a `-pp` 
+  preprocessor. (#2236, @aalekseyev)
 
 1.10.0 (30/05/2019)
 -------------------

src/dune_file.ml

@@ -358,7 +358,16 @@ module Preprocess = struct
       | Pps    of Pps.t
   end
 
-  let remove_future_syntax t v : Without_future_syntax.t =
+  module Pp_flag_consumer = struct
+    (* Compiler allows the output of [-pp] to be a binary AST.
+       Merlin requires that to be a text file instead. *)
+    type t =
+      | Compiler
+      | Merlin
+  end
+
+  let remove_future_syntax
+        t ~(for_ : Pp_flag_consumer.t) v : Without_future_syntax.t =
     match t with
     | No_preprocessing -> No_preprocessing
     | Action (loc, action) -> Action (loc, action)
@@ -372,9 +381,27 @@ module Preprocess = struct
            Run
              (String_with_vars.make_var loc "bin"
                 ~payload:"ocaml-syntax-shims",
-              [ String_with_vars.make_text loc "-dump-ast"
-              ; String_with_vars.make_var loc "input-file"
-              ]))
+              ((match for_ with
+                 | Compiler -> [ String_with_vars.make_text loc "-dump-ast" ]
+                 | Merlin ->
+                   (* We generate a text file instead of AST. That gives you
+                      less precise locations, but at least Merlin doesn't fail
+                      outright.
+
+                      In general this hack should be applied to all -pp
+                      commands that might produce an AST, not just to
+                      Future_syntax. But doing so means we need to change
+                      dune language so the user can provide two versions of
+                      the command.
+
+                      Hopefully this will be fixed in merlin before that
+                      becomes a necessity.
+                   *)
+                   [])
+               @
+               [ 
+                 String_with_vars.make_var loc "input-file"
+               ])))
 end
 
 let enabled_if ~since =

src/dune_file.mli

@@ -30,7 +30,14 @@ module Preprocess : sig
 
   val loc : t -> Loc.t option
 
-  val remove_future_syntax : t -> Ocaml_version.t -> Without_future_syntax.t
+  module Pp_flag_consumer : sig
+    type t =
+      | Compiler
+      | Merlin
+  end
+
+  val remove_future_syntax :
+    t -> for_:Pp_flag_consumer.t -> Ocaml_version.t -> Without_future_syntax.t
 end
 
 module Per_module : Per_item.S with type key = Module.Name.t

src/merlin.ml

@@ -181,6 +181,7 @@ let pp_flags sctx ~expander ~dir_kind { preprocess; libname; _ }
   : (unit, string option) Build.t =
   let scope = Expander.scope expander in
   match Dune_file.Preprocess.remove_future_syntax preprocess
+          ~for_:Merlin
           (Super_context.context sctx).version
   with
   | Pps { loc; pps; flags; staged = _ } -> begin

src/preprocessing.ml

@@ -701,7 +701,9 @@ let make sctx ~dir ~expander ~dep_kind ~lint ~preprocess
                       ~lint ~lib_name ~scope ~dir_kind)
   in
   Per_module.map preprocess ~f:(fun pp ->
-    match Dune_file.Preprocess.remove_future_syntax pp
+    match Dune_file.Preprocess.remove_future_syntax
+            ~for_:Compiler
+            pp
             (Super_context.context sctx).version
     with
     | No_preprocessing ->

src/virtual_rules.ml

@@ -15,7 +15,7 @@ end = struct
 
   let make preprocess v =
     Dune_file.Per_module.map preprocess ~f:(fun pp ->
-      match Dune_file.Preprocess.remove_future_syntax pp v with
+      match Dune_file.Preprocess.remove_future_syntax ~for_:Compiler pp v with
       | No_preprocessing -> Module.ml_source
       | Action (_, _) ->
         fun m -> Module.ml_source (Module.pped m)

test/blackbox-tests/test-cases/merlin-tests/dune

@@ -7,3 +7,8 @@
  (name print-merlins-pp)
  (deps pp-with-expand/.merlin)
  (action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe %{deps})))
+
+(alias
+ (name print-merlins-future-syntax)
+ (deps future-syntax/.merlin)
+ (action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe %{deps})))

test/blackbox-tests/test-cases/merlin-tests/dune-project

@@ -1 +1 @@
-(lang dune 1.2)
+(lang dune 1.10)

test/blackbox-tests/test-cases/merlin-tests/future-syntax/dune

@@ -0,0 +1,4 @@
+(executable
+ (name pp_future_syntax)
+ (preprocess future_syntax)
+)

test/blackbox-tests/test-cases/merlin-tests/run.t

@@ -51,3 +51,16 @@ Make sure pp flag is correct and variables are expanded
   S .
   FLG -pp '$PP/_build/default/pp/pp.exe -nothing'
   FLG -w @a-4-29-40-41-42-44-45-48-58-59-60-40 -strict-sequence -strict-formats -short-paths -keep-locs
+
+We want future-syntax to either be applied, or not, depending on OCaml version.
+Adding the `echo` with expected output to the set of lines is a way of achieving that.
+
+  $ (echo "FLG -pp '\$BIN/ocaml-syntax-shims'"; dune build @print-merlins-future-syntax 2>&1) | sort | uniq
+  # Processing future-syntax/.merlin
+  B ../_build/default/future-syntax/.pp_future_syntax.eobjs/byte
+  EXCLUDE_QUERY_DIR
+  FLG -pp '$BIN/ocaml-syntax-shims'
+  FLG -w @a-4-29-40-41-42-44-45-48-58-59-60-40 -strict-sequence -strict-formats -short-paths -keep-locs
+  S .
+  sanitize_dot_merlin alias print-merlins-future-syntax
+

test/blackbox-tests/test-cases/merlin-tests/sanitize-dot-merlin/sanitize_dot_merlin.ml

@@ -4,11 +4,15 @@ let process_line =
   let path_re = Str.regexp {|^\([SB]\) /.+/lib/\(.+\)$|} in
   let ppx_re = Str.regexp {|^FLG -ppx '/.+/\.ppx/\(.+\)$|} in
   let pp_re = Str.regexp {|^FLG -pp '/.+/merlin-tests/\(.+\)$|} in
+  let special_pp_re =
+    Str.regexp {|^FLG -pp '/.+/_build/install/default/bin/\(.+\)$|}
+  in
   fun line ->
     line
     |> Str.replace_first path_re {|\1 $LIB_PREFIX/lib/\2|}
     |> Str.global_replace ppx_re {|FLG -ppx '$PPX/\1|}
     |> Str.global_replace pp_re {|FLG -pp '$PP/\1|}
+    |> Str.global_replace special_pp_re {|FLG -pp '$BIN/\1|}
 
 let () =
   let files = ref [] in