extra TySum constructors arise from <:ctyp< >> in original syntax

[vicuna]

Original bug ID: 5104
Reporter: jaked
Assigned to: @xclerc
Status: closed (set by @xavierleroy on 2015-12-11T18:04:45Z)
Resolution: fixed
Priority: normal
Severity: major
Version: 3.12.0+beta1 or 3.12.0+rc1
Fixed in version: 4.00.0+dev
Category: -for Camlp4 use https://github.com/ocaml/camlp4/issues
Related to: #5080 #5231
Monitored by: @hcarty

Bug description

Extra TySum constructors arise from <:ctyp< >> quotations compared to 3.11.x. E.g.

<:ctyp< Foo >>, <:ctyp< Foo of unit >>, <:ctyp< Foo | Bar >>, <:ctyp< $x$ and $y$ >>

and, more strangely, since this does not involve sums

<:ctyp< $x$; $y$ >>

In order to be portable between 3.11.x and 3.12.x I need to use Ast constructors directly.

[vicuna]

Comment author: @xclerc

For the record, here are the comparisons between (1) 3.11.0, and (2) the sources
in "version/3/12" (revision 10948).

<:ctyp< Foo >> gives:
(1) Ast.TySum (_loc, Ast.TyId (_loc, Ast.IdUid (_loc, "Foo")))
(2) Ast.TySum (_loc, (Ast.TyId (_loc, (Ast.IdUid (_loc, "Foo")))))

<:ctyp< Foo of unit >> gives:
(1) Ast.TySum (_loc,
Ast.TyOf (_loc, Ast.TyId (_loc, Ast.IdUid (_loc, "Foo")),
Ast.TyId (_loc, Ast.IdLid (_loc, "unit"))))
(2) Ast.TySum (_loc,
(Ast.TyOf (_loc, (Ast.TyId (_loc, (Ast.IdUid (_loc, "Foo")))),
(Ast.TyId (_loc, (Ast.IdLid (_loc, "unit")))))))

<:ctyp< Foo | Bar >> gives:
(1) Ast.TySum (_loc,
Ast.TyOr (_loc, Ast.TyId (_loc, Ast.IdUid (_loc, "Foo")),
Ast.TyId (_loc, Ast.IdUid (_loc, "Bar"))))
(2) Ast.TySum (_loc,
(Ast.TyOr (_loc, (Ast.TyId (_loc, (Ast.IdUid (_loc, "Foo")))),
(Ast.TyId (_loc, (Ast.IdUid (_loc, "Bar")))))))

<:ctyp< $x$ and $y$ >> gives:
(1) Ast.TyAnd (_loc, x, y)
(2) Ast.TyAnd (_loc, (Ast.TySum (_loc, x)), y)

<:ctyp< $x$; $y$ >> gives:
(1) Ast.TySem (_loc, (Ast.TySum (_loc, x)), y)
(2) Ast.TySem (_loc, x, y)

[vicuna]

Comment author: @xclerc

Here is a tentative patch.

Index: camlp4/Camlp4Parsers/Camlp4OCamlParser.ml

--- camlp4/Camlp4Parsers/Camlp4OCamlParser.ml (revision 10948)
+++ camlp4/Camlp4Parsers/Camlp4OCamlParser.ml (working copy)
@@ -524,9 +524,6 @@
;
type_kind:
[ [ "private"; tk = type_kind -> <:ctyp< private $tk$ >>

•    | t = TRY [OPT "|"; t = constructor_declarations;
  

•               test_not_dot_nor_lparen -> t] ->
  

•        <:ctyp< [ $t$ ] >>
     | t = TRY ctyp -> <:ctyp< $t$ >>
     | t = TRY ctyp; "="; "private"; tk = type_kind ->
         <:ctyp< $t$ == private $tk$ >>
  

@@ -534,6 +531,9 @@
<:ctyp< $t1$ == { $t2$ } >>
| t1 = TRY ctyp; "="; OPT "|"; t2 = constructor_declarations ->
<:ctyp< $t1$ == [ $t2$ ] >>

•    | t = TRY [OPT "|"; t = constructor_declarations;
  

•               test_not_dot_nor_lparen -> t] ->
  

•        <:ctyp< [ $t$ ] >>
     | "{"; t = label_declaration_list; "}" ->
         <:ctyp< { $t$ } >> ] ]
  

  ;

