summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2006-03-09 07:21:48 +0000
committerJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2006-03-09 07:21:48 +0000
commita5e7b241eadc7a89b27616be0bb83ddc7af87cb9 (patch)
treeea4632c528b8d372b39d62b367ad636f4881c33e
parent7554d24e6cfde8c6ba55fa3e8f2d23813c54906e (diff)
patch for merged and virtual instance variables
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7356 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat
-rw-r--r--testlabl/valvirt.diffs2013
1 files changed, 2013 insertions, 0 deletions
diff --git a/testlabl/valvirt.diffs b/testlabl/valvirt.diffs
new file mode 100644
index 000000000..4db7e0db4
--- /dev/null
+++ b/testlabl/valvirt.diffs
@@ -0,0 +1,2013 @@
+Index: utils/warnings.ml
+===================================================================
+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 9 Mar 2006 07:19:37 -0000
+@@ -26,7 +26,7 @@
+ | Statement_type (* S *)
+ | Unused_match (* U *)
+ | Unused_pat
+- | Hide_instance_variable of string (* V *)
++ | Instance_variable_override of string (* V *)
+ | Illegal_backslash (* X *)
+ | Implicit_public_methods of string list
+ | Unerasable_optional_argument
+@@ -54,7 +54,7 @@
+ | Statement_type -> 's'
+ | Unused_match
+ | Unused_pat -> 'u'
+- | Hide_instance_variable _ -> 'v'
++ | Instance_variable_override _ -> 'v'
+ | Illegal_backslash
+ | Implicit_public_methods _
+ | Unerasable_optional_argument
+@@ -126,9 +126,9 @@
+ String.concat " "
+ ("the following methods are overriden \
+ by the inherited class:\n " :: slist)
+- | Hide_instance_variable lab ->
+- "this definition of an instance variable " ^ lab ^
+- " hides a previously\ndefined instance variable of the same name."
++ | Instance_variable_override lab ->
++ "the instance variable " ^ lab ^ " is overriden.\n" ^
++ "The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
+ | Partial_application ->
+ "this function application is partial,\n\
+ maybe some arguments are missing."
+Index: utils/warnings.mli
+===================================================================
+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 9 Mar 2006 07:19:37 -0000
+@@ -26,7 +26,7 @@
+ | Statement_type (* S *)
+ | Unused_match (* U *)
+ | Unused_pat
+- | Hide_instance_variable of string (* V *)
++ | Instance_variable_override of string (* V *)
+ | Illegal_backslash (* X *)
+ | Implicit_public_methods of string list
+ | Unerasable_optional_argument
+Index: parsing/parser.mly
+===================================================================
+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 9 Mar 2006 07:19:37 -0000
+@@ -623,6 +623,8 @@
+ { [] }
+ | class_fields INHERIT class_expr parent_binder
+ { Pcf_inher ($3, $4) :: $1 }
++ | class_fields VAL virtual_value
++ { Pcf_valvirt $3 :: $1 }
+ | class_fields VAL value
+ { Pcf_val $3 :: $1 }
+ | class_fields virtual_method
+@@ -638,14 +640,20 @@
+ AS LIDENT
+ { Some $2 }
+ | /* empty */
+- {None}
++ { None }
++;
++virtual_value:
++ MUTABLE VIRTUAL label COLON core_type
++ { $3, Mutable, $5, symbol_rloc () }
++ | VIRTUAL mutable_flag label COLON core_type
++ { $3, $2, $5, symbol_rloc () }
+ ;
+ value:
+- mutable_flag label EQUAL seq_expr
+- { $2, $1, $4, symbol_rloc () }
+- | mutable_flag label type_constraint EQUAL seq_expr
+- { $2, $1, (let (t, t') = $3 in ghexp(Pexp_constraint($5, t, t'))),
+- symbol_rloc () }
++ mutable_flag label EQUAL seq_expr
++ { $2, $1, $4, symbol_rloc () }
++ | mutable_flag label type_constraint EQUAL seq_expr
++ { $2, $1, (let (t, t') = $3 in ghexp(Pexp_constraint($5, t, t'))),
++ symbol_rloc () }
+ ;
+ virtual_method:
+ METHOD PRIVATE VIRTUAL label COLON poly_type
+@@ -711,8 +719,12 @@
+ | class_sig_fields CONSTRAINT constrain { Pctf_cstr $3 :: $1 }
+ ;
+ value_type:
+- mutable_flag label COLON core_type
+- { $2, $1, Some $4, symbol_rloc () }
++ VIRTUAL mutable_flag label COLON core_type
++ { $3, $2, Virtual, $5, symbol_rloc () }
++ | MUTABLE virtual_flag label COLON core_type
++ { $3, Mutable, $2, $5, symbol_rloc () }
++ | label COLON core_type
++ { $1, Immutable, Concrete, $3, symbol_rloc () }
+ ;
+ method_type:
+ METHOD private_flag label COLON poly_type
+Index: parsing/parsetree.mli
+===================================================================
+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 9 Mar 2006 07:19:37 -0000
+@@ -152,7 +152,7 @@
+
+ and class_type_field =
+ Pctf_inher of class_type
+- | Pctf_val of (string * mutable_flag * core_type option * Location.t)
++ | Pctf_val of (string * mutable_flag * virtual_flag * core_type * Location.t)
+ | Pctf_virt of (string * private_flag * core_type * Location.t)
+ | Pctf_meth of (string * private_flag * core_type * Location.t)
+ | Pctf_cstr of (core_type * core_type * Location.t)
+@@ -179,6 +179,7 @@
+
+ and class_field =
+ Pcf_inher of class_expr * string option
++ | Pcf_valvirt of (string * mutable_flag * core_type * Location.t)
+ | Pcf_val of (string * mutable_flag * expression * Location.t)
+ | Pcf_virt of (string * private_flag * core_type * Location.t)
+ | Pcf_meth of (string * private_flag * expression * Location.t)
+Index: parsing/printast.ml
+===================================================================
+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 9 Mar 2006 07:19:37 -0000
+@@ -353,10 +353,11 @@
+ | Pctf_inher (ct) ->
+ line i ppf "Pctf_inher\n";
+ class_type i ppf ct;
+- | Pctf_val (s, mf, cto, loc) ->
++ | Pctf_val (s, mf, vf, ct, loc) ->
+ line i ppf
+- "Pctf_val \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc;
+- option i core_type ppf cto;
++ "Pctf_val \"%s\" %a %a %a\n" s
++ fmt_mutable_flag mf fmt_virtual_flag vf fmt_location loc;
++ core_type (i+1) ppf ct;
+ | Pctf_virt (s, pf, ct, loc) ->
+ line i ppf
+ "Pctf_virt \"%s\" %a %a\n" s fmt_private_flag pf fmt_location loc;
+@@ -428,6 +429,10 @@
+ line i ppf "Pcf_inher\n";
+ class_expr (i+1) ppf ce;
+ option (i+1) string ppf so;
++ | Pcf_valvirt (s, mf, ct, loc) ->
++ line i ppf
++ "Pcf_valvirt \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc;
++ core_type (i+1) ppf ct;
+ | Pcf_val (s, mf, e, loc) ->
+ line i ppf
+ "Pcf_val \"%s\" %a %a\n" s fmt_mutable_flag mf fmt_location loc;
+Index: typing/btype.ml
+===================================================================
+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 9 Mar 2006 07:19:37 -0000
+@@ -330,7 +330,7 @@
+
+ let unmark_class_signature sign =
+ unmark_type sign.cty_self;
+- Vars.iter (fun l (m, t) -> unmark_type t) sign.cty_vars
++ Vars.iter (fun l (m, v, t) -> unmark_type t) sign.cty_vars
+
+ let rec unmark_class_type =
+ function
+Index: typing/ctype.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -857,7 +857,7 @@
+ Tcty_signature
+ {cty_self = copy sign.cty_self;
+ cty_vars =
+- Vars.map (function (mut, ty) -> (mut, copy ty)) sign.cty_vars;
++ Vars.map (function (m, v, ty) -> (m, v, copy ty)) sign.cty_vars;
+ cty_concr = sign.cty_concr;
+ cty_inher =
+ List.map (fun (p,tl) -> (p, List.map copy tl)) sign.cty_inher}
+@@ -2354,6 +2354,7 @@
+ | CM_Val_type_mismatch of string * (type_expr * type_expr) list
+ | CM_Meth_type_mismatch of string * (type_expr * type_expr) list
+ | CM_Non_mutable_value of string
++ | CM_Non_concrete_value of string
+ | CM_Missing_value of string
+ | CM_Missing_method of string
+ | CM_Hide_public of string
+@@ -2390,8 +2391,8 @@
+ end)
+ pairs;
+ Vars.iter
+- (fun lab (mut, ty) ->
+- let (mut', ty') = Vars.find lab sign1.cty_vars in
++ (fun lab (mut, v, ty) ->
++ let (mut', v', ty') = Vars.find lab sign1.cty_vars in
+ try moregen true type_pairs env ty' ty with Unify trace ->
+ raise (Failure [CM_Val_type_mismatch
+ (lab, expand_trace env trace)]))
+@@ -2455,11 +2456,13 @@
+ in
+ let error =
+ Vars.fold
+- (fun lab (mut, ty) err ->
++ (fun lab (mut, vr, ty) err ->
+ try
+- let (mut', ty') = Vars.find lab sign1.cty_vars in
++ let (mut', vr', ty') = Vars.find lab sign1.cty_vars in
+ if mut = Mutable && mut' <> Mutable then
+ CM_Non_mutable_value lab::err
++ else if vr = Concrete && vr' <> Concrete then
++ CM_Non_concrete_value lab::err
+ else
+ err
+ with Not_found ->
+@@ -2516,8 +2519,8 @@
+ end)
+ pairs;
+ Vars.iter
+- (fun lab (mut, ty) ->
+- let (mut', ty') = Vars.find lab sign1.cty_vars in
++ (fun lab (_, _, ty) ->
++ let (_, _, ty') = Vars.find lab sign1.cty_vars in
+ try eqtype true type_pairs subst env ty ty' with Unify trace ->
+ raise (Failure [CM_Val_type_mismatch
+ (lab, expand_trace env trace)]))
+@@ -2578,11 +2581,13 @@
+ in
+ let error =
+ Vars.fold
+- (fun lab (mut, ty) err ->
++ (fun lab (mut, vr, ty) err ->
+ try
+- let (mut', ty') = Vars.find lab sign1.cty_vars in
++ let (mut', vr', ty') = Vars.find lab sign1.cty_vars in
+ if mut = Mutable && mut' <> Mutable then
+ CM_Non_mutable_value lab::err
++ else if vr = Concrete && vr' <> Concrete then
++ CM_Non_concrete_value lab::err
+ else
+ err
+ with Not_found ->
+@@ -3279,7 +3284,7 @@
+ let nondep_class_signature env id sign =
+ { cty_self = nondep_type_rec env id sign.cty_self;
+ cty_vars =
+- Vars.map (function (m, t) -> (m, nondep_type_rec env id t))
++ Vars.map (function (m, v, t) -> (m, v, nondep_type_rec env id t))
+ sign.cty_vars;
+ cty_concr = sign.cty_concr;
+ cty_inher =
+Index: typing/ctype.mli
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -170,6 +170,7 @@
+ | CM_Val_type_mismatch of string * (type_expr * type_expr) list
+ | CM_Meth_type_mismatch of string * (type_expr * type_expr) list
+ | CM_Non_mutable_value of string
++ | CM_Non_concrete_value of string
+ | CM_Missing_value of string
+ | CM_Missing_method of string
+ | CM_Hide_public of string
+Index: typing/includeclass.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -78,6 +78,9 @@
+ | CM_Non_mutable_value lab ->
+ fprintf ppf
+ "@[The non-mutable instance variable %s cannot become mutable@]" lab
++ | CM_Non_concrete_value lab ->
++ fprintf ppf
++ "@[The virtual instance variable %s cannot become concrete@]" lab
+ | CM_Missing_value lab ->
+ fprintf ppf "@[The first class type has no instance variable %s@]" lab
+ | CM_Missing_method lab ->
+Index: typing/oprint.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -291,8 +291,10 @@
+ fprintf ppf "@[<2>method %s%s%s :@ %a@]"
+ (if priv then "private " else "") (if virt then "virtual " else "")
+ name !out_type ty
+- | Ocsg_value (name, mut, ty) ->
+- fprintf ppf "@[<2>val %s%s :@ %a@]" (if mut then "mutable " else "")
++ | Ocsg_value (name, mut, vr, ty) ->
++ fprintf ppf "@[<2>val %s%s%s :@ %a@]"
++ (if mut then "mutable " else "")
++ (if vr then "virtual " else "")
+ name !out_type ty
+
+ let out_class_type = ref print_out_class_type
+Index: typing/outcometree.mli
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -71,7 +71,7 @@
+ and out_class_sig_item =
+ | Ocsg_constraint of out_type * out_type
+ | Ocsg_method of string * bool * bool * out_type
+- | Ocsg_value of string * bool * out_type
++ | Ocsg_value of string * bool * bool * out_type
+
+ type out_module_type =
+ | Omty_abstract
+Index: typing/printtyp.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -650,7 +650,7 @@
+ Ctype.flatten_fields (Ctype.object_fields sign.cty_self)
+ in
+ List.iter (fun met -> mark_loops (method_type met)) fields;
+- Vars.iter (fun _ (_, ty) -> mark_loops ty) sign.cty_vars
++ Vars.iter (fun _ (_, _, ty) -> mark_loops ty) sign.cty_vars
+ | Tcty_fun (_, ty, cty) ->
+ mark_loops ty;
+ prepare_class_type params cty
+@@ -682,13 +682,15 @@
+ csil (tree_of_constraints params)
+ in
+ let all_vars =
+- Vars.fold (fun l (m, t) all -> (l, m, t) :: all) sign.cty_vars [] in
++ Vars.fold (fun l (m, v, t) all -> (l, m, v, t) :: all) sign.cty_vars []
++ in
+ (* Consequence of PR#3607: order of Map.fold has changed! *)
+ let all_vars = List.rev all_vars in
+ let csil =
+ List.fold_left
+- (fun csil (l, m, t) ->
+- Ocsg_value (l, m = Mutable, tree_of_typexp sch t) :: csil)
++ (fun csil (l, m, v, t) ->
++ Ocsg_value (l, m = Mutable, v = Virtual, tree_of_typexp sch t)
++ :: csil)
+ csil all_vars
+ in
+ let csil =
+Index: typing/subst.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -178,7 +178,8 @@
+
+ let class_signature s sign =
+ { cty_self = typexp s sign.cty_self;
+- cty_vars = Vars.map (function (m, t) -> (m, typexp s t)) sign.cty_vars;
++ cty_vars =
++ Vars.map (function (m, v, t) -> (m, v, typexp s t)) sign.cty_vars;
+ cty_concr = sign.cty_concr;
+ cty_inher =
+ List.map (fun (p, tl) -> (type_path s p, List.map (typexp s) tl))
+Index: typing/typeclass.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -24,7 +24,7 @@
+
+ type error =
+ Unconsistent_constraint of (type_expr * type_expr) list
+- | Method_type_mismatch of string * (type_expr * type_expr) list
++ | Field_type_mismatch of string * string * (type_expr * type_expr) list
+ | Structure_expected of class_type
+ | Cannot_apply of class_type
+ | Apply_wrong_label of label
+@@ -36,7 +36,7 @@
+ | Unbound_class_type_2 of Longident.t
+ | Abbrev_type_clash of type_expr * type_expr * type_expr
+ | Constructor_type_mismatch of string * (type_expr * type_expr) list
+- | Virtual_class of bool * string list
++ | Virtual_class of bool * string list * string list
+ | Parameter_arity_mismatch of Longident.t * int * int
+ | Parameter_mismatch of (type_expr * type_expr) list
+ | Bad_parameters of Ident.t * type_expr * type_expr
+@@ -49,6 +49,7 @@
+ | Non_collapsable_conjunction of
+ Ident.t * Types.class_declaration * (type_expr * type_expr) list
+ | Final_self_clash of (type_expr * type_expr) list
++ | Mutability_mismatch of string * mutable_flag
+
+ exception Error of Location.t * error
+
+@@ -90,7 +91,7 @@
+ generalize_class_type cty
+ | Tcty_signature {cty_self = sty; cty_vars = vars; cty_inher = inher} ->
+ Ctype.generalize sty;
+- Vars.iter (fun _ (_, ty) -> Ctype.generalize ty) vars;
++ Vars.iter (fun _ (_, _, ty) -> Ctype.generalize ty) vars;
+ List.iter (fun (_,tl) -> List.iter Ctype.generalize tl) inher
+ | Tcty_fun (_, ty, cty) ->
+ Ctype.generalize ty;
+@@ -152,7 +153,7 @@
+ | Tcty_signature sign ->
+ Ctype.closed_schema sign.cty_self
+ &&
+- Vars.fold (fun _ (_, ty) cc -> Ctype.closed_schema ty && cc)
++ Vars.fold (fun _ (_, _, ty) cc -> Ctype.closed_schema ty && cc)
+ sign.cty_vars
+ true
+ | Tcty_fun (_, ty, cty) ->
+@@ -172,7 +173,7 @@
+ limited_generalize rv cty
+ | Tcty_signature sign ->
+ Ctype.limited_generalize rv sign.cty_self;
+- Vars.iter (fun _ (_, ty) -> Ctype.limited_generalize rv ty)
++ Vars.iter (fun _ (_, _, ty) -> Ctype.limited_generalize rv ty)
+ sign.cty_vars;
+ List.iter (fun (_, tl) -> List.iter (Ctype.limited_generalize rv) tl)
+ sign.cty_inher
+@@ -201,11 +202,25 @@
+ Env.add_value id {val_type = ty; val_kind = Val_unbound} par_env)
+
+ (* Enter an instance variable in the environment *)
+-let enter_val cl_num vars lab mut ty val_env met_env par_env =
+- let (id, val_env, met_env, par_env) as result =
+- enter_met_env lab (Val_ivar (mut, cl_num)) ty val_env met_env par_env
++let enter_val cl_num vars inh lab mut virt ty val_env met_env par_env loc =
++ let (id, virt) =
++ try
++ let (id, mut', virt', ty') = Vars.find lab !vars in
++ if mut' <> mut then raise (Error(loc, Mutability_mismatch(lab, mut)));
++ Ctype.unify val_env (Ctype.instance ty) (Ctype.instance ty');
++ (if not inh then Some id else None),
++ (if virt' = Concrete then virt' else virt)
++ with
++ Ctype.Unify tr ->
++ raise (Error(loc, Field_type_mismatch("instance variable", lab, tr)))
++ | Not_found -> None, virt
++ in
++ let (id, _, _, _) as result =
++ match id with Some id -> (id, val_env, met_env, par_env)
++ | None ->
++ enter_met_env lab (Val_ivar (mut, cl_num)) ty val_env met_env par_env
+ in
+- vars := Vars.add lab (id, mut, ty) !vars;
++ vars := Vars.add lab (id, mut, virt, ty) !vars;
+ result
+
+ let inheritance self_type env concr_meths warn_meths loc parent =
+@@ -218,7 +233,7 @@
+ with Ctype.Unify trace ->
+ match trace with
+ _::_::_::({desc = Tfield(n, _, _, _)}, _)::rem ->
+- raise(Error(loc, Method_type_mismatch (n, rem)))
++ raise(Error(loc, Field_type_mismatch ("method", n, rem)))
+ | _ ->
+ assert false
+ end;
+@@ -243,7 +258,7 @@
+ in
+ let ty = transl_simple_type val_env false sty in
+ try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
+- raise(Error(loc, Method_type_mismatch (lab, trace)))
++ raise(Error(loc, Field_type_mismatch ("method", lab, trace)))
+
+ let delayed_meth_specs = ref []
+
+@@ -253,7 +268,7 @@
+ in
+ let unif ty =
+ try Ctype.unify val_env ty ty' with Ctype.Unify trace ->
+- raise(Error(loc, Method_type_mismatch (lab, trace)))
++ raise(Error(loc, Field_type_mismatch ("method", lab, trace)))
+ in
+ match sty.ptyp_desc, priv with
+ Ptyp_poly ([],sty), Public ->
+@@ -279,6 +294,15 @@
+
+ (*******************************)
+
++let add_val env loc lab (mut, virt, ty) val_sig =
++ let virt =
++ try
++ let (mut', virt', ty') = Vars.find lab val_sig in
++ if virt' = Concrete then virt' else virt
++ with Not_found -> virt
++ in
++ Vars.add lab (mut, virt, ty) val_sig
++
+ let rec class_type_field env self_type meths (val_sig, concr_meths, inher) =
+ function
+ Pctf_inher sparent ->
+@@ -293,25 +317,12 @@
+ parent
+ in
+ let val_sig =
+- Vars.fold
+- (fun lab (mut, ty) val_sig -> Vars.add lab (mut, ty) val_sig)
+- cl_sig.cty_vars val_sig
+- in
++ Vars.fold (add_val env sparent.pcty_loc) cl_sig.cty_vars val_sig in
+ (val_sig, concr_meths, inher)
+
+- | Pctf_val (lab, mut, sty_opt, loc) ->
+- let (mut, ty) =
+- match sty_opt with
+- None ->
+- let (mut', ty) =
+- try Vars.find lab val_sig with Not_found ->
+- raise(Error(loc, Unbound_val lab))
+- in
+- (if mut = Mutable then mut' else Immutable), ty
+- | Some sty ->
+- mut, transl_simple_type env false sty
+- in
+- (Vars.add lab (mut, ty) val_sig, concr_meths, inher)
++ | Pctf_val (lab, mut, virt, sty, loc) ->
++ let ty = transl_simple_type env false sty in
++ (add_val env loc lab (mut, virt, ty) val_sig, concr_meths, inher)
+
+ | Pctf_virt (lab, priv, sty, loc) ->
+ declare_method env meths self_type lab priv sty loc;
+@@ -397,7 +408,7 @@
+
+ let rec class_field cl_num self_type meths vars
+ (val_env, met_env, par_env, fields, concr_meths, warn_meths,
+- inh_vals, inher) =
++ warn_vals, inher) =
+ function
+ Pcf_inher (sparent, super) ->
+ let parent = class_expr cl_num val_env par_env sparent in
+@@ -411,18 +422,23 @@
+ parent.cl_type
+ in
+ (* Variables *)
+- let (val_env, met_env, par_env, inh_vars, inh_vals) =
++ let (val_env, met_env, par_env, inh_vars, warn_vals) =
+ Vars.fold
+- (fun lab (mut, ty) (val_env, met_env, par_env, inh_vars, inh_vals) ->
++ (fun lab info (val_env, met_env, par_env, inh_vars, warn_vals) ->
++ let mut, vr, ty = info in
+ let (id, val_env, met_env, par_env) =
+- enter_val cl_num vars lab mut ty val_env met_env par_env
++ enter_val cl_num vars true lab mut vr ty val_env met_env par_env
++ sparent.pcl_loc
+ in
+- if StringSet.mem lab inh_vals then
+- Location.prerr_warning sparent.pcl_loc
+- (Warnings.Hide_instance_variable lab);
+- (val_env, met_env, par_env, (lab, id) :: inh_vars,
+- StringSet.add lab inh_vals))
+- cl_sig.cty_vars (val_env, met_env, par_env, [], inh_vals)
++ let warn_vals =
++ if vr = Virtual then warn_vals else
++ if StringSet.mem lab warn_vals then
++ (Location.prerr_warning sparent.pcl_loc
++ (Warnings.Instance_variable_override lab); warn_vals)
++ else StringSet.add lab warn_vals
++ in
++ (val_env, met_env, par_env, (lab, id) :: inh_vars, warn_vals))
++ cl_sig.cty_vars (val_env, met_env, par_env, [], warn_vals)
+ in
+ (* Inherited concrete methods *)
+ let inh_meths =
+@@ -443,11 +459,26 @@
+ in
+ (val_env, met_env, par_env,
+ lazy(Cf_inher (parent, inh_vars, inh_meths))::fields,
+- concr_meths, warn_meths, inh_vals, inher)
++ concr_meths, warn_meths, warn_vals, inher)
++
++ | Pcf_valvirt (lab, mut, styp, loc) ->
++ if !Clflags.principal then Ctype.begin_def ();
++ let ty = Typetexp.transl_simple_type val_env false styp in
++ if !Clflags.principal then begin
++ Ctype.end_def ();
++ Ctype.generalize_structure ty
++ end;
++ let (id, val_env, met_env', par_env) =
++ enter_val cl_num vars false lab mut Virtual ty
++ val_env met_env par_env loc
++ in
++ (val_env, met_env', par_env,
++ lazy(Cf_val (lab, id, None, met_env' == met_env)) :: fields,
++ concr_meths, warn_meths, StringSet.remove lab warn_vals, inher)
+
+ | Pcf_val (lab, mut, sexp, loc) ->
+- if StringSet.mem lab inh_vals then
+- Location.prerr_warning loc (Warnings.Hide_instance_variable lab);
++ if StringSet.mem lab warn_vals then
++ Location.prerr_warning loc (Warnings.Instance_variable_override lab);
+ if !Clflags.principal then Ctype.begin_def ();
+ let exp =
+ try type_exp val_env sexp with Ctype.Unify [(ty, _)] ->
+@@ -457,17 +488,19 @@
+ Ctype.end_def ();
+ Ctype.generalize_structure exp.exp_type
+ end;
+- let (id, val_env, met_env, par_env) =
+- enter_val cl_num vars lab mut exp.exp_type val_env met_env par_env
+- in
+- (val_env, met_env, par_env, lazy(Cf_val (lab, id, exp)) :: fields,
+- concr_meths, warn_meths, inh_vals, inher)
++ let (id, val_env, met_env', par_env) =
++ enter_val cl_num vars false lab mut Concrete exp.exp_type
++ val_env met_env par_env loc
++ in
++ (val_env, met_env', par_env,
++ lazy(Cf_val (lab, id, Some exp, met_env' == met_env)) :: fields,
++ concr_meths, warn_meths, StringSet.add lab warn_vals, inher)
+
+ | Pcf_virt (lab, priv, sty, loc) ->
+ virtual_method val_env meths self_type lab priv sty loc;
+ let warn_meths = Concr.remove lab warn_meths in
+ (val_env, met_env, par_env, fields, concr_meths, warn_meths,
+- inh_vals, inher)
++ warn_vals, inher)
+
+ | Pcf_meth (lab, priv, expr, loc) ->
+ let (_, ty) =
+@@ -493,7 +526,7 @@
+ end
+ | _ -> assert false
+ with Ctype.Unify trace ->
+- raise(Error(loc, Method_type_mismatch (lab, trace)))
++ raise(Error(loc, Field_type_mismatch ("method", lab, trace)))
+ end;
+ let meth_expr = make_method cl_num expr in
+ (* backup variables for Pexp_override *)
+@@ -510,12 +543,12 @@
+ Cf_meth (lab, texp)
+ end in
+ (val_env, met_env, par_env, field::fields,
+- Concr.add lab concr_meths, Concr.add lab warn_meths, inh_vals, inher)
++ Concr.add lab concr_meths, Concr.add lab warn_meths, warn_vals, inher)
+
+ | Pcf_cstr (sty, sty', loc) ->
+ type_constraint val_env sty sty' loc;
+ (val_env, met_env, par_env, fields, concr_meths, warn_meths,
+- inh_vals, inher)
++ warn_vals, inher)
+
+ | Pcf_let (rec_flag, sdefs, loc) ->
+ let (defs, val_env) =
+@@ -545,7 +578,7 @@
+ ([], met_env, par_env)
+ in
+ (val_env, met_env, par_env, lazy(Cf_let(rec_flag, defs, vals))::fields,
+- concr_meths, warn_meths, inh_vals, inher)
++ concr_meths, warn_meths, warn_vals, inher)
+
+ | Pcf_init expr ->
+ let expr = make_method cl_num expr in
+@@ -562,7 +595,7 @@
+ Cf_init texp
+ end in
+ (val_env, met_env, par_env, field::fields,
+- concr_meths, warn_meths, inh_vals, inher)
++ concr_meths, warn_meths, warn_vals, inher)
+
+ and class_structure cl_num final val_env met_env loc (spat, str) =
+ (* Environment for substructures *)
+@@ -616,7 +649,7 @@
+ Ctype.unify val_env self_type (Ctype.newvar ());
+ let sign =
+ {cty_self = public_self;
+- cty_vars = Vars.map (function (id, mut, ty) -> (mut, ty)) !vars;
++ cty_vars = Vars.map (fun (id, mut, vr, ty) -> (mut, vr, ty)) !vars;
+ cty_concr = concr_meths;
+ cty_inher = inher} in
+ let methods = get_methods self_type in
+@@ -628,7 +661,11 @@
+ be modified after this point *)
+ Ctype.close_object self_type;
+ let mets = virtual_methods {sign with cty_self = self_type} in
+- if mets <> [] then raise(Error(loc, Virtual_class(true, mets)));
++ let vals =
++ Vars.fold
++ (fun name (mut, vr, ty) l -> if vr = Virtual then name :: l else l)
++ sign.cty_vars [] in
++ if mets <> [] then raise(Error(loc, Virtual_class(true, mets, vals)));
+ let self_methods =
+ List.fold_right
+ (fun (lab,kind,ty) rem ->
+@@ -1135,9 +1172,14 @@
+ in
+
+ if cl.pci_virt = Concrete then begin
+- match virtual_methods (Ctype.signature_of_class_type typ) with
+- [] -> ()
+- | mets -> raise(Error(cl.pci_loc, Virtual_class(define_class, mets)))
++ let sign = Ctype.signature_of_class_type typ in
++ let mets = virtual_methods sign in
++ let vals =
++ Vars.fold
++ (fun name (mut, vr, ty) l -> if vr = Virtual then name :: l else l)
++ sign.cty_vars [] in
++ if mets <> [] || vals <> [] then
++ raise(Error(cl.pci_loc, Virtual_class(true, mets, vals)));
+ end;
+
+ (* Misc. *)
+@@ -1400,10 +1442,10 @@
+ Printtyp.report_unification_error ppf trace
+ (fun ppf -> fprintf ppf "Type")
+ (fun ppf -> fprintf ppf "is not compatible with type")
+- | Method_type_mismatch (m, trace) ->
++ | Field_type_mismatch (k, m, trace) ->
+ Printtyp.report_unification_error ppf trace
+ (function ppf ->
+- fprintf ppf "The method %s@ has type" m)
++ fprintf ppf "The %s %s@ has type" k m)
+ (function ppf ->
+ fprintf ppf "but is expected to have type")
+ | Structure_expected clty ->
+@@ -1451,15 +1493,20 @@
+ fprintf ppf "The expression \"new %s\" has type" c)
+ (function ppf ->
+ fprintf ppf "but is used with type")
+- | Virtual_class (cl, mets) ->
++ | Virtual_class (cl, mets, vals) ->
+ let print_mets ppf mets =
+ List.iter (function met -> fprintf ppf "@ %s" met) mets in
+ let cl_mark = if cl then "" else " type" in
++ let missings =
++ match mets, vals with
++ [], _ -> "variables"
++ | _, [] -> "methods"
++ | _ -> "methods and variables"
++ in
+ fprintf ppf
+- "@[This class%s should be virtual@ \
+- @[<2>The following methods are undefined :%a@]
+- @]"
+- cl_mark print_mets mets
++ "@[This class%s should be virtual.@ \
++ @[<2>The following %s are undefined :%a@]@]"
++ cl_mark missings print_mets (mets @ vals)
+ | Parameter_arity_mismatch(lid, expected, provided) ->
+ fprintf ppf
+ "@[The class constructor %a@ expects %i type argument(s),@ \
+@@ -1532,3 +1579,10 @@
+ fprintf ppf "This object is expected to have type")
+ (function ppf ->
+ fprintf ppf "but has actually type")
++ | Mutability_mismatch (lab, mut) ->
++ let mut1, mut2 =
++ if mut = Immutable then "mutable", "immutable"
++ else "immutable", "mutable" in
++ fprintf ppf
++ "@[The instance variable is %s,@ it cannot be redefined as %s@]"
++ mut1 mut2
+Index: typing/typeclass.mli
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -49,7 +49,7 @@
+
+ type error =
+ Unconsistent_constraint of (type_expr * type_expr) list
+- | Method_type_mismatch of string * (type_expr * type_expr) list
++ | Field_type_mismatch of string * string * (type_expr * type_expr) list
+ | Structure_expected of class_type
+ | Cannot_apply of class_type
+ | Apply_wrong_label of label
+@@ -61,7 +61,7 @@
+ | Unbound_class_type_2 of Longident.t
+ | Abbrev_type_clash of type_expr * type_expr * type_expr
+ | Constructor_type_mismatch of string * (type_expr * type_expr) list
+- | Virtual_class of bool * string list
++ | Virtual_class of bool * string list * string list
+ | Parameter_arity_mismatch of Longident.t * int * int
+ | Parameter_mismatch of (type_expr * type_expr) list
+ | Bad_parameters of Ident.t * type_expr * type_expr
+@@ -74,6 +74,7 @@
+ | Non_collapsable_conjunction of
+ Ident.t * Types.class_declaration * (type_expr * type_expr) list
+ | Final_self_clash of (type_expr * type_expr) list
++ | Mutability_mismatch of string * mutable_flag
+
+ exception Error of Location.t * error
+
+Index: typing/typecore.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -611,11 +611,11 @@
+ List.for_all
+ (function
+ Cf_meth _ -> true
+- | Cf_val (_,_,e) -> incr count; is_nonexpansive e
++ | Cf_val (_,_,e,_) -> incr count; is_nonexpansive_opt e
+ | Cf_init e -> is_nonexpansive e
+ | Cf_inher _ | Cf_let _ -> false)
+ fields &&
+- Vars.fold (fun _ (mut,_) b -> decr count; b && mut = Immutable)
++ Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
+ vars true &&
+ !count = 0
+ | _ -> false
+@@ -1356,7 +1356,7 @@
+ (path_self, _) ->
+ let type_override (lab, snewval) =
+ begin try
+- let (id, _, ty) = Vars.find lab !vars in
++ let (id, _, _, ty) = Vars.find lab !vars in
+ (Path.Pident id, type_expect env snewval (instance ty))
+ with
+ Not_found ->
+Index: typing/typecore.mli
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -38,7 +38,8 @@
+ string -> type_expr -> Env.t -> Env.t -> Env.t -> Parsetree.pattern ->
+ Typedtree.pattern *
+ (Ident.t * type_expr) Meths.t ref *
+- (Ident.t * Asttypes.mutable_flag * type_expr) Vars.t ref *
++ (Ident.t * Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr)
++ Vars.t ref *
+ Env.t * Env.t * Env.t
+ val type_expect:
+ ?in_function:(Location.t * type_expr) ->
+Index: typing/typedtree.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -106,7 +106,7 @@
+
+ and class_field =
+ Cf_inher of class_expr * (string * Ident.t) list * (string * Ident.t) list
+- | Cf_val of string * Ident.t * expression
++ | Cf_val of string * Ident.t * expression option * bool
+ | Cf_meth of string * expression
+ | Cf_let of rec_flag * (pattern * expression) list *
+ (Ident.t * expression) list
+Index: typing/typedtree.mli
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -107,7 +107,8 @@
+ and class_field =
+ Cf_inher of class_expr * (string * Ident.t) list * (string * Ident.t) list
+ (* Inherited instance variables and concrete methods *)
+- | Cf_val of string * Ident.t * expression
++ | Cf_val of string * Ident.t * expression option * bool
++ (* None = virtual, true = override *)
+ | Cf_meth of string * expression
+ | Cf_let of rec_flag * (pattern * expression) list *
+ (Ident.t * expression) list
+Index: typing/types.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -90,7 +90,8 @@
+ | Val_prim of Primitive.description (* Primitive *)
+ | Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *)
+ | Val_self of (Ident.t * type_expr) Meths.t ref *
+- (Ident.t * Asttypes.mutable_flag * type_expr) Vars.t ref *
++ (Ident.t * Asttypes.mutable_flag *
++ Asttypes.virtual_flag * type_expr) Vars.t ref *
+ string * type_expr
+ (* Self *)
+ | Val_anc of (string * Ident.t) list * string
+@@ -156,7 +157,8 @@
+
+ and class_signature =
+ { cty_self: type_expr;
+- cty_vars: (Asttypes.mutable_flag * type_expr) Vars.t;
++ cty_vars:
++ (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
+ cty_concr: Concr.t;
+ cty_inher: (Path.t * type_expr list) list }
+
+Index: typing/types.mli
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -91,7 +91,8 @@
+ | Val_prim of Primitive.description (* Primitive *)
+ | Val_ivar of mutable_flag * string (* Instance variable (mutable ?) *)
+ | Val_self of (Ident.t * type_expr) Meths.t ref *
+- (Ident.t * Asttypes.mutable_flag * type_expr) Vars.t ref *
++ (Ident.t * Asttypes.mutable_flag *
++ Asttypes.virtual_flag * type_expr) Vars.t ref *
+ string * type_expr
+ (* Self *)
+ | Val_anc of (string * Ident.t) list * string
+@@ -158,7 +159,8 @@
+
+ and class_signature =
+ { cty_self: type_expr;
+- cty_vars: (Asttypes.mutable_flag * type_expr) Vars.t;
++ cty_vars:
++ (Asttypes.mutable_flag * Asttypes.virtual_flag * type_expr) Vars.t;
+ cty_concr: Concr.t;
+ cty_inher: (Path.t * type_expr list) list }
+
+Index: typing/unused_var.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -245,7 +245,7 @@
+ match cf with
+ | Pcf_inher (ce, _) -> class_expr ppf tbl ce;
+ | Pcf_val (_, _, e, _) -> expression ppf tbl e;
+- | Pcf_virt _ -> ()
++ | Pcf_virt _ | Pcf_valvirt _ -> ()
+ | Pcf_meth (_, _, e, _) -> expression ppf tbl e;
+ | Pcf_cstr _ -> ()
+ | Pcf_let (recflag, pel, _) -> let_pel ppf tbl recflag pel None;
+Index: bytecomp/translclass.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -133,10 +133,10 @@
+ (fun _ -> lambda_unit) cl
+ in
+ (inh_init, lsequence obj_init' obj_init, true)
+- | Cf_val (_, id, exp) ->
++ | Cf_val (_, id, Some exp, _) ->
+ (inh_init, lsequence (set_inst_var obj id exp) obj_init,
+ has_init)
+- | Cf_meth _ ->
++ | Cf_meth _ | Cf_val _ ->
+ (inh_init, obj_init, has_init)
+ | Cf_init _ ->
+ (inh_init, obj_init, true)
+@@ -213,27 +213,17 @@
+ if len < 2 && nvals = 0 then Meths.fold (bind_method tbl) meths cl_init else
+ if len = 0 && nvals < 2 then transl_vals tbl true vals cl_init else
+ let ids = Ident.create "ids" in
+- let i = ref len in
+- let getter, names, cl_init =
+- match vals with [] -> "get_method_labels", [], cl_init
+- | (_,id0)::vals' ->
+- incr i;
+- let i = ref (List.length vals) in
+- "new_methods_variables",
+- [transl_meth_list (List.map fst vals)],
+- Llet(Strict, id0, lfield ids 0,
+- List.fold_right
+- (fun (name,id) rem ->
+- decr i;
+- Llet(Alias, id, Lprim(Poffsetint !i, [Lvar id0]), rem))
+- vals' cl_init)
++ let i = ref (len + nvals) in
++ let getter, names =
++ if nvals = 0 then "get_method_labels", [] else
++ "new_methods_variables", [transl_meth_list (List.map fst vals)]
+ in
+ Llet(StrictOpt, ids,
+ Lapply (oo_prim getter,
+ [Lvar tbl; transl_meth_list (List.map fst methl)] @ names),
+ List.fold_right
+ (fun (lab,id) lam -> decr i; Llet(StrictOpt, id, lfield ids !i, lam))
+- methl cl_init)
++ (methl @ vals) cl_init)
+
+ let output_methods tbl methods lam =
+ match methods with
+@@ -283,8 +273,9 @@
+ (vals, meths_super cla str.cl_meths meths)
+ inh_init cl_init msubst top cl in
+ (inh_init, cl_init, [], values)
+- | Cf_val (name, id, exp) ->
+- (inh_init, cl_init, methods, (name, id)::values)
++ | Cf_val (name, id, exp, over) ->
++ let values = if over then values else (name, id) :: values in
++ (inh_init, cl_init, methods, values)
+ | Cf_meth (name, exp) ->
+ let met_code = msubst true (transl_exp exp) in
+ let met_code =
+@@ -342,27 +333,24 @@
+ assert (Path.same path path');
+ let lpath = transl_path path in
+ let inh = Ident.create "inh"
+- and inh_vals = Ident.create "vals"
+- and inh_meths = Ident.create "meths"
++ and ofs = List.length vals + 1
+ and valids, methids = super in
+ let cl_init =
+ List.fold_left
+ (fun init (nm, id, _) ->
+- Llet(StrictOpt, id, lfield inh_meths (index nm concr_meths),
++ Llet(StrictOpt, id, lfield inh (index nm concr_meths + ofs),
+ init))
+ cl_init methids in
+ let cl_init =
+ List.fold_left
+ (fun init (nm, id) ->
+- Llet(StrictOpt, id, lfield inh_vals (index nm vals), init))
++ Llet(StrictOpt, id, lfield inh (index nm vals + 1), init))
+ cl_init valids in
+ (inh_init,
+ Llet (Strict, inh,
+ Lapply(oo_prim "inherits", narrow_args @
+ [lpath; Lconst(Const_pointer(if top then 1 else 0))]),
+- Llet(StrictOpt, obj_init, lfield inh 0,
+- Llet(Alias, inh_vals, lfield inh 1,
+- Llet(Alias, inh_meths, lfield inh 2, cl_init)))))
++ Llet(StrictOpt, obj_init, lfield inh 0, cl_init)))
+ | _ ->
+ let core cl_init =
+ build_class_init cla true super inh_init cl_init msubst top cl
+Index: driver/main_args.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -136,11 +136,11 @@
+ \032 E/e enable/disable fragile match\n\
+ \032 F/f enable/disable partially applied function\n\
+ \032 L/l enable/disable labels omitted in application\n\
+- \032 M/m enable/disable overriden method\n\
++ \032 M/m enable/disable overriden methods\n\
+ \032 P/p enable/disable partial match\n\
+ \032 S/s enable/disable non-unit statement\n\
+ \032 U/u enable/disable unused match case\n\
+- \032 V/v enable/disable hidden instance variable\n\
++ \032 V/v enable/disable overriden instance variables\n\
+ \032 Y/y enable/disable suspicious unused variables\n\
+ \032 Z/z enable/disable all other unused variables\n\
+ \032 X/x enable/disable all other warnings\n\
+Index: driver/optmain.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -173,7 +173,7 @@
+ \032 P/p enable/disable partial match\n\
+ \032 S/s enable/disable non-unit statement\n\
+ \032 U/u enable/disable unused match case\n\
+- \032 V/v enable/disable hidden instance variables\n\
++ \032 V/v enable/disable overriden instance variables\n\
+ \032 Y/y enable/disable suspicious unused variables\n\
+ \032 Z/z enable/disable all other unused variables\n\
+ \032 X/x enable/disable all other warnings\n\
+Index: stdlib/camlinternalOO.ml
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -206,7 +206,11 @@
+ (table.methods_by_name, table.methods_by_label, table.hidden_meths,
+ table.vars, virt_meth_labs, vars)
+ :: table.previous_states;
+- table.vars <- Vars.empty;
++ table.vars <-
++ Vars.fold
++ (fun lab info tvars ->
++ if List.mem lab vars then Vars.add lab info tvars else tvars)
++ table.vars Vars.empty;
+ let by_name = ref Meths.empty in
+ let by_label = ref Labs.empty in
+ List.iter2
+@@ -255,9 +259,11 @@
+ index
+
+ let new_variable table name =
+- let index = new_slot table in
+- table.vars <- Vars.add name index table.vars;
+- index
++ try Vars.find name table.vars
++ with Not_found ->
++ let index = new_slot table in
++ table.vars <- Vars.add name index table.vars;
++ index
+
+ let to_array arr =
+ if arr = Obj.magic 0 then [||] else arr
+@@ -265,16 +271,17 @@
+ let new_methods_variables table meths vals =
+ let meths = to_array meths in
+ let nmeths = Array.length meths and nvals = Array.length vals in
+- let index = new_variable table vals.(0) in
+- let res = Array.create (nmeths + 1) index in
+- for i = 1 to nvals - 1 do ignore (new_variable table vals.(i)) done;
++ let res = Array.create (nmeths + nvals) 0 in
+ for i = 0 to nmeths - 1 do
+- res.(i+1) <- get_method_label table meths.(i)
++ res.(i) <- get_method_label table meths.(i)
++ done;
++ for i = 0 to nvals - 1 do
++ res.(i+nmeths) <- new_variable table vals.(i)
+ done;
+ res
+
+ let get_variable table name =
+- Vars.find name table.vars
++ try Vars.find name table.vars with Not_found -> assert false
+
+ let get_variables table names =
+ Array.map (get_variable table) names
+@@ -315,9 +322,12 @@
+ let init =
+ if top then super cla env else Obj.repr (super cla) in
+ widen cla;
+- (init, Array.map (get_variable cla) (to_array vals),
+- Array.map (fun nm -> get_method cla (get_method_label cla nm))
+- (to_array concr_meths))
++ Array.concat
++ [[| repr init |];
++ magic (Array.map (get_variable cla) (to_array vals) : int array);
++ Array.map
++ (fun nm -> repr (get_method cla (get_method_label cla nm) : closure))
++ (to_array concr_meths) ]
+
+ let make_class pub_meths class_init =
+ let table = create_table pub_meths in
+Index: stdlib/camlinternalOO.mli
+===================================================================
+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 9 Mar 2006 07:19:38 -0000
+@@ -46,8 +46,7 @@
+ val init_class : table -> unit
+ val inherits :
+ table -> string array -> string array -> string array ->
+- (t * (table -> obj -> Obj.t) * t * obj) -> bool ->
+- (Obj.t * int array * closure array)
++ (t * (table -> obj -> Obj.t) * t * obj) -> bool -> Obj.t array
+ val make_class :
+ string array -> (table -> Obj.t -> t) ->
+ (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t)
+@@ -79,6 +78,7 @@
+
+ (** {6 Builtins to reduce code size} *)
+
++(*
+ val get_const : t -> closure
+ val get_var : int -> closure
+ val get_env : int -> int -> closure
+@@ -103,6 +103,7 @@
+ val send_var : tag -> int -> int -> closure
+ val send_env : tag -> int -> int -> int -> closure
+ val send_meth : tag -> label -> int -> closure
++*)
+
+ type impl =
+ GetConst
+Index: stdlib/sys.ml
+===================================================================
+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 9 Mar 2006 07:19:39 -0000
+@@ -78,4 +78,4 @@
+
+ (* OCaml version string, must be in the format described in sys.mli. *)
+
+-let ocaml_version = "3.10+dev3 (2006-01-24)";;
++let ocaml_version = "3.10+dev4 (2006-03-09)";;
+Index: tools/depend.ml
+===================================================================
+RCS file: /net/yquem/devel/caml/repository/csl/tools/depend.ml,v
+retrieving revision 1.9
+diff -u -r1.9 depend.ml
+--- tools/depend.ml 23 Mar 2005 03:08:37 -0000 1.9
++++ tools/depend.ml 9 Mar 2006 07:19:39 -0000
+@@ -87,7 +87,7 @@
+
+ and add_class_type_field bv = function
+ Pctf_inher cty -> add_class_type bv cty
+- | Pctf_val(_, _, oty, _) -> add_opt add_type bv oty
++ | Pctf_val(_, _, _, ty, _) -> add_type bv ty
+ | Pctf_virt(_, _, ty, _) -> add_type bv ty
+ | Pctf_meth(_, _, ty, _) -> add_type bv ty
+ | Pctf_cstr(ty1, ty2, _) -> add_type bv ty1; add_type bv ty2
+@@ -280,6 +280,7 @@
+ and add_class_field bv = function
+ Pcf_inher(ce, _) -> add_class_expr bv ce
+ | Pcf_val(_, _, e, _) -> add_expr bv e
++ | Pcf_valvirt(_, _, ty, _)
+ | Pcf_virt(_, _, ty, _) -> add_type bv ty
+ | Pcf_meth(_, _, e, _) -> add_expr bv e
+ | Pcf_cstr(ty1, ty2, _) -> add_type bv ty1; add_type bv ty2
+Index: tools/ocamlprof.ml
+===================================================================
+RCS file: /net/yquem/devel/caml/repository/csl/tools/ocamlprof.ml,v
+retrieving revision 1.38
+diff -u -r1.38 ocamlprof.ml
+--- tools/ocamlprof.ml 24 Mar 2005 17:20:54 -0000 1.38
++++ tools/ocamlprof.ml 9 Mar 2006 07:19:39 -0000
+@@ -328,7 +328,7 @@
+ rewrite_patexp_list iflag spat_sexp_list
+ | Pcf_init sexp ->
+ rewrite_exp iflag sexp
+- | Pcf_virt _ | Pcf_cstr _ -> ()
++ | Pcf_valvirt _ | Pcf_virt _ | Pcf_cstr _ -> ()
+
+ and rewrite_class_expr iflag cexpr =
+ match cexpr.pcl_desc with
+Index: otherlibs/labltk/browser/searchpos.ml
+===================================================================
+RCS file: /net/yquem/devel/caml/repository/csl/otherlibs/labltk/browser/searchpos.ml,v
+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 9 Mar 2006 07:19:39 -0000
+@@ -141,9 +141,8 @@
+ List.iter cfl ~f:
+ begin function
+ Pctf_inher cty -> search_pos_class_type cty ~pos ~env
+- | Pctf_val (_, _, Some ty, loc) ->
++ | Pctf_val (_, _, _, ty, loc) ->
+ if in_loc loc ~pos then search_pos_type ty ~pos ~env
+- | Pctf_val _ -> ()
+ | Pctf_virt (_, _, ty, loc) ->
+ if in_loc loc ~pos then search_pos_type ty ~pos ~env
+ | Pctf_meth (_, _, ty, loc) ->
+@@ -685,7 +684,8 @@
+ begin function
+ Cf_inher (cl, _, _) ->
+ search_pos_class_expr cl ~pos
+- | Cf_val (_, _, exp) -> search_pos_expr exp ~pos
++ | Cf_val (_, _, Some exp, _) -> search_pos_expr exp ~pos
++ | Cf_val _ -> ()
+ | Cf_meth (_, exp) -> search_pos_expr exp ~pos
+ | Cf_let (_, pel, iel) ->
+ List.iter pel ~f:
+Index: camlp4/camlp4/ast2pt.ml
+===================================================================
+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 9 Mar 2006 07:19:39 -0000
+@@ -244,6 +244,7 @@
+ ;
+ value mkmutable m = if m then Mutable else Immutable;
+ value mkprivate m = if m then Private else Public;
++value mkvirtual m = if m then Virtual else Concrete;
+ value mktrecord (loc, n, m, t) =
+ (n, mkmutable m, ctyp (mkpolytype t), mkloc loc);
+ value mkvariant (loc, c, tl) = (c, List.map ctyp tl, mkloc loc);
+@@ -862,8 +863,8 @@
+ | CgInh loc ct -> [Pctf_inher (class_type ct) :: l]
+ | CgMth loc s pf t ->
+ [Pctf_meth (s, mkprivate pf, ctyp (mkpolytype t), mkloc loc) :: l]
+- | CgVal loc s b t ->
+- [Pctf_val (s, mkmutable b, Some (ctyp t), mkloc loc) :: l]
++ | CgVal loc s b v t ->
++ [Pctf_val (s, mkmutable b, mkvirtual v, ctyp t, mkloc loc) :: l]
+ | CgVir loc s b t ->
+ [Pctf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l] ]
+ and class_expr =
+@@ -907,7 +908,9 @@
+ [Pcf_meth (s, mkprivate b, e, mkloc loc) :: l]
+ | CrVal loc s b e -> [Pcf_val (s, mkmutable b, expr e, mkloc loc) :: l]
+ | CrVir loc s b t ->
+- [Pcf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l] ]
++ [Pcf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l]
++ | CrVvr loc s b t ->
++ [Pcf_valvirt (s, mkmutable b, ctyp t, mkloc loc) :: l] ]
+ ;
+
+ value interf ast = List.fold_right sig_item ast [];
+Index: camlp4/camlp4/mLast.mli
+===================================================================
+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 9 Mar 2006 07:19:39 -0000
+@@ -180,7 +180,7 @@
+ | CgDcl of loc and list class_sig_item
+ | CgInh of loc and class_type
+ | CgMth of loc and string and bool and ctyp
+- | CgVal of loc and string and bool and ctyp
++ | CgVal of loc and string and bool and bool and ctyp
+ | CgVir of loc and string and bool and ctyp ]
+ and class_expr =
+ [ CeApp of loc and class_expr and expr
+@@ -196,7 +196,8 @@
+ | CrIni of loc and expr
+ | CrMth of loc and string and bool and expr and option ctyp
+ | CrVal of loc and string and bool and expr
+- | CrVir of loc and string and bool and ctyp ]
++ | CrVir of loc and string and bool and ctyp
++ | CrVvr of loc and string and bool and ctyp ]
+ ;
+
+ external loc_of_ctyp : ctyp -> loc = "%field0";
+Index: camlp4/camlp4/reloc.ml
+===================================================================
+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 9 Mar 2006 07:19:39 -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)
+ | CgMth loc x1 x2 x3 -> let nloc = floc loc in CgMth nloc x1 x2 (ctyp floc sh x3)
+- | CgVal loc x1 x2 x3 -> let nloc = floc loc in CgVal nloc x1 x2 (ctyp floc sh x3)
++ | CgVal loc x1 x2 x3 x4 -> let nloc = floc loc in CgVal nloc x1 x2 x3 (ctyp floc sh x4)
+ | CgVir loc x1 x2 x3 -> let nloc = floc loc in CgVir nloc x1 x2 (ctyp floc sh x3) ]
+ and class_expr floc sh =
+ self where rec self =
+@@ -377,5 +377,6 @@
+ | CrMth loc x1 x2 x3 x4 ->
+ let nloc = floc loc in CrMth nloc x1 x2 (expr floc sh x3) (option_map (ctyp floc sh) x4)
+ | CrVal loc x1 x2 x3 -> let nloc = floc loc in CrVal nloc x1 x2 (expr floc sh x3)
+- | CrVir loc x1 x2 x3 -> let nloc = floc loc in CrVir nloc x1 x2 (ctyp floc sh x3) ]
++ | CrVir loc x1 x2 x3 -> let nloc = floc loc in CrVir nloc x1 x2 (ctyp floc sh x3)
++ | CrVvr loc x1 x2 x3 -> let nloc = floc loc in CrVvr nloc x1 x2 (ctyp floc sh x3) ]
+ ;
+Index: camlp4/etc/pa_o.ml
+===================================================================
+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 9 Mar 2006 07:19:39 -0000
+@@ -1037,8 +1037,14 @@
+ class_str_item:
+ [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] ->
+ <:class_str_item< inherit $ce$ $opt:pb$ >>
+- | "val"; mf = OPT "mutable"; lab = label; e = cvalue_binding ->
+- <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >>
++ | "val"; "mutable"; lab = label; e = cvalue_binding ->
++ <:class_str_item< value mutable $lab$ = $e$ >>
++ | "val"; lab = label; e = cvalue_binding ->
++ <:class_str_item< value $lab$ = $e$ >>
++ | "val"; "mutable"; "virtual"; lab = label; ":"; t = ctyp ->
++ <:class_str_item< value virtual mutable $lab$ : $t$ >>
++ | "val"; "virtual"; mf = OPT "mutable"; lab = label; ":"; t = ctyp ->
++ <:class_str_item< value virtual $opt:o2b mf$ $lab$ : $t$ >>
+ | "method"; "private"; "virtual"; l = label; ":"; t = poly_type ->
+ <:class_str_item< method virtual private $l$ : $t$ >>
+ | "method"; "virtual"; "private"; l = label; ":"; t = poly_type ->
+@@ -1087,8 +1093,9 @@
+ ;
+ class_sig_item:
+ [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >>
+- | "val"; mf = OPT "mutable"; l = label; ":"; t = ctyp ->
+- <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >>
++ | "val"; mf = OPT "mutable"; vf = OPT "virtual";
++ l = label; ":"; t = ctyp ->
++ <:class_sig_item< value $opt:o2b mf$ $opt:o2b vf$ $l$ : $t$ >>
+ | "method"; "private"; "virtual"; l = label; ":"; t = poly_type ->
+ <:class_sig_item< method virtual private $l$ : $t$ >>
+ | "method"; "virtual"; "private"; l = label; ":"; t = poly_type ->
+Index: camlp4/etc/pr_o.ml
+===================================================================
+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 9 Mar 2006 07:19:39 -0000
+@@ -1768,10 +1768,11 @@
+ [: `S LR "method"; private_flag pf; `label lab;
+ `S LR ":" :];
+ `ctyp t "" k :]
+- | MLast.CgVal _ lab mf t ->
++ | MLast.CgVal _ lab mf vf t ->
+ fun curr next dg k ->
+ [: `HVbox
+- [: `S LR "val"; mutable_flag mf; `label lab; `S LR ":" :];
++ [: `S LR "val"; mutable_flag mf; virtual_flag vf;
++ `label lab; `S LR ":" :];
+ `ctyp t "" k :]
+ | MLast.CgVir _ lab pf t ->
+ fun curr next dg k ->
+Index: camlp4/meta/pa_r.ml
+===================================================================
+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 9 Mar 2006 07:19:39 -0000
+@@ -658,7 +658,9 @@
+ | "inherit"; ce = class_expr; pb = OPT as_lident ->
+ <:class_str_item< inherit $ce$ $opt:pb$ >>
+ | "value"; mf = OPT "mutable"; lab = label; e = cvalue_binding ->
+- <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >>
++ <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >>
++ | "value"; "virtual"; mf = OPT "mutable"; l = label; ":"; t = ctyp ->
++ <:class_str_item< value virtual $opt:o2b mf$ $l$ : $t$ >>
+ | "method"; "virtual"; pf = OPT "private"; l = label; ":"; t = ctyp ->
+ <:class_str_item< method virtual $opt:o2b pf$ $l$ : $t$ >>
+ | "method"; pf = OPT "private"; l = label; topt = OPT polyt;
+@@ -701,8 +703,9 @@
+ [ [ "declare"; st = LIST0 [ s = class_sig_item; ";" -> s ]; "end" ->
+ <:class_sig_item< declare $list:st$ end >>
+ | "inherit"; cs = class_type -> <:class_sig_item< inherit $cs$ >>
+- | "value"; mf = OPT "mutable"; l = label; ":"; t = ctyp ->
+- <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >>
++ | "value"; mf = OPT "mutable"; vf = OPT "virtual";
++ l = label; ":"; t = ctyp ->
++ <:class_sig_item< value $opt:o2b mf$ $opt:o2b vf$ $l$ : $t$ >>
+ | "method"; "virtual"; pf = OPT "private"; l = label; ":"; t = ctyp ->
+ <:class_sig_item< method virtual $opt:o2b pf$ $l$ : $t$ >>
+ | "method"; pf = OPT "private"; l = label; ":"; t = ctyp ->
+Index: camlp4/meta/q_MLast.ml
+===================================================================
+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 9 Mar 2006 07:19:39 -0000
+@@ -947,6 +947,8 @@
+ Qast.Node "CrDcl" [Qast.Loc; st]
+ | "inherit"; ce = class_expr; pb = SOPT as_lident ->
+ Qast.Node "CrInh" [Qast.Loc; ce; pb]
++ | "value"; "virtual"; mf = SOPT "mutable"; l = label; ":"; t = ctyp ->
++ Qast.Node "CrVvr" [Qast.Loc; l; o2b mf; t]
+ | "value"; mf = SOPT "mutable"; lab = label; e = cvalue_binding ->
+ Qast.Node "CrVal" [Qast.Loc; lab; o2b mf; e]
+ | "method"; "virtual"; pf = SOPT "private"; l = label; ":"; t = ctyp ->
+@@ -992,8 +994,9 @@
+ [ [ "declare"; st = SLIST0 [ s = class_sig_item; ";" -> s ]; "end" ->
+ Qast.Node "CgDcl" [Qast.Loc; st]
+ | "inherit"; cs = class_type -> Qast.Node "CgInh" [Qast.Loc; cs]
+- | "value"; mf = SOPT "mutable"; l = label; ":"; t = ctyp ->
+- Qast.Node "CgVal" [Qast.Loc; l; o2b mf; t]
++ | "value"; mf = SOPT "mutable"; vf = SOPT "virtual";
++ l = label; ":"; t = ctyp ->
++ Qast.Node "CgVal" [Qast.Loc; l; o2b mf; o2b vf; t]
+ | "method"; "virtual"; pf = SOPT "private"; l = label; ":"; t = ctyp ->
+ Qast.Node "CgVir" [Qast.Loc; l; o2b pf; t]
+ | "method"; pf = SOPT "private"; l = label; ":"; t = ctyp ->
+Index: camlp4/ocaml_src/camlp4/ast2pt.ml
+===================================================================
+RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/ast2pt.ml,v
+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 9 Mar 2006 07:19:39 -0000
+@@ -227,6 +227,7 @@
+ ;;
+ let mkmutable m = if m then Mutable else Immutable;;
+ let mkprivate m = if m then Private else Public;;
++let mkvirtual m = if m then Virtual else Concrete;;
+ let mktrecord (loc, n, m, t) =
+ n, mkmutable m, ctyp (mkpolytype t), mkloc loc
+ ;;
+@@ -878,8 +879,8 @@
+ | CgInh (loc, ct) -> Pctf_inher (class_type ct) :: l
+ | CgMth (loc, s, pf, t) ->
+ Pctf_meth (s, mkprivate pf, ctyp (mkpolytype t), mkloc loc) :: l
+- | CgVal (loc, s, b, t) ->
+- Pctf_val (s, mkmutable b, Some (ctyp t), mkloc loc) :: l
++ | CgVal (loc, s, b, v, t) ->
++ Pctf_val (s, mkmutable b, mkvirtual v, ctyp t, mkloc loc) :: l
+ | CgVir (loc, s, b, t) ->
+ Pctf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l
+ and class_expr =
+@@ -923,6 +924,8 @@
+ | CrVal (loc, s, b, e) -> Pcf_val (s, mkmutable b, expr e, mkloc loc) :: l
+ | CrVir (loc, s, b, t) ->
+ Pcf_virt (s, mkprivate b, ctyp (mkpolytype t), mkloc loc) :: l
++ | CrVvr (loc, s, b, t) ->
++ Pcf_valvirt (s, mkmutable b, ctyp t, mkloc loc) :: l
+ ;;
+
+ let interf ast = List.fold_right sig_item ast [];;
+Index: camlp4/ocaml_src/camlp4/mLast.mli
+===================================================================
+RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/mLast.mli,v
+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 9 Mar 2006 07:19:39 -0000
+@@ -180,7 +180,7 @@
+ | CgDcl of loc * class_sig_item list
+ | CgInh of loc * class_type
+ | CgMth of loc * string * bool * ctyp
+- | CgVal of loc * string * bool * ctyp
++ | CgVal of loc * string * bool * bool * ctyp
+ | CgVir of loc * string * bool * ctyp
+ and class_expr =
+ CeApp of loc * class_expr * expr
+@@ -197,6 +197,7 @@
+ | CrMth of loc * string * bool * expr * ctyp option
+ | CrVal of loc * string * bool * expr
+ | CrVir of loc * string * bool * ctyp
++ | CrVvr of loc * string * bool * ctyp
+ ;;
+
+ external loc_of_ctyp : ctyp -> loc = "%field0";;
+Index: camlp4/ocaml_src/camlp4/reloc.ml
+===================================================================
+RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/camlp4/reloc.ml,v
+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 9 Mar 2006 07:19:39 -0000
+@@ -430,8 +430,8 @@
+ let nloc = floc loc in CgInh (nloc, class_type floc sh x1)
+ | CgMth (loc, x1, x2, x3) ->
+ let nloc = floc loc in CgMth (nloc, x1, x2, ctyp floc sh x3)
+- | CgVal (loc, x1, x2, x3) ->
+- let nloc = floc loc in CgVal (nloc, x1, x2, ctyp floc sh x3)
++ | CgVal (loc, x1, x2, x3, x4) ->
++ let nloc = floc loc in CgVal (nloc, x1, x2, x3, ctyp floc sh x4)
+ | CgVir (loc, x1, x2, x3) ->
+ let nloc = floc loc in CgVir (nloc, x1, x2, ctyp floc sh x3)
+ in
+@@ -478,6 +478,8 @@
+ let nloc = floc loc in CrVal (nloc, x1, x2, expr floc sh x3)
+ | CrVir (loc, x1, x2, x3) ->
+ let nloc = floc loc in CrVir (nloc, x1, x2, ctyp floc sh x3)
++ | CrVvr (loc, x1, x2, x3) ->
++ let nloc = floc loc in CrVvr (nloc, x1, x2, ctyp floc sh x3)
+ in
+ self
+ ;;
+Index: camlp4/ocaml_src/meta/pa_r.ml
+===================================================================
+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 9 Mar 2006 07:19:39 -0000
+@@ -2161,6 +2161,15 @@
+ (fun (t : 'ctyp) _ (l : 'label) (pf : string option) _ _
+ (_loc : Lexing.position * Lexing.position) ->
+ (MLast.CrVir (_loc, l, o2b pf, t) : 'class_str_item));
++ [Gramext.Stoken ("", "value"); Gramext.Stoken ("", "virtual");
++ Gramext.Sopt (Gramext.Stoken ("", "mutable"));
++ Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
++ Gramext.Stoken ("", ":");
++ Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
++ Gramext.action
++ (fun (t : 'ctyp) _ (l : 'label) (mf : string option) _ _
++ (_loc : Lexing.position * Lexing.position) ->
++ (MLast.CrVvr (_loc, l, o2b mf, t) : 'class_str_item));
+ [Gramext.Stoken ("", "value");
+ Gramext.Sopt (Gramext.Stoken ("", "mutable"));
+ Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
+@@ -2338,13 +2347,15 @@
+ (MLast.CgVir (_loc, l, o2b pf, t) : 'class_sig_item));
+ [Gramext.Stoken ("", "value");
+ Gramext.Sopt (Gramext.Stoken ("", "mutable"));
++ Gramext.Sopt (Gramext.Stoken ("", "virtual"));
+ Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
+ Gramext.Stoken ("", ":");
+ Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
+ Gramext.action
+- (fun (t : 'ctyp) _ (l : 'label) (mf : string option) _
++ (fun (t : 'ctyp) _ (l : 'label) (vf : string option)
++ (mf : string option) _
+ (_loc : Lexing.position * Lexing.position) ->
+- (MLast.CgVal (_loc, l, o2b mf, t) : 'class_sig_item));
++ (MLast.CgVal (_loc, l, o2b mf, o2b vf, t) : 'class_sig_item));
+ [Gramext.Stoken ("", "inherit");
+ Gramext.Snterm
+ (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))],
+Index: camlp4/ocaml_src/meta/q_MLast.ml
+===================================================================
+RCS file: /net/yquem/devel/caml/repository/csl/camlp4/ocaml_src/meta/q_MLast.ml,v
+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 9 Mar 2006 07:19:39 -0000
+@@ -3152,9 +3152,9 @@
+ Gramext.action
+ (fun (x : string)
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Str x : 'e__17))])],
++ (Qast.Str x : 'e__18))])],
+ Gramext.action
+- (fun (a : 'e__17 option)
++ (fun (a : 'e__18 option)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Option a : 'a_opt));
+ [Gramext.Snterm
+@@ -3191,9 +3191,9 @@
+ Gramext.action
+ (fun (x : string)
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Str x : 'e__16))])],
++ (Qast.Str x : 'e__17))])],
+ Gramext.action
+- (fun (a : 'e__16 option)
++ (fun (a : 'e__17 option)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Option a : 'a_opt));
+ [Gramext.Snterm
+@@ -3216,9 +3216,9 @@
+ Gramext.action
+ (fun (x : string)
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Str x : 'e__15))])],
++ (Qast.Str x : 'e__16))])],
+ Gramext.action
+- (fun (a : 'e__15 option)
++ (fun (a : 'e__16 option)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Option a : 'a_opt));
+ [Gramext.Snterm
+@@ -3235,6 +3235,31 @@
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Node ("CrVal", [Qast.Loc; lab; o2b mf; e]) :
+ 'class_str_item));
++ [Gramext.Stoken ("", "value"); Gramext.Stoken ("", "virtual");
++ Gramext.srules
++ [[Gramext.Sopt
++ (Gramext.srules
++ [[Gramext.Stoken ("", "mutable")],
++ Gramext.action
++ (fun (x : string)
++ (_loc : Lexing.position * Lexing.position) ->
++ (Qast.Str x : 'e__15))])],
++ Gramext.action
++ (fun (a : 'e__15 option)
++ (_loc : Lexing.position * Lexing.position) ->
++ (Qast.Option a : 'a_opt));
++ [Gramext.Snterm
++ (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
++ Gramext.action
++ (fun (a : 'a_opt) (_loc : Lexing.position * Lexing.position) ->
++ (a : 'a_opt))];
++ Gramext.Snterm (Grammar.Entry.obj (label : 'label Grammar.Entry.e));
++ Gramext.Stoken ("", ":");
++ Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
++ Gramext.action
++ (fun (t : 'ctyp) _ (l : 'label) (mf : 'a_opt) _ _
++ (_loc : Lexing.position * Lexing.position) ->
++ (Qast.Node ("CrVvr", [Qast.Loc; l; o2b mf; t]) : 'class_str_item));
+ [Gramext.Stoken ("", "inherit");
+ Gramext.Snterm
+ (Grammar.Entry.obj (class_expr : 'class_expr Grammar.Entry.e));
+@@ -3366,9 +3391,9 @@
+ Gramext.action
+ (fun _ (csf : 'class_sig_item)
+ (_loc : Lexing.position * Lexing.position) ->
+- (csf : 'e__18))])],
++ (csf : 'e__19))])],
+ Gramext.action
+- (fun (a : 'e__18 list)
++ (fun (a : 'e__19 list)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.List a : 'a_list));
+ [Gramext.Snterm
+@@ -3446,9 +3471,9 @@
+ Gramext.action
+ (fun (x : string)
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Str x : 'e__22))])],
++ (Qast.Str x : 'e__24))])],
+ Gramext.action
+- (fun (a : 'e__22 option)
++ (fun (a : 'e__24 option)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Option a : 'a_opt));
+ [Gramext.Snterm
+@@ -3471,9 +3496,9 @@
+ Gramext.action
+ (fun (x : string)
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Str x : 'e__21))])],
++ (Qast.Str x : 'e__23))])],
+ Gramext.action
+- (fun (a : 'e__21 option)
++ (fun (a : 'e__23 option)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Option a : 'a_opt));
+ [Gramext.Snterm
+@@ -3496,9 +3521,26 @@
+ Gramext.action
+ (fun (x : string)
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Str x : 'e__20))])],
++ (Qast.Str x : 'e__21))])],
+ Gramext.action
+- (fun (a : 'e__20 option)
++ (fun (a : 'e__21 option)
++ (_loc : Lexing.position * Lexing.position) ->
++ (Qast.Option a : 'a_opt));
++ [Gramext.Snterm
++ (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
++ Gramext.action
++ (fun (a : 'a_opt) (_loc : Lexing.position * Lexing.position) ->
++ (a : 'a_opt))];
++ Gramext.srules
++ [[Gramext.Sopt
++ (Gramext.srules
++ [[Gramext.Stoken ("", "virtual")],
++ Gramext.action
++ (fun (x : string)
++ (_loc : Lexing.position * Lexing.position) ->
++ (Qast.Str x : 'e__22))])],
++ Gramext.action
++ (fun (a : 'e__22 option)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Option a : 'a_opt));
+ [Gramext.Snterm
+@@ -3510,9 +3552,10 @@
+ Gramext.Stoken ("", ":");
+ Gramext.Snterm (Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e))],
+ Gramext.action
+- (fun (t : 'ctyp) _ (l : 'label) (mf : 'a_opt) _
++ (fun (t : 'ctyp) _ (l : 'label) (vf : 'a_opt) (mf : 'a_opt) _
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Node ("CgVal", [Qast.Loc; l; o2b mf; t]) : 'class_sig_item));
++ (Qast.Node ("CgVal", [Qast.Loc; l; o2b mf; o2b vf; t]) :
++ 'class_sig_item));
+ [Gramext.Stoken ("", "inherit");
+ Gramext.Snterm
+ (Grammar.Entry.obj (class_type : 'class_type Grammar.Entry.e))],
+@@ -3531,9 +3574,9 @@
+ Gramext.action
+ (fun _ (s : 'class_sig_item)
+ (_loc : Lexing.position * Lexing.position) ->
+- (s : 'e__19))])],
++ (s : 'e__20))])],
+ Gramext.action
+- (fun (a : 'e__19 list)
++ (fun (a : 'e__20 list)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.List a : 'a_list));
+ [Gramext.Snterm
+@@ -3556,9 +3599,9 @@
+ Gramext.action
+ (fun (x : string)
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Str x : 'e__23))])],
++ (Qast.Str x : 'e__25))])],
+ Gramext.action
+- (fun (a : 'e__23 option)
++ (fun (a : 'e__25 option)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Option a : 'a_opt));
+ [Gramext.Snterm
+@@ -3593,9 +3636,9 @@
+ Gramext.action
+ (fun (x : string)
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Str x : 'e__24))])],
++ (Qast.Str x : 'e__26))])],
+ Gramext.action
+- (fun (a : 'e__24 option)
++ (fun (a : 'e__26 option)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Option a : 'a_opt));
+ [Gramext.Snterm
+@@ -3713,9 +3756,9 @@
+ Gramext.action
+ (fun (x : string)
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Str x : 'e__25))])],
++ (Qast.Str x : 'e__27))])],
+ Gramext.action
+- (fun (a : 'e__25 option)
++ (fun (a : 'e__27 option)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Option a : 'a_opt));
+ [Gramext.Snterm
+@@ -3922,9 +3965,9 @@
+ Gramext.action
+ (fun (x : string)
+ (_loc : Lexing.position * Lexing.position) ->
+- (Qast.Str x : 'e__26))])],
++ (Qast.Str x : 'e__28))])],
+ Gramext.action
+- (fun (a : 'e__26 option)
++ (fun (a : 'e__28 option)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.Option a : 'a_opt));
+ [Gramext.Snterm
+@@ -4390,9 +4433,9 @@
+ Gramext.action
+ (fun _ (e : 'expr)
+ (_loc : Lexing.position * Lexing.position) ->
+- (e : 'e__29))])],
++ (e : 'e__31))])],
+ Gramext.action
+- (fun (a : 'e__29 list)
++ (fun (a : 'e__31 list)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.List a : 'a_list));
+ [Gramext.Snterm
+@@ -4425,9 +4468,9 @@
+ Gramext.action
+ (fun _ (e : 'expr)
+ (_loc : Lexing.position * Lexing.position) ->
+- (e : 'e__28))])],
++ (e : 'e__30))])],
+ Gramext.action
+- (fun (a : 'e__28 list)
++ (fun (a : 'e__30 list)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.List a : 'a_list));
+ [Gramext.Snterm
+@@ -4454,9 +4497,9 @@
+ Gramext.action
+ (fun _ (e : 'expr)
+ (_loc : Lexing.position * Lexing.position) ->
+- (e : 'e__27))])],
++ (e : 'e__29))])],
+ Gramext.action
+- (fun (a : 'e__27 list)
++ (fun (a : 'e__29 list)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.List a : 'a_list));
+ [Gramext.Snterm
+@@ -4547,9 +4590,9 @@
+ Gramext.action
+ (fun _ (cf : 'class_str_item)
+ (_loc : Lexing.position * Lexing.position) ->
+- (cf : 'e__30))])],
++ (cf : 'e__32))])],
+ Gramext.action
+- (fun (a : 'e__30 list)
++ (fun (a : 'e__32 list)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.List a : 'a_list));
+ [Gramext.Snterm
+@@ -4592,9 +4635,9 @@
+ Gramext.action
+ (fun _ (csf : 'class_sig_item)
+ (_loc : Lexing.position * Lexing.position) ->
+- (csf : 'e__32))])],
++ (csf : 'e__34))])],
+ Gramext.action
+- (fun (a : 'e__32 list)
++ (fun (a : 'e__34 list)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.List a : 'a_list));
+ [Gramext.Snterm
+@@ -4623,9 +4666,9 @@
+ Gramext.action
+ (fun _ (csf : 'class_sig_item)
+ (_loc : Lexing.position * Lexing.position) ->
+- (csf : 'e__31))])],
++ (csf : 'e__33))])],
+ Gramext.action
+- (fun (a : 'e__31 list)
++ (fun (a : 'e__33 list)
+ (_loc : Lexing.position * Lexing.position) ->
+ (Qast.List a : 'a_list));
+ [Gramext.Snterm
+Index: camlp4/top/rprint.ml
+===================================================================
+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 9 Mar 2006 07:19:39 -0000
+@@ -288,8 +288,9 @@
+ fprintf ppf "@[<2>method %s%s%s :@ %a;@]"
+ (if priv then "private " else "") (if virt then "virtual " else "")
+ name Toploop.print_out_type.val ty
+- | Ocsg_value name mut ty ->
+- fprintf ppf "@[<2>value %s%s :@ %a;@]" (if mut then "mutable " else "")
++ | Ocsg_value name mut virt ty ->
++ fprintf ppf "@[<2>value %s%s%s :@ %a;@]"
++ (if mut then "mutable " else "") (if virt then "virtual " else "")
+ name Toploop.print_out_type.val ty ]
+ ;
+
+Index: ocamldoc/Makefile
+===================================================================
+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 9 Mar 2006 07:19:40 -0000
+@@ -31,7 +31,7 @@
+ MKDIR=mkdir -p
+ CP=cp -f
+ OCAMLDOC=ocamldoc
+-OCAMLDOC_RUN=sh ./runocamldoc $(SUPPORTS_SHARED_LIBRARIES)
++OCAMLDOC_RUN=./ocamldoc.opt #sh ./runocamldoc $(SUPPORTS_SHARED_LIBRARIES)
+ OCAMLDOC_OPT=$(OCAMLDOC).opt
+ OCAMLDOC_LIBCMA=odoc_info.cma
+ OCAMLDOC_LIBCMI=odoc_info.cmi
+@@ -188,12 +188,12 @@
+ ../otherlibs/num/num.mli
+
+ all: exe lib
+- $(MAKE) manpages
+
+ exe: $(OCAMLDOC)
+ lib: $(OCAMLDOC_LIBCMA) $(OCAMLDOC_LIBCMI) $(ODOC_TEST)
+
+ opt.opt: exeopt libopt
++ $(MAKE) manpages
+ exeopt: $(OCAMLDOC_OPT)
+ libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI)
+ debug:
+Index: ocamldoc/odoc_ast.ml
+===================================================================
+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 9 Mar 2006 07:19:40 -0000
+@@ -184,7 +184,7 @@
+ let rec iter = function
+ | [] ->
+ raise Not_found
+- | Typedtree.Cf_val (_, ident, exp) :: q
++ | Typedtree.Cf_val (_, ident, Some exp, _) :: q
+ when Name.from_ident ident = name ->
+ exp.Typedtree.exp_type
+ | _ :: q ->
+@@ -523,7 +523,8 @@
+ p_clexp.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum
+ q
+
+- | (Parsetree.Pcf_val (label, mutable_flag, expression, loc)) :: q ->
++ | (Parsetree.Pcf_val (label, mutable_flag, _, loc) |
++ Parsetree.Pcf_valvirt (label, mutable_flag, _, loc)) :: q ->
+ let complete_name = Name.concat current_class_name label in
+ let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
+ let type_exp =
+Index: ocamldoc/odoc_sig.ml
+===================================================================
+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 9 Mar 2006 07:19:40 -0000
+@@ -107,7 +107,7 @@
+ | _ -> assert false
+
+ let search_attribute_type name class_sig =
+- let (_, type_expr) = Types.Vars.find name class_sig.Types.cty_vars in
++ let (_, _, type_expr) = Types.Vars.find name class_sig.Types.cty_vars in
+ type_expr
+
+ let search_method_type name class_sig =
+@@ -269,7 +269,7 @@
+ [] -> pos_limit
+ | ele2 :: _ ->
+ match ele2 with
+- Parsetree.Pctf_val (_, _, _, loc)
++ Parsetree.Pctf_val (_, _, _, _, loc)
+ | Parsetree.Pctf_virt (_, _, _, loc)
+ | Parsetree.Pctf_meth (_, _, _, loc)
+ | Parsetree.Pctf_cstr (_, _, loc) -> loc.Location.loc_start.Lexing.pos_cnum
+@@ -330,7 +330,7 @@
+ in
+ ([], ele_comments)
+
+- | Parsetree.Pctf_val (name, mutable_flag, _, loc) :: q ->
++ | Parsetree.Pctf_val (name, mutable_flag, _, _, loc) :: q ->
+ (* of (string * mutable_flag * core_type option * Location.t)*)
+ let (comment_opt, eles_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
+ let complete_name = Name.concat current_class_name name in
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-24 12:58:53 +0000