[camlp4] Fix a bug with multiple class parameters

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7687 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

4 files changed, 22 insertions, 7 deletions

diff --git a/camlp4/Camlp4/Printers/OCaml.ml b/camlp4/Camlp4/Printers/OCaml.ml
index c1acdfe66..81b92324d 100644
--- a/camlp4/Camlp4/Printers/OCaml.ml
+++ b/camlp4/Camlp4/Printers/OCaml.ml
@@ -209,6 +209,12 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct
       | [x] -> pp f "%a@ " o#ctyp x
       | l -> pp f "@[<1>(%a)@]@ " (list o#ctyp ",@ ") l ];
 
+    method class_params f =
+      fun
+      [ <:ctyp< $t1$, $t2$ >> ->
+          pp f "@[<1>%a,@ %a@]" o#class_params t1 o#class_params t2
+      | x -> o#ctyp f x ];
+
     method mutable_flag f b = o#flag f b "mutable";
     method rec_flag f b = o#flag f b "rec";
     method virtual_flag f b = o#flag f b "virtual";
@@ -849,13 +855,13 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct
     | <:class_expr< $id:i$ >> ->
           pp f "@[<2>%a@]" o#ident i
     | <:class_expr< $id:i$ [ $t$ ] >> ->
-          pp f "@[<2>@[<1>[%a]@]@ %a@]" o#ctyp t o#ident i
+          pp f "@[<2>@[<1>[%a]@]@ %a@]" o#class_params t o#ident i
     (* | <:class_expr< virtual $id:i$ >> -> *)
     | Ast.CeCon _ Ast.BTrue i <:ctyp<>> ->
           pp f "@[<2>virtual@ %a@]" o#ident i
     | Ast.CeCon _ Ast.BTrue i t ->
     (* | <:class_expr< virtual $id:i$ [ $t$ ] >> -> *)
-          pp f "@[<2>virtual@ @[<1>[%a]@]@ %a@]" o#ctyp t o#ident i
+          pp f "@[<2>virtual@ @[<1>[%a]@]@ %a@]" o#class_params t o#ident i
     | <:class_expr< fun $p$ -> $ce$ >> ->
           pp f "@[<2>fun@ %a@ ->@ %a@]" o#patt p o#class_expr ce
     | <:class_expr< let $rec:r$ $bi$ in $ce$ >> ->
@@ -884,13 +890,13 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct
     [ <:class_type< $id:i$ >> ->
           pp f "@[<2>%a@]" o#ident i
     | <:class_type< $id:i$ [ $t$ ] >> ->
-          pp f "@[<2>[@,%a@]@,]@ %a" o#ctyp t o#ident i
+          pp f "@[<2>[@,%a@]@,]@ %a" o#class_params t o#ident i
     (* | <:class_type< virtual $id:i$ >> -> *)
     | Ast.CtCon _ Ast.BTrue i <:ctyp<>> ->
           pp f "@[<2>virtual@ %a@]" o#ident i
     (* | <:class_type< virtual $id:i$ [ $t$ ] >> -> *)
     | Ast.CtCon _ Ast.BTrue i t ->
-          pp f "@[<2>virtual@ [@,%a@]@,]@ %a" o#ctyp t o#ident i
+          pp f "@[<2>virtual@ [@,%a@]@,]@ %a" o#class_params t o#ident i
     | <:class_type< [ $t$ ] -> $ct$ >> ->
           pp f "@[<2>%a@ ->@ %a@]" o#simple_ctyp t o#class_type ct
     | <:class_type< object $csg$ end >> ->
diff --git a/camlp4/Camlp4/Printers/OCaml.mli b/camlp4/Camlp4/Printers/OCaml.mli
index 86e1d7cd8..9060e54dc 100644
--- a/camlp4/Camlp4/Printers/OCaml.mli
+++ b/camlp4/Camlp4/Printers/OCaml.mli
@@ -144,6 +144,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) : sig
     method string : formatter -> string -> unit;
     method sum_type : formatter -> Ast.ctyp -> unit;
     method type_params : formatter -> list Ast.ctyp -> unit;
+    method class_params : formatter -> Ast.ctyp -> unit;
     method under_pipe : 'a;
     method under_semi : 'a;
     method var : formatter -> string -> unit;
diff --git a/camlp4/Camlp4/Printers/OCamlr.ml b/camlp4/Camlp4/Printers/OCamlr.ml
index a696c351b..eaaa96c02 100644
--- a/camlp4/Camlp4/Printers/OCamlr.ml
+++ b/camlp4/Camlp4/Printers/OCamlr.ml
@@ -243,7 +243,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct
     [ <:class_expr< $id:i$ >> ->
           pp f "@[<2>%a@]" o#ident i
     | <:class_expr< $id:i$ [ $t$ ] >> ->
-          pp f "@[<2>%a@ @[<1>[%a]@]@]" o#ident i o#ctyp t
+          pp f "@[<2>%a@ @[<1>[%a]@]@]" o#ident i o#class_params t
     (* | <:class_expr< virtual $id:i$ >> -> *)
     | Ast.CeCon _ Ast.BTrue i <:ctyp<>> ->
           pp f "@[<2>virtual@ %a@]" o#ident i
diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
index f151b360c..a34fd04cb 100644
--- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
+++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
@@ -336,6 +336,14 @@ module Make (Ast : Sig.Camlp4Ast.S) = struct
     | <:ctyp< '$s$ >> -> [(s, (False, False)) :: acc]
     | _ -> assert False ];
 
+  value rec class_parameters t acc =
+    match t with
+    [ <:ctyp< $t1$, $t2$ >> -> class_parameters t1 (class_parameters t2 acc)
+    | <:ctyp< +'$s$ >> -> [(s, (True, False)) :: acc]
+    | <:ctyp< -'$s$ >> -> [(s, (False, True)) :: acc]
+    | <:ctyp< '$s$ >> -> [(s, (False, False)) :: acc]
+    | _ -> assert False ];
+
   value rec type_parameters_and_type_name t acc =
     match t with
     [ <:ctyp< $t1$ $t2$ >> ->
@@ -897,7 +905,7 @@ module Make (Ast : Sig.Camlp4Ast.S) = struct
       let (loc_params, (params, variance)) =
         match params with
         [ <:ctyp<>> -> (loc, ([], []))
-        | t -> (loc_of_ctyp t, List.split (type_parameters t [])) ]
+        | t -> (loc_of_ctyp t, List.split (class_parameters t [])) ]
       in
       {pci_virt = if mb2b vir then Virtual else Concrete;
        pci_params = (params, mkloc loc_params);
@@ -913,7 +921,7 @@ module Make (Ast : Sig.Camlp4Ast.S) = struct
       let (loc_params, (params, variance)) =
         match params with
         [ <:ctyp<>> -> (loc, ([], []))
-        | t -> (loc_of_ctyp t, List.split (type_parameters t [])) ]
+        | t -> (loc_of_ctyp t, List.split (class_parameters t [])) ]
       in
       {pci_virt = if mb2b vir then Virtual else Concrete;
        pci_params = (params, mkloc loc_params);