[camlp4] Fix a bug with multiple class parameters

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7687 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Nicolas Pouillard 2006-10-10 22:32:43 +00:00
parent 37473291bf
commit e00b58be00
4 changed files with 22 additions and 7 deletions

View File

@ -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 >> ->

View File

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

View File

@ -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

View File

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