[vicuna]

Comment author: Dmitry Grebeniuk

I've compiled last ocaml version from svn trunk with this patch.
Note that ocamlc without "-pp camlp4o" compiles the files.

$ cat aaa.ml
type t = A | B

$ ocamlc aaa.ml
$ ocamlc -pp camlp4o aaa.ml
File "aaa.ml", line 1, characters 9-10:
Parse error: [semi] expected after [str_item] (in [implem])
File "aaa.ml", line 1, characters 0-1:
Error: Preprocessor error

$ cat bbb.ml
type t = A

$ ocamlc bbb.ml
$ ocamlc -pp camlp4o bbb.ml
File "ghost-location", line 1, characters 9-0:
Failure: "invalid long identifier type"
File "bbb.ml", line 1, characters 0-1:
Error: Preprocessor error

[vicuna]

Comment author: @xclerc

Thanks for the feedback, seems like I mixed up results from
3.11.2, 3.12.0, and development versions...

[vicuna]

Comment author: @xclerc

Provided that my work was a bit more coherent, here is a patch that
implements an half back-step to the code of 3.11.2, and seems to
exhibit no regression.

However, the eyes of a camlp4-guru would be useful to bless this patch.

Index: camlp4/Camlp4Parsers/Camlp4OCamlParser.ml

--- camlp4/Camlp4Parsers/Camlp4OCamlParser.ml (revision 10948)
+++ camlp4/Camlp4Parsers/Camlp4OCamlParser.ml (working copy)
@@ -59,6 +59,19 @@
(Ast.loc_of_expr e2) in
<:expr< do { $e1$; $e2$ } >> ];

• value test_constr_decl =
• Gram.Entry.of_parser "test_constr_decl"

•  (fun strm ->
  

•    match Stream.npeek 1 strm with
  

•    [ [(UIDENT _, _)] ->
  

•        match Stream.npeek 2 strm with
  

•        [ [_; (KEYWORD ".", _)] -> raise Stream.Failure
  

•        | [_; (KEYWORD "(", _)] -> raise Stream.Failure
  

•        | [_ :: _] -> ()
  

•        | _ -> raise Stream.Failure ]
  

•    | [(KEYWORD "|", _)] -> ()
  

•    | _ -> raise Stream.Failure ]);
  

• value stream_peek_nth n strm =
  loop n (Stream.npeek n strm) where rec loop n =
  fun
  @@ -524,15 +537,15 @@
  ;
  type_kind:
  [ [ "private"; tk = type_kind -> <:ctyp< private $tk$ >>

•    | t = TRY [OPT "|"; t = constructor_declarations;
  

•               test_not_dot_nor_lparen -> t] ->
  

•    | test_constr_decl; OPT "|"; t = constructor_declarations;
  

•               test_not_dot_nor_lparen ->
         <:ctyp< [ $t$ ] >>
  

•    | t = TRY ctyp -> <:ctyp< $t$ >>
  

•    | t = TRY ctyp; "="; "private"; tk = type_kind ->
  

•    | t = ctyp -> <:ctyp< $t$ >>
  

•    | t = ctyp; "="; "private"; tk = type_kind ->
         <:ctyp< $t$ == private $tk$ >>
  

•    | t1 = TRY ctyp; "="; "{"; t2 = label_declaration_list; "}" ->
  

•    | t1 = ctyp; "="; "{"; t2 = label_declaration_list; "}" ->
         <:ctyp< $t1$ == { $t2$ } >>
  

•    | t1 = TRY ctyp; "="; OPT "|"; t2 = constructor_declarations ->
  

•    | t1 = ctyp; "="; OPT "|"; t2 = constructor_declarations ->
         <:ctyp< $t1$ == [ $t2$ ] >>
     | "{"; t = label_declaration_list; "}" ->
         <:ctyp< { $t$ } >> ] ]
  

[vicuna]

Comment author: @xclerc

Nicolas Pouillard provided me with a cleaner patch that has
been committed in "version/3.12". After some testing, it
seems to both resolve the issue and yield no regression.

Please test it, and re-open the issue if I missed something.