Handle merlin typed holes (#1698)

Author: gpetiot

CHANGES.md

@@ -10,6 +10,8 @@
 
 #### New features
 
+  + Handle merlin typed holes (#1698, @gpetiot)
+
 ### 0.19.0 (2021-07-16)
 
 #### Bug fixes

lib/Ast.ml

@@ -404,7 +404,7 @@ let rec mty_is_simple x =
 
 and mod_is_simple x =
   match x.pmod_desc with
-  | Pmod_ident _ | Pmod_unpack _ | Pmod_structure [] -> true
+  | Pmod_ident _ | Pmod_unpack _ | Pmod_structure [] | Pmod_hole -> true
   | Pmod_structure (_ :: _) | Pmod_extension _ | Pmod_functor (_, _) -> false
   | Pmod_constraint (e, t) -> mod_is_simple e && mty_is_simple t
   | Pmod_apply (a, b) -> mod_is_simple a && mod_is_simple b
@@ -1338,7 +1338,7 @@ end = struct
        |Pexp_newtype _ | Pexp_open _ | Pexp_override _ | Pexp_pack _
        |Pexp_poly _ | Pexp_record _ | Pexp_send _ | Pexp_sequence _
        |Pexp_setfield _ | Pexp_setinstvar _ | Pexp_tuple _
-       |Pexp_unreachable | Pexp_variant _ | Pexp_while _ ->
+       |Pexp_unreachable | Pexp_variant _ | Pexp_while _ | Pexp_hole ->
           assert false
       | Pexp_extension (_, ext) -> assert (check_extensions ext)
       | Pexp_object {pcstr_self; pcstr_fields} ->
@@ -1434,7 +1434,7 @@ end = struct
             assert (e1 == exp || e2 == exp)
         | Pexp_extension (_, ext) -> assert (check_extensions ext)
         | Pexp_constant _ | Pexp_ident _ | Pexp_new _ | Pexp_pack _
-         |Pexp_unreachable ->
+         |Pexp_unreachable | Pexp_hole ->
             assert false
         | Pexp_object {pcstr_fields; _} ->
             assert (check_pcstr_fields pcstr_fields)
@@ -2108,7 +2108,7 @@ end = struct
          |Pexp_new _ | Pexp_object _ | Pexp_override _ | Pexp_pack _
          |Pexp_poly _ | Pexp_record _ | Pexp_send _ | Pexp_unreachable
          |Pexp_variant (_, None)
-         |Pexp_while _ ->
+         |Pexp_hole | Pexp_while _ ->
             false
       in
       Exp.mem_cls cls exp
@@ -2186,7 +2186,7 @@ end = struct
        |Pexp_new _ | Pexp_object _ | Pexp_override _ | Pexp_pack _
        |Pexp_poly _ | Pexp_record _ | Pexp_send _ | Pexp_unreachable
        |Pexp_variant (_, None)
-       |Pexp_while _ ->
+       |Pexp_hole | Pexp_while _ ->
           false
     in
     Hashtbl.find_or_add marked_parenzed_inner_nested_match exp

lib/Fmt_ast.ml

@@ -198,6 +198,8 @@ let update_items_config c items update_config =
 
 let box_semisemi b k = hvbox_if b 0 (k $ fmt_if b "@,;;")
 
+let fmt_hole () = str "_"
+
 let fmt_item_list c ctx update_config ast fmt_item items =
   let items = update_items_config c items update_config in
   let break_struct = c.conf.break_struct || is_top ctx in
@@ -2572,6 +2574,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0)
            $ fmt_atrs ) )
   | Pexp_poly _ ->
       impossible "only used for methods, handled during method formatting"
+  | Pexp_hole -> hvbox 0 (fmt_hole () $ fmt_atrs)
 
 and fmt_let_bindings c ~ctx ?ext ~parens ~loc ~attributes ~fmt_atrs ~fmt_expr
     rec_flag bindings body =
@@ -4124,6 +4127,14 @@ and fmt_module_expr ?(can_break_before_struct = false) c ({ast= m; _} as xmod)
             ( fmt_docstring c ~epi:(fmt "@,") doc
             $ fmt_extension c ctx "%" x1
             $ fmt_attributes c ~pre:Space ~key:"@" atrs ) }
