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);