From 8296428f173fb395f3e880ae1e020feb07ea5dc3 Mon Sep 17 00:00:00 2001 From: Jacques Garrigue Date: Fri, 10 Mar 2006 06:21:08 +0000 Subject: [PATCH] rebinding a virtual class git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7358 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- testlabl/valvirt.diffs | 171 ++++++++++++++++++++++++++++------------- 1 file changed, 119 insertions(+), 52 deletions(-) diff --git a/testlabl/valvirt.diffs b/testlabl/valvirt.diffs index b1fced920..6941c25d5 100644 --- a/testlabl/valvirt.diffs +++ b/testlabl/valvirt.diffs @@ -4,7 +4,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/utils/warnings.ml,v retrieving revision 1.23 diff -u -r1.23 warnings.ml --- utils/warnings.ml 15 Sep 2005 03:09:26 -0000 1.23 -+++ utils/warnings.ml 10 Mar 2006 01:17:40 -0000 ++++ utils/warnings.ml 10 Mar 2006 06:19:21 -0000 @@ -26,7 +26,7 @@ | Statement_type (* S *) | Unused_match (* U *) @@ -42,7 +42,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/utils/warnings.mli,v retrieving revision 1.16 diff -u -r1.16 warnings.mli --- utils/warnings.mli 15 Sep 2005 03:09:26 -0000 1.16 -+++ utils/warnings.mli 10 Mar 2006 01:17:40 -0000 ++++ utils/warnings.mli 10 Mar 2006 06:19:21 -0000 @@ -26,7 +26,7 @@ | Statement_type (* S *) | Unused_match (* U *) @@ -58,7 +58,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/parsing/parser.mly,v retrieving revision 1.123 diff -u -r1.123 parser.mly --- parsing/parser.mly 23 Mar 2005 03:08:37 -0000 1.123 -+++ parsing/parser.mly 10 Mar 2006 01:17:40 -0000 ++++ parsing/parser.mly 10 Mar 2006 06:19:21 -0000 @@ -623,6 +623,8 @@ { [] } | class_fields INHERIT class_expr parent_binder @@ -116,7 +116,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/parsing/parsetree.mli,v retrieving revision 1.42 diff -u -r1.42 parsetree.mli --- parsing/parsetree.mli 23 Mar 2005 03:08:37 -0000 1.42 -+++ parsing/parsetree.mli 10 Mar 2006 01:17:40 -0000 ++++ parsing/parsetree.mli 10 Mar 2006 06:19:21 -0000 @@ -152,7 +152,7 @@ and class_type_field = @@ -140,7 +140,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/parsing/printast.ml,v retrieving revision 1.29 diff -u -r1.29 printast.ml --- parsing/printast.ml 4 Jan 2006 16:55:50 -0000 1.29 -+++ parsing/printast.ml 10 Mar 2006 01:17:40 -0000 ++++ parsing/printast.ml 10 Mar 2006 06:19:21 -0000 @@ -353,10 +353,11 @@ | Pctf_inher (ct) -> line i ppf "Pctf_inher\n"; @@ -173,7 +173,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/btype.ml,v retrieving revision 1.38 diff -u -r1.38 btype.ml --- typing/btype.ml 4 Jan 2006 16:55:50 -0000 1.38 -+++ typing/btype.ml 10 Mar 2006 01:17:40 -0000 ++++ typing/btype.ml 10 Mar 2006 06:19:21 -0000 @@ -330,7 +330,7 @@ let unmark_class_signature sign = @@ -189,7 +189,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v retrieving revision 1.200 diff -u -r1.200 ctype.ml --- typing/ctype.ml 6 Jan 2006 02:16:24 -0000 1.200 -+++ typing/ctype.ml 10 Mar 2006 01:17:41 -0000 ++++ typing/ctype.ml 10 Mar 2006 06:19:22 -0000 @@ -857,7 +857,7 @@ Tcty_signature {cty_self = copy sign.cty_self; @@ -329,7 +329,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.mli,v retrieving revision 1.53 diff -u -r1.53 ctype.mli --- typing/ctype.mli 9 Dec 2004 12:40:53 -0000 1.53 -+++ typing/ctype.mli 10 Mar 2006 01:17:41 -0000 ++++ typing/ctype.mli 10 Mar 2006 06:19:22 -0000 @@ -170,10 +170,11 @@ | CM_Val_type_mismatch of string * (type_expr * type_expr) list | CM_Meth_type_mismatch of string * (type_expr * type_expr) list @@ -349,7 +349,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/includeclass.ml,v retrieving revision 1.7 diff -u -r1.7 includeclass.ml --- typing/includeclass.ml 6 Mar 2000 22:11:57 -0000 1.7 -+++ typing/includeclass.ml 10 Mar 2006 01:17:41 -0000 ++++ typing/includeclass.ml 10 Mar 2006 06:19:22 -0000 @@ -78,14 +78,17 @@ | CM_Non_mutable_value lab -> fprintf ppf @@ -376,7 +376,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/oprint.ml,v retrieving revision 1.22 diff -u -r1.22 oprint.ml --- typing/oprint.ml 23 Mar 2005 03:08:37 -0000 1.22 -+++ typing/oprint.ml 10 Mar 2006 01:17:41 -0000 ++++ typing/oprint.ml 10 Mar 2006 06:19:22 -0000 @@ -291,8 +291,10 @@ fprintf ppf "@[<2>method %s%s%s :@ %a@]" (if priv then "private " else "") (if virt then "virtual " else "") @@ -396,7 +396,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/outcometree.mli,v retrieving revision 1.14 diff -u -r1.14 outcometree.mli --- typing/outcometree.mli 23 Mar 2005 03:08:37 -0000 1.14 -+++ typing/outcometree.mli 10 Mar 2006 01:17:41 -0000 ++++ typing/outcometree.mli 10 Mar 2006 06:19:22 -0000 @@ -71,7 +71,7 @@ and out_class_sig_item = | Ocsg_constraint of out_type * out_type @@ -412,7 +412,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/printtyp.ml,v retrieving revision 1.140 diff -u -r1.140 printtyp.ml --- typing/printtyp.ml 4 Jan 2006 16:55:50 -0000 1.140 -+++ typing/printtyp.ml 10 Mar 2006 01:17:41 -0000 ++++ typing/printtyp.ml 10 Mar 2006 06:19:22 -0000 @@ -650,7 +650,7 @@ Ctype.flatten_fields (Ctype.object_fields sign.cty_self) in @@ -458,7 +458,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/subst.ml,v retrieving revision 1.49 diff -u -r1.49 subst.ml --- typing/subst.ml 4 Jan 2006 16:55:50 -0000 1.49 -+++ typing/subst.ml 10 Mar 2006 01:17:41 -0000 ++++ typing/subst.ml 10 Mar 2006 06:19:22 -0000 @@ -178,7 +178,8 @@ let class_signature s sign = @@ -475,7 +475,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/typeclass.ml,v retrieving revision 1.85 diff -u -r1.85 typeclass.ml --- typing/typeclass.ml 22 Jul 2005 06:42:36 -0000 1.85 -+++ typing/typeclass.ml 10 Mar 2006 01:17:41 -0000 ++++ typing/typeclass.ml 10 Mar 2006 06:19:22 -0000 @@ -24,7 +24,7 @@ type error = @@ -868,7 +868,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/typeclass.mli,v retrieving revision 1.18 diff -u -r1.18 typeclass.mli --- typing/typeclass.mli 1 Dec 2003 00:32:11 -0000 1.18 -+++ typing/typeclass.mli 10 Mar 2006 01:17:41 -0000 ++++ typing/typeclass.mli 10 Mar 2006 06:19:22 -0000 @@ -49,7 +49,7 @@ type error = @@ -901,7 +901,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v retrieving revision 1.178 diff -u -r1.178 typecore.ml --- typing/typecore.ml 6 Jan 2006 02:25:37 -0000 1.178 -+++ typing/typecore.ml 10 Mar 2006 01:17:42 -0000 ++++ typing/typecore.ml 10 Mar 2006 06:19:22 -0000 @@ -611,11 +611,11 @@ List.for_all (function @@ -931,7 +931,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.mli,v retrieving revision 1.37 diff -u -r1.37 typecore.mli --- typing/typecore.mli 4 Mar 2005 14:51:31 -0000 1.37 -+++ typing/typecore.mli 10 Mar 2006 01:17:42 -0000 ++++ typing/typecore.mli 10 Mar 2006 06:19:22 -0000 @@ -38,7 +38,8 @@ string -> type_expr -> Env.t -> Env.t -> Env.t -> Parsetree.pattern -> Typedtree.pattern * @@ -948,7 +948,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/typedtree.ml,v retrieving revision 1.36 diff -u -r1.36 typedtree.ml --- typing/typedtree.ml 25 Nov 2003 09:20:43 -0000 1.36 -+++ typing/typedtree.ml 10 Mar 2006 01:17:42 -0000 ++++ typing/typedtree.ml 10 Mar 2006 06:19:22 -0000 @@ -106,7 +106,7 @@ and class_field = @@ -974,7 +974,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/typedtree.mli,v retrieving revision 1.34 diff -u -r1.34 typedtree.mli --- typing/typedtree.mli 25 Nov 2003 09:20:43 -0000 1.34 -+++ typing/typedtree.mli 10 Mar 2006 01:17:42 -0000 ++++ typing/typedtree.mli 10 Mar 2006 06:19:22 -0000 @@ -107,7 +107,8 @@ and class_field = Cf_inher of class_expr * (string * Ident.t) list * (string * Ident.t) list @@ -1001,7 +1001,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/typemod.ml,v retrieving revision 1.73 diff -u -r1.73 typemod.ml --- typing/typemod.ml 8 Aug 2005 09:41:51 -0000 1.73 -+++ typing/typemod.ml 10 Mar 2006 01:17:42 -0000 ++++ typing/typemod.ml 10 Mar 2006 06:19:22 -0000 @@ -17,6 +17,7 @@ open Misc open Longident @@ -1028,7 +1028,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/types.ml,v retrieving revision 1.25 diff -u -r1.25 types.ml --- typing/types.ml 9 Dec 2004 12:40:53 -0000 1.25 -+++ typing/types.ml 10 Mar 2006 01:17:42 -0000 ++++ typing/types.ml 10 Mar 2006 06:19:22 -0000 @@ -90,7 +90,8 @@ | Val_prim of Primitive.description (* Primitive *) | Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *) @@ -1055,7 +1055,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/types.mli,v retrieving revision 1.25 diff -u -r1.25 types.mli --- typing/types.mli 9 Dec 2004 12:40:53 -0000 1.25 -+++ typing/types.mli 10 Mar 2006 01:17:42 -0000 ++++ typing/types.mli 10 Mar 2006 06:19:22 -0000 @@ -91,7 +91,8 @@ | Val_prim of Primitive.description (* Primitive *) | Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *) @@ -1082,7 +1082,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/typing/unused_var.ml,v retrieving revision 1.5 diff -u -r1.5 unused_var.ml --- typing/unused_var.ml 4 Jan 2006 16:55:50 -0000 1.5 -+++ typing/unused_var.ml 10 Mar 2006 01:17:42 -0000 ++++ typing/unused_var.ml 10 Mar 2006 06:19:22 -0000 @@ -245,7 +245,7 @@ match cf with | Pcf_inher (ce, _) -> class_expr ppf tbl ce; @@ -1098,7 +1098,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translclass.ml,v retrieving revision 1.38 diff -u -r1.38 translclass.ml --- bytecomp/translclass.ml 13 Aug 2005 20:59:37 -0000 1.38 -+++ bytecomp/translclass.ml 10 Mar 2006 01:17:42 -0000 ++++ bytecomp/translclass.ml 10 Mar 2006 06:19:22 -0000 @@ -133,10 +133,10 @@ (fun _ -> lambda_unit) cl in @@ -1189,16 +1189,83 @@ diff -u -r1.38 translclass.ml | _ -> let core cl_init = build_class_init cla true super inh_init cl_init msubst top cl -@@ -592,7 +580,7 @@ +@@ -397,12 +385,16 @@ + XXX Il devrait etre peu couteux d'ecrire des classes : + class c x y = d e f + *) +-let rec transl_class_rebind obj_init cl = ++let rec transl_class_rebind obj_init cl vf = + match cl.cl_desc with + Tclass_ident path -> ++ if vf = Concrete then begin ++ try if (Env.find_class path cl.cl_env).cty_new = None then raise Exit ++ with Not_found -> raise Exit ++ end; + (path, obj_init) + | Tclass_fun (pat, _, cl, partial) -> +- let path, obj_init = transl_class_rebind obj_init cl in ++ let path, obj_init = transl_class_rebind obj_init cl vf in + let build params rem = + let param = name_pattern "param" [pat, ()] in + Lfunction (Curried, param::params, +@@ -414,14 +406,14 @@ + Lfunction (Curried, params, rem) -> build params rem + | rem -> build [] rem) + | Tclass_apply (cl, oexprs) -> +- let path, obj_init = transl_class_rebind obj_init cl in ++ let path, obj_init = transl_class_rebind obj_init cl vf in + (path, transl_apply obj_init oexprs) + | Tclass_let (rec_flag, defs, vals, cl) -> +- let path, obj_init = transl_class_rebind obj_init cl in ++ let path, obj_init = transl_class_rebind obj_init cl vf in + (path, Translcore.transl_let rec_flag defs obj_init) + | Tclass_structure _ -> raise Exit + | Tclass_constraint (cl', _, _, _) -> +- let path, obj_init = transl_class_rebind obj_init cl' in ++ let path, obj_init = transl_class_rebind obj_init cl' vf in + let rec check_constraint = function + Tcty_constr(path', _, _) when Path.same path path' -> () + | Tcty_fun (_, _, cty) -> check_constraint cty +@@ -430,21 +422,21 @@ + check_constraint cl.cl_type; + (path, obj_init) + +-let rec transl_class_rebind_0 self obj_init cl = ++let rec transl_class_rebind_0 self obj_init cl vf = + match cl.cl_desc with + Tclass_let (rec_flag, defs, vals, cl) -> +- let path, obj_init = transl_class_rebind_0 self obj_init cl in ++ let path, obj_init = transl_class_rebind_0 self obj_init cl vf in + (path, Translcore.transl_let rec_flag defs obj_init) + | _ -> +- let path, obj_init = transl_class_rebind obj_init cl in ++ let path, obj_init = transl_class_rebind obj_init cl vf in + (path, lfunction [self] obj_init) + +-let transl_class_rebind ids cl = ++let transl_class_rebind ids cl vf = + try + let obj_init = Ident.create "obj_init" + and self = Ident.create "self" in + let obj_init0 = lapply (Lvar obj_init) [Lvar self] in +- let path, obj_init' = transl_class_rebind_0 self obj_init0 cl in ++ let path, obj_init' = transl_class_rebind_0 self obj_init0 cl vf in + if not (Translcore.check_recursive_lambda ids obj_init') then + raise(Error(cl.cl_loc, Illegal_class_expr)); + let id = (obj_init' = lfunction [self] obj_init0) in +@@ -592,9 +584,9 @@ *) -let transl_class ids cl_id arity pub_meths cl = +let transl_class ids cl_id arity pub_meths cl vflag = (* First check if it is not only a rebind *) - let rebind = transl_class_rebind ids cl in +- let rebind = transl_class_rebind ids cl in ++ let rebind = transl_class_rebind ids cl vflag in if rebind <> lambda_unit then rebind else -@@ -696,9 +684,7 @@ + + (* Prepare for heavy environment handling *) +@@ -696,9 +688,7 @@ (* Simplest case: an object defined at toplevel (ids=[]) *) if top && ids = [] then llets (ltable cla (ldirect obj_init)) else @@ -1209,7 +1276,7 @@ diff -u -r1.38 translclass.ml and lclass lam = let cl_init = llets (Lfunction(Curried, [cla], cl_init)) in Llet(Strict, class_init, cl_init, lam (free_variables cl_init)) -@@ -800,11 +786,11 @@ +@@ -800,11 +790,11 @@ (* Wrapper for class compilation *) @@ -1230,7 +1297,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translclass.mli,v retrieving revision 1.11 diff -u -r1.11 translclass.mli --- bytecomp/translclass.mli 12 Aug 2004 12:55:11 -0000 1.11 -+++ bytecomp/translclass.mli 10 Mar 2006 01:17:42 -0000 ++++ bytecomp/translclass.mli 10 Mar 2006 06:19:22 -0000 @@ -16,7 +16,8 @@ open Lambda @@ -1247,7 +1314,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translmod.ml,v retrieving revision 1.51 diff -u -r1.51 translmod.ml --- bytecomp/translmod.ml 12 Aug 2004 12:55:11 -0000 1.51 -+++ bytecomp/translmod.ml 10 Mar 2006 01:17:42 -0000 ++++ bytecomp/translmod.ml 10 Mar 2006 06:19:22 -0000 @@ -317,10 +317,10 @@ | Tstr_open path :: rem -> transl_structure fields cc rootpath rem @@ -1311,7 +1378,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/driver/main_args.ml,v retrieving revision 1.48 diff -u -r1.48 main_args.ml --- driver/main_args.ml 4 Jan 2006 16:55:49 -0000 1.48 -+++ driver/main_args.ml 10 Mar 2006 01:17:42 -0000 ++++ driver/main_args.ml 10 Mar 2006 06:19:22 -0000 @@ -136,11 +136,11 @@ \032 E/e enable/disable fragile match\n\ \032 F/f enable/disable partially applied function\n\ @@ -1332,7 +1399,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/driver/optmain.ml,v retrieving revision 1.87 diff -u -r1.87 optmain.ml --- driver/optmain.ml 4 Jan 2006 16:55:49 -0000 1.87 -+++ driver/optmain.ml 10 Mar 2006 01:17:42 -0000 ++++ driver/optmain.ml 10 Mar 2006 06:19:22 -0000 @@ -173,7 +173,7 @@ \032 P/p enable/disable partial match\n\ \032 S/s enable/disable non-unit statement\n\ @@ -1348,7 +1415,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/stdlib/camlinternalOO.ml,v retrieving revision 1.14 diff -u -r1.14 camlinternalOO.ml --- stdlib/camlinternalOO.ml 25 Oct 2005 18:34:07 -0000 1.14 -+++ stdlib/camlinternalOO.ml 10 Mar 2006 01:17:42 -0000 ++++ stdlib/camlinternalOO.ml 10 Mar 2006 06:19:22 -0000 @@ -206,7 +206,11 @@ (table.methods_by_name, table.methods_by_label, table.hidden_meths, table.vars, virt_meth_labs, vars) @@ -1422,7 +1489,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/stdlib/camlinternalOO.mli,v retrieving revision 1.9 diff -u -r1.9 camlinternalOO.mli --- stdlib/camlinternalOO.mli 25 Oct 2005 18:34:07 -0000 1.9 -+++ stdlib/camlinternalOO.mli 10 Mar 2006 01:17:42 -0000 ++++ stdlib/camlinternalOO.mli 10 Mar 2006 06:19:22 -0000 @@ -46,8 +46,7 @@ val init_class : table -> unit val inherits : @@ -1455,7 +1522,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/stdlib/sys.ml,v retrieving revision 1.141 diff -u -r1.141 sys.ml --- stdlib/sys.ml 24 Jan 2006 11:12:26 -0000 1.141 -+++ stdlib/sys.ml 10 Mar 2006 01:17:42 -0000 ++++ stdlib/sys.ml 10 Mar 2006 06:19:22 -0000 @@ -78,4 +78,4 @@ (* OCaml version string, must be in the format described in sys.mli. *) @@ -1468,7 +1535,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/otherlibs/labltk/browser/searchpo retrieving revision 1.48 diff -u -r1.48 searchpos.ml --- otherlibs/labltk/browser/searchpos.ml 23 Mar 2005 03:08:37 -0000 1.48 -+++ otherlibs/labltk/browser/searchpos.ml 10 Mar 2006 01:17:42 -0000 ++++ otherlibs/labltk/browser/searchpos.ml 10 Mar 2006 06:19:22 -0000 @@ -141,9 +141,8 @@ List.iter cfl ~f: begin function @@ -1505,7 +1572,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/ocamldoc/Makefile,v retrieving revision 1.61 diff -u -r1.61 Makefile --- ocamldoc/Makefile 4 Jan 2006 16:55:49 -0000 1.61 -+++ ocamldoc/Makefile 10 Mar 2006 01:17:42 -0000 ++++ ocamldoc/Makefile 10 Mar 2006 06:19:23 -0000 @@ -31,7 +31,7 @@ MKDIR=mkdir -p CP=cp -f @@ -1535,7 +1602,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/ocamldoc/odoc_ast.ml,v retrieving revision 1.27 diff -u -r1.27 odoc_ast.ml --- ocamldoc/odoc_ast.ml 4 Jan 2006 16:55:49 -0000 1.27 -+++ ocamldoc/odoc_ast.ml 10 Mar 2006 01:17:42 -0000 ++++ ocamldoc/odoc_ast.ml 10 Mar 2006 06:19:23 -0000 @@ -88,7 +88,7 @@ ident_type_decl_list | Typedtree.Tstr_class info_list -> @@ -1579,7 +1646,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/ocamldoc/odoc_sig.ml,v retrieving revision 1.37 diff -u -r1.37 odoc_sig.ml --- ocamldoc/odoc_sig.ml 4 Jan 2006 16:55:50 -0000 1.37 -+++ ocamldoc/odoc_sig.ml 10 Mar 2006 01:17:42 -0000 ++++ ocamldoc/odoc_sig.ml 10 Mar 2006 06:19:23 -0000 @@ -107,7 +107,7 @@ | _ -> assert false @@ -1613,7 +1680,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/camlp4/ast2pt.ml,v retrieving revision 1.36 diff -u -r1.36 ast2pt.ml --- camlp4/camlp4/ast2pt.ml 29 Jun 2005 04:11:26 -0000 1.36 -+++ camlp4/camlp4/ast2pt.ml 10 Mar 2006 01:17:42 -0000 ++++ camlp4/camlp4/ast2pt.ml 10 Mar 2006 06:19:23 -0000 @@ -244,6 +244,7 @@ ; value mkmutable m = if m then Mutable else Immutable; @@ -1650,7 +1717,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/camlp4/mLast.mli,v retrieving revision 1.18 diff -u -r1.18 mLast.mli --- camlp4/camlp4/mLast.mli 29 Jun 2005 04:11:26 -0000 1.18 -+++ camlp4/camlp4/mLast.mli 10 Mar 2006 01:17:42 -0000 ++++ camlp4/camlp4/mLast.mli 10 Mar 2006 06:19:23 -0000 @@ -180,7 +180,7 @@ | CgDcl of loc and list class_sig_item | CgInh of loc and class_type @@ -1676,7 +1743,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/camlp4/reloc.ml,v retrieving revision 1.18 diff -u -r1.18 reloc.ml --- camlp4/camlp4/reloc.ml 29 Jun 2005 04:11:26 -0000 1.18 -+++ camlp4/camlp4/reloc.ml 10 Mar 2006 01:17:42 -0000 ++++ camlp4/camlp4/reloc.ml 10 Mar 2006 06:19:23 -0000 @@ -350,7 +350,7 @@ | CgDcl loc x1 -> let nloc = floc loc in CgDcl nloc (List.map (class_sig_item floc sh) x1) | CgInh loc x1 -> let nloc = floc loc in CgInh nloc (class_type floc sh x1) @@ -1700,7 +1767,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/etc/pa_o.ml,v retrieving revision 1.66 diff -u -r1.66 pa_o.ml --- camlp4/etc/pa_o.ml 29 Jun 2005 04:11:26 -0000 1.66 -+++ camlp4/etc/pa_o.ml 10 Mar 2006 01:17:42 -0000 ++++ camlp4/etc/pa_o.ml 10 Mar 2006 06:19:23 -0000 @@ -1037,8 +1037,14 @@ class_str_item: [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] -> @@ -1736,7 +1803,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/etc/pr_o.ml,v retrieving revision 1.51 diff -u -r1.51 pr_o.ml --- camlp4/etc/pr_o.ml 5 Jan 2006 10:44:29 -0000 1.51 -+++ camlp4/etc/pr_o.ml 10 Mar 2006 01:17:42 -0000 ++++ camlp4/etc/pr_o.ml 10 Mar 2006 06:19:23 -0000 @@ -1768,10 +1768,11 @@ [: `S LR "method"; private_flag pf; `label lab; `S LR ":" :]; @@ -1757,7 +1824,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/meta/pa_r.ml,v retrieving revision 1.64 diff -u -r1.64 pa_r.ml --- camlp4/meta/pa_r.ml 29 Jun 2005 04:11:26 -0000 1.64 -+++ camlp4/meta/pa_r.ml 10 Mar 2006 01:17:42 -0000 ++++ camlp4/meta/pa_r.ml 10 Mar 2006 06:19:23 -0000 @@ -658,7 +658,9 @@ | "inherit"; ce = class_expr; pb = OPT as_lident -> <:class_str_item< inherit $ce$ $opt:pb$ >> @@ -1787,7 +1854,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/meta/q_MLast.ml,v retrieving revision 1.60 diff -u -r1.60 q_MLast.ml --- camlp4/meta/q_MLast.ml 29 Jun 2005 04:11:26 -0000 1.60 -+++ camlp4/meta/q_MLast.ml 10 Mar 2006 01:17:42 -0000 ++++ camlp4/meta/q_MLast.ml 10 Mar 2006 06:19:23 -0000 @@ -947,6 +947,8 @@ Qast.Node "CrDcl" [Qast.Loc; st] | "inherit"; ce = class_expr; pb = SOPT as_lident -> @@ -1815,7 +1882,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/ast2pt.ml retrieving revision 1.36 diff -u -r1.36 ast2pt.ml --- camlp4/ocaml_src/camlp4/ast2pt.ml 29 Jun 2005 04:11:26 -0000 1.36 -+++ camlp4/ocaml_src/camlp4/ast2pt.ml 10 Mar 2006 01:17:42 -0000 ++++ camlp4/ocaml_src/camlp4/ast2pt.ml 10 Mar 2006 06:19:23 -0000 @@ -227,6 +227,7 @@ ;; let mkmutable m = if m then Mutable else Immutable;; @@ -1850,7 +1917,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/mLast.mli retrieving revision 1.20 diff -u -r1.20 mLast.mli --- camlp4/ocaml_src/camlp4/mLast.mli 29 Jun 2005 04:11:26 -0000 1.20 -+++ camlp4/ocaml_src/camlp4/mLast.mli 10 Mar 2006 01:17:42 -0000 ++++ camlp4/ocaml_src/camlp4/mLast.mli 10 Mar 2006 06:19:23 -0000 @@ -180,7 +180,7 @@ | CgDcl of loc * class_sig_item list | CgInh of loc * class_type @@ -1874,7 +1941,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/reloc.ml, retrieving revision 1.20 diff -u -r1.20 reloc.ml --- camlp4/ocaml_src/camlp4/reloc.ml 29 Jun 2005 04:11:26 -0000 1.20 -+++ camlp4/ocaml_src/camlp4/reloc.ml 10 Mar 2006 01:17:42 -0000 ++++ camlp4/ocaml_src/camlp4/reloc.ml 10 Mar 2006 06:19:23 -0000 @@ -430,8 +430,8 @@ let nloc = floc loc in CgInh (nloc, class_type floc sh x1) | CgMth (loc, x1, x2, x3) -> @@ -1901,7 +1968,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/meta/pa_r.ml,v retrieving revision 1.59 diff -u -r1.59 pa_r.ml --- camlp4/ocaml_src/meta/pa_r.ml 29 Jun 2005 04:11:26 -0000 1.59 -+++ camlp4/ocaml_src/meta/pa_r.ml 10 Mar 2006 01:17:43 -0000 ++++ camlp4/ocaml_src/meta/pa_r.ml 10 Mar 2006 06:19:24 -0000 @@ -2161,6 +2161,15 @@ (fun (t : 'ctyp) _ (l : 'label) (pf : string option) _ _ (_loc : Lexing.position * Lexing.position) -> @@ -1942,7 +2009,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/meta/q_MLast.ml, retrieving revision 1.65 diff -u -r1.65 q_MLast.ml --- camlp4/ocaml_src/meta/q_MLast.ml 12 Jan 2006 08:54:21 -0000 1.65 -+++ camlp4/ocaml_src/meta/q_MLast.ml 10 Mar 2006 01:17:43 -0000 ++++ camlp4/ocaml_src/meta/q_MLast.ml 10 Mar 2006 06:19:24 -0000 @@ -3152,9 +3152,9 @@ Gramext.action (fun (x : string) @@ -2227,7 +2294,7 @@ RCS file: /net/yquem/devel/caml/repository/csl/camlp4/top/rprint.ml,v retrieving revision 1.18 diff -u -r1.18 rprint.ml --- camlp4/top/rprint.ml 29 Jun 2005 04:11:26 -0000 1.18 -+++ camlp4/top/rprint.ml 10 Mar 2006 01:17:43 -0000 ++++ camlp4/top/rprint.ml 10 Mar 2006 06:19:24 -0000 @@ -288,8 +288,9 @@ fprintf ppf "@[<2>method %s%s%s :@ %a;@]" (if priv then "private " else "") (if virt then "virtual " else "")