+  | Pmod_hole ->
+      let doc, atrs = doc_atrs pmod_attributes in
+      { empty with
+        bdy=
+          Cmts.fmt c pmod_loc
+            ( fmt_docstring c ~epi:(fmt "@,") doc
+            $ fmt_hole ()
+            $ fmt_attributes c ~pre:Space ~key:"@" atrs ) }
 
 and fmt_structure c ctx itms =
   let update_config c i =

test/failing/dune.inc

@@ -77,19 +77,6 @@
  (package ocamlformat)
  (action (diff tests/exprs.ml.broken-ref exprs.ml.output)))
 
-(rule
- (deps tests/.ocamlformat )
- (package ocamlformat)
- (action
-   (with-outputs-to ifand.ml.output
-     (with-accepted-exit-codes 1
-       (run %{bin:ocamlformat} %{dep:tests/ifand.ml})))))
-
-(rule
- (alias runtest)
- (package ocamlformat)
- (action (diff tests/ifand.ml.broken-ref ifand.ml.output)))
-
 (rule
  (deps tests/.ocamlformat )
  (package ocamlformat)
@@ -129,19 +116,6 @@
  (package ocamlformat)
  (action (diff tests/js_bench.ml.broken-ref js_bench.ml.output)))
 
-(rule
- (deps tests/.ocamlformat )
- (package ocamlformat)
- (action
-   (with-outputs-to js_bind.ml.output
-     (with-accepted-exit-codes 1
-       (run %{bin:ocamlformat} %{dep:tests/js_bind.ml})))))
-
-(rule
- (alias runtest)
- (package ocamlformat)
- (action (diff tests/js_bind.ml.broken-ref js_bind.ml.output)))
-
 (rule
  (deps tests/.ocamlformat )
  (package ocamlformat)
@@ -194,32 +168,6 @@
  (package ocamlformat)
  (action (diff tests/js_low_priority.ml.broken-ref js_low_priority.ml.output)))
 
-(rule
- (deps tests/.ocamlformat )
- (package ocamlformat)
- (action
-   (with-outputs-to js_map.ml.output
-     (with-accepted-exit-codes 1
-       (run %{bin:ocamlformat} %{dep:tests/js_map.ml})))))
-
-(rule
- (alias runtest)
- (package ocamlformat)
- (action (diff tests/js_map.ml.broken-ref js_map.ml.output)))
-
-(rule
- (deps tests/.ocamlformat )
- (package ocamlformat)
- (action
-   (with-outputs-to js_poly.ml.output
-     (with-accepted-exit-codes 1
-       (run %{bin:ocamlformat} %{dep:tests/js_poly.ml})))))
-
-(rule
- (alias runtest)
- (package ocamlformat)
- (action (diff tests/js_poly.ml.broken-ref js_poly.ml.output)))
-
 (rule
  (deps tests/.ocamlformat )
  (package ocamlformat)
@@ -324,32 +272,6 @@
  (package ocamlformat)
  (action (diff tests/never_align.ml.broken-ref never_align.ml.output)))
 
-(rule
- (deps tests/.ocamlformat )
- (package ocamlformat)
- (action
-   (with-outputs-to object.ml.output
-     (with-accepted-exit-codes 1
-       (run %{bin:ocamlformat} %{dep:tests/object.ml})))))
-
-(rule
- (alias runtest)
- (package ocamlformat)
- (action (diff tests/object.ml.broken-ref object.ml.output)))
-
-(rule
- (deps tests/.ocamlformat )
- (package ocamlformat)
- (action
-   (with-outputs-to obuild.ml.output
-     (with-accepted-exit-codes 1
-       (run %{bin:ocamlformat} %{dep:tests/obuild.ml})))))
-
-(rule
- (alias runtest)
- (package ocamlformat)
- (action (diff tests/obuild.ml.broken-ref obuild.ml.output)))
-
 (rule
  (deps tests/.ocamlformat )
  (package ocamlformat)

test/failing/tests/edge_cases.ml.broken-ref

@@ -1,5 +1,5 @@
 ocamlformat: ignoring "tests/edge_cases.ml" (syntax error)
-File "tests/edge_cases.ml", line 21, characters 4-5:
-21 |     _
-         ^
-Error: Syntax error: wildcard "_" not expected.
+File "tests/edge_cases.ml", line 90, characters 4-12:
+90 |     function (_ : [ `c ]) -> d
+         ^^^^^^^^
+Error: Syntax error