Fix printing of bindings with polymorphic type annotations and attributes

[mrmr1993]

This fixes a bug that bit @mobileink recently, where printing the code
generated by ppx_deriving.eq and attempting to re-parse it resulted in a
parse error. This bug manifested where a let binding has a polymorphic
type 'a. _ and an attribute on the bound expression.

To reproduce:

• create testfile with

 #load_rec "parsing/pprintast.cmo";;
 #load_rec "parsing/lexer.cmo";;
 #load_rec "parsing/parser.cmo";;

let phrase =
  {ocaml|
let rec equal :
          'a.    ('a -> 'a -> Ppx_deriving_runtime.bool) -> 'a t -> 'a t
          -> Ppx_deriving_runtime.bool =
  (let open! Ppx_deriving_runtime in
  fun poly_a (_ : unit) (_ : unit) -> true) [@ocaml.warning "-A"]
  [@@ocaml.warning "-39"]
|ocaml};;

let parse_roundtrip str =
  Pprintast.string_of_structure
    (Parser.implementation Lexer.token (Lexing.from_string str));;

let phrase_roundtrip = parse_roundtrip phrase;;

parse_roundtrip phrase_roundtrip;;

• start the toplevel with TOPFLAGS="-I parsing -I utils" make runtop
• run #use "testfile"

On trunk, this fails with an error at
parse_roundtrip phrase_roundtrip, where the parser chokes on the
let (equal : 'a. ...) = ... construction. With this change, the
printer and parser round-trip successfully.

[nojb]

I did a quick reading to the code, but couldn't figure out what was being fixed. Could you post the output of Pprintast "before" and "after" this change for your sample? It would help reviewing the PR.

Also, it may be a good idea adding a regression test with your sample (although the best thing would be to have a systematic test of Pprintast on a large set of files, but that is orthogonal to the present PR).

[mrmr1993]

Before:

let rec (equal :
          'a .
            ('a -> 'a -> Ppx_deriving_runtime.bool) ->
              'a t -> 'a t -> Ppx_deriving_runtime.bool)
  =
  ((let open! Ppx_deriving_runtime in
      fun poly_a -> fun (_ : unit) -> fun (_ : unit) -> true)
  [@ocaml.warning "-A"])[@@ocaml.warning "-39"]

After:

let rec equal
  : 'a .
      ('a -> 'a -> Ppx_deriving_runtime.bool) ->
        'a t -> 'a t -> Ppx_deriving_runtime.bool
  =
  ((let open! Ppx_deriving_runtime in
      fun poly_a -> fun (_ : unit) -> fun (_ : unit) -> true)
  [@ocaml.warning "-A"])[@@ocaml.warning "-39"]

The brackets in the trunk version cause it to be parsed as a pattern type annotation, but polymorphic types aren't allowed as pattern type annotations.

[nojb]

Thanks, it is clearer now. Sorry for the naive question, but do you know of a case where the parentheses removed by this patch are actually needed?

[mrmr1993]

do you know of a case where the parentheses removed by this patch are actually needed?

They would be needed if there was an annotation that spans the name and the type signature, e.g.

let (x : int) [@hi] = 1

The Pprintast output for that AST has something of the lisp about it.

let (((x : int))[@hi ]) = 1

For bare patterns, I think only let (module M) = ... in ... and let (exception _) = ... in ... require parenthesis, and the exception case is rejected outright by the compiler.

[nojb]

See also #7200

[nojb]

The patch LGTM. The only thing missing is to add a test for it. This is easy: just add your sample fragment to the file testsuite/tests/parsetree/source.ml. The test testsuite/tests/parsetree/test.ml checks that this file can be re-parsed after being parsed and printed with Pprintast.

[mrmr1993]

Done, thanks!

[nojb]

LGTM (once CI passes).

[nojb]

Merged, thanks!