summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorXavier Clerc <xavier.clerc@inria.fr>2011-07-21 07:59:32 +0000
committerXavier Clerc <xavier.clerc@inria.fr>2011-07-21 07:59:32 +0000
commit2ae723a2e994411b0034eb7ce69b9f8f8640579d (patch)
tree655e06ce218a5475d93688cf00275d1be41e92cb
parentefb3949fef3374ac03996143143ee2a36643e5b7 (diff)
removed 'testlabl'.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@11141 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat
-rw-r--r--testlabl/.ignore2
-rw-r--r--testlabl/coerce.diffs93
-rw-r--r--testlabl/dirs_multimatch1
-rw-r--r--testlabl/dirs_poly1
-rw-r--r--testlabl/fixedtypes.ml77
-rw-r--r--testlabl/marshal_objects.diffs800
-rw-r--r--testlabl/multimatch.diffs1418
-rw-r--r--testlabl/multimatch.ml158
-rw-r--r--testlabl/newlabels.ps1458
-rw-r--r--testlabl/objvariant.diffs354
-rw-r--r--testlabl/objvariant.ml42
-rw-r--r--testlabl/printers.ml11
-rw-r--r--testlabl/tests.ml22
-rw-r--r--testlabl/valvirt.diffs2349
-rw-r--r--testlabl/varunion.ml435
15 files changed, 0 insertions, 7221 deletions
diff --git a/testlabl/.ignore b/testlabl/.ignore
deleted file mode 100644
index 4539eb6d0..000000000
--- a/testlabl/.ignore
+++ /dev/null
@@ -1,2 +0,0 @@
-*.out
-*.out2
diff --git a/testlabl/coerce.diffs b/testlabl/coerce.diffs
deleted file mode 100644
index e90e1fc93..000000000
--- a/testlabl/coerce.diffs
+++ /dev/null
@@ -1,93 +0,0 @@
-Index: typing/ctype.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v
-retrieving revision 1.201
-diff -u -r1.201 ctype.ml
---- typing/ctype.ml 5 Apr 2006 02:28:13 -0000 1.201
-+++ typing/ctype.ml 17 May 2006 23:48:22 -0000
-@@ -490,6 +490,31 @@
- unmark_class_signature sign;
- Some reason
-
-+(* Variant for checking principality *)
-+
-+let rec free_nodes_rec ty =
-+ let ty = repr ty in
-+ if ty.level >= lowest_level then begin
-+ if ty.level <= !current_level then raise Exit;
-+ ty.level <- pivot_level - ty.level;
-+ begin match ty.desc with
-+ Tvar ->
-+ raise Exit
-+ | Tobject (ty, _) ->
-+ free_nodes_rec ty
-+ | Tfield (_, _, ty1, ty2) ->
-+ free_nodes_rec ty1; free_nodes_rec ty2
-+ | Tvariant row ->
-+ let row = row_repr row in
-+ iter_row free_nodes_rec {row with row_bound = []};
-+ if not (static_row row) then free_nodes_rec row.row_more
-+ | _ ->
-+ iter_type_expr free_nodes_rec ty
-+ end;
-+ end
-+
-+let has_free_nodes ty =
-+ try free_nodes_rec ty; false with Exit -> true
-
- (**********************)
- (* Type duplication *)
-Index: typing/ctype.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.mli,v
-retrieving revision 1.54
-diff -u -r1.54 ctype.mli
---- typing/ctype.mli 5 Apr 2006 02:28:13 -0000 1.54
-+++ typing/ctype.mli 17 May 2006 23:48:22 -0000
-@@ -228,6 +228,9 @@
- val closed_class:
- type_expr list -> class_signature -> closed_class_failure option
- (* Check whether all type variables are bound *)
-+val has_free_nodes: type_expr -> bool
-+ (* Check whether there are free type variables, or nodes with
-+ level lower or equal to !current_level *)
-
- val unalias: type_expr -> type_expr
- val signature_of_class_type: class_type -> class_signature
-Index: typing/typecore.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v
-retrieving revision 1.181
-diff -u -r1.181 typecore.ml
---- typing/typecore.ml 16 Apr 2006 23:28:22 -0000 1.181
-+++ typing/typecore.ml 17 May 2006 23:48:22 -0000
-@@ -1183,12 +1183,29 @@
- let (ty', force) =
- Typetexp.transl_simple_type_delayed env sty'
- in
-+ if !Clflags.principal then begin_def ();
- let arg = type_exp env sarg in
-+ let has_fv =
-+ if !Clflags.principal then begin
-+ end_def ();
-+ let b = has_free_nodes arg.exp_type in
-+ Ctype.unify env arg.exp_type (newvar ());
-+ b
-+ end else
-+ free_variables arg.exp_type <> []
-+ in
- begin match arg.exp_desc, !self_coercion, (repr ty').desc with
- Texp_ident(_, {val_kind=Val_self _}), (path,r) :: _,
- Tconstr(path',_,_) when Path.same path path' ->
- r := sexp.pexp_loc :: !r;
- force ()
-+ | _ when not has_fv ->
-+ begin try
-+ let force' = subtype env arg.exp_type ty' in
-+ force (); force' ()
-+ with Subtype (tr1, tr2) ->
-+ raise(Error(sexp.pexp_loc, Not_subtype(tr1, tr2)))
-+ end
- | _ ->
- let ty, b = enlarge_type env ty' in
- force ();
diff --git a/testlabl/dirs_multimatch b/testlabl/dirs_multimatch
deleted file mode 100644
index b44951464..000000000
--- a/testlabl/dirs_multimatch
+++ /dev/null
@@ -1 +0,0 @@
-parsing typing bytecomp driver toplevel \ No newline at end of file
diff --git a/testlabl/dirs_poly b/testlabl/dirs_poly
deleted file mode 100644
index 3aec606ed..000000000
--- a/testlabl/dirs_poly
+++ /dev/null
@@ -1 +0,0 @@
-bytecomp byterun driver parsing stdlib tools toplevel typing utils otherlibs/labltk/browser/searchpos.ml
diff --git a/testlabl/fixedtypes.ml b/testlabl/fixedtypes.ml
deleted file mode 100644
index a7d7ca4ae..000000000
--- a/testlabl/fixedtypes.ml
+++ /dev/null
@@ -1,77 +0,0 @@
-(* cvs update -r fixedtypes parsing typing *)
-
-(* recursive types *)
-class c = object (self) method m = 1 method s = self end
-module type S = sig type t = private #c end;;
-
-module M : S = struct type t = c end
-module type S' = S with type t = c;;
-
-class d = object inherit c method n = 2 end
-module type S2 = S with type t = private #d;;
-module M2 : S = struct type t = d end;;
-module M3 : S = struct type t = private #d end;;
-
-module T1 = struct
- type ('a,'b) a = [`A of 'a | `B of 'b]
- type ('a,'b) b = [`Z | ('a,'b) a]
-end
-module type T2 = sig
- type a and b
- val evala : a -> int
- val evalb : b -> int
-end
-module type T3 = sig
- type a0 = private [> (a0,b0) T1.a]
- and b0 = private [> (a0,b0) T1.b]
-end
-module type T4 = sig
- include T3
- include T2 with type a = a0 and type b = b0
-end
-module F(X:T4) = struct
- type a = X.a and b = X.b
- let a = X.evala (`B `Z)
- let b = X.evalb (`A(`B `Z))
- let a2b (x : a) : b = `A x
- let b2a (x : b) : a = `B x
-end
-module M4 = struct
- type a = [`A of a | `B of b | `ZA]
- and b = [`A of a | `B of b | `Z]
- type a0 = a
- type b0 = b
- let rec eval0 = function
- `A a -> evala a
- | `B b -> evalb b
- and evala : a -> int = function
- #T1.a as x -> 1 + eval0 x
- | `ZA -> 3
- and evalb : b -> int = function
- #T1.a as x -> 1 + eval0 x
- | `Z -> 7
-end
-module M5 = F(M4)
-
-module M6 : sig
- class ci : int ->
- object
- val x : int
- method x : int
- method move : int -> unit
- end
- type c = private #ci
- val create : int -> c
-end = struct
- class ci x = object
- val mutable x : int = x
- method x = x
- method move d = x <- x+d
- end
- type c = ci
- let create = new ci
-end
-let f (x : M6.c) = x#move 3; x#x;;
-
-module M : sig type t = private [> `A of bool] end =
- struct type t = [`A of int] end
diff --git a/testlabl/marshal_objects.diffs b/testlabl/marshal_objects.diffs
deleted file mode 100644
index bb9b4dd71..000000000
--- a/testlabl/marshal_objects.diffs
+++ /dev/null
@@ -1,800 +0,0 @@
-? bytecomp/alpha_eq.ml
-Index: bytecomp/lambda.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/lambda.ml,v
-retrieving revision 1.44
-diff -u -r1.44 lambda.ml
---- bytecomp/lambda.ml 25 Aug 2005 15:35:16 -0000 1.44
-+++ bytecomp/lambda.ml 2 Feb 2006 05:08:56 -0000
-@@ -287,9 +287,10 @@
- let compare = compare
- end)
-
--let free_ids get l =
-+let free_ids get used l =
- let fv = ref IdentSet.empty in
- let rec free l =
-+ let old = !fv in
- iter free l;
- fv := List.fold_right IdentSet.add (get l) !fv;
- match l with
-@@ -307,17 +308,20 @@
- fv := IdentSet.remove v !fv
- | Lassign(id, e) ->
- fv := IdentSet.add id !fv
-+ | Lifused(id, e) ->
-+ if used && not (IdentSet.mem id old) then fv := IdentSet.remove id !fv
- | Lvar _ | Lconst _ | Lapply _
- | Lprim _ | Lswitch _ | Lstaticraise _
- | Lifthenelse _ | Lsequence _ | Lwhile _
-- | Lsend _ | Levent _ | Lifused _ -> ()
-+ | Lsend _ | Levent _ -> ()
- in free l; !fv
-
--let free_variables l =
-- free_ids (function Lvar id -> [id] | _ -> []) l
-+let free_variables ?(ifused=false) l =
-+ free_ids (function Lvar id -> [id] | _ -> []) ifused l
-
- let free_methods l =
-- free_ids (function Lsend(Self, Lvar meth, obj, _) -> [meth] | _ -> []) l
-+ free_ids (function Lsend(Self, Lvar meth, obj, _) -> [meth] | _ -> [])
-+ false l
-
- (* Check if an action has a "when" guard *)
- let raise_count = ref 0
-Index: bytecomp/lambda.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/lambda.mli,v
-retrieving revision 1.42
-diff -u -r1.42 lambda.mli
---- bytecomp/lambda.mli 25 Aug 2005 15:35:16 -0000 1.42
-+++ bytecomp/lambda.mli 2 Feb 2006 05:08:56 -0000
-@@ -177,7 +177,7 @@
-
- val iter: (lambda -> unit) -> lambda -> unit
- module IdentSet: Set.S with type elt = Ident.t
--val free_variables: lambda -> IdentSet.t
-+val free_variables: ?ifused:bool -> lambda -> IdentSet.t
- val free_methods: lambda -> IdentSet.t
-
- val transl_path: Path.t -> lambda
-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 2 Feb 2006 05:08:56 -0000
-@@ -46,6 +46,10 @@
-
- let lfield v i = Lprim(Pfield i, [Lvar v])
-
-+let ltuple l = Lprim(Pmakeblock(0,Immutable), l)
-+
-+let lprim name args = Lapply(oo_prim name, args)
-+
- let transl_label l = share (Const_immstring l)
-
- let rec transl_meth_list lst =
-@@ -68,8 +72,8 @@
- Lvar offset])])]))
-
- let transl_val tbl create name =
-- Lapply (oo_prim (if create then "new_variable" else "get_variable"),
-- [Lvar tbl; transl_label name])
-+ lprim (if create then "new_variable" else "get_variable")
-+ [Lvar tbl; transl_label name]
-
- let transl_vals tbl create vals rem =
- List.fold_right
-@@ -82,7 +86,7 @@
- (fun (nm, id) rem ->
- try
- (nm, id,
-- Lapply(oo_prim "get_method", [Lvar tbl; Lvar (Meths.find nm meths)]))
-+ lprim "get_method" [Lvar tbl; Lvar (Meths.find nm meths)])
- :: rem
- with Not_found -> rem)
- inh_meths []
-@@ -97,17 +101,15 @@
- let (inh_init, obj_init, has_init) = init obj' in
- if obj_init = lambda_unit then
- (inh_init,
-- Lapply (oo_prim (if has_init then "create_object_and_run_initializers"
-- else"create_object_opt"),
-- [obj; Lvar cl]))
-+ lprim (if has_init then "create_object_and_run_initializers"
-+ else"create_object_opt")
-+ [obj; Lvar cl])
- else begin
- (inh_init,
-- Llet(Strict, obj',
-- Lapply (oo_prim "create_object_opt", [obj; Lvar cl]),
-+ Llet(Strict, obj', lprim "create_object_opt" [obj; Lvar cl],
- Lsequence(obj_init,
- if not has_init then Lvar obj' else
-- Lapply (oo_prim "run_initializers_opt",
-- [obj; Lvar obj'; Lvar cl]))))
-+ lprim "run_initializers_opt" [obj; Lvar obj'; Lvar cl])))
- end
-
- let rec build_object_init cl_table obj params inh_init obj_init cl =
-@@ -203,14 +205,13 @@
-
-
- let bind_method tbl lab id cl_init =
-- Llet(StrictOpt, id, Lapply (oo_prim "get_method_label",
-- [Lvar tbl; transl_label lab]),
-+ Llet(StrictOpt, id, lprim "get_method_label" [Lvar tbl; transl_label lab],
- cl_init)
-
--let bind_methods tbl meths vals cl_init =
-- let methl = Meths.fold (fun lab id tl -> (lab,id) :: tl) meths [] in
-+let bind_methods tbl methl vals cl_init =
- let len = List.length methl and nvals = List.length vals in
-- if len < 2 && nvals = 0 then Meths.fold (bind_method tbl) meths cl_init else
-+ if len < 2 && nvals = 0 then
-+ List.fold_right (fun (n,i) -> bind_method tbl n i) methl 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
-@@ -229,21 +230,19 @@
- vals' cl_init)
- in
- Llet(StrictOpt, ids,
-- Lapply (oo_prim getter,
-- [Lvar tbl; transl_meth_list (List.map fst methl)] @ names),
-+ lprim 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))
-+ (fun (lab,id) lam -> decr i; Llet(Alias, id, lfield ids !i, lam))
- methl cl_init)
-
- let output_methods tbl methods lam =
- match methods with
- [] -> lam
- | [lab; code] ->
-- lsequence (Lapply(oo_prim "set_method", [Lvar tbl; lab; code])) lam
-+ lsequence (lprim "set_method" [Lvar tbl; lab; code]) lam
- | _ ->
-- lsequence (Lapply(oo_prim "set_methods",
-- [Lvar tbl; Lprim(Pmakeblock(0,Immutable), methods)]))
-- lam
-+ lsequence (lprim "set_methods" [Lvar tbl; ltuple methods]) lam
-
- let rec ignore_cstrs cl =
- match cl.cl_desc with
-@@ -266,7 +265,8 @@
- Llet (Strict, obj_init,
- Lapply(Lprim(Pfield 1, [lpath]), Lvar cla ::
- if top then [Lprim(Pfield 3, [lpath])] else []),
-- bind_super cla super cl_init))
-+ bind_super cla super cl_init),
-+ [], [])
- | _ ->
- assert false
- end
-@@ -278,10 +278,11 @@
- match field with
- Cf_inher (cl, vals, meths) ->
- let cl_init = output_methods cla methods cl_init in
-- let inh_init, cl_init =
-+ let (inh_init, cl_init, meths', vals') =
- build_class_init cla false
- (vals, meths_super cla str.cl_meths meths)
- inh_init cl_init msubst top cl in
-+ let cl_init = bind_methods cla meths' vals' cl_init in
- (inh_init, cl_init, [], values)
- | Cf_val (name, id, exp) ->
- (inh_init, cl_init, methods, (name, id)::values)
-@@ -304,29 +305,37 @@
- (inh_init, cl_init, methods, vals @ values)
- | Cf_init exp ->
- (inh_init,
-- Lsequence(Lapply (oo_prim "add_initializer",
-- Lvar cla :: msubst false (transl_exp exp)),
-+ Lsequence(lprim "add_initializer"
-+ (Lvar cla :: msubst false (transl_exp exp)),
- cl_init),
- methods, values))
- str.cl_field
- (inh_init, cl_init, [], [])
- in
- let cl_init = output_methods cla methods cl_init in
-- (inh_init, bind_methods cla str.cl_meths values cl_init)
-+ (* inh_init, bind_methods cla str.cl_meths values cl_init *)
-+ let methods = Meths.fold (fun n i l -> (n,i)::l) str.cl_meths [] in
-+ (inh_init, cl_init, methods, values)
- | Tclass_fun (pat, vals, cl, _) ->
-- let (inh_init, cl_init) =
-+ let (inh_init, cl_init, methods, values) =
- build_class_init cla cstr super inh_init cl_init msubst top cl
- in
-+ let fv = free_variables ~ifused:true cl_init in
-+ let vals = List.filter (fun (id,_) -> IdentSet.mem id fv) vals in
- let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in
-- (inh_init, transl_vals cla true vals cl_init)
-+ (* inh_init, transl_vals cla true vals cl_init *)
-+ (inh_init, cl_init, methods, vals @ values)
- | Tclass_apply (cl, exprs) ->
- build_class_init cla cstr super inh_init cl_init msubst top cl
- | Tclass_let (rec_flag, defs, vals, cl) ->
-- let (inh_init, cl_init) =
-+ let (inh_init, cl_init, methods, values) =
- build_class_init cla cstr super inh_init cl_init msubst top cl
- in
-+ let fv = free_variables ~ifused:true cl_init in
-+ let vals = List.filter (fun (id,_) -> IdentSet.mem id fv) vals in
- let vals = List.map (function (id, _) -> (Ident.name id, id)) vals in
-- (inh_init, transl_vals cla true vals cl_init)
-+ (* inh_init, transl_vals cla true vals cl_init *)
-+ (inh_init, cl_init, methods, vals @ values)
- | Tclass_constraint (cl, vals, meths, concr_meths) ->
- let virt_meths =
- List.filter (fun lab -> not (Concr.mem lab concr_meths)) meths in
-@@ -358,23 +367,34 @@
- 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))]),
-+ lprim "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(Alias, inh_meths, lfield inh 2, cl_init)))),
-+ [], [])
- | _ ->
- let core cl_init =
- build_class_init cla true super inh_init cl_init msubst top cl
- in
- if cstr then core cl_init else
-- let (inh_init, cl_init) =
-- core (Lsequence (Lapply (oo_prim "widen", [Lvar cla]), cl_init))
-+ let (inh_init, cl_init, methods, values) =
-+ core (Lsequence (lprim "widen" [Lvar cla], cl_init))
- in
-- (inh_init,
-- Lsequence(Lapply (oo_prim "narrow", narrow_args), cl_init))
-+ let cl_init = bind_methods cla methods values cl_init in
-+ (inh_init, Lsequence(lprim "narrow" narrow_args, cl_init), [], [])
- end
-
-+let build_class_init cla env inh_init obj_init msubst top cl =
-+ let inh_init = List.rev inh_init in
-+ let (inh_init, cl_init, methods, values) =
-+ build_class_init cla true ([],[]) inh_init obj_init msubst top cl in
-+ assert (inh_init = []);
-+ if IdentSet.mem env (free_variables ~ifused:true cl_init)
-+ then bind_methods cla methods (("", env) :: values) cl_init
-+ else Llet(Alias, env, lambda_unit, bind_methods cla methods values cl_init)
-+
- let rec build_class_lets cl =
- match cl.cl_desc with
- Tclass_let (rec_flag, defs, vals, cl) ->
-@@ -459,16 +479,16 @@
- Strict, new_init, lfunction [obj_init] obj_init',
- Llet(
- Alias, cla, transl_path path,
-- Lprim(Pmakeblock(0, Immutable),
-- [Lapply(Lvar new_init, [lfield cla 0]);
-- lfunction [table]
-- (Llet(Strict, env_init,
-- Lapply(lfield cla 1, [Lvar table]),
-- lfunction [envs]
-- (Lapply(Lvar new_init,
-- [Lapply(Lvar env_init, [Lvar envs])]))));
-- lfield cla 2;
-- lfield cla 3])))
-+ ltuple
-+ [Lapply(Lvar new_init, [lfield cla 0]);
-+ lfunction [table]
-+ (Llet(Strict, env_init,
-+ Lapply(lfield cla 1, [Lvar table]),
-+ lfunction [envs]
-+ (Lapply(Lvar new_init,
-+ [Lapply(Lvar env_init, [Lvar envs])]))));
-+ lfield cla 2;
-+ lfield cla 3]))
- with Exit ->
- lambda_unit
-
-@@ -541,7 +561,7 @@
- open CamlinternalOO
- let builtin_meths arr self env env2 body =
- let builtin, args = builtin_meths self env env2 body in
-- if not arr then [Lapply(oo_prim builtin, args)] else
-+ if not arr then [lprim builtin args] else
- let tag = match builtin with
- "get_const" -> GetConst
- | "get_var" -> GetVar
-@@ -599,7 +619,8 @@
-
- (* Prepare for heavy environment handling *)
- let tables = Ident.create (Ident.name cl_id ^ "_tables") in
-- let (top_env, req) = oo_add_class tables in
-+ let table_init = ref None in
-+ let (top_env, req) = oo_add_class tables table_init in
- let top = not req in
- let cl_env, llets = build_class_lets cl in
- let new_ids = if top then [] else Env.diff top_env cl_env in
-@@ -633,6 +654,7 @@
- begin try
- (* Doesn't seem to improve size for bytecode *)
- (* if not !Clflags.native_code then raise Not_found; *)
-+ if !Clflags.debug then raise Not_found;
- builtin_meths arr [self] env env2 (lfunction args body')
- with Not_found ->
- [lfunction (self :: args)
-@@ -665,15 +687,8 @@
- build_object_init_0 cla [] cl copy_env subst_env top ids in
- if not (Translcore.check_recursive_lambda ids obj_init) then
- raise(Error(cl.cl_loc, Illegal_class_expr));
-- let inh_init' = List.rev inh_init in
-- let (inh_init', cl_init) =
-- build_class_init cla true ([],[]) inh_init' obj_init msubst top cl
-- in
-- assert (inh_init' = []);
-- let table = Ident.create "table"
-- and class_init = Ident.create (Ident.name cl_id ^ "_init")
-- and env_init = Ident.create "env_init"
-- and obj_init = Ident.create "obj_init" in
-+ let cl_init = build_class_init cla env2 inh_init obj_init msubst top cl in
-+ let obj_init = Ident.create "obj_init" in
- let pub_meths =
- List.sort
- (fun s s' -> compare (Btype.hash_variant s) (Btype.hash_variant s'))
-@@ -685,42 +700,44 @@
- let name' = List.assoc tag rev_map in
- if name' <> name then raise(Error(cl.cl_loc, Tags(name, name'))))
- tags pub_meths;
-+ let pos = cl.cl_loc.Location.loc_end in
-+ let filepos = [transl_label pos.Lexing.pos_fname;
-+ Lconst(Const_base(Const_int pos.Lexing.pos_cnum))] in
- let ltable table lam =
-- Llet(Strict, table,
-- Lapply (oo_prim "create_table", [transl_meth_list pub_meths]), lam)
-+ Llet(Strict, table, lprim "create_table" [transl_meth_list pub_meths], lam)
- and ldirect obj_init =
- Llet(Strict, obj_init, cl_init,
-- Lsequence(Lapply (oo_prim "init_class", [Lvar cla]),
-+ Lsequence(lprim "init_class_shared" (Lvar cla :: filepos),
- Lapply(Lvar obj_init, [lambda_unit])))
- in
- (* Simplest case: an object defined at toplevel (ids=[]) *)
- if top && ids = [] then llets (ltable cla (ldirect obj_init)) else
-
-+ let table = Ident.create "table"
-+ and class_init = Ident.create (Ident.name cl_id ^ "_init")
-+ and env_init = Ident.create (Ident.name cl_id ^ "_env_init") in
-+ let cl_init_fun = Lfunction(Curried, [cla], cl_init) in
- let concrete =
- ids = [] ||
- Typeclass.virtual_methods (Ctype.signature_of_class_type cl.cl_type) = []
-- and lclass lam =
-- let cl_init = llets (Lfunction(Curried, [cla], cl_init)) in
-+ and lclass cl_init lam =
- Llet(Strict, class_init, cl_init, lam (free_variables cl_init))
- and lbody fv =
- if List.for_all (fun id -> not (IdentSet.mem id fv)) ids then
-- Lapply (oo_prim "make_class",[transl_meth_list pub_meths;
-- Lvar class_init])
-+ lprim "make_class"
-+ (transl_meth_list pub_meths :: Lvar class_init :: filepos)
- else
- ltable table (
- Llet(
- Strict, env_init, Lapply(Lvar class_init, [Lvar table]),
-- Lsequence(
-- Lapply (oo_prim "init_class", [Lvar table]),
-- Lprim(Pmakeblock(0, Immutable),
-- [Lapply(Lvar env_init, [lambda_unit]);
-- Lvar class_init; Lvar env_init; lambda_unit]))))
-+ Lsequence(lprim "init_class_shared" (Lvar table :: filepos),
-+ ltuple [Lapply(Lvar env_init, [lambda_unit]);
-+ Lvar class_init; Lvar env_init; lambda_unit])))
- and lbody_virt lenvs =
-- Lprim(Pmakeblock(0, Immutable),
-- [lambda_unit; Lfunction(Curried,[cla], cl_init); lambda_unit; lenvs])
-+ ltuple [lambda_unit; cl_init_fun; lambda_unit; lenvs]
- in
- (* Still easy: a class defined at toplevel *)
-- if top && concrete then lclass lbody else
-+ if top && concrete then lclass (llets cl_init_fun) lbody else
- if top then llets (lbody_virt lambda_unit) else
-
- (* Now for the hard stuff: prepare for table cacheing *)
-@@ -733,23 +750,16 @@
- let lenv =
- let menv =
- if !new_ids_meths = [] then lambda_unit else
-- Lprim(Pmakeblock(0, Immutable),
-- List.map (fun id -> Lvar id) !new_ids_meths) in
-+ ltuple (List.map (fun id -> Lvar id) !new_ids_meths) in
- if !new_ids_init = [] then menv else
-- Lprim(Pmakeblock(0, Immutable),
-- menv :: List.map (fun id -> Lvar id) !new_ids_init)
-+ ltuple (menv :: List.map (fun id -> Lvar id) !new_ids_init)
- and linh_envs =
- List.map (fun (_, p) -> Lprim(Pfield 3, [transl_path p]))
- (List.rev inh_init)
- in
- let make_envs lam =
- Llet(StrictOpt, envs,
-- (if linh_envs = [] then lenv else
-- Lprim(Pmakeblock(0, Immutable), lenv :: linh_envs)),
-- lam)
-- and def_ids cla lam =
-- Llet(StrictOpt, env2,
-- Lapply (oo_prim "new_variable", [Lvar cla; transl_label ""]),
-+ (if linh_envs = [] then lenv else ltuple (lenv :: linh_envs)),
- lam)
- in
- let inh_paths =
-@@ -757,46 +767,53 @@
- (fun (_,path) -> List.mem (Path.head path) new_ids) inh_init in
- let inh_keys =
- List.map (fun (_,p) -> Lprim(Pfield 1, [transl_path p])) inh_paths in
-- let lclass lam =
-- Llet(Strict, class_init,
-- Lfunction(Curried, [cla], def_ids cla cl_init), lam)
-+ let lclass_init lam =
-+ Llet(Strict, class_init, cl_init_fun, lam)
- and lcache lam =
- if inh_keys = [] then Llet(Alias, cached, Lvar tables, lam) else
-- Llet(Strict, cached,
-- Lapply(oo_prim "lookup_tables",
-- [Lvar tables; Lprim(Pmakeblock(0, Immutable), inh_keys)]),
-+ Llet(Strict, cached, lprim "lookup_tables" [Lvar tables; ltuple inh_keys],
- lam)
- and lset cached i lam =
- Lprim(Psetfield(i, true), [Lvar cached; lam])
- in
-- let ldirect () =
-- ltable cla
-- (Llet(Strict, env_init, def_ids cla cl_init,
-- Lsequence(Lapply (oo_prim "init_class", [Lvar cla]),
-- lset cached 0 (Lvar env_init))))
-- and lclass_virt () =
-- lset cached 0 (Lfunction(Curried, [cla], def_ids cla cl_init))
-+ let ldirect prim pos =
-+ ltable cla (
-+ Llet(Strict, env_init, cl_init,
-+ Lsequence(lprim prim (Lvar cla :: pos), Lvar env_init)))
-+ and lclass_concrete cached =
-+ ltuple [Lapply (lfield cached 0, [lenvs]);
-+ lfield cached 1; lfield cached 0; lenvs]
- in
-+
- llets (
-- lcache (
-- Lsequence(
-- Lifthenelse(lfield cached 0, lambda_unit,
-- if ids = [] then ldirect () else
-- if not concrete then lclass_virt () else
-- lclass (
-- Lapply (oo_prim "make_class_store",
-- [transl_meth_list pub_meths;
-- Lvar class_init; Lvar cached]))),
- make_envs (
-- if ids = [] then Lapply(lfield cached 0, [lenvs]) else
-- Lprim(Pmakeblock(0, Immutable),
-- if concrete then
-- [Lapply(lfield cached 0, [lenvs]);
-- lfield cached 1;
-- lfield cached 0;
-- lenvs]
-- else [lambda_unit; lfield cached 0; lambda_unit; lenvs]
-- )))))
-+ if inh_paths = [] && concrete then
-+ if ids = [] then begin
-+ table_init := Some (ldirect "init_class_shared" filepos);
-+ Lapply (Lvar tables, [lenvs])
-+ end else begin
-+ let init =
-+ lclass cl_init_fun (fun _ ->
-+ lprim "make_class_env"
-+ (transl_meth_list pub_meths :: Lvar class_init :: filepos))
-+ in table_init := Some init;
-+ lclass_concrete tables
-+ end
-+ else begin
-+ lcache (
-+ Lsequence(
-+ Lifthenelse(lfield cached 0, lambda_unit,
-+ if ids = [] then lset cached 0 (ldirect "init_class" []) else
-+ if not concrete then lset cached 0 cl_init_fun else
-+ lclass_init (
-+ lprim "make_class_store"
-+ [transl_meth_list pub_meths; Lvar class_init; Lvar cached])),
-+ llets (
-+ make_envs (
-+ if ids = [] then Lapply(lfield cached 0, [lenvs]) else
-+ if concrete then lclass_concrete cached else
-+ ltuple [lambda_unit; lfield cached 0; lambda_unit; lenvs]))))
-+ end))
-
- (* Wrapper for class compilation *)
-
-Index: bytecomp/translobj.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translobj.ml,v
-retrieving revision 1.9
-diff -u -r1.9 translobj.ml
---- bytecomp/translobj.ml 26 May 2004 11:10:51 -0000 1.9
-+++ bytecomp/translobj.ml 2 Feb 2006 05:08:56 -0000
-@@ -88,7 +88,6 @@
-
- (* Insert labels *)
-
--let string s = Lconst (Const_base (Const_string s))
- let int n = Lconst (Const_base (Const_int n))
-
- let prim_makearray =
-@@ -124,8 +123,8 @@
- let top_env = ref Env.empty
- let classes = ref []
-
--let oo_add_class id =
-- classes := id :: !classes;
-+let oo_add_class id init =
-+ classes := (id, init) :: !classes;
- (!top_env, !cache_required)
-
- let oo_wrap env req f x =
-@@ -141,10 +140,12 @@
- let lambda = f x in
- let lambda =
- List.fold_left
-- (fun lambda id ->
-+ (fun lambda (id, init) ->
- Llet(StrictOpt, id,
-- Lprim(Pmakeblock(0, Mutable),
-- [lambda_unit; lambda_unit; lambda_unit]),
-+ (match !init with
-+ Some lam -> lam
-+ | None -> Lprim(Pmakeblock(0, Mutable),
-+ [lambda_unit; lambda_unit; lambda_unit])),
- lambda))
- lambda !classes
- in
-Index: bytecomp/translobj.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/translobj.mli,v
-retrieving revision 1.6
-diff -u -r1.6 translobj.mli
---- bytecomp/translobj.mli 26 May 2004 11:10:51 -0000 1.6
-+++ bytecomp/translobj.mli 2 Feb 2006 05:08:56 -0000
-@@ -25,4 +25,4 @@
- Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda
-
- val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
--val oo_add_class: Ident.t -> Env.t * bool
-+val oo_add_class: Ident.t -> Lambda.lambda option ref -> Env.t * bool
-Index: byterun/compare.h
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/byterun/compare.h,v
-retrieving revision 1.2
-diff -u -r1.2 compare.h
---- byterun/compare.h 31 Dec 2003 14:20:35 -0000 1.2
-+++ byterun/compare.h 2 Feb 2006 05:08:56 -0000
-@@ -17,5 +17,6 @@
- #define CAML_COMPARE_H
-
- CAMLextern int caml_compare_unordered;
-+CAMLextern value caml_compare(value, value);
-
- #endif /* CAML_COMPARE_H */
-Index: byterun/extern.c
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/byterun/extern.c,v
-retrieving revision 1.59
-diff -u -r1.59 extern.c
---- byterun/extern.c 4 Jan 2006 16:55:49 -0000 1.59
-+++ byterun/extern.c 2 Feb 2006 05:08:56 -0000
-@@ -411,6 +411,22 @@
- extern_record_location(v);
- break;
- }
-+ case Object_tag: {
-+ value field0;
-+ mlsize_t i;
-+ i = Wosize_val(Field(v, 0)) - 1;
-+ field0 = Field(Field(v, 0),i);
-+ if (Wosize_val(field0) > 0) {
-+ writecode32(CODE_OBJECT, Wosize_hd (hd));
-+ extern_record_location(v);
-+ extern_rec(field0);
-+ for (i = 1; i < sz - 1; i++) extern_rec(Field(v, i));
-+ v = Field(v, i);
-+ goto tailcall;
-+ }
-+ if (!extern_closures)
-+ extern_invalid_argument("output_value: dynamic class");
-+ } /* may fall through */
- default: {
- value field0;
- mlsize_t i;
-Index: byterun/intern.c
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/byterun/intern.c,v
-retrieving revision 1.60
-diff -u -r1.60 intern.c
---- byterun/intern.c 22 Sep 2005 14:21:50 -0000 1.60
-+++ byterun/intern.c 2 Feb 2006 05:08:56 -0000
-@@ -28,6 +28,8 @@
- #include "mlvalues.h"
- #include "misc.h"
- #include "reverse.h"
-+#include "callback.h"
-+#include "compare.h"
-
- static unsigned char * intern_src;
- /* Reading pointer in block holding input data. */
-@@ -98,6 +100,25 @@
- #define readblock(dest,len) \
- (memmove((dest), intern_src, (len)), intern_src += (len))
-
-+static value get_method_table (value key)
-+{
-+ static value *classes = NULL;
-+ value current;
-+ if (classes == NULL) {
-+ classes = caml_named_value("caml_oo_classes");
-+ if (classes == NULL) return 0;
-+ caml_register_global_root(classes);
-+ }
-+ for (current = Field(*classes, 0); Is_block(current);
-+ current = Field(current, 1))
-+ {
-+ value head = Field(current, 0);
-+ if (caml_compare(key, Field(head, 0)) == Val_int(0))
-+ return Field(head, 1);
-+ }
-+ return 0;
-+}
-+
- static void intern_cleanup(void)
- {
- if (intern_input_malloced) caml_stat_free(intern_input);
-@@ -315,6 +336,24 @@
- Custom_ops_val(v) = ops;
- intern_dest += 1 + size;
- break;
-+ case CODE_OBJECT:
-+ size = read32u();
-+ v = Val_hp(intern_dest);
-+ *dest = v;
-+ if (intern_obj_table != NULL) intern_obj_table[obj_counter++] = v;
-+ dest = (value *) (intern_dest + 1);
-+ *intern_dest = Make_header(size, Object_tag, intern_color);
-+ intern_dest += 1 + size;
-+ intern_rec(dest);
-+ *dest = get_method_table(*dest);
-+ if (*dest == 0) {
-+ intern_cleanup();
-+ caml_failwith("input_value: unknown class");
-+ }
-+ for(size--, dest++; size > 1; size--, dest++)
-+ intern_rec(dest);
-+ goto tailcall;
-+
- default:
- intern_cleanup();
- caml_failwith("input_value: ill-formed message");
-Index: byterun/intext.h
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/byterun/intext.h,v
-retrieving revision 1.32
-diff -u -r1.32 intext.h
---- byterun/intext.h 22 Sep 2005 14:21:50 -0000 1.32
-+++ byterun/intext.h 2 Feb 2006 05:08:56 -0000
-@@ -56,6 +56,7 @@
- #define CODE_CODEPOINTER 0x10
- #define CODE_INFIXPOINTER 0x11
- #define CODE_CUSTOM 0x12
-+#define CODE_OBJECT 0x14
-
- #if ARCH_FLOAT_ENDIANNESS == 0x76543210
- #define CODE_DOUBLE_NATIVE CODE_DOUBLE_BIG
-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 2 Feb 2006 05:08:56 -0000
-@@ -305,10 +305,38 @@
- public_methods;
- table
-
-+(*
-+let create_table_variables pub_meths priv_meths vars =
-+ let tbl = create_table pub_meths in
-+ let pub_meths = to_array pub_meths
-+ and priv_meths = to_array priv_meths
-+ and vars = to_array vars in
-+ let len = 2 + Array.length pub_meths + Array.length priv_meths in
-+ let res = Array.create len tbl in
-+ let mv = new_methods_variables tbl pub_meths vars in
-+ Array.blit mv 0 res 1;
-+ res
-+*)
-+
- let init_class table =
- inst_var_count := !inst_var_count + table.size - 1;
- table.initializers <- List.rev table.initializers;
-- resize table (3 + magic table.methods.(1) * 16 / Sys.word_size)
-+ let len = 3 + magic table.methods.(1) * 16 / Sys.word_size in
-+ (* keep 1 more for extra info *)
-+ let len = if len > Array.length table.methods then len else len+1 in
-+ resize table len
-+
-+let classes = ref []
-+let () = Callback.register "caml_oo_classes" classes
-+
-+let init_class_shared table (file : string) (pos : int) =
-+ init_class table;
-+ let rec unique_pos pos =
-+ if List.mem_assoc (file, pos) !classes then unique_pos (pos + 0x100000)
-+ else pos in
-+ let pos = unique_pos pos in
-+ table.methods.(Array.length table.methods - 1) <- Obj.magic (file, pos);
-+ classes := ((file, pos), table.methods) :: !classes
-
- let inherits cla vals virt_meths concr_meths (_, super, _, env) top =
- narrow cla vals virt_meths concr_meths;
-@@ -319,12 +347,18 @@
- Array.map (fun nm -> get_method cla (get_method_label cla nm))
- (to_array concr_meths))
-
--let make_class pub_meths class_init =
-+let make_class pub_meths class_init file pos =
- let table = create_table pub_meths in
- let env_init = class_init table in
-- init_class table;
-+ init_class_shared table file pos;
- (env_init (Obj.repr 0), class_init, env_init, Obj.repr 0)
-
-+let make_class_env pub_meths class_init file pos =
-+ let table = create_table pub_meths in
-+ let env_init = class_init table in
-+ init_class_shared table file pos;
-+ (env_init, class_init)
-+
- type init_table = { mutable env_init: t; mutable class_init: table -> t }
-
- let make_class_store pub_meths class_init init_table =
-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 2 Feb 2006 05:08:56 -0000
-@@ -43,14 +43,20 @@
- val add_initializer : table -> (obj -> unit) -> unit
- val dummy_table : table
- val create_table : string array -> table
-+(* val create_table_variables :
-+ string array -> string array -> string array -> table *)
- val init_class : table -> unit
-+val init_class_shared : table -> string -> int -> unit
- val inherits :
- table -> string array -> string array -> string array ->
- (t * (table -> obj -> Obj.t) * t * obj) -> bool ->
- (Obj.t * int array * closure array)
- val make_class :
-- string array -> (table -> Obj.t -> t) ->
-+ string array -> (table -> Obj.t -> t) -> string -> int ->
- (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t)
-+val make_class_env :
-+ string array -> (table -> Obj.t -> t) -> string -> int ->
-+ (Obj.t -> t) * (table -> Obj.t -> t)
- type init_table
- val make_class_store :
- string array -> (table -> t) -> init_table -> unit
diff --git a/testlabl/multimatch.diffs b/testlabl/multimatch.diffs
deleted file mode 100644
index 6eb34b72e..000000000
--- a/testlabl/multimatch.diffs
+++ /dev/null
@@ -1,1418 +0,0 @@
-Index: parsing/lexer.mll
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/parsing/lexer.mll,v
-retrieving revision 1.73
-diff -u -r1.73 lexer.mll
---- parsing/lexer.mll 11 Apr 2005 16:44:26 -0000 1.73
-+++ parsing/lexer.mll 2 Feb 2006 06:28:32 -0000
-@@ -63,6 +63,8 @@
- "match", MATCH;
- "method", METHOD;
- "module", MODULE;
-+ "multifun", MULTIFUN;
-+ "multimatch", MULTIMATCH;
- "mutable", MUTABLE;
- "new", NEW;
- "object", OBJECT;
-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 2 Feb 2006 06:28:32 -0000
-@@ -257,6 +257,8 @@
- %token MINUSDOT
- %token MINUSGREATER
- %token MODULE
-+%token MULTIFUN
-+%token MULTIMATCH
- %token MUTABLE
- %token <nativeint> NATIVEINT
- %token NEW
-@@ -325,7 +327,7 @@
- %nonassoc SEMI /* below EQUAL ({lbl=...; lbl=...}) */
- %nonassoc LET /* above SEMI ( ...; let ... in ...) */
- %nonassoc below_WITH
--%nonassoc FUNCTION WITH /* below BAR (match ... with ...) */
-+%nonassoc FUNCTION WITH MULTIFUN /* below BAR (match ... with ...) */
- %nonassoc AND /* above WITH (module rec A: SIG with ... and ...) */
- %nonassoc THEN /* below ELSE (if ... then ...) */
- %nonassoc ELSE /* (if ... then ... else ...) */
-@@ -804,8 +806,12 @@
- { mkexp(Pexp_function("", None, List.rev $3)) }
- | FUN labeled_simple_pattern fun_def
- { let (l,o,p) = $2 in mkexp(Pexp_function(l, o, [p, $3])) }
-+ | MULTIFUN opt_bar match_cases
-+ { mkexp(Pexp_multifun(List.rev $3)) }
- | MATCH seq_expr WITH opt_bar match_cases
-- { mkexp(Pexp_match($2, List.rev $5)) }
-+ { mkexp(Pexp_match($2, List.rev $5, false)) }
-+ | MULTIMATCH seq_expr WITH opt_bar match_cases
-+ { mkexp(Pexp_match($2, List.rev $5, true)) }
- | TRY seq_expr WITH opt_bar match_cases
- { mkexp(Pexp_try($2, List.rev $5)) }
- | TRY seq_expr WITH error
-@@ -1318,10 +1324,10 @@
- | simple_core_type2 { Rinherit $1 }
- ;
- tag_field:
-- name_tag OF opt_ampersand amper_type_list
-- { Rtag ($1, $3, List.rev $4) }
-- | name_tag
-- { Rtag ($1, true, []) }
-+ name_tag OF opt_ampersand amper_type_list amper_type_pair_list
-+ { Rtag ($1, $3, List.rev $4, $5) }
-+ | name_tag amper_type_pair_list
-+ { Rtag ($1, true, [], $2) }
- ;
- opt_ampersand:
- AMPERSAND { true }
-@@ -1331,6 +1337,11 @@
- core_type { [$1] }
- | amper_type_list AMPERSAND core_type { $3 :: $1 }
- ;
-+amper_type_pair_list:
-+ AMPERSAND core_type EQUAL core_type amper_type_pair_list
-+ { ($2, $4) :: $5 }
-+ | /* empty */
-+ { [] }
- opt_present:
- LBRACKETGREATER name_tag_list RBRACKET { List.rev $2 }
- | /* empty */ { [] }
-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 2 Feb 2006 06:28:32 -0000
-@@ -43,7 +43,7 @@
- | Pfield_var
-
- and row_field =
-- Rtag of label * bool * core_type list
-+ Rtag of label * bool * core_type list * (core_type * core_type) list
- | Rinherit of core_type
-
- (* XXX Type expressions for the class language *)
-@@ -86,7 +86,7 @@
- | Pexp_let of rec_flag * (pattern * expression) list * expression
- | Pexp_function of label * expression option * (pattern * expression) list
- | Pexp_apply of expression * (label * expression) list
-- | Pexp_match of expression * (pattern * expression) list
-+ | Pexp_match of expression * (pattern * expression) list * bool
- | Pexp_try of expression * (pattern * expression) list
- | Pexp_tuple of expression list
- | Pexp_construct of Longident.t * expression option * bool
-@@ -111,6 +111,7 @@
- | Pexp_lazy of expression
- | Pexp_poly of expression * core_type option
- | Pexp_object of class_structure
-+ | Pexp_multifun of (pattern * expression) list
-
- (* Value descriptions *)
-
-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 2 Feb 2006 06:28:32 -0000
-@@ -205,10 +205,14 @@
- line i ppf "Pexp_apply\n";
- expression i ppf e;
- list i label_x_expression ppf l;
-- | Pexp_match (e, l) ->
-+ | Pexp_match (e, l, b) ->
- line i ppf "Pexp_match\n";
- expression i ppf e;
- list i pattern_x_expression_case ppf l;
-+ bool i ppf b
-+ | Pexp_multifun l ->
-+ line i ppf "Pexp_multifun\n";
-+ list i pattern_x_expression_case ppf l;
- | Pexp_try (e, l) ->
- line i ppf "Pexp_try\n";
- expression i ppf e;
-@@ -653,7 +657,7 @@
-
- and label_x_bool_x_core_type_list i ppf x =
- match x with
-- Rtag (l, b, ctl) ->
-+ Rtag (l, b, ctl, cstr) ->
- line i ppf "Rtag \"%s\" %s\n" l (string_of_bool b);
- list (i+1) core_type ppf ctl
- | Rinherit (ct) ->
-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 2 Feb 2006 06:28:32 -0000
-@@ -66,16 +66,16 @@
- Clink r when !r <> Cunknown -> commu_repr !r
- | c -> c
-
--let rec row_field_repr_aux tl = function
-- Reither(_, tl', _, {contents = Some fi}) ->
-- row_field_repr_aux (tl@tl') fi
-- | Reither(c, tl', m, r) ->
-- Reither(c, tl@tl', m, r)
-+let rec row_field_repr_aux tl tl2 = function
-+ Reither(_, tl', _, tl2', {contents = Some fi}) ->
-+ row_field_repr_aux (tl@tl') (tl2@tl2') fi
-+ | Reither(c, tl', m, tl2', r) ->
-+ Reither(c, tl@tl', m, tl2@tl2', r)
- | Rpresent (Some _) when tl <> [] ->
- Rpresent (Some (List.hd tl))
- | fi -> fi
-
--let row_field_repr fi = row_field_repr_aux [] fi
-+let row_field_repr fi = row_field_repr_aux [] [] fi
-
- let rec rev_concat l ll =
- match ll with
-@@ -170,7 +170,8 @@
- (fun (_, fi) ->
- match row_field_repr fi with
- | Rpresent(Some ty) -> f ty
-- | Reither(_, tl, _, _) -> List.iter f tl
-+ | Reither(_, tl, _, tl2, _) ->
-+ List.iter f tl; List.iter (fun (t1,t2) -> f t1; f t2) tl2
- | _ -> ())
- row.row_fields;
- match (repr row.row_more).desc with
-@@ -208,15 +209,17 @@
- (fun (l, fi) -> l,
- match row_field_repr fi with
- | Rpresent(Some ty) -> Rpresent(Some(f ty))
-- | Reither(c, tl, m, e) ->
-+ | Reither(c, tl, m, tpl, e) ->
- let e = if keep then e else ref None in
- let m = if row.row_fixed then fixed else m in
- let tl = List.map f tl in
-+ let tl1 = List.map (fun (t1,_) -> repr (f t1)) tpl
-+ and tl2 = List.map (fun (_,t2) -> repr (f t2)) tpl in
- bound := List.filter
- (function {desc=Tconstr(_,[],_)} -> false | _ -> true)
-- (List.map repr tl)
-+ (List.map repr tl @ tl1 @ tl2)
- @ !bound;
-- Reither(c, tl, m, e)
-+ Reither(c, tl, m, List.combine tl1 tl2, e)
- | _ -> fi)
- row.row_fields in
- let name =
-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 2 Feb 2006 06:28:32 -0000
-@@ -340,7 +340,7 @@
- let fi = filter_row_fields erase fi in
- match row_field_repr f with
- Rabsent -> fi
-- | Reither(_,_,false,e) when erase -> set_row_field e Rabsent; fi
-+ | Reither(_,_,false,_,e) when erase -> set_row_field e Rabsent; fi
- | _ -> p :: fi
-
- (**************************************)
-@@ -1286,6 +1286,10 @@
-
- module TypeMap = Map.Make (TypeOps)
-
-+
-+(* A list of univars which may appear free in a type, but only if generic *)
-+let allowed_univars = ref TypeSet.empty
-+
- (* Test the occurence of free univars in a type *)
- (* that's way too expansive. Must do some kind of cacheing *)
- let occur_univar env ty =
-@@ -1307,7 +1311,12 @@
- then
- match ty.desc with
- Tunivar ->
-- if not (TypeSet.mem ty bound) then raise (Unify [ty, newgenvar()])
-+ if TypeSet.mem ty bound then () else
-+ if TypeSet.mem ty !allowed_univars &&
-+ (ty.level = generic_level ||
-+ ty.level = pivot_level - generic_level)
-+ then ()
-+ else raise (Unify [ty, newgenvar()])
- | Tpoly (ty, tyl) ->
- let bound = List.fold_right TypeSet.add (List.map repr tyl) bound in
- occur_rec bound ty
-@@ -1393,6 +1402,7 @@
- with exn -> univar_pairs := old_univars; raise exn
-
- let univar_pairs = ref []
-+let delayed_conditionals = ref []
-
-
- (*****************)
-@@ -1691,9 +1701,11 @@
- with Not_found -> (h,l)::hl)
- (List.map (fun (l,_) -> (hash_variant l, l)) row1.row_fields)
- (List.map fst r2));
-+ let fixed1 = row1.row_fixed || rm1.desc <> Tvar
-+ and fixed2 = row2.row_fixed || rm2.desc <> Tvar in
- let more =
-- if row1.row_fixed then rm1 else
-- if row2.row_fixed then rm2 else
-+ if fixed1 then rm1 else
-+ if fixed2 then rm2 else
- newgenvar ()
- in update_level env (min rm1.level rm2.level) more;
- let fixed = row1.row_fixed || row2.row_fixed
-@@ -1726,18 +1738,18 @@
- let bound = row1.row_bound @ row2.row_bound in
- let row0 = {row_fields = []; row_more = more; row_bound = bound;
- row_closed = closed; row_fixed = fixed; row_name = name} in
-- let set_more row rest =
-+ let set_more row row_fixed rest =
- let rest =
- if closed then
- filter_row_fields row.row_closed rest
- else rest in
-- if rest <> [] && (row.row_closed || row.row_fixed)
-- || closed && row.row_fixed && not row.row_closed then begin
-+ if rest <> [] && (row.row_closed || row_fixed)
-+ || closed && row_fixed && not row.row_closed then begin
- let t1 = mkvariant [] true and t2 = mkvariant rest false in
- raise (Unify [if row == row1 then (t1,t2) else (t2,t1)])
- end;
- let rm = row_more row in
-- if row.row_fixed then
-+ if row_fixed then
- if row0.row_more == rm then () else
- if rm.desc = Tvar then link_type rm row0.row_more else
- unify env rm row0.row_more
-@@ -1748,11 +1760,11 @@
- in
- let md1 = rm1.desc and md2 = rm2.desc in
- begin try
-- set_more row1 r2;
-- set_more row2 r1;
-+ set_more row1 fixed1 r2;
-+ set_more row2 fixed2 r1;
- List.iter
- (fun (l,f1,f2) ->
-- try unify_row_field env row1.row_fixed row2.row_fixed l f1 f2
-+ try unify_row_field env fixed1 fixed2 row1 row2 l f1 f2
- with Unify trace ->
- raise (Unify ((mkvariant [l,f1] true,
- mkvariant [l,f2] true) :: trace)))
-@@ -1761,13 +1773,13 @@
- log_type rm1; rm1.desc <- md1; log_type rm2; rm2.desc <- md2; raise exn
- end
-
--and unify_row_field env fixed1 fixed2 l f1 f2 =
-+and unify_row_field env fixed1 fixed2 row1 row2 l f1 f2 =
- let f1 = row_field_repr f1 and f2 = row_field_repr f2 in
- if f1 == f2 then () else
- match f1, f2 with
- Rpresent(Some t1), Rpresent(Some t2) -> unify env t1 t2
- | Rpresent None, Rpresent None -> ()
-- | Reither(c1, tl1, m1, e1), Reither(c2, tl2, m2, e2) ->
-+ | Reither(c1, tl1, m1, tp1, e1), Reither(c2, tl2, m2, tp2, e2) ->
- if e1 == e2 then () else
- let redo =
- (m1 || m2) &&
-@@ -1777,32 +1789,70 @@
- List.iter (unify env t1) tl;
- !e1 <> None || !e2 <> None
- end in
-- if redo then unify_row_field env fixed1 fixed2 l f1 f2 else
-+ let redo =
-+ redo || begin
-+ if tp1 = [] && fixed1 then unify_pairs env tp2;
-+ if tp2 = [] && fixed2 then unify_pairs env tp1;
-+ !e1 <> None || !e2 <> None
-+ end
-+ in
-+ if redo then unify_row_field env fixed1 fixed2 row1 row2 l f1 f2 else
- let tl1 = List.map repr tl1 and tl2 = List.map repr tl2 in
- let rec remq tl = function [] -> []
- | ty :: tl' ->
- if List.memq ty tl then remq tl tl' else ty :: remq tl tl'
- in
- let tl2' = remq tl2 tl1 and tl1' = remq tl1 tl2 in
-+ let repr_pairs = List.map (fun (t1,t2) -> repr t1, repr t2) in
-+ let tp1 = repr_pairs tp1 and tp2 = repr_pairs tp2 in
-+ let rec rempq tp = function [] -> []
-+ | (t1,t2 as p) :: tp' ->
-+ if List.exists (fun (t1',t2') -> t1==t1' && t2==t2') (tp@tp') then
-+ rempq tp tp'
-+ else p :: rempq tp tp'
-+ in
-+ let tp1' =
-+ if fixed2 then begin
-+ delayed_conditionals :=
-+ (!univar_pairs, tp1, l, row2) :: !delayed_conditionals;
-+ []
-+ end else rempq tp2 tp1
-+ and tp2' =
-+ if fixed1 then begin
-+ delayed_conditionals :=
-+ (!univar_pairs, tp2, l, row1) :: !delayed_conditionals;
-+ []
-+ end else rempq tp1 tp2
-+ in
- let e = ref None in
-- let f1' = Reither(c1 || c2, tl1', m1 || m2, e)
-- and f2' = Reither(c1 || c2, tl2', m1 || m2, e) in
-- set_row_field e1 f1'; set_row_field e2 f2';
-- | Reither(_, _, false, e1), Rabsent -> set_row_field e1 f2
-- | Rabsent, Reither(_, _, false, e2) -> set_row_field e2 f1
-+ let f1' = Reither(c1 || c2, tl1', m1 || m2, tp2', e)
-+ and f2' = Reither(c1 || c2, tl2', m1 || m2, tp1', e) in
-+ set_row_field e1 f1'; set_row_field e2 f2'
-+ | Reither(_, _, false, _, e1), Rabsent -> set_row_field e1 f2
-+ | Rabsent, Reither(_, _, false, _, e2) -> set_row_field e2 f1
- | Rabsent, Rabsent -> ()
-- | Reither(false, tl, _, e1), Rpresent(Some t2) when not fixed1 ->
-+ | Reither(false, tl, _, tp, e1), Rpresent(Some t2) when not fixed1 ->
- set_row_field e1 f2;
-- (try List.iter (fun t1 -> unify env t1 t2) tl
-+ begin try
-+ List.iter (fun t1 -> unify env t1 t2) tl;
-+ List.iter (fun (t1,t2) -> unify env t1 t2) tp
-+ with exn -> e1 := None; raise exn
-+ end
-+ | Rpresent(Some t1), Reither(false, tl, _, tp, e2) when not fixed2 ->
-+ set_row_field e2 f1;
-+ begin try
-+ List.iter (unify env t1) tl;
-+ List.iter (fun (t1,t2) -> unify env t1 t2) tp
-+ with exn -> e2 := None; raise exn
-+ end
-+ | Reither(true, [], _, tpl, e1), Rpresent None when not fixed1 ->
-+ set_row_field e1 f2;
-+ (try List.iter (fun (t1,t2) -> unify env t1 t2) tpl
- with exn -> e1 := None; raise exn)
-- | Rpresent(Some t1), Reither(false, tl, _, e2) when not fixed2 ->
-+ | Rpresent None, Reither(true, [], _, tpl, e2) when not fixed2 ->
- set_row_field e2 f1;
-- (try List.iter (unify env t1) tl
-+ (try List.iter (fun (t1,t2) -> unify env t1 t2) tpl
- with exn -> e2 := None; raise exn)
-- | Reither(true, [], _, e1), Rpresent None when not fixed1 ->
-- set_row_field e1 f2
-- | Rpresent None, Reither(true, [], _, e2) when not fixed2 ->
-- set_row_field e2 f1
- | _ -> raise (Unify [])
-
-
-@@ -1920,6 +1970,166 @@
- (* Matching between type schemes *)
- (***********************************)
-
-+(* Forward declaration (order should be reversed...) *)
-+let equal' = ref (fun _ -> failwith "Ctype.equal'")
-+
-+let make_generics_univars tyl =
-+ let polyvars = ref TypeSet.empty in
-+ let rec make_rec ty =
-+ let ty = repr ty in
-+ if ty.level = generic_level then begin
-+ if ty.desc = Tvar then begin
-+ log_type ty;
-+ ty.desc <- Tunivar;
-+ polyvars := TypeSet.add ty !polyvars
-+ end
-+ else if ty.desc = Tunivar then set_level ty (generic_level - 1);
-+ ty.level <- pivot_level - generic_level;
-+ iter_type_expr make_rec ty
-+ end
-+ in
-+ List.iter make_rec tyl;
-+ List.iter unmark_type tyl;
-+ !polyvars
-+
-+(* New version of moregeneral, using unification *)
-+
-+let copy_cond (p,tpl,l,row) =
-+ let row =
-+ match repr (copy (newgenty (Tvariant row))) with
-+ {desc=Tvariant row} -> row
-+ | _ -> assert false
-+ and pairs =
-+ List.map (fun (t1,t2) -> copy t1, copy t2) tpl in
-+ (p, pairs, l, row)
-+
-+let get_row_field l row =
-+ try row_field_repr (List.assoc l (row_repr row).row_fields)
-+ with Not_found -> Rabsent
-+
-+let rec check_conditional_list env cdtls pattvars tpls =
-+ match cdtls with
-+ [] ->
-+ let finished =
-+ List.for_all (fun (_,t1,t2) -> !equal' env false [t1] [t2]) tpls in
-+ if not finished then begin
-+ let polyvars = make_generics_univars pattvars in
-+ delayed_conditionals := [];
-+ allowed_univars := polyvars;
-+ List.iter (fun (pairs, ty1, ty2) -> unify_pairs env ty1 ty2 pairs)
-+ tpls;
-+ check_conditionals env polyvars !delayed_conditionals
-+ end
-+ | (pairs, tpl1, l, row2 as cond) :: cdtls ->
-+ let cont = check_conditional_list env cdtls pattvars in
-+ let tpl1 =
-+ List.filter (fun (t1,t2) -> not (!equal' env false [t1] [t2])) tpl1 in
-+ let included =
-+ List.for_all
-+ (fun (t1,t2) ->
-+ List.exists
-+ (fun (_,t1',t2') -> !equal' env false [t1;t2] [t1';t2'])
-+ tpls)
-+ tpl1 in
-+ if included then cont tpls else
-+ match get_row_field l row2 with
-+ Rpresent _ ->
-+ cont (List.map (fun (t1,t2) -> (pairs,t1,t2)) tpl1 @ tpls)
-+ | Rabsent -> cont tpls
-+ | Reither (c, tl2, _, _, _) ->
-+ cont tpls;
-+ if c && tl2 <> [] then () (* cannot succeed *) else
-+ let (pairs, tpl1, l, row2) = copy_cond cond
-+ and tpls = List.map (fun (p,t1,t2) -> p, copy t1, copy t2) tpls
-+ and pattvars = List.map copy pattvars
-+ and cdtls = List.map copy_cond cdtls in
-+ cleanup_types ();
-+ let tl2, tpl2, e2 =
-+ match get_row_field l row2 with
-+ Reither (c, tl2, _, tpl2, e2) -> tl2, tpl2, e2
-+ | _ -> assert false
-+ in
-+ let snap = Btype.snapshot () in
-+ let ok =
-+ try
-+ begin match tl2 with
-+ [] ->
-+ set_row_field e2 (Rpresent None)
-+ | t::tl ->
-+ set_row_field e2 (Rpresent (Some t));
-+ List.iter (unify env t) tl
-+ end;
-+ List.iter (fun (t1,t2) -> unify_pairs env t1 t2 pairs) tpl2;
-+ true
-+ with exn ->
-+ Btype.backtrack snap;
-+ false
-+ in
-+ (* This is not [cont] : types have been copied *)
-+ if ok then
-+ check_conditional_list env cdtls pattvars
-+ (List.map (fun (t1,t2) -> (pairs,t1,t2)) tpl1 @ tpls)
-+
-+and check_conditionals env polyvars cdtls =
-+ let cdtls = List.map copy_cond cdtls in
-+ let pattvars = ref [] in
-+ TypeSet.iter
-+ (fun ty ->
-+ let ty = repr ty in
-+ match ty.desc with
-+ Tsubst ty ->
-+ let ty = repr ty in
-+ begin match ty.desc with
-+ Tunivar ->
-+ log_type ty;
-+ ty.desc <- Tvar;
-+ pattvars := ty :: !pattvars
-+ | Ttuple [tv;_] ->
-+ if tv.desc = Tunivar then
-+ (log_type tv; tv.desc <- Tvar; pattvars := ty :: !pattvars)
-+ else if tv.desc <> Tvar then assert false
-+ | Tvar -> ()
-+ | _ -> assert false
-+ end
-+ | _ -> ())
-+ polyvars;
-+ cleanup_types ();
-+ check_conditional_list env cdtls !pattvars []
-+
-+
-+(* Must empty univar_pairs first *)
-+let unify_poly env polyvars subj patt =
-+ let old_level = !current_level in
-+ current_level := generic_level;
-+ delayed_conditionals := [];
-+ allowed_univars := polyvars;
-+ try
-+ unify env subj patt;
-+ check_conditionals env polyvars !delayed_conditionals;
-+ current_level := old_level;
-+ allowed_univars := TypeSet.empty;
-+ delayed_conditionals := []
-+ with exn ->
-+ current_level := old_level;
-+ allowed_univars := TypeSet.empty;
-+ delayed_conditionals := [];
-+ raise exn
-+
-+let moregeneral env _ subj patt =
-+ let old_level = !current_level in
-+ current_level := generic_level;
-+ let subj = instance subj
-+ and patt = instance patt in
-+ let polyvars = make_generics_univars [patt] in
-+ current_level := old_level;
-+ let snap = Btype.snapshot () in
-+ try
-+ unify_poly env polyvars subj patt;
-+ true
-+ with Unify _ ->
-+ Btype.backtrack snap;
-+ false
-+
- (*
- Update the level of [ty]. First check that the levels of generic
- variables from the subject are not lowered.
-@@ -2072,35 +2282,101 @@
- Rpresent(Some t1), Rpresent(Some t2) ->
- moregen inst_nongen type_pairs env t1 t2
- | Rpresent None, Rpresent None -> ()
-- | Reither(false, tl1, _, e1), Rpresent(Some t2) when not univ ->
-+ | Reither(false, tl1, _, [], e1), Rpresent(Some t2) when not univ ->
- set_row_field e1 f2;
- List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2) tl1
-- | Reither(c1, tl1, _, e1), Reither(c2, tl2, m2, e2) ->
-+ | Reither(c1, tl1, _, tpl1, e1), Reither(c2, tl2, m2, tpl2, e2) ->
- if e1 != e2 then begin
- if c1 && not c2 then raise(Unify []);
-- set_row_field e1 (Reither (c2, [], m2, e2));
-- if List.length tl1 = List.length tl2 then
-- List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
-- else match tl2 with
-- t2 :: _ ->
-+ let tpl' = if tpl1 = [] then tpl2 else [] in
-+ set_row_field e1 (Reither (c2, [], m2, tpl', e2));
-+ begin match tl2 with
-+ [t2] ->
- List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2)
- tl1
-- | [] ->
-- if tl1 <> [] then raise (Unify [])
-+ | _ ->
-+ if List.length tl1 <> List.length tl2 then raise (Unify []);
-+ List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
-+ end;
-+ if tpl1 <> [] then
-+ delayed_conditionals :=
-+ (!univar_pairs, tpl1, l, row2) :: !delayed_conditionals
- end
-- | Reither(true, [], _, e1), Rpresent None when not univ ->
-+ | Reither(true, [], _, [], e1), Rpresent None when not univ ->
- set_row_field e1 f2
-- | Reither(_, _, _, e1), Rabsent when not univ ->
-+ | Reither(_, _, _, [], e1), Rabsent when not univ ->
- set_row_field e1 f2
- | Rabsent, Rabsent -> ()
- | _ -> raise (Unify []))
- pairs
-
-+let check_conditional env (pairs, tpl1, l, row2) tpls cont =
-+ let tpl1 =
-+ List.filter (fun (t1,t2) -> not (!equal' env false [t1] [t2])) tpl1 in
-+ let included =
-+ List.for_all
-+ (fun (t1,t2) ->
-+ List.exists (fun (t1',t2') -> !equal' env false [t1;t2] [t1';t2'])
-+ tpls)
-+ tpl1 in
-+ if tpl1 = [] || included then cont tpls else
-+ match get_row_field l row2 with
-+ Rpresent _ -> cont (tpl1 @ tpls)
-+ | Rabsent -> cont tpls
-+ | Reither (c, tl2, _, tpl2, e2) ->
-+ if not c || tl2 = [] then begin
-+ let snap = Btype.snapshot () in
-+ let ok =
-+ try
-+ begin match tl2 with
-+ [] ->
-+ set_row_field e2 (Rpresent None)
-+ | t::tl ->
-+ set_row_field e2 (Rpresent (Some t));
-+ List.iter (unify env t) tl
-+ end;
-+ List.iter (fun (t1,t2) -> unify_pairs env t1 t2 pairs) tpl2;
-+ true
-+ with Unify _ -> false
-+ in
-+ if ok then cont (tpl1 @ tpls);
-+ Btype.backtrack snap
-+ end;
-+ cont tpls
-+
-+let rec check_conditionals inst_nongen env cdtls tpls =
-+ match cdtls with
-+ [] ->
-+ let tpls =
-+ List.filter (fun (t1,t2) -> not (!equal' env false [t1] [t2])) tpls in
-+ if tpls = [] then () else begin
-+ delayed_conditionals := [];
-+ let tl1, tl2 = List.split tpls in
-+ let type_pairs = TypePairs.create 13 in
-+ List.iter2 (moregen false type_pairs env) tl2 tl1;
-+ check_conditionals inst_nongen env !delayed_conditionals []
-+ end
-+ | cdtl :: cdtls ->
-+ check_conditional env cdtl tpls
-+ (check_conditionals inst_nongen env cdtls)
-+
-+
- (* Must empty univar_pairs first *)
- let moregen inst_nongen type_pairs env patt subj =
- univar_pairs := [];
-- moregen inst_nongen type_pairs env patt subj
-+ delayed_conditionals := [];
-+ try
-+ moregen inst_nongen type_pairs env patt subj;
-+ check_conditionals inst_nongen env !delayed_conditionals [];
-+ univar_pairs := [];
-+ delayed_conditionals := []
-+ with exn ->
-+ univar_pairs := [];
-+ delayed_conditionals := [];
-+ raise exn
-+
-
-+(* old implementation
- (*
- Non-generic variable can be instanciated only if [inst_nongen] is
- true. So, [inst_nongen] should be set to false if the subject might
-@@ -2128,6 +2404,7 @@
- in
- current_level := old_level;
- res
-+*)
-
-
- (* Alternative approach: "rigidify" a type scheme,
-@@ -2296,30 +2573,36 @@
- {desc=Tvariant row2} -> eqtype_row rename type_pairs subst env row1 row2
- | _ -> raise Cannot_expand
- with Cannot_expand ->
-+ let eqtype_rec = eqtype rename type_pairs subst env in
- let row1 = row_repr row1 and row2 = row_repr row2 in
- let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
- if row1.row_closed <> row2.row_closed
- || not row1.row_closed && (r1 <> [] || r2 <> [])
- || filter_row_fields false (r1 @ r2) <> []
- then raise (Unify []);
-- if not (static_row row1) then
-- eqtype rename type_pairs subst env row1.row_more row2.row_more;
-+ if not (static_row row1) then eqtype_rec row1.row_more row2.row_more;
- List.iter
- (fun (_,f1,f2) ->
- match row_field_repr f1, row_field_repr f2 with
- Rpresent(Some t1), Rpresent(Some t2) ->
-- eqtype rename type_pairs subst env t1 t2
-- | Reither(true, [], _, _), Reither(true, [], _, _) ->
-- ()
-- | Reither(false, t1::tl1, _, _), Reither(false, t2::tl2, _, _) ->
-- eqtype rename type_pairs subst env t1 t2;
-+ eqtype_rec t1 t2
-+ | Reither(true, [], _, tp1, _), Reither(true, [], _, tp2, _) ->
-+ List.iter2
-+ (fun (t1,t1') (t2,t2') -> eqtype_rec t1 t2; eqtype_rec t1' t2')
-+ tp1 tp2
-+ | Reither(false, t1::tl1, _, tpl1, _),
-+ Reither(false, t2::tl2, _, tpl2, _) ->
-+ eqtype_rec t1 t2;
-+ List.iter2
-+ (fun (t1,t1') (t2,t2') -> eqtype_rec t1 t2; eqtype_rec t1' t2')
-+ tpl1 tpl2;
- if List.length tl1 = List.length tl2 then
- (* if same length allow different types (meaning?) *)
-- List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
-+ List.iter2 eqtype_rec tl1 tl2
- else begin
- (* otherwise everything must be equal *)
-- List.iter (eqtype rename type_pairs subst env t1) tl2;
-- List.iter (fun t1 -> eqtype rename type_pairs subst env t1 t2) tl1
-+ List.iter (eqtype_rec t1) tl2;
-+ List.iter (fun t1 -> eqtype_rec t1 t2) tl1
- end
- | Rpresent None, Rpresent None -> ()
- | Rabsent, Rabsent -> ()
-@@ -2334,6 +2617,8 @@
- with
- Unify _ -> false
-
-+let () = equal' := equal
-+
- (* Must empty univar_pairs first *)
- let eqtype rename type_pairs subst env t1 t2 =
- univar_pairs := [];
-@@ -2770,14 +3055,14 @@
- (fun (l,f as orig) -> match row_field_repr f with
- Rpresent None ->
- if posi then
-- (l, Reither(true, [], false, ref None)), Unchanged
-+ (l, Reither(true, [], false, [], ref None)), Unchanged
- else
- orig, Unchanged
- | Rpresent(Some t) ->
- let (t', c) = build_subtype env visited loops posi level' t in
- if posi && level > 0 then begin
- bound := t' :: !bound;
-- (l, Reither(false, [t'], false, ref None)), c
-+ (l, Reither(false, [t'], false, [], ref None)), c
- end else
- (l, Rpresent(Some t')), c
- | _ -> assert false)
-@@ -2960,11 +3245,11 @@
- List.fold_left
- (fun cstrs (_,f1,f2) ->
- match row_field_repr f1, row_field_repr f2 with
-- (Rpresent None|Reither(true,_,_,_)), Rpresent None ->
-+ (Rpresent None|Reither(true,_,_,[],_)), Rpresent None ->
- cstrs
- | Rpresent(Some t1), Rpresent(Some t2) ->
- subtype_rec env ((t1, t2)::trace) t1 t2 cstrs
-- | Reither(false, t1::_, _, _), Rpresent(Some t2) ->
-+ | Reither(false, t1::_, _, [], _), Rpresent(Some t2) ->
- subtype_rec env ((t1, t2)::trace) t1 t2 cstrs
- | Rabsent, _ -> cstrs
- | _ -> raise Exit)
-@@ -2977,11 +3262,11 @@
- (fun cstrs (_,f1,f2) ->
- match row_field_repr f1, row_field_repr f2 with
- Rpresent None, Rpresent None
-- | Reither(true,[],_,_), Reither(true,[],_,_)
-+ | Reither(true,[],_,[],_), Reither(true,[],_,[],_)
- | Rabsent, Rabsent ->
- cstrs
- | Rpresent(Some t1), Rpresent(Some t2)
-- | Reither(false,[t1],_,_), Reither(false,[t2],_,_) ->
-+ | Reither(false,[t1],_,[],_), Reither(false,[t2],_,[],_) ->
- subtype_rec env ((t1, t2)::trace) t1 t2 cstrs
- | _ -> raise Exit)
- cstrs pairs
-@@ -3079,16 +3364,26 @@
- let fields = List.map
- (fun (l,f) ->
- let f = row_field_repr f in l,
-- match f with Reither(b, ty::(_::_ as tyl), m, e) ->
-- let tyl' =
-- List.fold_left
-- (fun tyl ty ->
-- if List.exists (fun ty' -> equal env false [ty] [ty']) tyl
-- then tyl else ty::tyl)
-- [ty] tyl
-+ match f with Reither(b, tyl, m, tp, e) ->
-+ let rem_dbl eq l =
-+ List.rev
-+ (List.fold_left
-+ (fun xs x -> if List.exists (eq x) xs then xs else x::xs)
-+ [] l)
-+ in
-+ let tyl' = rem_dbl (fun t1 t2 -> equal env false [t1] [t2]) tyl
-+ and tp' =
-+ List.filter
-+ (fun (ty1,ty2) -> not (equal env false [ty1] [ty2])) tp
-+ in
-+ let tp' =
-+ rem_dbl
-+ (fun (t1,t2) (t1',t2') -> equal env false [t1;t2] [t1';t2'])
-+ tp'
- in
-- if List.length tyl' <= List.length tyl then
-- let f = Reither(b, List.rev tyl', m, ref None) in
-+ if List.length tyl' < List.length tyl
-+ || List.length tp' < List.length tp then
-+ let f = Reither(b, tyl', m, tp', ref None) in
- set_row_field e f;
- f
- else f
-@@ -3344,9 +3639,9 @@
- List.iter
- (fun (l,fi) ->
- match row_field_repr fi with
-- Reither (c, t1::(_::_ as tl), m, e) ->
-+ Reither (c, t1::(_::_ as tl), m, tp, e) ->
- List.iter (unify env t1) tl;
-- set_row_field e (Reither (c, [t1], m, ref None))
-+ set_row_field e (Reither (c, [t1], m, tp, ref None))
- | _ ->
- ())
- row.row_fields;
-Index: typing/includecore.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/includecore.ml,v
-retrieving revision 1.32
-diff -u -r1.32 includecore.ml
---- typing/includecore.ml 8 Aug 2005 05:40:52 -0000 1.32
-+++ typing/includecore.ml 2 Feb 2006 06:28:32 -0000
-@@ -71,10 +71,10 @@
- (fun (_, f1, f2) ->
- match Btype.row_field_repr f1, Btype.row_field_repr f2 with
- Rpresent(Some t1),
-- (Rpresent(Some t2) | Reither(false, [t2], _, _)) ->
-+ (Rpresent(Some t2) | Reither(false,[t2],_,[],_)) ->
- to_equal := (t1,t2) :: !to_equal; true
-- | Rpresent None, (Rpresent None | Reither(true, [], _, _)) -> true
-- | Reither(c1,tl1,_,_), Reither(c2,tl2,_,_)
-+ | Rpresent None, (Rpresent None | Reither(true,[],_,[],_)) -> true
-+ | Reither(c1,tl1,_,[],_), Reither(c2,tl2,_,[],_)
- when List.length tl1 = List.length tl2 && c1 = c2 ->
- to_equal := List.combine tl1 tl2 @ !to_equal; true
- | Rabsent, (Reither _ | Rabsent) -> true
-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 2 Feb 2006 06:28:33 -0000
-@@ -223,14 +223,18 @@
- print_fields rest ppf []
- | (s, t) :: l ->
- fprintf ppf "%s : %a;@ %a" s print_out_type t (print_fields rest) l
--and print_row_field ppf (l, opt_amp, tyl) =
-+and print_row_field ppf (l, opt_amp, tyl, tpl) =
- let pr_of ppf =
- if opt_amp then fprintf ppf " of@ &@ "
- else if tyl <> [] then fprintf ppf " of@ "
-- else fprintf ppf ""
-- in
-- fprintf ppf "@[<hv 2>`%s%t%a@]" l pr_of (print_typlist print_out_type " &")
-- tyl
-+ and pr_tp ppf (t1,t2) =
-+ fprintf ppf "@[<hv 2>%a =@ %a@]"
-+ print_out_type t1
-+ print_out_type t2
-+ in
-+ fprintf ppf "@[<hv 2>`%s%t%a%a@]" l pr_of
-+ (print_typlist print_out_type " &") tyl
-+ (print_list_init pr_tp (fun ppf -> fprintf ppf " &@ ")) tpl
- and print_typlist print_elem sep ppf =
- function
- [] -> ()
-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 2 Feb 2006 06:28:33 -0000
-@@ -61,7 +61,8 @@
- bool * out_variant * bool * (string list) option
- | Otyp_poly of string list * out_type
- and out_variant =
-- | Ovar_fields of (string * bool * out_type list) list
-+ | Ovar_fields of
-+ (string * bool * out_type list * (out_type * out_type) list ) list
- | Ovar_name of out_ident * out_type list
-
- type out_class_type =
-Index: typing/parmatch.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/parmatch.ml,v
-retrieving revision 1.70
-diff -u -r1.70 parmatch.ml
---- typing/parmatch.ml 24 Mar 2005 17:20:54 -0000 1.70
-+++ typing/parmatch.ml 2 Feb 2006 06:28:33 -0000
-@@ -568,11 +568,11 @@
- List.fold_left
- (fun nm (tag,f) ->
- match Btype.row_field_repr f with
-- | Reither(_, _, false, e) ->
-+ | Reither(_, _, false, _, e) ->
- (* m=false means that this tag is not explicitly matched *)
- Btype.set_row_field e Rabsent;
- None
-- | Rabsent | Reither (_, _, true, _) | Rpresent _ -> nm)
-+ | Rabsent | Reither (_, _, true, _, _) | Rpresent _ -> nm)
- row.row_name row.row_fields in
- if not row.row_closed || nm != row.row_name then begin
- (* this unification cannot fail *)
-@@ -605,8 +605,8 @@
- List.for_all
- (fun (tag,f) ->
- match Btype.row_field_repr f with
-- Rabsent | Reither(_, _, false, _) -> true
-- | Reither (_, _, true, _)
-+ Rabsent | Reither(_, _, false, _, _) -> true
-+ | Reither (_, _, true, _, _)
- (* m=true, do not discard matched tags, rather warn *)
- | Rpresent _ -> List.mem tag fields)
- row.row_fields
-@@ -739,7 +739,7 @@
- match Btype.row_field_repr f with
- Rabsent (* | Reither _ *) -> others
- (* This one is called after erasing pattern info *)
-- | Reither (c, _, _, _) -> make_other_pat tag c :: others
-+ | Reither (c, _, _, _, _) -> make_other_pat tag c :: others
- | Rpresent arg -> make_other_pat tag (arg = None) :: others)
- [] row.row_fields
- with
-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 2 Feb 2006 06:28:33 -0000
-@@ -157,9 +157,12 @@
- and raw_field ppf = function
- Rpresent None -> fprintf ppf "Rpresent None"
- | Rpresent (Some t) -> fprintf ppf "@[<1>Rpresent(Some@,%a)@]" raw_type t
-- | Reither (c,tl,m,e) ->
-- fprintf ppf "@[<hov1>Reither(%b,@,%a,@,%b,@,@[<1>ref%t@])@]" c
-- raw_type_list tl m
-+ | Reither (c,tl,m,tpl,e) ->
-+ fprintf ppf "@[<hov1>Reither(%b,@,%a,@,%b,@,%a,@,@[<1>ref%t@])@]"
-+ c raw_type_list tl m
-+ (raw_list
-+ (fun ppf (t1,t2) ->
-+ fprintf ppf "@[%a,@,%a@]" raw_type t1 raw_type t2)) tpl
- (fun ppf ->
- match !e with None -> fprintf ppf " None"
- | Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f)
-@@ -219,8 +222,9 @@
- List.for_all
- (fun (_, f) ->
- match row_field_repr f with
-- | Reither(c, l, _, _) ->
-- row.row_closed && if c then l = [] else List.length l = 1
-+ | Reither(c, l, _, pl, _) ->
-+ row.row_closed && pl = [] &&
-+ if c then l = [] else List.length l = 1
- | _ -> true)
- row.row_fields
-
-@@ -392,13 +396,16 @@
-
- and tree_of_row_field sch (l, f) =
- match row_field_repr f with
-- | Rpresent None | Reither(true, [], _, _) -> (l, false, [])
-- | Rpresent(Some ty) -> (l, false, [tree_of_typexp sch ty])
-- | Reither(c, tyl, _, _) ->
-- if c (* contradiction: un constructeur constant qui a un argument *)
-- then (l, true, tree_of_typlist sch tyl)
-- else (l, false, tree_of_typlist sch tyl)
-- | Rabsent -> (l, false, [] (* une erreur, en fait *))
-+ | Rpresent None | Reither(true, [], _, [], _) -> (l, false, [], [])
-+ | Rpresent(Some ty) -> (l, false, [tree_of_typexp sch ty], [])
-+ | Reither(c, tyl, _, tpl, _) ->
-+ let ttpl =
-+ List.map
-+ (fun (t1,t2) -> tree_of_typexp sch t1, tree_of_typexp sch t2)
-+ tpl
-+ in
-+ (l, c && tpl = [], tree_of_typlist sch tyl, ttpl)
-+ | Rabsent -> (l, false, [], [] (* une erreur, en fait *))
-
- and tree_of_typlist sch tyl =
- List.map (tree_of_typexp sch) tyl
-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 2 Feb 2006 06:28:33 -0000
-@@ -727,7 +727,7 @@
- {pexp_loc = loc; pexp_desc =
- Pexp_match({pexp_loc = loc; pexp_desc =
- Pexp_ident(Longident.Lident"*opt*")},
-- scases)} in
-+ scases, false)} in
- let sfun =
- {pcl_loc = scl.pcl_loc; pcl_desc =
- Pcl_fun(l, None, {ppat_loc = loc; ppat_desc = Ppat_var"*opt*"},
-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 2 Feb 2006 06:28:33 -0000
-@@ -156,15 +156,21 @@
- let field = row_field tag row in
- begin match field with
- | Rabsent -> assert false
-- | Reither (true, [], _, e) when not row.row_closed ->
-- set_row_field e (Rpresent None)
-- | Reither (false, ty::tl, _, e) when not row.row_closed ->
-+ | Reither (true, [], _, tpl, e) when not row.row_closed ->
-+ set_row_field e (Rpresent None);
-+ List.iter
-+ (fun (t1,t2) -> unify_pat pat.pat_env {pat with pat_type=t1} t2)
-+ tpl
-+ | Reither (false, ty::tl, _, tpl, e) when not row.row_closed ->
- set_row_field e (Rpresent (Some ty));
-+ List.iter
-+ (fun (t1,t2) -> unify_pat pat.pat_env {pat with pat_type=t1} t2)
-+ tpl;
- begin match opat with None -> assert false
- | Some pat -> List.iter (unify_pat pat.pat_env pat) (ty::tl)
- end
-- | Reither (c, l, true, e) when not row.row_fixed ->
-- set_row_field e (Reither (c, [], false, ref None))
-+ | Reither (c, l, true, tpl, e) when not row.row_fixed ->
-+ set_row_field e (Reither (c, [], false, [], ref None))
- | _ -> ()
- end;
- (* Force check of well-formedness *)
-@@ -307,13 +313,13 @@
- match row_field_repr f with
- Rpresent None ->
- (l,None) :: pats,
-- (l, Reither(true,[], true, ref None)) :: fields
-+ (l, Reither(true,[], true, [], ref None)) :: fields
- | Rpresent (Some ty) ->
- bound := ty :: !bound;
- (l, Some {pat_desc=Tpat_any; pat_loc=Location.none; pat_env=env;
- pat_type=ty})
- :: pats,
-- (l, Reither(false, [ty], true, ref None)) :: fields
-+ (l, Reither(false, [ty], true, [], ref None)) :: fields
- | _ -> pats, fields)
- ([],[]) fields in
- let row =
-@@ -337,6 +343,18 @@
- pat pats in
- rp { r with pat_loc = loc }
-
-+let rec flatten_or_pat pat =
-+ match pat.pat_desc with
-+ Tpat_or (p1, p2, _) ->
-+ flatten_or_pat p1 @ flatten_or_pat p2
-+ | _ ->
-+ [pat]
-+
-+let all_variants pat =
-+ List.for_all
-+ (function {pat_desc=Tpat_variant _} -> true | _ -> false)
-+ (flatten_or_pat pat)
-+
- let rec find_record_qual = function
- | [] -> None
- | (Longident.Ldot (modname, _), _) :: _ -> Some modname
-@@ -423,7 +441,7 @@
- let arg = may_map (type_pat env) sarg in
- let arg_type = match arg with None -> [] | Some arg -> [arg.pat_type] in
- let row = { row_fields =
-- [l, Reither(arg = None, arg_type, true, ref None)];
-+ [l, Reither(arg = None, arg_type, true, [], ref None)];
- row_bound = arg_type;
- row_closed = false;
- row_more = newvar ();
-@@ -788,7 +806,7 @@
- newty (Tarrow(p, type_option (newvar ()), type_approx env e, Cok))
- | Pexp_function (p,_,(_,e)::_) ->
- newty (Tarrow(p, newvar (), type_approx env e, Cok))
-- | Pexp_match (_, (_,e)::_) -> type_approx env e
-+ | Pexp_match (_, (_,e)::_, false) -> type_approx env e
- | Pexp_try (e, _) -> type_approx env e
- | Pexp_tuple l -> newty (Ttuple(List.map (type_approx env) l))
- | Pexp_ifthenelse (_,e,_) -> type_approx env e
-@@ -939,17 +957,26 @@
- exp_loc = sexp.pexp_loc;
- exp_type = ty_res;
- exp_env = env }
-- | Pexp_match(sarg, caselist) ->
-+ | Pexp_match(sarg, caselist, multi) ->
- let arg = type_exp env sarg in
- let ty_res = newvar() in
- let cases, partial =
-- type_cases env arg.exp_type ty_res (Some sexp.pexp_loc) caselist
-+ type_cases env arg.exp_type ty_res (Some sexp.pexp_loc) caselist ~multi
- in
- re {
- exp_desc = Texp_match(arg, cases, partial);
- exp_loc = sexp.pexp_loc;
- exp_type = ty_res;
- exp_env = env }
-+ | Pexp_multifun caselist ->
-+ let ty_arg = newvar() and ty_res = newvar() in
-+ let cases, partial =
-+ type_cases env ty_arg ty_res (Some sexp.pexp_loc) caselist ~multi:true
-+ in
-+ { exp_desc = Texp_function (cases, partial);
-+ exp_loc = sexp.pexp_loc;
-+ exp_type = newty (Tarrow ("", ty_arg, ty_res, Cok));
-+ exp_env = env }
- | Pexp_try(sbody, caselist) ->
- let body = type_exp env sbody in
- let cases, _ =
-@@ -1758,7 +1785,7 @@
- {pexp_loc = loc; pexp_desc =
- Pexp_match({pexp_loc = loc; pexp_desc =
- Pexp_ident(Longident.Lident"*opt*")},
-- scases)} in
-+ scases, false)} in
- let sfun =
- {pexp_loc = sexp.pexp_loc; pexp_desc =
- Pexp_function(l, None,[{ppat_loc = loc; ppat_desc = Ppat_var"*opt*"},
-@@ -1864,7 +1891,8 @@
-
- (* Typing of match cases *)
-
--and type_cases ?in_function env ty_arg ty_res partial_loc caselist =
-+and type_cases ?in_function ?(multi=false)
-+ env ty_arg ty_res partial_loc caselist =
- let ty_arg' = newvar () in
- let pattern_force = ref [] in
- let pat_env_list =
-@@ -1898,10 +1926,64 @@
- let cases =
- List.map2
- (fun (pat, ext_env) (spat, sexp) ->
-- let exp = type_expect ?in_function ext_env sexp ty_res in
-- (pat, exp))
-- pat_env_list caselist
-- in
-+ let add_variant_case lab row ty_res ty_res' =
-+ let fi = List.assoc lab (row_repr row).row_fields in
-+ begin match row_field_repr fi with
-+ Reither (c, _, m, _, e) ->
-+ let row' =
-+ { row_fields =
-+ [lab, Reither(c,[],false,[ty_res,ty_res'], ref None)];
-+ row_more = newvar (); row_bound = [ty_res; ty_res'];
-+ row_closed = false; row_fixed = false; row_name = None }
-+ in
-+ unify_pat ext_env {pat with pat_type= newty (Tvariant row)}
-+ (newty (Tvariant row'))
-+ | _ ->
-+ unify_exp ext_env
-+ { exp_desc = Texp_tuple []; exp_type = ty_res;
-+ exp_env = ext_env; exp_loc = sexp.pexp_loc }
-+ ty_res'
-+ end
-+ in
-+ pat,
-+ match pat.pat_desc with
-+ _ when multi && all_variants pat ->
-+ let ty_res' = newvar () in
-+ List.iter
-+ (function {pat_desc=Tpat_variant(lab,_,row)} ->
-+ add_variant_case lab row ty_res ty_res'
-+ | _ -> assert false)
-+ (flatten_or_pat pat);
-+ type_expect ?in_function ext_env sexp ty_res'
-+ | Tpat_alias (p, id) when multi && all_variants p ->
-+ let vd = Env.find_value (Path.Pident id) ext_env in
-+ let row' =
-+ match repr vd.val_type with
-+ {desc=Tvariant row'} -> row'
-+ | _ -> assert false
-+ in
-+ begin_def ();
-+ let tv = newvar () in
-+ let env = Env.add_value id {vd with val_type=tv} ext_env in
-+ let exp = type_exp env sexp in
-+ end_def ();
-+ generalize exp.exp_type;
-+ generalize tv;
-+ List.iter
-+ (function {pat_desc=Tpat_variant(lab,_,row)}, [tv'; ty'] ->
-+ let fi' = List.assoc lab (row_repr row').row_fields in
-+ let row' =
-+ {row' with row_fields=[lab,fi']; row_more=newvar()} in
-+ unify_pat ext_env {pat with pat_type=tv'}
-+ (newty (Tvariant row'));
-+ add_variant_case lab row ty_res ty'
-+ | _ -> assert false)
-+ (List.map (fun p -> p, instance_list [tv; exp.exp_type])
-+ (flatten_or_pat p));
-+ {exp with exp_type = instance exp.exp_type}
-+ | _ ->
-+ type_expect ?in_function ext_env sexp ty_res)
-+ pat_env_list caselist in
- let partial =
- match partial_loc with None -> Partial
- | Some loc -> Parmatch.check_partial loc cases
-Index: typing/typedecl.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typedecl.ml,v
-retrieving revision 1.75
-diff -u -r1.75 typedecl.ml
---- typing/typedecl.ml 16 Aug 2005 00:48:56 -0000 1.75
-+++ typing/typedecl.ml 2 Feb 2006 06:28:33 -0000
-@@ -432,8 +432,10 @@
- match Btype.row_field_repr f with
- Rpresent (Some ty) ->
- compute_same ty
-- | Reither (_, tyl, _, _) ->
-- List.iter compute_same tyl
-+ | Reither (_, tyl, _, tpl, _) ->
-+ List.iter compute_same tyl;
-+ List.iter (compute_variance_rec true true true)
-+ (List.map fst tpl @ List.map snd tpl)
- | _ -> ())
- row.row_fields;
- compute_same row.row_more
-@@ -856,8 +858,8 @@
- explain row.row_fields
- (fun (l,f) -> match Btype.row_field_repr f with
- Rpresent (Some t) -> t
-- | Reither (_,[t],_,_) -> t
-- | Reither (_,tl,_,_) -> Btype.newgenty (Ttuple tl)
-+ | Reither (_,[t],_,_,_) -> t
-+ | Reither (_,tl,_,_,_) -> Btype.newgenty (Ttuple tl)
- | _ -> Btype.newgenty (Ttuple[]))
- "case" (fun (lab,_) -> "`" ^ lab ^ " of ")
- | _ -> trivial ty'
-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 2 Feb 2006 06:28:33 -0000
-@@ -48,7 +48,9 @@
-
- and row_field =
- Rpresent of type_expr option
-- | Reither of bool * type_expr list * bool * row_field option ref
-+ | Reither of
-+ bool * type_expr list * bool *
-+ (type_expr * type_expr) list * row_field option ref
- | Rabsent
-
- and abbrev_memo =
-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 2 Feb 2006 06:28:33 -0000
-@@ -47,7 +47,9 @@
-
- and row_field =
- Rpresent of type_expr option
-- | Reither of bool * type_expr list * bool * row_field option ref
-+ | Reither of
-+ bool * type_expr list * bool *
-+ (type_expr * type_expr) list * row_field option ref
- (* 1st true denotes a constant constructor *)
- (* 2nd true denotes a tag in a pattern matching, and
- is erased later *)
-Index: typing/typetexp.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typetexp.ml,v
-retrieving revision 1.54
-diff -u -r1.54 typetexp.ml
---- typing/typetexp.ml 22 Jul 2005 06:42:36 -0000 1.54
-+++ typing/typetexp.ml 2 Feb 2006 06:28:33 -0000
-@@ -207,9 +207,9 @@
- match Btype.row_field_repr f with
- | Rpresent (Some ty) ->
- bound := ty :: !bound;
-- Reither(false, [ty], false, ref None)
-+ Reither(false, [ty], false, [], ref None)
- | Rpresent None ->
-- Reither (true, [], false, ref None)
-+ Reither (true, [], false, [], ref None)
- | _ -> f)
- row.row_fields
- in
-@@ -273,13 +273,16 @@
- (l, f) :: fields
- in
- let rec add_field fields = function
-- Rtag (l, c, stl) ->
-+ Rtag (l, c, stl, stpl) ->
- name := None;
- let f = match present with
- Some present when not (List.mem l present) ->
-- let tl = List.map (transl_type env policy) stl in
-- bound := tl @ !bound;
-- Reither(c, tl, false, ref None)
-+ let transl_list = List.map (transl_type env policy) in
-+ let tl = transl_list stl in
-+ let stpl1, stpl2 = List.split stpl in
-+ let tpl1 = transl_list stpl1 and tpl2 = transl_list stpl2 in
-+ bound := tl @ tpl1 @ tpl2 @ !bound;
-+ Reither(c, tl, false, List.combine tpl1 tpl2, ref None)
- | _ ->
- if List.length stl > 1 || c && stl <> [] then
- raise(Error(styp.ptyp_loc, Present_has_conjunction l));
-@@ -311,9 +314,9 @@
- begin match f with
- Rpresent(Some ty) ->
- bound := ty :: !bound;
-- Reither(false, [ty], false, ref None)
-+ Reither(false, [ty], false, [], ref None)
- | Rpresent None ->
-- Reither(true, [], false, ref None)
-+ Reither(true, [], false, [], ref None)
- | _ ->
- assert false
- end
-@@ -406,7 +409,8 @@
- {row with row_fixed=true;
- row_fields = List.map
- (fun (s,f as p) -> match Btype.row_field_repr f with
-- Reither (c, tl, m, r) -> s, Reither (c, tl, true, r)
-+ Reither (c, tl, m, tpl, r) ->
-+ s, Reither (c, tl, true, tpl, r)
- | _ -> p)
- row.row_fields};
- Btype.iter_row make_fixed_univars row
-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 2 Feb 2006 06:28:33 -0000
-@@ -122,9 +122,11 @@
- | Pexp_apply (e, lel) ->
- expression ppf tbl e;
- List.iter (fun (_, e) -> expression ppf tbl e) lel;
-- | Pexp_match (e, pel) ->
-+ | Pexp_match (e, pel, _) ->
- expression ppf tbl e;
- match_pel ppf tbl pel;
-+ | Pexp_multifun pel ->
-+ match_pel ppf tbl pel;
- | Pexp_try (e, pel) ->
- expression ppf tbl e;
- match_pel ppf tbl pel;
-Index: bytecomp/matching.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/bytecomp/matching.ml,v
-retrieving revision 1.67
-diff -u -r1.67 matching.ml
---- bytecomp/matching.ml 7 Sep 2005 16:07:48 -0000 1.67
-+++ bytecomp/matching.ml 2 Feb 2006 06:28:33 -0000
-@@ -1991,7 +1991,7 @@
- List.iter
- (fun (_, f) ->
- match Btype.row_field_repr f with
-- Rabsent | Reither(true, _::_, _, _) -> ()
-+ Rabsent | Reither(true, _::_, _, _, _) -> ()
- | _ -> incr num_constr)
- row.row_fields
- else
-Index: toplevel/genprintval.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/toplevel/genprintval.ml,v
-retrieving revision 1.38
-diff -u -r1.38 genprintval.ml
---- toplevel/genprintval.ml 13 Jun 2005 04:55:53 -0000 1.38
-+++ toplevel/genprintval.ml 2 Feb 2006 06:28:33 -0000
-@@ -293,7 +293,7 @@
- | (l, f) :: fields ->
- if Btype.hash_variant l = tag then
- match Btype.row_field_repr f with
-- | Rpresent(Some ty) | Reither(_,[ty],_,_) ->
-+ | Rpresent(Some ty) | Reither(_,[ty],_,_,_) ->
- let args =
- tree_of_val (depth - 1) (O.field obj 1) ty in
- Oval_variant (l, Some args)
diff --git a/testlabl/multimatch.ml b/testlabl/multimatch.ml
deleted file mode 100644
index 7c9aa73f9..000000000
--- a/testlabl/multimatch.ml
+++ /dev/null
@@ -1,158 +0,0 @@
-(* Simple example *)
-let f x =
- (multimatch x with `A -> 1 | `B -> true),
- (multimatch x with `A -> 1. | `B -> "1");;
-
-(* OK *)
-module M : sig
- val f :
- [< `A & 'a = int & 'b = float | `B & 'b =string & 'a = bool] -> 'a * 'b
-end = struct let f = f end;;
-
-(* Bad *)
-module M : sig
- val f :
- [< `A & 'a = int & 'b = float | `B & 'b =string & 'a = int] -> 'a * 'b
-end = struct let f = f end;;
-
-(* Should be good! *)
-module M : sig
- val f :
- [< `A & 'a = int * float | `B & 'a = bool * string] -> 'a
-end = struct let f = f end;;
-
-let f = multifun `A|`B as x -> f x;;
-
-(* Two-level example *)
-let f = multifun
- `A -> (multifun `C -> 1 | `D -> 1.)
- | `B -> (multifun `C -> true | `D -> "1");;
-
-(* OK *)
-module M : sig
- val f :
- [< `A & 'b = [< `C & 'a = int | `D & 'a = float & 'c = bool] -> 'a
- | `B & 'b = [< `C & 'c = bool | `D & 'c = string] -> 'c] -> 'b
-end = struct let f = f end;;
-
-(* Bad *)
-module M : sig
- val f :
- [< `A & 'b = [< `C & 'a = int | `D & 'a = bool] -> 'a
- | `B & 'b = [< `C & 'c = bool | `D & 'c = string] -> 'c] -> 'b
-end = struct let f = f end;;
-
-module M : sig
- val f :
- [< `A & 'b = [< `C & 'a = int | `D] -> 'a
- | `B & 'b = [< `C & 'c = bool | `D & 'c = string] -> 'c] -> 'b
-end = struct let f = f end;;
-
-
-(* Examples with hidden sharing *)
-let r = ref []
-let f = multifun `A -> 1 | `B -> true
-let g x = r := [f x];;
-
-(* Bad! *)
-module M : sig
- val g : [< `A & 'a = int | `B & 'a = bool] -> unit
-end = struct let g = g end;;
-
-let r = ref []
-let f = multifun `A -> r | `B -> ref [];;
-(* Now OK *)
-module M : sig
- val f : [< `A & 'b = int list ref | `B & 'b = 'c list ref] -> 'b
-end = struct let f = f end;;
-(* Still OK *)
-let l : int list ref = r;;
-module M : sig
- val f : [< `A & 'b = int list ref | `B & 'b = 'c list ref] -> 'b
-end = struct let f = f end;;
-
-
-(* Examples that would need unification *)
-let f = multifun `A -> (1, []) | `B -> (true, [])
-let g x = fst (f x);;
-(* Didn't work, now Ok *)
-module M : sig
- val g : [< `A & 'a * 'b = int * bool | `B & 'a * 'b = bool * int] -> 'a
-end = struct let g = g end;;
-let g = multifun (`A|`B) as x -> g x;;
-
-(* Other examples *)
-
-let f x =
- let a = multimatch x with `A -> 1 | `B -> "1" in
- (multifun `A -> print_int | `B -> print_string) x a
-;;
-
-let f = multifun (`A|`B) as x -> f x;;
-
-type unit_op = [`Set of int | `Move of int]
-type int_op = [`Get]
-
-let op r =
- multifun
- `Get -> !r
- | `Set x -> r := x
- | `Move dx -> r := !r + dx
-;;
-
-let rec trace r = function
- [] -> []
- | op1 :: ops ->
- multimatch op1 with
- #int_op as op1 ->
- let x = op r op1 in
- x :: trace r ops
- | #unit_op as op1 ->
- op r op1;
- trace r ops
-;;
-
-class point x = object
- val mutable x : int = x
- method get = x
- method set y = x <- y
- method move dx = x <- x + dx
-end;;
-
-let poly sort coeffs x =
- let add, mul, zero =
- multimatch sort with
- `Int -> (+), ( * ), 0
- | `Float -> (+.), ( *. ), 0.
- in
- let rec compute = function
- [] -> zero
- | c :: cs -> add c (mul x (compute cs))
- in
- compute coeffs
-;;
-
-module M : sig
- val poly : [< `Int & 'a = int | `Float & 'a = float] -> 'a list -> 'a -> 'a
-end = struct let poly = poly end;;
-
-type ('a,'b) num_sort =
- 'b constraint 'b = [< `Int & 'a = int | `Float & 'a = float]
-module M : sig
- val poly : ('a,_) num_sort -> 'a list -> 'a -> 'a
-end = struct let poly = poly end;;
-
-
-(* type dispatch *)
-
-type num = [ `Int | `Float ]
-let print0 = multifun
- `Int -> print_int
- | `Float -> print_float
-;;
-let print1 = multifun
- #num as x -> print0 x
- | `List t -> List.iter (print0 t)
- | `Pair(t1,t2) -> (fun (x,y) -> print0 t1 x; print0 t2 y)
-;;
-print1 (`Pair(`Int,`Float)) (1,1.0);;
diff --git a/testlabl/newlabels.ps b/testlabl/newlabels.ps
deleted file mode 100644
index 01eac1945..000000000
--- a/testlabl/newlabels.ps
+++ /dev/null
@@ -1,1458 +0,0 @@
-%!PS-Adobe-2.0
-%%Creator: dvipsk 5.78 p1.4 Copyright 1996-98 ASCII Corp.(www-ptex@ascii.co.jp)
-%%dvipsk 5.78 Copyright 1998 Radical Eye Software (www.radicaleye.com)
-%%Title: newlabels.dvi
-%%Pages: 2 0
-%%PageOrder: Ascend
-%%BoundingBox: 0 0 596 842
-%%EndComments
-%%BeginProcSet: PStoPS 1 15
-userdict begin
-[/showpage/erasepage/copypage]{dup where{pop dup load
- type/operatortype eq{1 array cvx dup 0 3 index cvx put
- bind def}{pop}ifelse}{pop}ifelse}forall
-[/letter/legal/executivepage/a4/a4small/b5/com10envelope
- /monarchenvelope/c5envelope/dlenvelope/lettersmall/note
- /folio/quarto/a5]{dup where{dup wcheck{exch{}put}
- {pop{}def}ifelse}{pop}ifelse}forall
-/setpagedevice {pop}bind 1 index where{dup wcheck{3 1 roll put}
- {pop def}ifelse}{def}ifelse
-/PStoPSmatrix matrix currentmatrix def
-/PStoPSxform matrix def/PStoPSclip{clippath}def
-/defaultmatrix{PStoPSmatrix exch PStoPSxform exch concatmatrix}bind def
-/initmatrix{matrix defaultmatrix setmatrix}bind def
-/initclip[{matrix currentmatrix PStoPSmatrix setmatrix
- [{currentpoint}stopped{$error/newerror false put{newpath}}
- {/newpath cvx 3 1 roll/moveto cvx 4 array astore cvx}ifelse]
- {[/newpath cvx{/moveto cvx}{/lineto cvx}
- {/curveto cvx}{/closepath cvx}pathforall]cvx exch pop}
- stopped{$error/errorname get/invalidaccess eq{cleartomark
- $error/newerror false put cvx exec}{stop}ifelse}if}bind aload pop
- /initclip dup load dup type dup/operatortype eq{pop exch pop}
- {dup/arraytype eq exch/packedarraytype eq or
- {dup xcheck{exch pop aload pop}{pop cvx}ifelse}
- {pop cvx}ifelse}ifelse
- {newpath PStoPSclip clip newpath exec setmatrix} bind aload pop]cvx def
-/initgraphics{initmatrix newpath initclip 1 setlinewidth
- 0 setlinecap 0 setlinejoin []0 setdash 0 setgray
- 10 setmiterlimit}bind def
-end
-%%EndProcSet
-%DVIPSCommandLine: dvips -f newlabels
-%DVIPSParameters: dpi=300
-%DVIPSSource: TeX output 1999.10.26:1616
-%%BeginProcSet: tex.pro
-%!
-/TeXDict 300 dict def TeXDict begin /N{def}def /B{bind def}N /S{exch}N
-/X{S N}B /TR{translate}N /isls false N /vsize 11 72 mul N /hsize 8.5 72
-mul N /landplus90{false}def /@rigin{isls{[0 landplus90{1 -1}{-1 1}
-ifelse 0 0 0]concat}if 72 Resolution div 72 VResolution div neg scale
-isls{landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div
-hsize mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul
-TR[matrix currentmatrix{dup dup round sub abs 0.00001 lt{round}if}
-forall round exch round exch]setmatrix}N /@landscape{/isls true N}B
-/@manualfeed{statusdict /manualfeed true put}B /@copies{/#copies X}B
-/FMat[1 0 0 -1 0 0]N /FBB[0 0 0 0]N /nn 0 N /IE 0 N /ctr 0 N /df-tail{
-/nn 8 dict N nn begin /FontType 3 N /FontMatrix fntrx N /FontBBox FBB N
-string /base X array /BitMaps X /BuildChar{CharBuilder}N /Encoding IE N
-end dup{/foo setfont}2 array copy cvx N load 0 nn put /ctr 0 N[}B /df{
-/sf 1 N /fntrx FMat N df-tail}B /dfs{div /sf X /fntrx[sf 0 0 sf neg 0 0]
-N df-tail}B /E{pop nn dup definefont setfont}B /ch-width{ch-data dup
-length 5 sub get}B /ch-height{ch-data dup length 4 sub get}B /ch-xoff{
-128 ch-data dup length 3 sub get sub}B /ch-yoff{ch-data dup length 2 sub
-get 127 sub}B /ch-dx{ch-data dup length 1 sub get}B /ch-image{ch-data
-dup type /stringtype ne{ctr get /ctr ctr 1 add N}if}B /id 0 N /rw 0 N
-/rc 0 N /gp 0 N /cp 0 N /G 0 N /sf 0 N /CharBuilder{save 3 1 roll S dup
-/base get 2 index get S /BitMaps get S get /ch-data X pop /ctr 0 N ch-dx
-0 ch-xoff ch-yoff ch-height sub ch-xoff ch-width add ch-yoff
-setcachedevice ch-width ch-height true[1 0 0 -1 -.1 ch-xoff sub ch-yoff
-.1 sub]{ch-image}imagemask restore}B /D{/cc X dup type /stringtype ne{]}
-if nn /base get cc ctr put nn /BitMaps get S ctr S sf 1 ne{dup dup
-length 1 sub dup 2 index S get sf div put}if put /ctr ctr 1 add N}B /I{
-cc 1 add D}B /bop{userdict /bop-hook known{bop-hook}if /SI save N @rigin
-0 0 moveto /V matrix currentmatrix dup 1 get dup mul exch 0 get dup mul
-add .99 lt{/QV}{/RV}ifelse load def pop pop}N /eop{SI restore userdict
-/eop-hook known{eop-hook}if showpage}N /@start{userdict /start-hook
-known{start-hook}if pop /VResolution X /Resolution X 1000 div /DVImag X
-/IE 256 array N 2 string 0 1 255{IE S dup 360 add 36 4 index cvrs cvn
-put}for pop 65781.76 div /vsize X 65781.76 div /hsize X}N /p{show}N
-/RMat[1 0 0 -1 0 0]N /BDot 260 string N /rulex 0 N /ruley 0 N /v{/ruley
-X /rulex X V}B /V{}B /RV statusdict begin /product where{pop false[
-(Display)(NeXT)(LaserWriter 16/600)]{dup length product length le{dup
-length product exch 0 exch getinterval eq{pop true exit}if}{pop}ifelse}
-forall}{false}ifelse end{{gsave TR -.1 .1 TR 1 1 scale rulex ruley false
-RMat{BDot}imagemask grestore}}{{gsave TR -.1 .1 TR rulex ruley scale 1 1
-false RMat{BDot}imagemask grestore}}ifelse B /QV{gsave newpath transform
-round exch round exch itransform moveto rulex 0 rlineto 0 ruley neg
-rlineto rulex neg 0 rlineto fill grestore}B /a{moveto}B /delta 0 N /tail
-{dup /delta X 0 rmoveto}B /M{S p delta add tail}B /b{S p tail}B /c{-4 M}
-B /d{-3 M}B /e{-2 M}B /f{-1 M}B /g{0 M}B /h{1 M}B /i{2 M}B /j{3 M}B /k{
-4 M}B /w{0 rmoveto}B /l{p -4 w}B /m{p -3 w}B /n{p -2 w}B /o{p -1 w}B /q{
-p 1 w}B /r{p 2 w}B /s{p 3 w}B /t{p 4 w}B /x{0 S rmoveto}B /y{3 2 roll p
-a}B /bos{/SS save N}B /eos{SS restore}B end
-
-%%EndProcSet
-TeXDict begin 39158280 55380996 1000 300 300 (newlabels.dvi)
-@start
-%DVIPSBitmapFont: Fa cmr6 6 2
-/Fa 2 51 df<187898181818181818181818181818FF08107D8F0F> 49
-D<1F00618040C08060C0600060006000C00180030006000C00102020207FC0FFC00B107F
-8F0F> I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fb cmmi8 8 4
-/Fb 4 111 df<FFC0FF1C00181C00101C00101C00103800203800203800203800207000
-40700040700040700040E00080E00080E00080E00080E00100E00200E004006008003830
-000FC00018177E9618> 85 D<0300038003000000000000000000000000001C00240046
-0046008C000C0018001800180031003100320032001C0009177F960C> 105
-D<383C1E0044C6630047028100460301008E0703000C0603000C0603000C060300180C06
-00180C0620180C0C20180C0C40301804C0301807001B0E7F8D1F> 109
-D<383C0044C6004702004602008E06000C06000C06000C0600180C00180C401818401818
-80300980300E00120E7F8D15> I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fc cmbx8 8 4
-/Fc 4 111 df<01800780FF80FF80078007800780078007800780078007800780078007
-800780078007800780FFF8FFF80D157D9414> 49 D<387C7C7C3800000000FCFC3C3C3C
-3C3C3C3C3C3C3C3CFFFF08187F970B> 105 D<FC7E0FC0FD8730E03E07C0F03E07C0F03C
-0780F03C0780F03C0780F03C0780F03C0780F03C0780F03C0780F03C0780F03C0780F0FF
-1FE3FCFF1FE3FC1E0F7E8E23> 109 D<FC7C00FD8E003E0F003E0F003C0F003C0F003C0F
-003C0F003C0F003C0F003C0F003C0F003C0F00FF3FC0FF3FC0120F7E8E17> I
-E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fd cmsy8 8 3
-/Fd 3 93 df<FFFFF0FFFFF014027D881B> 0 D<020002000200C218F2783AE00F800F80
-3AE0F278C2180200020002000D0E7E8E12> 3 D<03F8001FFF003C07806000C0C00060C0
-0060C00060C00060C00060C00060C00060C00060C00060C00060C00060C00060C00060C0
-006040002013137E9218> 92 D E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fe cmtt12 12 43
-/Fe 43 125 df<01818003C3C003C3C003C3C003C3C003C3C003C3C07FFFF0FFFFF8FFFF
-F87FFFF00787800787800787800F8F800F0F000F0F000F0F000F0F007FFFF0FFFFF8FFFF
-F87FFFF01E1E001E1E001E1E001E1E001E1E001E1E000C0C00151E7E9D1A> 35
-D<00E00003F00007F8000738000E1C000E1C000E1C000E1C000E38000E39FC0E71FC07F1
-FC07E1C007C1C00781C00783800F83801FC3803DC70078E70070EE00E07E00E07E00E03C
-08E03C1CE07E1C70FF1C7FE7F83FC3F80F00E0161E7F9D1A> 38
-D<0038007800F001E003C007800F000E001C001C0038003800700070007000E000E000E0
-00E000E000E000E000E000E000E000700070007000380038001C001C000E000F00078003
-C001E000F8007800380D2878A21A> 40 D<6000F00078003C001E000F000780038001C0
-01C000E000E0007000700070003800380038003800380038003800380038003800700070
-007000E000E001C001C0038007800F001E003C007800F00060000D287CA21A> I<7FFFC0
-FFFFE0FFFFE07FFFC013047D901A> 45 D<00C001C001C003C007C00FC07FC0FDC071C0
-01C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C0
-7FFF7FFF7FFF101E7B9D1A> 49 D<03F8000FFE001FFF803C07C07801E07000E0E00070
-F00070F000706000700000700000700000E00000E00001C00003C0000780000F00001E00
-003C0000780000F00003E00007C0000F00001E00703C00707FFFF0FFFFF07FFFF0141E7D
-9D1A> I<03FC000FFF003FFFC03C03E07800E07800707800700000700000700000E00001
-E00007C003FF8003FF0003FFC00003E00000E0000070000078000038000038600038F000
-38F00078E000707000E07E03E03FFFC00FFF0001FC00151E7E9D1A> I<01FC0007FF001F
-FFC01F07C03C01E07800F07000707000707000707800F03800E01E03C00FFF8003FE0007
-FF001F8FC03C01E07800F0700070E00038E00038E00038E00038F000787000707800F03E
-03E01FFFC007FF0001FC00151E7E9D1A> 56 D<01F00007FC001FFE003E0F0038078070
-03807001C0E001C0E001C0E001E0E000E0E000E0E001E07001E07803E03C0FE01FFFE00F
-FCE003F0E00001C00001C00001C0000380600380F00700F00F00F03E007FFC003FF0000F
-C000131E7D9D1A> I<3078FCFC78300000000000000000003078FCFC7830061576941A>
-I<183C7E7E3C18000000000000000000183C7E7E3E1E0E0E1C3CF8F060071C77941A> I<
-0000C00003E00007E0000FC0003F80007E0000FC0003F80007E0000FC0003F80007E0000
-FC0000FC00007E00003F80000FC00007E00003F80000FC00007E00003F80000FC00007E0
-0003E00000C0131A7D9B1A> I<7FFFF0FFFFF8FFFFF87FFFF00000000000000000000000
-007FFFF0FFFFF8FFFFF87FFFF0150C7E941A> I<600000F80000FC00007E00003F80000F
-C00007E00003F80000FC00007E00003F80000FC00007E00007E0000FC0003F80007E0000
-FC0003F80007E0000FC0003F80007E0000FC0000F80000600000131A7D9B1A> I<007C38
-01FF3807FFF80F83F81E00F81C0078380078380038700038700038700000E00000E00000
-E00000E00000E00000E00000E00000E000007000007000387000383800383800381C0070
-1E00F00F83E007FFC001FF80007C00151E7E9D1A> 67 D<FE03FEFF03FEFF03FE1D8070
-1D80701DC0701CC0701CC0701CE0701CE0701C60701C70701C70701C30701C38701C3870
-1C18701C1C701C1C701C0C701C0E701C0E701C06701C06701C07701C03701C0370FF81F0
-FF81F0FF80F0171E7F9D1A> 78 D<03F8E00FFEE01FFFE03C07E07801E0F001E0E000E0
-E000E0E000E0E000007000007800003F80001FF80007FF00007FC00007E00000F0000070
-000038000038600038E00038E00038E00070F000F0FE01E0FFFFC0EFFF80E1FE00151E7E
-9D1A> 83 D<7FFFFEFFFFFEFFFFFEE0380EE0380EE0380EE0380E003800003800003800
-003800003800003800003800003800003800003800003800003800003800003800003800
-00380000380000380000380000380003FF8003FF8003FF80171E7F9D1A> I<FFFCFFFCFF
-FCE000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E0
-00E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000FFFCFFFCFF
-FC0E2776A21A> 91 D<FFFCFFFCFFFC001C001C001C001C001C001C001C001C001C001C
-001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C
-001C001C001C001C001CFFFCFFFCFFFC0E277FA21A> 93 D<1FF0003FFC007FFE00780F
-00300700000380000380007F8007FF801FFF803F8380780380700380E00380E00380E003
-80700780780F803FFFFC1FFDFC07F0FC16157D941A> 97 D<7E0000FE00007E00000E00
-000E00000E00000E00000E00000E00000E3E000EFF800FFFE00FC1F00F80700F00380E00
-380E001C0E001C0E001C0E001C0E001C0E001C0E001C0F00380F00780F80F00FC1E00FFF
-C00EFF80063E00161E7F9D1A> I<00FF8003FFC00FFFE01F01E03C00C078000070000070
-0000E00000E00000E00000E00000E000007000007000007800703C00701F01F00FFFE003
-FFC000FE0014157D941A> I<000FC0001FC0000FC00001C00001C00001C00001C00001C0
-0001C001F1C007FDC00FFFC01E0FC03C07C07803C07001C0E001C0E001C0E001C0E001C0
-E001C0E001C0E001C07003C07003C03807C03E0FC01FFFF807FDFC01F1F8161E7E9D1A>
-I<01F80007FF000FFF801E07C03C01C07800E07000E0E00070E00070FFFFF0FFFFF0FFFF
-F0E000007000007000007800703C00701F01F00FFFE003FF8000FE0014157D941A> I<00
-07E0001FF0003FF800787800F03000E00000E00000E00000E0007FFFF0FFFFF0FFFFF000
-E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000
-E00000E00000E0003FFF807FFFC03FFF80151E7F9D1A> I<7E0000FE00007E00000E0000
-0E00000E00000E00000E00000E00000E3E000EFF800FFFC00FC1C00F80E00F00E00E00E0
-0E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E07FC3FC
-FFE7FE7FC3FC171E7F9D1A> 104 D<00C00001E00001E00000C000000000000000000000
-0000000000000000007FE0007FE0007FE00000E00000E00000E00000E00000E00000E000
-00E00000E00000E00000E00000E00000E00000E00000E00000E0007FFF80FFFFC07FFF80
-121F7C9E1A> I<7FE000FFE0007FE00000E00000E00000E00000E00000E00000E00000E0
-0000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E0
-0000E00000E00000E00000E00000E0007FFFC0FFFFE07FFFC0131E7D9D1A> 108
-D<7CE0E000FFFBF8007FFFF8001F1F1C001E1E1C001E1E1C001C1C1C001C1C1C001C1C1C
-001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C001C1C1C
-007F1F1F00FFBFBF807F1F1F00191580941A> I<7E3E00FEFF807FFFC00FC1C00F80E00F
-00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E
-00E07FC3FCFFE7FE7FC3FC17157F941A> I<01F00007FC001FFF003E0F803C07807803C0
-7001C0E000E0E000E0E000E0E000E0E000E0E000E0F001E07001C07803C03C07803E0F80
-1FFF0007FC0001F00013157D941A> I<7E3E00FEFF807FFFE00FC1F00F80700F00380E00
-380E001C0E001C0E001C0E001C0E001C0E001C0E001C0F00380F00780F80F00FC1E00FFF
-C00EFF800E3E000E00000E00000E00000E00000E00000E00000E00000E00007FC000FFE0
-007FC00016207F941A> I<7F81F8FF8FFC7F9FFE03FE1E03F80C03E00003E00003C00003
-80000380000380000380000380000380000380000380000380000380007FFF00FFFF007F
-FF0017157F941A> 114 D<07FB801FFF807FFF80780780E00380E00380E003807800007F
-C0001FFC0007FE00003F800007806001C0E001C0E001C0F003C0FC0780FFFF00EFFE00E3
-F80012157C941A> I<0180000380000380000380000380000380000380007FFFE0FFFFE0
-FFFFE0038000038000038000038000038000038000038000038000038000038000038070
-03807003807003807001C1E001FFE000FF80003F00141C7F9B1A> I<7E07E0FE0FE07E07
-E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00E00
-E00E00E00E01E00F03E007FFFC03FFFE00FCFC17157F941A> I<7F83FCFFC7FE7F83FC0E
-00E00E00E00E00E00701C00701C00701C003838003838003838001C70001C70001C70000
-EE0000EE0000EE00007C00007C0000380017157F941A> I<FF83FEFF83FEFF83FE380038
-3800381C00701C00701C00701C38701C7C701C7C700C6C600EEEE00EEEE00EEEE00EEEE0
-0EC6E006C6C007C7C00783C00783C017157F941A> I<7FC7F87FCFFC7FC7F80703C00383
-8003C70001EF0000FE00007C00007800003800007C0000EE0001EE0001C7000383800783
-C00F01C07FC7FCFFC7FE7FC7FC17157F941A> I<7F83FCFFC7FE7F83FC0E00E00E00E007
-00E00701C00701C00381C003838003C38001C38001C70000E70000E70000E60000660000
-6E00003C00003C00003C0000380000380000380000700000700030F00078E00071E0007F
-C0003F80001E000017207F941A> I<60F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0
-F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F060042775A21A> 124 D
-E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Ff cmr8 8 3
-/Ff 3 51 df<003000003000003000003000003000003000003000003000003000003000
-003000FFFFFCFFFFFC003000003000003000003000003000003000003000003000003000
-00300000300016187E931B> 43 D<06000E00FE000E000E000E000E000E000E000E000E
-000E000E000E000E000E000E000E000E000E00FFE00B157D9412> 49
-D<0F8030E040708030C038E0384038003800700070006000C00180030006000C08080810
-183FF07FF0FFF00D157E9412> I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fg cmmi12 12 13
-/Fg 13 121 df<0FFFF81FFFFC3FFFF870200040200080200080600000600000600000C0
-0000C00000C00000C00001C0000180000180000380000380000380000700000300001615
-7E9415> 28 D<0000100000002000000020000000200000002000000040000000400000
-004000000040000000800000008000000080000000800000010000000FE00000711C0001
-C10600030203000E0203801C020180180201C0380401C0700401C0700401C0700401C0E0
-080380E0080380E00807006008070070100E0030101C00301038001C10E0000623800001
-FE0000002000000020000000400000004000000040000000400000008000000080000000
-800000008000001A2D7EA21D> 30 D<70F8F8F87005057C840E> 58
-D<70F8FCFC7404040404080810102040060F7C840E> I<00008000018000018000030000
-0300000300000600000600000600000C00000C00000C0000180000180000180000300000
-300000300000600000600000600000C00000C00000C00001800001800001800001800003
-00000300000300000600000600000600000C00000C00000C000018000018000018000030
-0000300000300000600000600000600000C00000C00000C0000011317DA418> 61
-D<00FFFC00000F8000000F0000000F0000001E0000001E0000001E0000001E0000003C00
-00003C0000003C0000003C00000078000000780000007800000078000000F0000000F000
-0000F0000000F0000001E0000001E0000001E0002001E0002003C0004003C0004003C000
-8003C0008007800180078001000780030007800F000F803E00FFFFFE001B227DA121> 76
-D<1FFFFFFE1E01E00E1801E0063001E0062003C0062003C0064003C0044003C004400780
-04800780048007800400078000000F0000000F0000000F0000000F0000001E0000001E00
-00001E0000001E0000003C0000003C0000003C0000003C00000078000000780000007800
-000078000000F0000000F0000000F0000000F0000001F000007FFFC0001F227EA11D> 84
-D<3FFE01FF8003C0003C0003C000300003C0001000078000200007800020000780002000
-07800020000F000040000F000040000F000040000F000040001E000080001E000080001E
-000080001E000080003C000100003C000100003C000100003C0001000078000200007800
-020000780002000078000200007000040000F000040000F0000800007000080000700010
-00007000200000380040000038008000001C01000000060600000001F800000021237DA1
-21> I<007E000381000700800E00801C0080380080780100700600FFF800F00000F00000
-E00000E00000E00000E00000E00080E000807003003004001838000FC00011157D9417>
-101 D<01E00FC001C001C001C0038003800380038007000700070007000E000E000E000E
-001C001C001C001C0038003800380038007000700070007080E100E100E100620062003C
-000B237EA20F> 108 D<03C0F004631C04740E08780E08700708700708700F00E00F00E0
-0F00E00F00E00F01C01E01C01E01C01E01C03C03803803803803C07003C0E0072180071E
-000700000700000E00000E00000E00000E00001C00001C00001C0000FF8000181F819418
-> 112 D<3C0F004630C04741C08783C08783C08701808700000E00000E00000E00000E00
-001C00001C00001C00001C000038000038000038000038000070000030000012157E9416
-> 114 D<01E0F006310C081A1C101A3C201C3C201C18201C000038000038000038000038
-0000700000700000700000700860E010F0E010F0E020E170404230803C1F0016157E941C
-> 120 D E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fh cmti12 12 22
-/Fh 22 122 df<FFF0FFF0FFE00C037C8B11> 45 D<70F8F8F0E005057A840F> I<00F8
-C00185C00705C00E03800E03801C03803C0380380700780700780700780700F00E00F00E
-00F00E00F00E10F01C20701C20703C20305C40308C400F078014157B9419> 97
-D<03C01F8003800380038007000700070007000E000E000E000E001C001CF81D0C1E0E3C
-0638073807380F700F700F700F700FE01EE01EE01EE03CE038E038607060E031C01F0010
-237BA216> I<007E0001C1000301800703800E07801C07803C0000380000780000780000
-780000F00000F00000F00000F00000F00100700100700200300C001830000FC00011157B
-9416> I<00003C0003F80000380000380000380000700000700000700000700000E00000
-E00000E00000E00001C000F9C00185C00705C00E03800E03801C03803C03803807007807
-00780700780700F00E00F00E00F00E00F00E10F01C20701C20703C20305C40308C400F07
-8016237BA219> I<00F803840E021C023C0238027804F018FFE0F000F000E000E000E000
-E000E002E0026004701830600F800F157A9416> I<00003E0000470000CF00018F000186
-000380000380000380000700000700000700000700000700000E0000FFF0000E00000E00
-000E00001C00001C00001C00001C00001C00003800003800003800003800003800007000
-00700000700000700000700000E00000E00000E00000E00000C00001C00001C000718000
-F18000F300006200003C0000182D82A20F> I<001F180030B800E0B801C07001C0700380
-700780700700E00F00E00F00E00F00E01E01C01E01C01E01C01E01C01E03800E03800E07
-80060B8006170001E700000700000700000E00000E00000E00701C00F01800F0300060E0
-003F8000151F7E9416> I<00C001E001C001C0000000000000000000000000000000001E
-002300430043008700870087000E000E001C001C001C0038003800384070807080708071
-0032001C000B217BA00F> 105 D<00F00007E00000E00000E00000E00001C00001C00001
-C00001C0000380000380000380000380000700000701E00702100704700E08F00E10F00E
-20600E40001D80001E00001FC0001C7000383800383800381C00381C2070384070384070
-3840701880E01880600F0014237DA216> 107 D<01E00FC001C001C001C0038003800380
-038007000700070007000E000E000E000E001C001C001C001C0038003800380038007000
-700070007100E200E200E200E200640038000B237CA20C> I<1C0F80F8002610C10C0047
-6066060087807807008780780700870070070087007007000E00E00E000E00E00E000E00
-E00E000E00E00E001C01C01C001C01C01C001C01C01C001C01C038203803803840380380
-70403803807080380380308070070031003003001E0023157B9428> I<380F804C30C04E
-40608E80708F00708E00708E00701C00E01C00E01C00E01C00E03801C03801C03801C038
-0384700388700308700708700310E003106001E016157B941B> I<007E0001C300038180
-0701C00E01C01C01E03C01E03801E07801E07801E07801E0F003C0F003C0F00380F00780
-700700700E00700C0030180018700007C00013157B9419> I<01C1F002621804741C0878
-0C08700E08700E08701E00E01E00E01E00E01E00E01E01C03C01C03C01C03C01C0780380
-7003807003C0E003C1C0072380071E000700000700000E00000E00000E00000E00001C00
-001C00001C0000FFC000171F7F9419> I<1C1F002620804741C08783C08703C087018087
-00000E00000E00000E00000E00001C00001C00001C00001C000038000038000038000038
-000070000030000012157B9415> 114 D<00FC000183000200800401800C03800C03000C
-00000F00000FF00007FC0003FE00003E00000F00000700700700F00600F00600E0040040
-08002030001FC00011157D9414> I<00C001C001C001C001C003800380038003800700FF
-F8070007000E000E000E000E001C001C001C001C00380038003800381070207020704070
-8031001E000D1F7C9E10> I<1E0060E02300E0F04380E1F04381C0F08381C0708701C030
-8701C030070380200E0380200E0380200E0380201C0700401C0700401C0700401C070080
-1C0700801C0701001C0F01000C0B02000613840003E0F8001C157B9420> 119
-D<03C1E0046210083470103CF02038F020386020380000700000700000700000700000E0
-0000E00000E00000E02061C040F1C040F1C080E2C100446200383C0014157D9416> I<1E
-00302300704380704380E08380E08700E08700E00701C00E01C00E01C00E01C01C03801C
-03801C03801C03801C07001C07001C07001C0F000C3E0003CE00000E00000E00001C0060
-1C00F03800F03000E0600080C0004380003E0000141F7B9418> I
-E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fi cmbx12 12 20
-/Fi 20 122 df<FFFFFF8000FFFFFFF00007F003FC0007F0007E0007F0003F0007F0001F
-8007F0000FC007F00007E007F00007E007F00007F007F00003F007F00003F007F00003F0
-07F00003F807F00003F807F00003F807F00003F807F00003F807F00003F807F00003F807
-F00003F807F00003F807F00003F007F00003F007F00003F007F00007E007F00007E007F0
-000FC007F0001F8007F0003F0007F0007E0007F003FC00FFFFFFF000FFFFFF800025227E
-A12B> 68 D<01FE0207FF861F01FE3C007E7C001E78000E78000EF80006F80006FC0006
-FC0000FF0000FFE0007FFF007FFFC03FFFF01FFFF80FFFFC03FFFE003FFE0003FE00007F
-00003F00003FC0001FC0001FC0001FE0001EE0001EF0003CFC003CFF00F8C7FFE080FF80
-18227DA11F> 83 D<7FFFFFFF807FFFFFFF807E03F80F807803F807807003F803806003
-F80180E003F801C0E003F801C0C003F800C0C003F800C0C003F800C0C003F800C00003F8
-00000003F800000003F800000003F800000003F800000003F800000003F800000003F800
-000003F800000003F800000003F800000003F800000003F800000003F800000003F80000
-0003F800000003F800000003F800000003F800000003F8000001FFFFF00001FFFFF00022
-227EA127> I<0FFC003FFF807E07C07E03E07E01E07E01F03C01F00001F00001F0003FF0
-03FDF01FC1F03F01F07E01F0FC01F0FC01F0FC01F0FC01F07E02F07E0CF81FF87F07E03F
-18167E951B> 97 D<FF000000FF0000001F0000001F0000001F0000001F0000001F0000
-001F0000001F0000001F0000001F0000001F0000001F0000001F0FE0001F3FF8001FE07C
-001F803E001F001F001F000F801F000F801F000FC01F000FC01F000FC01F000FC01F000F
-C01F000FC01F000FC01F000FC01F000F801F001F801F801F001FC03E001EE07C001C3FF8
-00180FC0001A237EA21F> I<00FF8007FFE00F83F01F03F03E03F07E03F07C01E07C0000
-FC0000FC0000FC0000FC0000FC0000FC00007C00007E00007E00003E00181F00300FC060
-07FFC000FF0015167E9519> I<00FE0007FF800F87C01E01E03E01F07C00F07C00F8FC00
-F8FC00F8FFFFF8FFFFF8FC0000FC0000FC00007C00007C00007E00003E00181F00300FC0
-7003FFC000FF0015167E951A> 101 D<001FC0007FE000F1F001E3F003E3F007C3F007C1
-E007C00007C00007C00007C00007C00007C000FFFE00FFFE0007C00007C00007C00007C0
-0007C00007C00007C00007C00007C00007C00007C00007C00007C00007C00007C00007C0
-0007C00007C0003FFC003FFC00142380A211> I<01FE0F0007FFBF800F87C7801F03E780
-1E01E0003E01F0003E01F0003E01F0003E01F0003E01F0001E01E0001F03E0000F87C000
-0FFF800009FE000018000000180000001C0000001FFFE0000FFFF80007FFFE001FFFFF00
-3C003F0078000F80F0000780F0000780F0000780F000078078000F003C001E001F007C00
-0FFFF80001FFC00019217F951C> I<1C003E007F007F007F003E001C0000000000000000
-00000000000000FF00FF001F001F001F001F001F001F001F001F001F001F001F001F001F
-001F001F001F001F001F00FFE0FFE00B247EA310> 105 D<FF00FF001F001F001F001F00
-1F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F00
-1F001F001F001F001F001F001F001F001F00FFE0FFE00B237EA210> 108
-D<FF07F007F000FF1FFC1FFC001F303E303E001F403E403E001F801F801F001F801F801F
-001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F
-001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F001F
-001F001F001F001F001F001F00FFE0FFE0FFE0FFE0FFE0FFE02B167E9530> I<FF07E000
-FF1FF8001F307C001F403C001F803E001F803E001F003E001F003E001F003E001F003E00
-1F003E001F003E001F003E001F003E001F003E001F003E001F003E001F003E001F003E00
-1F003E00FFE1FFC0FFE1FFC01A167E951F> I<00FE0007FFC00F83E01E00F03E00F87C00
-7C7C007C7C007CFC007EFC007EFC007EFC007EFC007EFC007EFC007E7C007C7C007C3E00
-F81F01F00F83E007FFC000FE0017167E951C> I<FF0FE000FF3FF8001FE07C001F803E00
-1F001F001F001F801F001F801F000FC01F000FC01F000FC01F000FC01F000FC01F000FC0
-1F000FC01F000FC01F001F801F001F801F803F001FC03E001FE0FC001F3FF8001F0FC000
-1F0000001F0000001F0000001F0000001F0000001F0000001F0000001F000000FFE00000
-FFE000001A207E951F> I<0FF3003FFF00781F00600700E00300E00300F00300FC00007F
-E0007FF8003FFE000FFF0001FF00000F80C00780C00380E00380E00380F00700FC0E00EF
-FC00C7F00011167E9516> 115 D<01800001800001800001800003800003800007800007
-80000F80003F8000FFFF00FFFF000F80000F80000F80000F80000F80000F80000F80000F
-80000F80000F80000F80000F81800F81800F81800F81800F81800F830007C30003FE0000
-F80011207F9F16> I<FF01FE00FF01FE001F003E001F003E001F003E001F003E001F003E
-001F003E001F003E001F003E001F003E001F003E001F003E001F003E001F003E001F003E
-001F003E001F007E001F00FE000F81BE0007FF3FC001FC3FC01A167E951F> I<FFE07FC0
-FFE07FC00F801C0007C0380003E0700003F0600001F8C00000F98000007F8000003F0000
-001F0000001F8000003FC0000037C0000063E00000C1F00001C0F8000380FC0007007E00
-0E003E00FF80FFE0FF80FFE01B167F951E> 120 D<FFE01FE0FFE01FE01F8007000F8006
-000FC00E0007C00C0007E00C0003E0180003E0180001F0300001F0300000F8600000F860
-00007CC000007CC000007FC000003F8000003F8000001F0000001F0000000E0000000E00
-00000C0000000C00000018000078180000FC380000FC300000FC60000069C000007F8000
-001F0000001B207F951E> I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fj cmsy10 12 15
-/Fj 15 107 df<FFFFFFFCFFFFFFFC1E027C8C27> 0 D<03F0000FFC001FFE003FFF007F
-FF807FFF80FFFFC0FFFFC0FFFFC0FFFFC0FFFFC0FFFFC0FFFFC0FFFFC07FFF807FFF803F
-FF001FFE000FFC0003F00012147D9519> 15 D<000FFFFC007FFFFC01F0000003800000
-060000000C0000001800000030000000300000006000000060000000C0000000C0000000
-C0000000C0000000C0000000C0000000C0000000C0000000600000006000000030000000
-30000000180000000C000000060000000380000001E00000007FFFFC001FFFFC1E1E7C9A
-27> 26 D<00000001800000000001800000000001800000000001800000000000C00000
-000000C000000000006000000000003000000000003000000000001C00000000000E0000
-0000000700FFFFFFFFFFE0FFFFFFFFFFE0000000000700000000000E00000000001C0000
-000000300000000000300000000000600000000000C00000000000C00000000001800000
-00000180000000000180000000000180002B1A7D9832> 33 D<001FFF007FFF01E00003
-80000600000C0000180000300000300000600000600000600000C00000C00000FFFFFFFF
-FFFFC00000C000006000006000006000003000003000001800000C000006000003800001
-E000007FFF001FFF181E7C9A21> 50 D<00000300000300000600000600000C00000C00
-00180000180000300000300000600000600000C00000C00000C000018000018000030000
-0300000600000600000C00000C0000180000180000300000300000600000600000C00000
-C0000180000180000300000300000300000600000600000C00000C000018000018000030
-0000300000600000600000C00000400000183079A300> 54 D<C0C0C0C0C0C0C0C0E0E0
-C0C0C0C0C0C0C0C003127D9400> I<00008000018001F980070F000C0300180380180780
-3006C03006C0700CE0600C60600C60600C60E01870E01870E01870E03070E03070E03070
-E06070E06070E06070E06070E0C070E0C070E0C070E18070E180706180606300607300E0
-7300E03300C03600C01E01801E01800C03000F0E000DF800180000180000180000142A7E
-A519> 59 D<000100000003000000030000000300000003000000030000000300000003
-000000030000000300000003000000030000000300000003000000030000000300000003
-000000030000000300000003000000030000000300000003000000030000000300000003
-000000030000000300000003000000030000FFFFFFFEFFFFFFFE1F207C9F27> 63
-D<40000040C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000
-C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000
-C0C00000C0C00000C0C00000C0C00000C0C00000C0600001806000018030000300180006
-000E001C000780780001FFE000007F80001A1F7D9D21> 91 D<007F800001FFE0000780
-78000E001C0018000600300003006000018060000180C00000C0C00000C0C00000C0C000
-00C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C000
-00C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C00000C0C000
-00C0400000401A1F7D9D21> I<000C0000000C0000001E0000001E0000001E0000003300
-0000330000006180000061800000C0C00000C0C00000C0C0000180600001806000030030
-00030030000300300006001800060018000C000C000C000C000C000C0018000600180006
-003000030030000300600001806000018060000180C00000C0C00000401A1F7D9D21> 94
-D<0003C0001E0000380000700000E00000E00000E00000E00000E00000E00000E00000E0
-0000E00000E00000E00000E00000E00000E00000E00000E00000E00001C0000380000F00
-00F800000F000003800001C00000E00000E00000E00000E00000E00000E00000E00000E0
-0000E00000E00000E00000E00000E00000E00000E00000E00000E000007000003800001E
-000003C012317DA419> 102 D<F800000F000003800001C00000E00000E00000E00000E0
-0000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E0
-0000E000007000003800001E000003C0001E0000380000700000E00000E00000E00000E0
-0000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E0
-0000E00001C0000380000F0000F8000012317DA419> I<C0C0C0C0C0C0C0C0C0C0C0C0C0
-C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0
-02317AA40E> 106 D E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fk cmr12 12 65
-/Fk 65 125 df<001FC1F00070371800C03E3C01807C3C0380783C070038000700380007
-003800070038000700380007003800070038000700380007003800FFFFFFC00700380007
-003800070038000700380007003800070038000700380007003800070038000700380007
-0038000700380007003800070038000700380007003800070038000700380007003C007F
-E1FFC01E2380A21C> 11 D<001FC0000070200000C01000018038000380780007007800
-0700300007000000070000000700000007000000070000000700000007000000FFFFF800
-070078000700380007003800070038000700380007003800070038000700380007003800
-070038000700380007003800070038000700380007003800070038000700380007003800
-070038007FE1FF80192380A21B> I<001FD8000070380000C07800018078000380780007
-0038000700380007003800070038000700380007003800070038000700380007003800FF
-FFF800070038000700380007003800070038000700380007003800070038000700380007
-003800070038000700380007003800070038000700380007003800070038000700380007
-003800070038007FF3FF80192380A21B> I<000FC07F00007031C08000E00B004001801E
-00E003803E01E007003C01E007001C00C007001C000007001C000007001C000007001C00
-0007001C000007001C000007001C0000FFFFFFFFE007001C01E007001C00E007001C00E0
-07001C00E007001C00E007001C00E007001C00E007001C00E007001C00E007001C00E007
-001C00E007001C00E007001C00E007001C00E007001C00E007001C00E007001C00E00700
-1C00E007001C00E07FF1FFCFFE272380A229> I<70F8FCFC740404040408081010204006
-0F7CA20E> 39 D<00200040008001000300060004000C000C0018001800300030003000
-7000600060006000E000E000E000E000E000E000E000E000E000E000E000E000E000E000
-6000600060007000300030003000180018000C000C000400060003000100008000400020
-0B327CA413> I<800040002000100018000C000400060006000300030001800180018001
-C000C000C000C000E000E000E000E000E000E000E000E000E000E000E000E000E000E000
-C000C000C001C0018001800180030003000600060004000C00180010002000400080000B
-327DA413> I<70F8FCFC7404040404080810102040060F7C840E> 44
-D<FFF8FFF80D02808B10> I<70F8F8F87005057C840E> I<01F000071C000C0600180300
-3803803803807001C07001C07001C07001C0F001E0F001E0F001E0F001E0F001E0F001E0
-F001E0F001E0F001E0F001E0F001E0F001E0F001E0F001E07001C07001C07001C07803C0
-3803803803801C07000C0600071C0001F00013227EA018> 48 D<008003800F80F38003
-800380038003800380038003800380038003800380038003800380038003800380038003
-800380038003800380038003800380038007C0FFFE0F217CA018> I<03F0000C1C001007
-002007804003C04003C08003E0F003E0F801E0F801E0F801E02003E00003E00003C00003
-C0000780000700000E00001C0000180000300000600000C0000180000100000200200400
-200800201800603000403FFFC07FFFC0FFFFC013217EA018> I<03F8000C1E00100F0020
-07804007C07807C07803C07807C03807C0000780000780000700000F00000C0000380003
-F000001C00000F000007800007800003C00003C00003E02003E07003E0F803E0F803E0F0
-03C04003C0400780200780100F000C1C0003F00013227EA018> I<000300000300000700
-000700000F00001700001700002700006700004700008700018700010700020700060700
-040700080700080700100700200700200700400700C00700FFFFF8000700000700000700
-000700000700000700000700000F80007FF015217FA018> I<70F8F8F870000000000000
-000000000070F8F8F87005157C940E> 58 D<FFFFFFFEFFFFFFFE000000000000000000
-0000000000000000000000000000000000000000000000FFFFFFFEFFFFFFFE1F0C7D9126
-> 61 D<07E01838201C400E800FF00FF00FF00F000F000E001C00380030006000C000C0
-00800080018001000100010001000100010000000000000000000000038007C007C007C0
-038010237DA217> 63 D<0001800000018000000180000003C0000003C0000003C00000
-05E0000005E0000009F0000008F0000008F00000107800001078000010780000203C0000
-203C0000203C0000401E0000401E0000C01F0000800F0000800F0001FFFF800100078001
-000780020003C0020003C0020003C0040001E0040001E0040001E0080000F01C0000F03E
-0001F8FF800FFF20237EA225> 65 D<FFFFF8000F800E0007800780078003C0078003E0
-078001E0078001F0078001F0078001F0078001F0078001F0078001E0078003E0078007C0
-07800F8007803E0007FFFE0007800780078003C0078001E0078001F0078000F0078000F8
-078000F8078000F8078000F8078000F8078000F8078001F0078001F0078003E0078007C0
-0F800F00FFFFFC001D227EA123> I<0007E0100038183000E0063001C00170038000F007
-0000F00E0000701E0000701C0000303C0000303C0000307C0000107800001078000010F8
-000000F8000000F8000000F8000000F8000000F8000000F8000000F80000007800000078
-0000107C0000103C0000103C0000101C0000201E0000200E000040070000400380008001
-C0010000E0020000381C000007E0001C247DA223> I<FFFFF0000F801E00078007000780
-0380078001C0078000E0078000F007800078078000780780007C0780003C0780003C0780
-003C0780003E0780003E0780003E0780003E0780003E0780003E0780003E0780003E0780
-003E0780003C0780003C0780007C0780007807800078078000F0078000E0078001E00780
-03C0078007000F801E00FFFFF0001F227EA125> I<FFFFFFC00F8007C0078001C0078000
-C00780004007800040078000600780002007800020078000200780202007802000078020
-0007802000078060000780E00007FFE0000780E000078060000780200007802000078020
-000780200007800000078000000780000007800000078000000780000007800000078000
-00078000000FC00000FFFE00001B227EA120> 70 D<0007F008003C0C1800E0021801C0
-01B8038000F8070000780F0000381E0000381E0000183C0000183C0000187C0000087800
-000878000008F8000000F8000000F8000000F8000000F8000000F8000000F8000000F800
-1FFF780000F8780000787C0000783C0000783C0000781E0000781E0000780F0000780700
-0078038000B801C000B800E00318003C0C080007F00020247DA226> I<FFFC3FFF0FC003
-F0078001E0078001E0078001E0078001E0078001E0078001E0078001E0078001E0078001
-E0078001E0078001E0078001E0078001E0078001E007FFFFE0078001E0078001E0078001
-E0078001E0078001E0078001E0078001E0078001E0078001E0078001E0078001E0078001
-E0078001E0078001E0078001E00FC003F0FFFC3FFF20227EA125> I<FFFC0FC007800780
-078007800780078007800780078007800780078007800780078007800780078007800780
-07800780078007800780078007800780078007800FC0FFFC0E227EA112> I<FFFC00FF80
-0FC0007C0007800030000780002000078000400007800080000780010000078002000007
-80040000078008000007801000000780200000078040000007808000000781C000000783
-E000000785E000000788F000000790F0000007A078000007C03C000007803C000007801E
-000007800F000007800F00000780078000078007C000078003C000078001E000078001E0
-00078000F000078000F8000FC000FC00FFFC07FF8021227EA126> 75
-D<FFFC001F80000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00
-000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00010F00
-010F00010F00010F00030F00030F00020F00060F00060F001E1F007EFFFFFE18227DA11E
-> I<FF8007FF07C000F807C0007005E0002004F0002004F0002004780020047C0020043C
-0020041E0020041F0020040F002004078020040780200403C0200401E0200401E0200400
-F0200400F8200400782004003C2004003E2004001E2004000F2004000F20040007A00400
-03E0040003E0040001E0040001E0040000E00E0000601F000060FFE0002020227EA125>
-78 D<000FE00000783C0000E00E0003C00780078003C00F0001E00E0000E01E0000F03C
-0000783C0000787C00007C7C00007C7800003C7800003CF800003EF800003EF800003EF8
-00003EF800003EF800003EF800003EF800003EF800003E7800003C7C00007C7C00007C3C
-0000783E0000F81E0000F00F0001E00F0001E0078003C003C0078000E00E0000783C0000
-0FE0001F247DA226> I<FFFFF0000F803C0007800F0007800780078007C0078003C00780
-03E0078003E0078003E0078003E0078003E0078003E0078003C0078007C0078007800780
-0F0007803C0007FFF0000780000007800000078000000780000007800000078000000780
-0000078000000780000007800000078000000780000007800000078000000FC00000FFFC
-00001B227EA121> I<FFFFE000000F803C000007800E00000780078000078007C0000780
-03C000078003E000078003E000078003E000078003E000078003E000078003C000078007
-C000078007800007800E000007803C000007FFE000000780700000078038000007801C00
-0007801E000007800E000007800F000007800F000007800F000007800F000007800F8000
-07800F800007800F800007800F808007800FC080078007C0800FC003C100FFFC01E20000
-00007C0021237EA124> 82 D<03F0200C0C601802603001E07000E0600060E00060E000
-60E00020E00020E00020F00000F000007800007F00003FF0001FFE000FFF0003FF80003F
-C00007E00001E00000F00000F0000070800070800070800070800070C00060C00060E000
-C0F000C0C80180C6070081FC0014247DA21B> I<7FFFFFF8780780786007801840078008
-4007800840078008C007800C800780048007800480078004800780040007800000078000
-000780000007800000078000000780000007800000078000000780000007800000078000
-000780000007800000078000000780000007800000078000000780000007800000078000
-00078000000FC00001FFFE001E227EA123> I<FFF0007FC01F80001F000F00000C000F80
-000C000780000800078000080003C000100003C000100003C000100001E000200001E000
-200001F000600000F000400000F000400000780080000078008000007C008000003C0100
-00003C010000001E020000001E020000001E020000000F040000000F040000000F8C0000
-000788000000078800000003D000000003D000000003F000000001E000000001E0000000
-00C000000000C000000000C0000022237FA125> 86 D<FFF03FFC03FE1F8007E000F80F
-0003C000700F0003C000200F0001E00020078001E00040078001E00040078003F0004003
-C002F0008003C002F0008003C002F0008003E00478018001E00478010001E00478010001
-E0083C010000F0083C020000F0083C020000F0101E02000078101E04000078101E040000
-78200F0400003C200F0800003C200F0800003C600F8800001E40079000001E4007900000
-1E4007D000001F8003F000000F8003E000000F8003E000000F0001E00000070001C00000
-070001C00000060000C0000002000080002F237FA132> I<FEFEC0C0C0C0C0C0C0C0C0C0
-C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0FE
-FE07317BA40E> 91 D<FEFE060606060606060606060606060606060606060606060606
-060606060606060606060606060606060606060606FEFE07317FA40E> 93
-D<1FE000303800780C00780E0030070000070000070000070000FF0007C7001E07003C07
-00780700700700F00708F00708F00708F00F087817083C23900FC1E015157E9418> 97
-D<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E00000E00
-000E00000E00000E1F000E61C00E80600F00300E00380E003C0E001C0E001E0E001E0E00
-1E0E001E0E001E0E001E0E001E0E001C0E003C0E00380F00700C80600C41C0083F001723
-7FA21B> I<01FE000703000C07801C0780380300780000700000F00000F00000F00000F0
-0000F00000F00000F000007000007800403800401C00800C010007060001F80012157E94
-16> I<0000E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E0
-0000E00000E00000E001F8E00704E00C02E01C01E03800E07800E07000E0F000E0F000E0
-F000E0F000E0F000E0F000E0F000E07000E07800E03800E01801E00C02E0070CF001F0FE
-17237EA21B> I<01FC000707000C03801C01C03801C07801E07000E0F000E0FFFFE0F000
-00F00000F00000F00000F000007000007800203800201C00400E008007030000FC001315
-7F9416> I<003E0000E30001C78003878003078007000007000007000007000007000007
-0000070000070000070000FFF80007000007000007000007000007000007000007000007
-00000700000700000700000700000700000700000700000700000700000700000780007F
-F000112380A20F> I<00007003F1980E1E181C0E18380700380700780780780780780780
-7807803807003807001C0E001E1C0033F0002000002000003000003800003FFE001FFFC0
-0FFFE03000F0600030C00018C00018C00018C000186000306000303800E00E038003FE00
-15217F9518> I<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00
-000E00000E00000E00000E00000E1F800E60C00E80E00F00700F00700E00700E00700E00
-700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00
-70FFE7FF18237FA21B> I<1C003E003E003E001C00000000000000000000000000000000
-000E007E001E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E
-000E000E00FFC00A227FA10E> I<00E001F001F001F000E0000000000000000000000000
-00000000007007F000F00070007000700070007000700070007000700070007000700070
-00700070007000700070007000700070007000706070F0E0F0C061803F000C2C83A10F>
-I<0E0000FE00001E00000E00000E00000E00000E00000E00000E00000E00000E00000E00
-000E00000E00000E03FC0E01F00E01C00E01800E02000E04000E08000E10000E38000EF8
-000F1C000E1E000E0E000E07000E07800E03C00E01C00E01E00E00F00E00F8FFE3FE1723
-7FA21A> I<0E00FE001E000E000E000E000E000E000E000E000E000E000E000E000E000E
-000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E
-00FFE00B237FA20E> I<0E1FC07F00FE60E183801E807201C00F003C00E00F003C00E00E
-003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E00
-3800E00E003800E00E003800E00E003800E00E003800E00E003800E00E003800E00E0038
-00E0FFE3FF8FFE27157F942A> I<0E1F80FE60C01E80E00F00700F00700E00700E00700E
-00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E
-0070FFE7FF18157F941B> I<01FC000707000C01801800C03800E0700070700070F00078
-F00078F00078F00078F00078F00078F000787000707800F03800E01C01C00E0380070700
-01FC0015157F9418> I<0E1F00FE61C00E80600F00700E00380E003C0E003C0E001E0E00
-1E0E001E0E001E0E001E0E001E0E001E0E003C0E003C0E00380F00700E80E00E41C00E3F
-000E00000E00000E00000E00000E00000E00000E00000E00000E0000FFE000171F7F941B
-> I<01F8200704600E02601C01603801E07800E07800E0F000E0F000E0F000E0F000E0F0
-00E0F000E0F000E07800E07800E03801E01C01E00C02E0070CE001F0E00000E00000E000
-00E00000E00000E00000E00000E00000E00000E0000FFE171F7E941A> I<0E3CFE461E8F
-0F0F0F060F000E000E000E000E000E000E000E000E000E000E000E000E000E000F00FFF0
-10157F9413> I<0F8830786018C018C008C008E008F0007F003FE00FF001F8003C801C80
-0C800CC00CC008E018D0308FC00E157E9413> I<02000200020002000600060006000E00
-1E003E00FFFC0E000E000E000E000E000E000E000E000E000E000E000E040E040E040E04
-0E040E040708030801F00E1F7F9E13> I<0E0070FE07F01E00F00E00700E00700E00700E
-00700E00700E00700E00700E00700E00700E00700E00700E00700E00700E00F00E00F006
-017003827800FC7F18157F941B> I<FF80FE1E00781E00300E00200E0020070040070040
-0780C003808003808001C10001C10000E20000E20000E200007400007400003800003800
-00380000100017157F941A> I<FF8FF87F3E01E03C1C01C0181C01E0180E01E0100E0260
-100E027010070270200704302007043820038438400388184003881C4001C81C8001D00C
-8001D00E8000F00F0000E0070000E00700006006000040020020157F9423> I<FF83FE1F
-00F00E00C007008007810003830001C20000E400007800007800003800003C00004E0000
-8F000187000103800201C00401E00C00E03E01F0FF03FE17157F941A> I<FF80FE1E0078
-1E00300E00200E00200700400700400780C003808003808001C10001C10000E20000E200
-00E200007400007400003800003800003800001000001000002000002000002000004000
-F04000F08000F180004300003C0000171F7F941A> I<3FFFC0380380300780200700600E
-00401C00403C0040380000700000E00001E00001C0000380400700400F00400E00C01C00
-80380080780180700780FFFF8012157F9416> I<FFFFFFFFFFFF3001808C31> 124
-D E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fl cmbx12 14.4 19
-/Fl 19 118 df<00007FE0030007FFFC07001FFFFF0F007FF00F9F00FF0001FF01FC0000
-FF03F800007F07F000003F0FE000001F1FC000001F1FC000000F3F8000000F3F80000007
-7F800000077F800000077F00000000FF00000000FF00000000FF00000000FF00000000FF
-00000000FF00000000FF00000000FF00000000FF000000007F000000007F800000007F80
-0000073F800000073F800000071FC00000071FC000000E0FE000000E07F000001C03F800
-003C01FC00007800FF0001F0007FF007C0001FFFFF800007FFFE0000007FF00028297CA8
-31> 67 D<FFFFFC0000FFFFFC0000FFFFFC000003FC00000003FC00000003FC00000003
-FC00000003FC00000003FC00000003FC00000003FC00000003FC00000003FC00000003FC
-00000003FC00000003FC00000003FC00000003FC00000003FC00000003FC00000003FC00
-000003FC00000003FC00000003FC00000003FC0001C003FC0001C003FC0001C003FC0001
-C003FC0003C003FC00038003FC00038003FC00078003FC00078003FC000F8003FC000F80
-03FC001F8003FC007F8003FC01FF00FFFFFFFF00FFFFFFFF00FFFFFFFF0022297EA828>
-76 D<0000FFC00000000FFFFC0000003F807F000000FE001FC00001F80007E00003F000
-03F00007E00001F8000FE00001FC001FC00000FE001FC00000FE003F8000007F003F8000
-007F007F8000007F807F0000003F807F0000003F807F0000003F80FF0000003FC0FF0000
-003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000003FC0FF0000
-003FC0FF0000003FC0FF0000003FC07F0000003F807F8000007F807F8000007F803F8000
-007F003F8000007F001FC00000FE001FC00000FE000FE00001FC0007F00003F80003F800
-07F00001FC000FE00000FE001FC000003FC0FF0000000FFFFC00000000FFC000002A297C
-A833> 79 D<FFFFF0007FFFFFFFF0007FFFFFFFF0007FFF03FE000001C001FE00000380
-01FE0000038001FF0000078000FF0000070000FF80000F00007F80000E00007FC0000E00
-003FC0001C00003FC0001C00003FE0003C00001FE0003800001FF0007800000FF0007000
-000FF80070000007F800E0000007F800E0000003FC01C0000003FC01C0000003FE03C000
-0001FE0380000001FF0780000000FF0700000000FF87000000007F8E000000007F8E0000
-00007FDE000000003FDC000000003FFC000000001FF8000000001FF8000000000FF00000
-00000FF0000000000FF00000000007E00000000007E00000000003C00000000003C00000
-30297FA833> 86 D<03FF80000FFFF0001F01FC003F80FE003F807F003F803F003F803F
-801F003F8000003F8000003F8000003F8000003F80003FFF8001FC3F800FE03F801F803F
-803F003F807E003F80FC003F80FC003F80FC003F80FC003F80FC005F807E00DF803F839F
-FC1FFE0FFC03FC03FC1E1B7E9A21> 97 D<FFE00000FFE00000FFE000000FE000000FE0
-00000FE000000FE000000FE000000FE000000FE000000FE000000FE000000FE000000FE0
-00000FE000000FE1FE000FEFFF800FFE07E00FF803F00FF001F80FE000FC0FE000FC0FE0
-007E0FE0007E0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0
-007F0FE0007E0FE0007E0FE0007E0FE000FC0FE000FC0FF001F80FF803F00F9C0FE00F0F
-FF800E01FC00202A7EA925> I<00007FF000007FF000007FF0000007F0000007F0000007
-F0000007F0000007F0000007F0000007F0000007F0000007F0000007F0000007F0000007
-F0003F87F001FFF7F007F03FF00FC00FF01F8007F03F0007F03F0007F07E0007F07E0007
-F07E0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007
-F07E0007F07E0007F03F0007F03F0007F01F800FF00FC01FF007E07FFF01FFE7FF007F87
-FF202A7EA925> 100 D<003FC00001FFF00003E07C000F803E001F801F001F001F003F00
-0F807E000F807E000FC07E000FC0FE0007C0FE0007C0FFFFFFC0FFFFFFC0FE000000FE00
-0000FE0000007E0000007E0000007F0000003F0001C01F0001C00F80038007C0070003F0
-1E0000FFFC00003FE0001A1B7E9A1F> I<0007F8003FFC007E3E01FC7F03F87F03F07F07
-F07F07F03E07F00007F00007F00007F00007F00007F00007F000FFFFC0FFFFC0FFFFC007
-F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007
-F00007F00007F00007F00007F00007F00007F00007F00007F0007FFF807FFF807FFF8018
-2A7EA915> I<FFE00000FFE00000FFE000000FE000000FE000000FE000000FE000000FE0
-00000FE000000FE000000FE000000FE000000FE000000FE000000FE000000FE07E000FE1
-FF800FE30FC00FE40FE00FE807E00FF807F00FF007F00FF007F00FE007F00FE007F00FE0
-07F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE0
-07F00FE007F00FE007F00FE007F00FE007F0FFFE3FFFFFFE3FFFFFFE3FFF202A7DA925>
-104 D<07000F801FC03FE03FE03FE01FC00F8007000000000000000000000000000000FF
-E0FFE0FFE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00F
-E00FE00FE00FE00FE00FE0FFFEFFFEFFFE0F2B7EAA12> I<FFE0FFE0FFE00FE00FE00FE0
-0FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE0
-0FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE0FFFEFFFEFFFE
-0F2A7EA912> 108 D<FFC07E00FFC1FF80FFC30FC00FC40FE00FC807E00FD807F00FD007
-F00FD007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007
-F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F0FFFE3F
-FFFFFE3FFFFFFE3FFF201B7D9A25> 110 D<003FE00001FFFC0003F07E000FC01F801F80
-0FC03F0007E03F0007E07E0003F07E0003F07E0003F0FE0003F8FE0003F8FE0003F8FE00
-03F8FE0003F8FE0003F8FE0003F8FE0003F87E0003F07E0003F03F0007E03F0007E01F80
-0FC00FC01F8007F07F0001FFFC00003FE0001D1B7E9A22> I<FFE1FE00FFEFFF80FFFE0F
-E00FF803F00FF001F80FE001FC0FE000FC0FE000FE0FE000FE0FE0007F0FE0007F0FE000
-7F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007F0FE0007E0FE000FE0FE000FE0FE000
-FC0FE001FC0FF001F80FF807F00FFC0FE00FEFFF800FE1FC000FE000000FE000000FE000
-000FE000000FE000000FE000000FE000000FE000000FE00000FFFE0000FFFE0000FFFE00
-0020277E9A25> I<FFC1F0FFC7FCFFC63E0FCC7F0FD87F0FD07F0FD07F0FF03E0FE0000F
-E0000FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE0000F
-E0000FE0000FE000FFFF00FFFF00FFFF00181B7F9A1B> 114 D<03FE300FFFF03E03F078
-00F07000F0F00070F00070F80070FE0000FFE0007FFF007FFFC03FFFE01FFFF007FFF800
-FFF80007FC0000FCE0007CE0003CF0003CF00038F80038FC0070FF01E0E7FFC0C1FF0016
-1B7E9A1B> I<00E00000E00000E00000E00001E00001E00001E00003E00003E00007E000
-0FE0001FFFE0FFFFE0FFFFE00FE0000FE0000FE0000FE0000FE0000FE0000FE0000FE000
-0FE0000FE0000FE0000FE0000FE0000FE0700FE0700FE0700FE0700FE0700FE0700FE070
-07F0E003F0C001FF80007F0014267FA51A> I<FFE07FF0FFE07FF0FFE07FF00FE007F00F
-E007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00F
-E007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE007F00FE00FF00F
-E00FF007E017F003F067FF01FFC7FF007F87FF201B7D9A25> I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fm cmr12 14.4 20
-/Fm 20 118 df<78FCFCFEFE7A02020202040404080810204007127B8510> 44
-D<00200000E00001E0000FE000FFE000F1E00001E00001E00001E00001E00001E00001E0
-0001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E0
-0001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E00001E0
-0001E00003F000FFFFC0FFFFC012287BA71D> 49 D<01FC0007FF000C0FC01803E02001
-F06001F04000F84000F8F800FCFC00FCFC007CFC007CFC007C7800FC0000FC0000F80000
-F80001F00001F00003E00003C0000780000700000E00001C0000380000300000600000C0
-000180000300040200040400080800081000082000183FFFF87FFFF0FFFFF0FFFFF01628
-7DA71D> I<000FC0003FF000F01801C01803803C07007C0F007C0E00381E00003C00003C
-00003C0000780000780000780000F83F00F8C1C0F900E0FA0070FA0038FC003CFC001EFC
-001EF8001EF8001FF8001FF8001FF8001F78001F78001F78001F78001F3C001E3C001E1C
-003C1E003C0E007807007003C1E001FFC0007E0018297EA71D> 54
-D<007E0001FF800781C00F00E01E00703C00383C003878003C78003CF8001EF8001EF800
-1EF8001EF8001FF8001FF8001FF8001F78001F78003F78003F3C003F1C005F0E005F0700
-9F03831F00FC1F00001E00001E00001E00003E00003C00003C0000381C00783E00703E00
-E03C01C01803801C0F000FFE0003F80018297EA71D> 57 D<0000FF00100007FFE03000
-1FC07830003E000C7000F80006F001F00003F003E00001F007C00000F00F800000700F80
-0000701F000000303F000000303E000000303E000000107E000000107E000000107C0000
-0000FC00000000FC00000000FC00000000FC00000000FC00000000FC00000000FC000000
-00FC00000000FC0000FFFF7C0000FFFF7E000003F07E000001F03E000001F03E000001F0
-3F000001F01F000001F00F800001F00F800001F007C00001F003E00001F001F00002F000
-F80002F0003E000C70001FC038300007FFE0100000FF8000282B7DA92E> 71
-D<01FFFE01FFFE0007E00003E00003E00003E00003E00003E00003E00003E00003E00003
-E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003
-E00003E00003E00003E00003E00003E00003E00003E03003E07803E0FC03E0FC03E0FC03
-C0F807C0400780200F00300E000C3C0003F000172A7DA81E> 74
-D<0001FF0000000F01E000003C0078000078003C0000E0000E0001E0000F0003C0000780
-07800003C00F800003E01F000001F01F000001F03E000000F83E000000F87E000000FC7E
-000000FC7C0000007C7C0000007CFC0000007EFC0000007EFC0000007EFC0000007EFC00
-00007EFC0000007EFC0000007EFC0000007EFC0000007E7C0000007C7E000000FC7E0000
-00FC7E000000FC3E000000F83F000001F81F000001F01F000001F00F800003E007800003
-C007C00007C003E0000F8000F0001E000078003C00003C007800000F01E0000001FF0000
-272B7DA92E> 79 D<03FC00000C070000100380003C01C0003E01E0003E00F0001C00F0
-000800F0000000F0000000F0000000F000007FF00003E0F0000F80F0001E00F0003C00F0
-007C00F0007800F040F800F040F800F040F800F040F801F0407C01F0403C0278801E0C7F
-8007F01E001A1A7E991D> 97 D<0F000000FF000000FF0000001F0000000F0000000F00
-00000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F00
-00000F0000000F07E0000F1838000F600E000F8007000F8007800F0003C00F0003C00F00
-01E00F0001E00F0001F00F0001F00F0001F00F0001F00F0001F00F0001F00F0001F00F00
-01E00F0001E00F0003E00F0003C00F0003800F8007800E800F000E401C000C303800080F
-C0001C2A7EA921> I<007F0001C0E00700100E00781E00F83C00F83C00707C0020780000
-F80000F80000F80000F80000F80000F80000F80000F800007800007C00003C00083C0008
-1E00100E002007006001C180007E00151A7E991A> I<00FC000387800701C00E01E01C00
-E03C00F03C00F0780078780078F80078F80078FFFFF8F80000F80000F80000F80000F800
-007800007800003C00083C00081E00100E002007004001C180007E00151A7E991A> 101
-D<00000F0001FC3080070743800E03C3801E03C1003C01E0003C01E0007C01F0007C01F0
-007C01F0007C01F0007C01F0003C01E0003C01E0001E03C0000E0380001707000011FC00
-0030000000300000003000000030000000180000001FFF80000FFFF00007FFF80018007C
-0030001E0070000E0060000700E0000700E0000700E0000700E000070070000E0070000E
-0038001C001C0038000781E00000FF000019287E9A1D> 103 D<1E003F003F003F003F00
-1E000000000000000000000000000000000000000F00FF00FF001F000F000F000F000F00
-0F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F00FFF0FFF0
-0C297EA811> 105 D<007E0003C3C00700E00E00701C00383C003C3C003C78001E78001E
-F8001FF8001FF8001FF8001FF8001FF8001FF8001FF8001F78001E78001E3C003C3C003C
-1C00380E00700700E003C3C0007E00181A7E991D> 111 D<003F010001E0830003804300
-0F0027001E0017001E001F003C000F007C000F007C000F0078000F00F8000F00F8000F00
-F8000F00F8000F00F8000F00F8000F00F8000F007C000F007C000F003C000F003E001F00
-1E001F000F002F0007804F0001C18F00007E0F0000000F0000000F0000000F0000000F00
-00000F0000000F0000000F0000000F0000000F0000000F000000FFF00000FFF01C267E99
-1F> 113 D<0F0F80FF11C0FF23E01F43E00F83E00F81C00F80000F00000F00000F00000F
-00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F00000F
-00000F8000FFFC00FFFC00131A7E9917> I<07F0801C0D80300380600180E00180E00080
-E00080F00080F800007E00007FE0003FFC001FFE0007FF00003F800007808003C08003C0
-8001C0C001C0C001C0E00180E00380F00300CC0E0083F800121A7E9917> I<0080000080
-000080000080000180000180000180000380000380000780000F80001FFF80FFFF800780
-000780000780000780000780000780000780000780000780000780000780000780000780
-0007804007804007804007804007804007804007804003C08001C08000E100003E001225
-7FA417> I<0F000F00FF00FF00FF00FF001F001F000F000F000F000F000F000F000F000F
-000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F000F
-000F000F000F000F000F000F000F001F000F001F0007002F0003804F8001C08FF0007F0F
-F01C1A7E9921> I E
-%EndDVIPSBitmapFont
-%DVIPSBitmapFont: Fn cmr17 20.74 18
-/Fn 18 119 df<000001FF00008000001FFFE0018000007F007801800001F8000E038000
-03E000070780000FC000018780001F000000CF80003E0000006F80007C0000003F8000F8
-0000003F8001F00000001F8003F00000000F8007E00000000F8007C000000007800FC000
-000007800FC000000007801F8000000003801F8000000003803F8000000003803F000000
-0001803F0000000001807F0000000001807F0000000001807E0000000000007E00000000
-0000FE000000000000FE000000000000FE000000000000FE000000000000FE0000000000
-00FE000000000000FE000000000000FE000000000000FE000000000000FE000000000000
-FE0000000000007E0000000000007E0000000000007F0000000000007F0000000001803F
-0000000001803F0000000001803F8000000001801F8000000001801F8000000003000FC0
-00000003000FC0000000030007E0000000060007E0000000060003F0000000060001F000
-00000C0000F80000001800007C0000001800003E0000003000001F0000006000000FC000
-01C0000003E0000380000001F8000E000000007F007C000000001FFFF00000000001FF00
-0000313D7CBB39> 67 D<FFFFFC000000FFFFFC00000003FE0000000001F80000000001
-F80000000001F80000000001F80000000001F80000000001F80000000001F80000000001
-F80000000001F80000000001F80000000001F80000000001F80000000001F80000000001
-F80000000001F80000000001F80000000001F80000000001F80000000001F80000000001
-F80000000001F80000000001F80000000001F80000000001F80000000001F80000000001
-F80000000001F80000000001F80000000001F80000000001F80000000001F80000000001
-F80000000001F80000000001F80000000001F80000006001F80000006001F80000006001
-F80000006001F80000006001F8000000E001F8000000C001F8000000C001F8000000C001
-F8000000C001F8000001C001F8000001C001F8000001C001F8000003C001F8000007C001
-F8000007C001F800000FC001F800003F8001F80000FF8003FC0007FF80FFFFFFFFFF80FF
-FFFFFFFF802B3B7CBA32> 76 D<000003FF00000000001E01E000000000F0003C000000
-03C0000F000000078000078000000F000003C000003E000001F000007C000000F80000F8
-0000007C0001F00000003E0001F00000003E0003E00000001F0007E00000001F8007C000
-00000F800FC00000000FC00F8000000007C01F8000000007E01F8000000007E03F000000
-0003F03F0000000003F03F0000000003F07F0000000003F87E0000000001F87E00000000
-01F87E0000000001F8FE0000000001FCFE0000000001FCFE0000000001FCFE0000000001
-FCFE0000000001FCFE0000000001FCFE0000000001FCFE0000000001FCFE0000000001FC
-FE0000000001FCFE0000000001FC7E0000000001F87F0000000003F87F0000000003F87F
-0000000003F87F0000000003F83F0000000003F03F8000000007F01F8000000007E01F80
-00000007E01FC00000000FE00FC00000000FC007C00000000F8007E00000001F8003E000
-00001F0001F00000003E0001F80000007E0000F80000007C00007C000000F800003E0000
-01F000000F000003C000000780000780000003E0001F00000000F8007C000000001E01E0
-0000000003FF000000363D7CBB3E> 79 D<003F80000001C0F0000003003C000004001E
-00000C000F000018000780001C0007C0003E0003C0003F0003E0003F0003E0003F0003E0
-001E0003E000000003E000000003E000000003E00000003FE000000FF3E000007E03E000
-01F803E00003E003E0000FC003E0001F8003E0003F0003E0003E0003E0007E0003E0007E
-0003E060FC0003E060FC0003E060FC0003E060FC0007E060FC0007E0607C000BE0607E00
-0BE0603E0011F0C01F0060F0C007C1807F8000FE003E0023257CA427> 97
-D<03E0000000FFE0000000FFE000000007E000000003E000000003E000000003E0000000
-03E000000003E000000003E000000003E000000003E000000003E000000003E000000003
-E000000003E000000003E000000003E000000003E000000003E000000003E000000003E0
-00000003E000000003E03FC00003E0E0780003E3001C0003E6000F0003E800078003F800
-03C003F00001E003E00001F003E00000F003E00000F803E00000F803E00000FC03E00000
-7C03E000007C03E000007E03E000007E03E000007E03E000007E03E000007E03E000007E
-03E000007E03E000007E03E000007E03E000007C03E000007C03E00000FC03E00000F803
-E00000F803E00001F003E00001E003F00003E003D80003C003C80007800384000E000383
-001C000381C0F00003003F8000273C7EBB2C> I<0007F800003C0E0000F0018001E000C0
-03C00060078000300F0000701F0000F81F0001F83E0001F83E0001F87E0000F07C000000
-7C000000FC000000FC000000FC000000FC000000FC000000FC000000FC000000FC000000
-FC0000007C0000007C0000007E0000003E0000003E00000C1F00000C1F0000180F800018
-0780003003C0006001E000C000F00180003C0E000007F8001E257DA423> I<0007F80000
-3C1E0000F0078001C003C003C001E0078000F00F0000F81F0000781E00007C3E00007C3E
-00007C7E00003E7C00003E7C00003EFC00003EFC00003EFFFFFFFEFC000000FC000000FC
-000000FC000000FC000000FC0000007C0000007C0000007E0000003E0000003E0000061F
-0000060F00000C0F80000C0780001803C0003000E00060007000C0001E07000003FC001F
-257EA423> 101 D<0000FC0000078300000E0380001C07C0003C0FC000780FC000F80FC0
-00F8078000F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0000001F0000001F00000FFFFFC00FFFFFC00
-01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0000003F800007FFFE0007FFFE0001A3C7FBB
-18> I<07000F801FC01FC01FC00F80070000000000000000000000000000000000000000
-0000000000000007C0FFC0FFC00FC007C007C007C007C007C007C007C007C007C007C007
-C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007
-C007C00FE0FFFEFFFE0F397DB815> 105 D<0003800007C0000FE0000FE0000FE00007C0
-000380000000000000000000000000000000000000000000000000000000000000000000
-0000000000000007E000FFE000FFE0000FE00003E00003E00003E00003E00003E00003E0
-0003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E0
-0003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E0
-0003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E00003E0
-7803C0FC07C0FC0780FC0780FC0F00780E00381C000FE000134A82B818> I<07C0FFC0FF
-C00FC007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007
-C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007
-C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007C007
-C00FE0FFFEFFFE0F3C7DBB15> 108 D<03E01FE0003FC000FFE0607C00C0F800FFE0801E
-01003C0007E3000F06001E0003E4000F88001F0003E4000F88001F0003E8000790000F00
-03E80007D0000F8003F00007E0000F8003F00007E0000F8003E00007C0000F8003E00007
-C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F80
-03E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007
-C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F80
-03E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007
-C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F8003E00007C0000F80
-07F0000FE0001FC0FFFF81FFFF03FFFEFFFF81FFFF03FFFE3F257EA443> I<03E01FE000
-FFE0607C00FFE0801E0007E3000F0003E4000F8003E4000F8003E800078003E80007C003
-F00007C003F00007C003E00007C003E00007C003E00007C003E00007C003E00007C003E0
-0007C003E00007C003E00007C003E00007C003E00007C003E00007C003E00007C003E000
-07C003E00007C003E00007C003E00007C003E00007C003E00007C003E00007C003E00007
-C003E00007C003E00007C003E00007C003E00007C007F0000FE0FFFF81FFFFFFFF81FFFF
-28257EA42C> I<0007FC0000001C070000007001C00001E000F00003C00078000780003C
-000F00001E001F00001F001E00000F003E00000F803E00000F807C000007C07C000007C0
-7C000007C0FC000007E0FC000007E0FC000007E0FC000007E0FC000007E0FC000007E0FC
-000007E0FC000007E0FC000007E07C000007C07C000007C07E00000FC03E00000F803E00
-000F801E00000F001F00001F000F00001E000780003C0003C000780001E000F000007001
-C000001C0700000007FC000023257EA427> I<03E03E00FFE0C300FFE1078007E20FC003
-E40FC003E80FC003E8078003E8030003F0000003F0000003F0000003E0000003E0000003
-E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003
-E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003E0000003
-E0000003E0000003E0000007F00000FFFFC000FFFFC0001A257EA41E> 114
-D<00FF02000700C6000C002E0010001E0030001E0060000E0060000E00E0000600E00006
-00E0000600F0000600F8000600FC0000007F0000003FF000003FFF80000FFFE00007FFF0
-0001FFFC00003FFE000001FE0000003F00C0001F00C0000F80C0000780E0000380E00003
-80E0000380E0000380F0000300F0000300F8000700F8000600E4000C00E2001800C18070
-00807F800019257DA41F> I<003000000030000000300000003000000030000000300000
-0070000000700000007000000070000000F0000000F0000001F0000001F0000003F00000
-07F000001FFFFE00FFFFFE0001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0000001F0000001F0000001F0000001F00000
-01F0000001F0000001F0000001F0000001F0018001F0018001F0018001F0018001F00180
-01F0018001F0018001F0018001F0018000F0010000F8030000F8030000780200003C0400
-000E08000003F00019357FB41E> I<FFFE000FFFFFFE000FFF07F00007F803E00003E003
-E00001C001F00001C001F000018001F800018000F800030000F8000300007C000600007C
-000600007E000600003E000C00003E000C00003F001C00001F001800001F001800000F80
-3000000F803000000FC070000007C060000007C060000003E0C0000003E0C0000003F1C0
-000001F180000001F180000000FB00000000FB00000000FF000000007E000000007E0000
-00003C000000003C000000003C0000000018000028257FA42A> 118
-D E
-%EndDVIPSBitmapFont
-end
-%%EndProlog
-%%BeginSetup
-%%Feature: *Resolution 300dpi
-TeXDict begin
-%%PaperSize: a4
-
-userdict/PStoPSxform PStoPSmatrix matrix currentmatrix
- matrix invertmatrix matrix concatmatrix
- matrix invertmatrix put
-%%EndSetup
-%%Page: (0,1) 1
-userdict/PStoPSsaved save put
-PStoPSmatrix setmatrix
-595.000000 0.271378 translate
-90 rotate
-0.706651 dup scale
-userdict/PStoPSmatrix matrix currentmatrix put
-userdict/PStoPSclip{0 0 moveto
- 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto
- closepath}put initclip
-/showpage{}def/copypage{}def/erasepage{}def
-PStoPSxform concat
-1 0 bop Fn 281 370 a(Cleaner) p 570 370 a(seman) n(tics) p
-927 370 a(for) p 1047 370 a(Ob) t(jectiv) n(e) p 1404
-370 a(Lab) r(el) p Fm 717 518 a(Jacques) p 934 518 a(Garrigue) 719
-634 y(Octob) r(er) p 945 634 a(26,) p 1040 634 a(1999) p
-Fl 11 836 a(Credits) p Fk 11 929 a(This) p 122 929 a(prop) q(osal) p
-319 929 a(con) o(tains) p 510 929 a(ideas) p 632 929
-a(from) p 747 929 a(Damien) p 928 929 a(Doligez) p 1101
-929 a(and) p 1196 929 a(Pierre) p 1340 929 a(W) l(eis.) p
-Fl 11 1073 a(Lab) r(els) p 221 1073 a(and) p 351 1073
-a(optionals) p Fk 11 1165 a(Lab) q(els) p 165 1165 a(and) p
-259 1165 a(optional) p 449 1165 a(argumen) o(ts) p 687
-1165 a(had) p 781 1165 a(t) o(w) o(o) p 873 1165 a(problems) p
-1082 1165 a(in) p 1139 1165 a(Ob) s(jectiv) o(e) p 1360
-1165 a(Lab) q(el.) p Fj 83 1280 a(\017) p Fk 133 1280
-a(They) p 259 1280 a(w) o(ere) p 372 1280 a(not) p 459
-1280 a(fully) p 570 1280 a(coheren) o(t) p 767 1280 a(with) p
-878 1280 a(the) p 963 1280 a(original) p 1139 1280 a(call-b) o(y-v) m
-(alue) p 1423 1280 a(seman) o(tics) p 1644 1280 a(of) p
-1700 1280 a(the) p 1784 1280 a(lan-) 133 1340 y(guage.) p
-303 1340 a(In) p 368 1340 a(some) p 495 1340 a(\(subtle\)) p
-681 1340 a(cases,) p 823 1340 a(a) p 868 1340 a(side-e\013ect) p
-1099 1340 a(migh) o(t) p 1243 1340 a(get) p 1329 1340
-a(dela) o(y) o(ed) p 1508 1340 a(more) p 1635 1340 a(than) p
-1753 1340 a(in) p 1814 1340 a(an) 133 1400 y(un) o(t) o(yp) q(ed) p
-322 1400 a(seman) o(tics.) p Fj 83 1502 a(\017) p Fk
-133 1502 a(F) l(or) p 220 1502 a(optional) p 410 1502
-a(argumen) o(ts,) p 660 1502 a(no) p 728 1502 a(un) o(t) o(yp) q(ed) p
-918 1502 a(seman) o(tics) p 1139 1502 a(existed.) 84
-1616 y(This) p 195 1616 a(new) p 295 1616 a(prop) q(osal) p
-492 1616 a(corrects) p 674 1616 a(these) p 799 1616 a(t) o(w) o(o) p
-891 1616 a(\015a) o(ws.) p Fi 11 1746 a(Syn) n(tax) p
-Fk 11 1838 a(W) l(e) p 95 1838 a(k) o(eep) p 206 1838
-a(Ob) s(jectiv) o(e) p 426 1838 a(Lab) q(el's) p 594
-1838 a(syn) o(tax,) p 764 1838 a(except) p 917 1838 a(for) p
-991 1838 a(default) p 1155 1838 a(v) m(alues) p 1301
-1838 a(in) p 1357 1838 a(optional) p 1547 1838 a(argumen) o(ts.) p
-Fh 329 1944 a(typ) n(expr) p Fk 528 1944 a(::=) p Fg
-634 1944 a(:) p 656 1944 a(:) p 678 1944 a(:) p Fj 579
-2004 a(j) p Fh 634 2004 a(typ) n(expr) p Fj 806 2004
-a(!) p Fh 870 2004 a(typ) n(expr) p Fj 579 2064 a(j) p
-Fk 634 2064 a([?]) p Fi(lab) r(el) p Fk 801 2064 a(:) p
-Fh(typ) n(expr) p Fj 987 2064 a(!) p Fh 1050 2064 a(typ) n(expr) 391
-2124 y(expr) p Fk 528 2124 a(::=) p Fg 634 2124 a(:) p
-656 2124 a(:) p 678 2124 a(:) p Fj 579 2185 a(j) p Fh
-634 2185 a(expr) p 746 2185 a(lab) n(ele) n(d-expr) p
-Ff 991 2163 a(+) p Fj 579 2245 a(j) p Fe 634 2245 a(fun) p
-Fj 728 2245 a(f) p Fh(lab) n(ele) n(d-simple-p) n(attern) p
-Fj 1209 2245 a(g) p Ff 1234 2227 a(+) p Fk 1280 2245
-a([) p Fe(when) p Fh 1412 2245 a(expr) p Fk 1507 2245
-a(]) p Fj 1535 2245 a(!) p Fh 1599 2245 a(expr) p Fj
-579 2305 a(j) p Fe 634 2305 a(function) p Fh 856 2305
-a(lab) n(ele) n(d-p) n(attern) p Fk 1177 2305 a([) p
-Fe(when) p Fh 1309 2305 a(expr) p Fk 1404 2305 a(]) p
-Fj 1432 2305 a(!) p Fh 1496 2305 a(expr) p Fj 785 2365
-a(f) p Fe(|) p Fh 851 2365 a(lab) n(ele) n(d-p) n(attern) p
-Fk 1172 2365 a([) p Fe(when) p Fg 1305 2365 a(expr) p
-Fk 1403 2365 a(]) p Fj 1430 2365 a(!) p Fh 1494 2365
-a(expr) p Fj 1589 2365 a(g) p Fd 1614 2347 a(\003) p
-Fh 242 2425 a(lab) n(ele) n(d-expr) p Fk 528 2425 a(::=) p
-634 2425 a([?]) p Fh(expr) p Fj 579 2486 a(j) p Fk 634
-2486 a([?]) p Fi(lab) r(el) p Fk 801 2486 a(:) p Fh(expr) 182
-2546 y(lab) n(ele) n(d-p) n(attern) p Fk 528 2546 a(::=) p
-Fh 634 2546 a(p) n(attern) p Fj 579 2606 a(j) p Fi 634
-2606 a(lab) r(el) p Fk 751 2606 a(:) p Fh(p) n(attern) p
-Fj 579 2666 a(j) p Fk 634 2666 a(?[) p Fe(\() p Fh(expr) p
-Fe(\)) p Fk(]) p Fi(lab) r(el) p Fk 943 2666 a(:) p Fh
-956 2666 a(p) n(attern) p Fk 926 2937 a(1) p eop
-PStoPSsaved restore
-userdict/PStoPSsaved save put
-PStoPSmatrix setmatrix
-595.000000 421.271378 translate
-90 rotate
-0.706651 dup scale
-userdict/PStoPSmatrix matrix currentmatrix put
-userdict/PStoPSclip{0 0 moveto
- 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto
- closepath}put initclip
-PStoPSxform concat
-2 1 bop Fi 11 168 a(Dynamic) p 247 168 a(seman) n(tics) p
-Fj 11 261 a(;) p Fk 52 261 a(is) p 101 261 a(a) p 141
-261 a(notation) p 337 261 a(for) p 411 261 a(the) p 495
-261 a(empt) o(y) p 644 261 a(lab) q(el.) 86 366 y(\() p
-Fe(fun) p Fi 198 366 a(l) p Fc 214 373 a(i) p Fk 227
-366 a(:) p Fg(x) p Fj 282 366 a(!) p Fg 346 366 a(e) p
-Fk(\)) p Fi 404 366 a(l) p Fc 420 373 a(1) p Fk 442 366
-a(:) p Fg 455 366 a(e) p Ff 478 373 a(1) p Fg 506 366
-a(:) p 528 366 a(:) p 550 366 a(:) p Fi 571 366 a(l) p
-Fc 587 373 a(n) p Fk 612 366 a(:) p Fg 625 366 a(e) p
-Fb 648 373 a(n) p Fj 515 427 a(!) p Fk 579 427 a(\() p
-Fg(e) p Fk([) p Fg(e) p Fb 658 434 a(i) p Fg 671 427
-a(=x) p Fk(]) p Fi 752 427 a(l) p Fc 768 434 a(1) p Fk
-790 427 a(:) p Fg(e) p Ff 827 434 a(1) p Fg 855 427 a(:) p
-877 427 a(:) p 899 427 a(:) p Fi 920 427 a(l) p Fc 936
-434 a(i) p Fd(\000) p Fc(1) p Fk 997 427 a(:) p Fg 1010
-427 a(e) p Fb 1033 434 a(i) p Fd(\000) p Ff(1) p Fi 1108
-427 a(l) p Fc 1124 434 a(i) p Ff(+) p Fc(1) p Fk 1185
-427 a(:) p Fg(e) p Fb 1222 434 a(i) p Ff(+1) p Fg 1289
-427 a(:) p 1311 427 a(:) p 1333 427 a(:) p Fi 1354 427
-a(l) p Fc 1370 434 a(n) p Fk 1395 427 a(:) p Fg 1408
-427 a(e) p Fb 1431 434 a(n) p Fk 86 487 a(\() p Fe(fun) p
-Fk 198 487 a(?) p Fi(l) p Fc 237 494 a(i) p Fk 250 487
-a(:) p Fg(x) p Fj 305 487 a(!) p Fg 369 487 a(e) p Fk(\)) p
-Fi 427 487 a(l) p Fc 443 494 a(1) p Fk 465 487 a(:) p
-Fg 478 487 a(e) p Ff 501 494 a(1) p Fg 529 487 a(:) p
-551 487 a(:) p 573 487 a(:) p Fi 594 487 a(l) p Fc 610
-494 a(n) p Fk 635 487 a(:) p Fg 648 487 a(e) p Fb 671
-494 a(n) p Fj 515 547 a(!) p Fg 579 547 a(e) p Fk([) p
-Fe(Some) p Fk 717 547 a(\() p Fg(e) p Fb 759 554 a(i) p
-Fk 773 547 a(\)) p Fg(=x) p Fk(]) p Fi 874 547 a(l) p
-Fc 890 554 a(1) p Fk 912 547 a(:) p Fg 925 547 a(e) p
-Ff 948 554 a(1) p Fg 976 547 a(:) p 998 547 a(:) p 1020
-547 a(:) p Fi 1042 547 a(l) p Fc 1058 554 a(i) p Fd(\000) p
-Fc(1) p Fk 1118 547 a(:) p Fg(e) p Fb 1155 554 a(i) p
-Fd(\000) p Ff(1) p Fi 1230 547 a(l) p Fc 1246 554 a(i) p
-Ff(+) p Fc(1) p Fk 1307 547 a(:) p Fg 1320 547 a(e) p
-Fb 1343 554 a(i) p Ff(+1) p Fg 1410 547 a(:) p 1432 547
-a(:) p 1454 547 a(:) p Fi 1476 547 a(l) p Fc 1492 554
-a(n) p Fk 1516 547 a(:) p Fg(e) p Fb 1553 554 a(n) p
-Fk 86 607 a(\() p Fe(fun) p Fk 198 607 a(?) p Fi(l) p
-Fk(:) p Fg 250 607 a(x) p Fj 292 607 a(!) p Fg 356 607
-a(e) p Fk(\)) p Fi 413 607 a(l) p Fc 429 614 a(1) p Fk
-451 607 a(:) p Fg(e) p Ff 488 614 a(1) p Fg 516 607 a(:) p
-538 607 a(:) p 560 607 a(:) p Fi 581 607 a(l) p Fc 597
-614 a(n) p Fk 621 607 a(:) p Fg(e) p Fb 658 614 a(n) p
-Fk 1154 607 a(when) p Fi 1281 607 a(l) p Fc 1297 614
-a(i) p Fk 1324 607 a(=) p Fj 1376 607 a(;) p Fk 1417
-607 a(and) p Fg 1512 607 a(l) p Fj 1541 607 a(62) p 1588
-607 a(f) p Fi(l) p Fc 1629 614 a(1) p Fg 1660 607 a(:) p
-1682 607 a(:) p 1704 607 a(:) p Fi 1725 607 a(l) p Fc
-1741 614 a(n) p Fj 1765 607 a(g) 515 667 y(!) p Fg 579
-667 a(e) p Fk([) p Fe(None) p Fg 717 667 a(=x) p Fk(]) p
-Fi 799 667 a(l) p Fc 815 674 a(1) p Fk 837 667 a(:) p
-Fg(e) p Ff 874 674 a(1) p Fg 901 667 a(:) p 923 667 a(:) p
-945 667 a(:) p Fi 967 667 a(l) p Fc 983 674 a(n) p Fk
-1007 667 a(:) p Fg(e) p Fb 1044 674 a(n) p Fk 86 728
-a(\(\() p Fe(fun) p Fi 217 728 a(l) p Fk(:) p Fg 246
-728 a(x) p Fj 288 728 a(!) p Fg 352 728 a(e) p Fk(\)) p
-Fi 409 728 a(l) p Fc 425 735 a(1) p Fk 447 728 a(:) p
-Fg(e) p Ff 484 735 a(1) p Fg 511 728 a(:) p 533 728 a(:) p
-555 728 a(:) p Fi 577 728 a(l) p Fc 593 735 a(m) p Fk
-629 728 a(:) p Fg 642 728 a(e) p Fb 665 735 a(m) p Fk
-698 728 a(\)) p Fi 733 728 a(l) p Fc 749 735 a(m) p Ff(+) p
-Fc(1) p Fk 833 728 a(:) p Fg 846 728 a(e) p Fb 869 735
-a(m) p Ff(+1) p Fg 955 728 a(:) p 977 728 a(:) p 999
-728 a(:) p Fi 1021 728 a(l) p Fc 1037 735 a(n) p Fk 1061
-728 a(:) p Fg(e) p Fb 1098 735 a(n) p Fk 1373 728 a(when) p
-Fi 1501 728 a(l) p Fj 1530 728 a(62) p 1577 728 a(f) p
-Fi(l) p Fc 1618 735 a(1) p Fg 1648 728 a(:) p 1670 728
-a(:) p 1692 728 a(:) p Fi 1714 728 a(l) p Fc 1730 735
-a(m) p Fj 1765 728 a(g) 515 788 y(!) p Fk 579 788 a(\() p
-Fe(fun) p Fi 691 788 a(l) p Fk(:) p Fg 720 788 a(x) p
-Fj 761 788 a(!) p Fg 825 788 a(e) p Fk(\)) p Fi 883 788
-a(l) p Fc 899 795 a(1) p Fk 921 788 a(:) p Fg 934 788
-a(e) p Ff 957 795 a(1) p Fg 985 788 a(:) p 1007 788 a(:) p
-1029 788 a(:) p Fi 1051 788 a(l) p Fc 1067 795 a(n) p
-Fk 1091 788 a(:) p Fg 1104 788 a(e) p Fb 1127 795 a(n) p
-Fk 86 848 a(\(\() p Fe(fun) p Fk 217 848 a(?) p Fi(l) p
-Fk(:) p Fg 269 848 a(x) p Fj 311 848 a(!) p Fg 375 848
-a(e) p Fk(\)) p Fi 432 848 a(l) p Fc 448 855 a(1) p Fk
-470 848 a(:) p Fg(e) p Ff 507 855 a(1) p Fg 535 848 a(:) p
-557 848 a(:) p 579 848 a(:) p Fi 600 848 a(l) p Fc 616
-855 a(m) p Fk 652 848 a(:) p Fg 665 848 a(e) p Fb 688
-855 a(m) p Fk 721 848 a(\)) p Fi 756 848 a(l) p Fc 772
-855 a(m) p Ff(+) p Fc(1) p Fk 856 848 a(:) p Fg 869 848
-a(e) p Fb 892 855 a(m) p Ff(+1) p Fg 978 848 a(:) p 1000
-848 a(:) p 1022 848 a(:) p Fi 1044 848 a(l) p Fc 1060
-855 a(n) p Fk 1084 848 a(:) p Fg(e) p Fb 1121 855 a(n) p
-Fk 1261 848 a(when) p Fj 1388 848 a(f) p Fi(l) p Fg(;) p
-Fj 1451 848 a(;g) p 1530 848 a(6) m(\\) p 1577 848 a(f) p
-Fi(l) p Fc 1618 855 a(1) p Fg 1648 848 a(:) p 1670 848
-a(:) p 1692 848 a(:) p Fi 1714 848 a(l) p Fc 1730 855
-a(m) p Fj 1765 848 a(g) 515 908 y(!) p Fk 579 908 a(\() p
-Fe(fun) p Fk 691 908 a(?) p Fi(l) p Fk(:) p Fg 743 908
-a(x) p Fj 785 908 a(!) p Fg 848 908 a(e) p Fk(\)) p Fi
-906 908 a(l) p Fc 922 915 a(1) p Fk 944 908 a(:) p Fg(e) p
-Ff 981 915 a(1) p Fg 1008 908 a(:) p 1030 908 a(:) p
-1052 908 a(:) p Fi 1074 908 a(l) p Fc 1090 915 a(n) p
-Fk 1114 908 a(:) p Fg 1127 908 a(e) p Fb 1150 915 a(n) p
-Fi 11 1035 a(T) n(yping) p Fk 11 1127 a(Seman) o(tics) p
-240 1127 a(are) p 321 1127 a(k) o(ept) p 430 1127 a(throughout) p
-685 1127 a(compilation) p 950 1127 a(b) o(y) p 1018 1127
-a(disallo) o(wing) p 1269 1127 a(lab) q(el) p 1387 1127
-a(comm) o(utation) p 1684 1127 a(for) p 1759 1127 a(func-) 11
-1187 y(tion) p 116 1187 a(t) o(yp) q(es.) p 278 1187
-a(Ho) o(w) o(ev) o(er,) p 494 1187 a(the) p 583 1187
-a(original) p 764 1187 a(comfort) p 949 1187 a(of) p
-1009 1187 a(out-of-order) p 1283 1187 a(application) p
-1540 1187 a(is) p 1594 1187 a(reco) o(v) o(ered) p 1814
-1187 a(b) o(y) 11 1247 y(allo) o(wing) p 207 1247 a(argumen) o(t) p
-431 1247 a(reordering) p 670 1247 a(in) p 732 1247 a(application,) p
-1005 1247 a(when) p 1138 1247 a(the) p 1227 1247 a(function's) p
-1457 1247 a(t) o(yp) q(e) p 1572 1247 a(is) p Fh 1626
-1247 a(wel) r(l) p 1731 1247 a(known) p Fk 11 1308 a(\() p
-Fh(c.f.) p Fk 118 1308 a(p) q(olymorphic) p 400 1308
-a(metho) q(ds\).) p Fl 11 1452 a(V) p 56 1452 a(arian) n(ts) p
-Fk 11 1544 a(V) l(arian) o(t) p 187 1544 a(t) o(yping,) p
-355 1544 a(as) p 417 1544 a(it) p 468 1544 a(is) p 519
-1544 a(presen) o(ted) p 739 1544 a(in) p 798 1544 a(the) p
-884 1544 a(user's) p 1022 1544 a(man) o(ual,) p 1210
-1544 a(is) p 1261 1544 a(not) p 1350 1544 a(principal:) p
-1576 1544 a(in) p 1635 1544 a(some) p 1760 1544 a(cases) 11
-1605 y(t) o(ypabilit) o(y) p 239 1605 a(of) p 301 1605
-a(an) p 375 1605 a(expression) p 616 1605 a(ma) o(y) p
-728 1605 a(dep) q(end) p 904 1605 a(on) p 978 1605 a(the) p
-1069 1605 a(order) p 1202 1605 a(in) p 1265 1605 a(whic) o(h) p
-1411 1605 a(the) p 1502 1605 a(t) o(yping) p 1660 1605
-a(algorithm) 11 1665 y(pro) q(ceeds.) p Fe 133 1779 a(#) p
-184 1779 a(let) p 286 1779 a(f1) p 363 1779 a(\(x) p
-440 1779 a(:) p 491 1779 a([<) p 568 1779 a(a) p 620
-1779 a(b\(int\)]\)) p 850 1779 a(=) p 902 1779 a(\(\)) 184
-1839 y(let) p 286 1839 a(f2) p 363 1839 a(\(x) p 440
-1839 a(:) p 491 1839 a([<) p 568 1839 a(a]\)) p 671 1839
-a(=) p 722 1839 a(\(\)) 184 1899 y(let) p 286 1899 a(f3) p
-363 1899 a(\(x) p 440 1899 a(:) p 491 1899 a([<) p 568
-1899 a(a) p 620 1899 a(b\(bool\)]\)) p 876 1899 a(=) p
-927 1899 a(\(\);;) 133 1960 y(val) p 235 1960 a(f1) p
-312 1960 a(:) p 363 1960 a([<) p 440 1960 a(a) p 491
-1960 a(b\(int\)]) p 696 1960 a(->) p 773 1960 a(unit) p
-902 1960 a(=) p 953 1960 a(<fun>) 133 2020 y(val) p 235
-2020 a(f2) p 312 2020 a(:) p 363 2020 a([<) p 440 2020
-a(a]) p 517 2020 a(->) p 594 2020 a(unit) p 722 2020
-a(=) p 773 2020 a(<fun>) 133 2080 y(val) p 235 2080 a(f3) p
-312 2080 a(:) p 363 2080 a([<) p 440 2080 a(a) p 491
-2080 a(b\(bool\)]) p 722 2080 a(->) p 799 2080 a(unit) p
-927 2080 a(=) p 978 2080 a(<fun>) 133 2140 y(#) p 184
-2140 a(fun) p 286 2140 a(x) p 338 2140 a(->) p 414 2140
-a(f1) p 491 2140 a(x;) p 568 2140 a(f2) p 645 2140 a(x;) p
-722 2140 a(f3) p 799 2140 a(x;;) 133 2200 y(-) p 184
-2200 a(:) p 235 2200 a([<) p 312 2200 a(a]) p 389 2200
-a(->) p 466 2200 a(unit) p 594 2200 a(=) p 645 2200 a(<fun>) 133
-2260 y(#) p 184 2260 a(fun) p 286 2260 a(x) p 338 2260
-a(->) p 414 2260 a(f1) p 491 2260 a(x;) p 568 2260 a(f3) p
-645 2260 a(x;;) 133 2321 y(Character) o(s) p 414 2321
-a(18-19:) 133 2381 y(This) p 261 2381 a(expressio) o(n) p
-543 2381 a(has) p 645 2381 a(type) p 773 2381 a([<) p
-850 2381 a(a) p 902 2381 a(b\(int\)]) p 1107 2381 a(but) p
-1209 2381 a(is) p 1286 2381 a(here) p 1414 2381 a(used) p
-1542 2381 a(with) p 1670 2381 a(type) 184 2441 y([<) p
-261 2441 a(a) p 312 2441 a(b\(bool\)]) p Fk 84 2555 a(Here) p
-204 2555 a(the) p 292 2555 a(constrain) o(t) p 526 2555
-a(in) o(tro) q(duced) p 775 2555 a(b) o(y) p Fe 848 2555
-a(f2) p Fk 920 2555 a(hides) p 1049 2555 a(the) p 1138
-2555 a(constructor) p Fe 1401 2555 a(b) p Fk(,) p 1462
-2555 a(and) p 1562 2555 a(a) o(v) o(oids) p 1714 2555
-a(a) p 1760 2555 a(clash) 11 2615 y(b) q(et) o(w) o(een) p
-Fe 199 2615 a(int) p Fk 292 2615 a(and) p Fe 387 2615
-a(bool) p Fk(.) 84 2676 y(An) p 163 2676 a(easy) p 270
-2676 a(w) o(a) o(y) p 369 2676 a(to) p 428 2676 a(solv) o(e) p
-547 2676 a(this) p 642 2676 a(w) o(ould) p 784 2676 a(b) q(e) p
-850 2676 a(to) p 909 2676 a(restrict) p 1077 2676 a(hiding) p
-1226 2676 a(absen) o(t) p 1379 2676 a(lab) q(els) p 1515
-2676 a(to) p 1575 2676 a(generic) p 1739 2676 a(t) o(yp) q(es.) 11
-2736 y(This) p 124 2736 a(w) o(a) o(y) p 224 2736 a(the) p
-310 2736 a(second) p 469 2736 a(case) p 574 2736 a(w) o(ould) p
-718 2736 a(still) p 814 2736 a(fail,) p 913 2736 a(since) p
-Fe 1034 2736 a(x) p Fk 1077 2736 a(has) p 1166 2736 a(a) p
-1208 2736 a(monorphic) p 1451 2736 a(t) o(yp) q(e.) p
-1584 2736 a(This) p 1697 2736 a(solution) 11 2796 y(w) o(ould) p
-153 2796 a(b) q(e) p 219 2796 a(correct) p 382 2796 a(and) p
-477 2796 a(principal.) 926 2937 y(2) p eop
-PStoPSsaved restore
-%%Page: (2,3) 2
-userdict/PStoPSsaved save put
-PStoPSmatrix setmatrix
-595.000000 0.271378 translate
-90 rotate
-0.706651 dup scale
-userdict/PStoPSmatrix matrix currentmatrix put
-userdict/PStoPSclip{0 0 moveto
- 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto
- closepath}put initclip
-/showpage{}def/copypage{}def/erasepage{}def
-PStoPSxform concat
-3 2 bop Fk 84 168 a(Ho) o(w) o(ev) o(er,) p 293 168 a(one) p
-382 168 a(can) p 472 168 a(easily) p 606 168 a(see) p
-684 168 a(that) p 789 168 a(this) p 884 168 a(solution) p
-1068 168 a(is) p 1117 168 a(coun) o(ter-in) o(tuitiv) o(e.) p
-1504 168 a(F) l(or) p 1591 168 a(the) p 1675 168 a(user,) p
-Fe 1791 168 a(b) p Fk 1833 168 a(is) 11 229 y(already) p
-183 229 a(an) p 250 229 a(imp) q(ossible) p 488 229 a(constructor,) p
-759 229 a(and) p 854 229 a(ha) o(ving) p 1011 229 a(a) p
-1052 229 a(clash) p 1174 229 a(on) p 1242 229 a(it) p
-1291 229 a(is) p 1340 229 a(hard) p 1453 229 a(to) p
-1513 229 a(understand.) 84 289 y(Another) p 277 289 a(solution) p
-463 289 a(is) p 514 289 a(to) p 575 289 a(go) p 642 289
-a(the) p 728 289 a(opp) q(osite) p 924 289 a(w) o(a) o(y) l(.) p
-1044 289 a(T) l(o) p 1117 289 a(accept) p 1271 289 a(more) p
-1395 289 a(programs.) p 1634 289 a(This) p 1747 289 a(is) p
-1798 289 a(the) 11 349 y(w) o(a) o(y) p 109 349 a(w) o(e) p
-181 349 a(explore) p 351 349 a(here,) p 470 349 a(with) p
-581 349 a(an) p 649 349 a(unc) o(hanged) p 891 349 a(syn) o(tax.) p
-Fi 11 479 a(T) n(yping) p Fk 11 571 a(The) p 114 571
-a(idea) p 220 571 a(is) p 273 571 a(to) p 336 571 a(dela) o(y) p
-466 571 a(uni\014cation) p 711 571 a(on) p 782 571 a(constructor) p
-1043 571 a(un) o(til) p 1161 571 a(they) p 1274 571 a(are) p
-1359 571 a(explicitely) p 1595 571 a(kno) o(wn) p 1753
-571 a(to) p 1816 571 a(b) q(e) 11 631 y(presen) o(t.) p
-199 631 a(W) l(e) p 280 631 a(k) o(eep) p 390 631 a(the) p
-472 631 a(\() p Fg(T) t(;) p 546 631 a(U;) p 601 631
-a(L) p Fk(\)) p 666 631 a(represen) o(tation) p 983 631
-a(of) p 1036 631 a(v) m(arian) o(t) p 1200 631 a(t) o(yp) q(es,) p
-1341 631 a(but) p Fg 1428 631 a(T) p Fk 1478 631 a(is) p
-1525 631 a(no) p 1591 631 a(longer) p 1735 631 a(a) p
-1774 631 a(map) 11 692 y(from) p 126 692 a(constructors) p
-403 692 a(to) p 462 692 a(t) o(yp) q(es,) p 605 692 a(but) p
-694 692 a(from) p 809 692 a(constructors) p 1086 692
-a(to) p 1146 692 a(sets) p 1241 692 a(of) p 1297 692
-a(t) o(yp) q(es.) 84 752 y(When) p 230 752 a(w) o(e) p
-307 752 a(unify) p 436 752 a(t) o(w) o(o) p 532 752 a(v) m(arian) o(t) p
-702 752 a(t) o(yp) q(es,) p 850 752 a(the) p 938 752
-a(\014rst) p 1043 752 a(step) p 1150 752 a(is) p 1204
-752 a(just) p 1305 752 a(to) p 1369 752 a(tak) o(e) p
-1479 752 a(the) p 1567 752 a(union) p 1707 752 a(of) p
-1767 752 a(b) q(oth) 11 812 y(t) o(yping) p 162 812 a(en) o(vironmen) o
-(ts,) p 476 812 a(dropping) p 682 812 a(unnecessary) p
-952 812 a(t) o(yp) q(es.) 204 932 y(\() p Fg(T) p Ff
-252 939 a(1) p Fg 272 932 a(;) p 294 932 a(U) p Ff 327
-939 a(1) p Fg 346 932 a(;) p 368 932 a(L) p Ff 401 939
-a(1) p Fk 421 932 a(\)) p Fj 451 932 a(^) p Fk 495 932
-a(\() p Fg(T) p Ff 543 939 a(2) p Fg 563 932 a(;) p 585
-932 a(U) p Ff 618 939 a(2) p Fg 637 932 a(;) p 659 932
-a(L) p Ff 692 939 a(2) p Fk 712 932 a(\)) p 745 932 a(=) p
-797 932 a(\(\() p Fg(T) p Ff 864 939 a(1) p Fj 883 932
-a(j) p Fb 897 939 a(U) p Fa 921 944 a(1) p Fd 938 939
-a(\\) p Fb(U) p Fa 986 944 a(2) p Fk 1005 932 a(\)) p
-Fj 1035 932 a([) p Fk 1079 932 a(\() p Fg(T) p Ff 1127
-939 a(2) p Fj 1146 932 a(j) p Fb 1160 939 a(U) p Fa 1184
-944 a(1) p Fd 1201 939 a(\\) p Fb(U) p Fa 1249 944 a(2) p
-Fk 1268 932 a(\)) p Fg(;) p 1309 932 a(U) p Ff 1342 939
-a(1) p Fj 1373 932 a(\\) p Fg 1417 932 a(U) p Ff 1450
-939 a(2) p Fg 1470 932 a(;) p 1492 932 a(L) p Ff 1525
-939 a(1) p Fj 1556 932 a([) p Fg 1600 932 a(L) p Ff 1633
-939 a(2) p Fk 1653 932 a(\)) 84 1042 y(Here) p 203 1042
-a(the) p 291 1042 a(union) p 431 1042 a(of) p 490 1042
-a(t) o(w) o(o) p 587 1042 a(t) o(yping) p 742 1042 a(en) o(vironmen) o
-(ts) p 1046 1042 a(is) p 1099 1042 a(the) p 1187 1042
-a(p) q(oin) o(t) o(wise) p 1407 1042 a(union) p 1547
-1042 a(of) p 1606 1042 a(their) p 1727 1042 a(sets) p
-1826 1042 a(of) 11 1102 y(t) o(yp) q(es) p 140 1102 a(for) p
-214 1102 a(eac) o(h) p 324 1102 a(constructor.) 84 1162
-y(This) p 195 1162 a(\014rst) p 296 1162 a(step) p 399
-1162 a(nev) o(er) p 529 1162 a(fails.) 84 1222 y(In) p
-145 1222 a(a) p 186 1222 a(second) p 343 1222 a(step,) p
-460 1222 a(structural) p 685 1222 a(constrain) o(ts) p
-934 1222 a(are) p 1015 1222 a(enforced) p 1209 1222 a(on) p
-1277 1222 a(the) p 1361 1222 a(resulting) p 1562 1222
-a(t) o(yp) q(e) p 1672 1222 a(\() p Fg(T) t(;) p 1746
-1222 a(U;) p 1801 1222 a(L) p Fk(\).) 11 1282 y(First,) p
-Fg 144 1282 a(L) p Fk 195 1282 a(should) p 351 1282 a(b) q(e) p
-418 1282 a(included) p 614 1282 a(in) p Fg 672 1282 a(U) p
-Fk 710 1282 a(.) p 749 1282 a(Then,) p 892 1282 a(for) p
-967 1282 a(all) p 1036 1282 a(constructors) p 1314 1282
-a(app) q(earing) p 1542 1282 a(in) p Fg 1600 1282 a(L) p
-Fk(,) p 1664 1282 a(the) p 1749 1282 a(set) p 1826 1282
-a(of) 11 1343 y(t) o(yp) q(es) p 136 1343 a(asso) q(ciated) p
-365 1343 a(with) p 472 1343 a(eac) o(h) p 578 1343 a(constructor) p
-833 1343 a(is) p 878 1343 a(collapsed) p 1084 1343 a(b) o(y) p
-1148 1343 a(uni\014cation.) p 1407 1343 a(This) p 1515
-1343 a(can) p 1600 1343 a(b) q(e) p 1663 1343 a(expressed) 11
-1403 y(b) o(y) p 78 1403 a(rewriting) p 287 1403 a(rules,) p
-417 1403 a(where) p Fg 558 1403 a(e) p Fk 597 1403 a(is) p
-646 1403 a(a) p 687 1403 a(m) o(ulti-equation) p 1015
-1403 a(and) p Fg 1109 1403 a(\036) p Fk 1155 1403 a(a) p
-1195 1403 a(set) p 1271 1403 a(of) p 1327 1403 a(m) o(ultiequations) 249
-1509 y(if) p Fg 294 1509 a(L) p Fj 341 1509 a(6\032) p
-Fg 393 1509 a(U) p Fk 448 1509 a(then) p 559 1509 a(\() p
-Fg(T) t(;) p 633 1509 a(U;) p 688 1509 a(L) p Fk(\)) p
-753 1509 a(=) p Fg 805 1509 a(e) p Fj 839 1509 a(^) p
-Fg 883 1509 a(\036) p Fj 926 1509 a(\000) p 956 1509
-a(!) p 1020 1509 a(?) p Fk 249 1629 a(if) p Fg 294 1629
-a(l) p Fj 323 1629 a(2) p Fg 370 1629 a(L) p Fk 420 1629
-a(and) p Fg 515 1629 a(T) p Fk 551 1629 a(\() p Fg(l) p
-Fk 586 1629 a(\)) p 617 1629 a(=) p Fj 669 1629 a(f) p
-Fg(\034) p Ff 715 1636 a(1) p Fg 735 1629 a(;) p 757
-1629 a(:) p 779 1629 a(:) p 801 1629 a(:) p 822 1629
-a(;) p 844 1629 a(\034) p Fb 865 1636 a(n) p Fj 889 1629
-a(g) p Fk 930 1629 a(then) 298 1689 y(\() p Fg(T) t(;) p
-372 1689 a(U;) p 427 1689 a(L) p Fk(\)) p 492 1689 a(=) p
-Fg 544 1689 a(e) p Fj 577 1689 a(^) p Fg 622 1689 a(\036) p
-Fj 664 1689 a(\000) p 695 1689 a(!) p Fk 759 1689 a(\() p
-Fg(T) p Fj 814 1689 a(f) p Fg(l) p Fj 867 1689 a(7!) p
-Fg 931 1689 a(\034) p Ff 952 1696 a(1) p Fj 972 1689
-a(g) p Fg(;) p 1019 1689 a(U;) p 1074 1689 a(L) p Fk(\)) p
-1139 1689 a(=) p Fg 1191 1689 a(e) p Fj 1225 1689 a(^) p
-Fg 1269 1689 a(\034) p Ff 1290 1696 a(1) p Fk 1324 1689
-a(=) p Fg 1376 1689 a(:) p 1398 1689 a(:) p 1420 1689
-a(:) p Fk 1447 1689 a(=) p Fg 1498 1689 a(\034) p Fb
-1519 1696 a(n) p Fj 1554 1689 a(^) p Fg 1598 1689 a(\036) p
-Fk 84 1796 a(Optionally) p 331 1796 a(one) p 425 1796
-a(can) p 519 1796 a(add) p 619 1796 a(rules) p 740 1796
-a(that) p 850 1796 a(remo) o(v) o(e) p 1022 1796 a(a) p
-1067 1796 a(constructor) p Fg 1329 1796 a(l) p Fk 1366
-1796 a(from) p Fg 1486 1796 a(U) p Fk 1545 1796 a(if) p
-1594 1796 a(the) p 1683 1796 a(equation) 11 1856 y(obtained) p
-211 1856 a(from) p Fg 326 1856 a(T) p Fk 362 1856 a(\() p
-Fg(l) p Fk 397 1856 a(\)) p 431 1856 a(has) p 518 1856
-a(no) p 586 1856 a(solution.) p 790 1856 a(Suc) o(h) p
-908 1856 a(rules) p 1024 1856 a(w) o(ould) p 1167 1856
-a(b) q(e) p 1233 1856 a(sound) p 1374 1856 a(and) p 1469
-1856 a(complete.) p Fi 11 1986 a(Syn) n(tax) p 198 1986
-a(of) p 262 1986 a(t) n(yp) r(es) p Fk 11 2078 a(Thanks) p
-188 2078 a(to) p 250 2078 a(the) p 336 2078 a(go) q(o) q(d) p
-458 2078 a(prop) q(erties) p 689 2078 a(of) p 747 2078
-a(these) p 874 2078 a(constrain) o(ts,) p 1139 2078 a(the) p
-1226 2078 a(surface) p 1392 2078 a(syn) o(tax) p 1551
-2078 a(of) p 1608 2078 a(t) o(yp) q(es) p 1740 2078 a(w) o(ould) 11
-2138 y(only) p 118 2138 a(ha) o(v) o(e) p 230 2138 a(to) p
-290 2138 a(b) q(e) p 356 2138 a(sligh) o(tly) p 527 2138
-a(extended.) p Fh 590 2244 a(tag-typ) n(e) p Fk 798 2244
-a(::=) p Fh 904 2244 a(ident) p Fj 849 2304 a(j) p Fh
-904 2304 a(ident) p Fe 1031 2304 a(\() p Fh(typ) n(expr-list) p
-Fe(\)) p Fh 523 2365 a(typ) n(expr-list) p Fk 798 2365
-a(::=) p Fh 904 2365 a(typ) n(expr) p Fj 849 2425 a(j) p
-Fh 904 2425 a(typ) n(expr) p Fe 1078 2425 a(&) p Fh 1120
-2425 a(typ) n(expr-list) p Fk 84 2531 a(Notice) p 234
-2531 a(that) p 336 2531 a(a) p 373 2531 a(0-ary) p 496
-2531 a(constructor) p 751 2531 a(and) p 842 2531 a(an) p
-907 2531 a(1-ary) p 1030 2531 a(construtor) p 1262 2531
-a(are) p 1340 2531 a(con) o(tradictory) l(,) p 1648 2531
-a(and) p 1740 2531 a(w) o(ould) 11 2592 y(result) p 146
-2592 a(in) p 203 2592 a(the) p 287 2592 a(absence) p
-466 2592 a(of) p 522 2592 a(this) p 617 2592 a(constructor.) 926
-2937 y(3) p eop
-PStoPSsaved restore
-userdict/PStoPSsaved save put
-PStoPSmatrix setmatrix
-595.000000 421.271378 translate
-90 rotate
-0.706651 dup scale
-userdict/PStoPSmatrix matrix currentmatrix put
-userdict/PStoPSclip{0 0 moveto
- 595.000000 0 rlineto 0 842.000000 rlineto -595.000000 0 rlineto
- closepath}put initclip
-PStoPSxform concat
-4 3 bop Fi 11 168 a(Discussion) p Fk 11 261 a(Suc) o(h) p
-133 261 a(a) p 179 261 a(c) o(hange) p 345 261 a(has) p
-436 261 a(the) p 525 261 a(ma) s(jor) p 672 261 a(adv) m(an) o(tage) p
-907 261 a(of) p 967 261 a(b) q(oth) p 1087 261 a(reco) o(v) o(ering) p
-1324 261 a(principalit) o(y) p 1589 261 a(and) p 1688
-261 a(a) o(v) o(oiding) 11 321 y(unin) o(tuitiv) o(e) p
-266 321 a(error) p 392 321 a(messages.) p 640 321 a(Constrain) o(ts) p
-909 321 a(created) p 1087 321 a(in) p 1152 321 a(suc) o(h) p
-1269 321 a(a) p 1317 321 a(w) o(a) o(y) p 1423 321 a(are) p
-1512 321 a(v) o(ery) p 1626 321 a(ligh) o(t:) p 1772
-321 a(they) 11 381 y(alw) o(a) o(ys) p 165 381 a(app) q(ear) p
-325 381 a(inside) p 463 381 a(a) p 502 381 a(v) m(arian) o(t) p
-666 381 a(t) o(yp) q(e,) p 788 381 a(and) p 882 381 a(if) p
-926 381 a(the) p 1008 381 a(v) m(arian) o(t) p 1172 381
-a(t) o(yp) q(e) p 1281 381 a(do) q(es) p 1390 381 a(not) p
-1475 381 a(app) q(ear) p 1635 381 a(in) p 1691 381 a(the) p
-1774 381 a(\014nal) 11 441 y(t) o(yp) q(e) p 120 441
-a(sc) o(heme,) p 301 441 a(then) p 412 441 a(the) p 496
-441 a(constrain) o(t) p 725 441 a(can) p 815 441 a(b) q(e) p
-881 441 a(discarded) p 1098 441 a(safely) l(.) 84 501
-y(On) p 165 501 a(the) p 249 501 a(other) p 376 501 a(hand,) p
-512 501 a(there) p 637 501 a(are) p 718 501 a(t) o(w) o(o) p
-810 501 a(dra) o(wbac) o(ks.) p Fj 83 616 a(\017) p Fk
-133 616 a(Some) p 259 616 a(errors) p 393 616 a(will) p
-482 616 a(b) q(e) p 544 616 a(dela) o(y) o(ed) p 715
-616 a(longer) p 858 616 a(than) p 968 616 a(no) o(w,) p
-1080 616 a(un) o(til) p 1191 616 a(a) p 1228 616 a(construtor) p
-1460 616 a(is) p 1505 616 a(actually) p 1687 616 a(included) 133
-676 y(in) p Fg 189 676 a(L) p Fk(.) p 258 676 a(It) p
-311 676 a(is) p 360 676 a(not) p 446 676 a(clear) p 563
-676 a(ho) o(w) p 665 676 a(damageable) p 930 676 a(it) p
-979 676 a(is.) p Fj 83 777 a(\017) p Fk 133 777 a(While) p
-272 777 a(t) o(yp) q(e) p 378 777 a(inference) p 579
-777 a(is) p 625 777 a(simple) p 774 777 a(and) p 865
-777 a(costless) p 1036 777 a(for) p 1108 777 a(this) p
-1200 777 a(extension,) p 1426 777 a(simpli\014cation) p
-1724 777 a(of) p 1776 777 a(con-) 133 838 y(strain) o(ts) p
-310 838 a(|marking) p 551 838 a(constructors) p 830 838
-a(with) p 943 838 a(unsolv) m(able) p 1182 838 a(constrain) o(ts) p
-1432 838 a(as) p 1494 838 a(absen) o(t,) p 1663 838 a(and) p
-1760 838 a(elim-) 133 898 y(inating) p 300 898 a(redundan) o(t) p
-536 898 a(t) o(yp) q(es) p 667 898 a(in) p 726 898 a(constrain) o(ts|) p
-1025 898 a(is) p 1076 898 a(a) p 1119 898 a(bit) p 1197
-898 a(more) p 1320 898 a(exp) q(ensiv) o(e.) p 1565 898
-a(Also,) p 1691 898 a(allo) o(wing) 133 958 y(suc) o(h) p
-244 958 a(constrained) p 506 958 a(t) o(yp) q(es) p 637
-958 a(inside) p 777 958 a(signatures) p 1010 958 a(w) o(ould) p
-1154 958 a(mean) p 1286 958 a(ha) o(ving) p 1444 958
-a(to) p 1506 958 a(solv) o(e) p 1627 958 a(a) p 1669
-958 a(matc) o(hing) 133 1018 y(problem,) p 333 1018 a(whic) o(h) p
-469 1018 a(is) p 514 1018 a(exp) q(onen) o(tial) p 772
-1018 a(in) p 825 1018 a(the) p 906 1018 a(n) o(um) o(b) q(er) p
-1080 1018 a(of) p 1132 1018 a(connected) p 1356 1018
-a(constrain) o(ts) p 1600 1018 a(inside) p 1735 1018
-a(a) p 1772 1018 a(t) o(yp) q(e) 133 1078 y(sc) o(heme.) 84
-1193 y(Reasonably) p 340 1193 a(e\016cien) o(t) p 516
-1193 a(algorithms) p 754 1193 a(exist) p 866 1193 a(to) p
-922 1193 a(solv) o(e) p 1038 1193 a(these) p 1159 1193
-a(problems,) p 1379 1193 a(so) p 1435 1193 a(the) p 1515
-1193 a(di\016cult) o(y) p 1715 1193 a(is) p 1760 1193
-a(more) 11 1253 y(in) p 67 1253 a(the) p 151 1253 a(increased) p
-363 1253 a(complexit) o(y) p 611 1253 a(of) p 667 1253
-a(the) p 751 1253 a(t) o(yp) q(e-c) o(hec) o(k) o(er) p
-1031 1253 a(than) p 1145 1253 a(in) p 1202 1253 a(run-time) p
-1402 1253 a(cost.) p Fl 11 1397 a(Other) p 205 1397 a(features) p
-Fk 11 1490 a(Ob) s(jectiv) o(e) p 238 1490 a(Lab) q(el) p
-380 1490 a(con) o(tains) p 579 1490 a(t) o(w) o(o) p
-678 1490 a(other) p 812 1490 a(features:) p 1029 1490
-a(p) q(olymorphic) p 1318 1490 a(metho) q(ds) p 1521
-1490 a(and) p 1623 1490 a(t) o(yp) q(e-driv) o(en) 11
-1550 y(access) p 153 1550 a(of) p 208 1550 a(records.) p
-394 1550 a(Both) p 514 1550 a(of) p 568 1550 a(them) p
-692 1550 a(use) p 775 1550 a(the) p 857 1550 a(same) p
-978 1550 a(metho) q(d) p 1154 1550 a(of) p 1209 1550
-a(enforcing) p 1417 1550 a(principalit) o(y) p 1676 1550
-a(of) p 1730 1550 a(t) o(yping) 11 1610 y(through) p
-191 1610 a(tracing) p 351 1610 a(user) p 450 1610 a(pro) o(vided) p
-647 1610 a(t) o(yp) q(e) p 752 1610 a(information.) p
-1034 1610 a(With) p 1155 1610 a(this) p 1246 1610 a(tracing,) p
-1422 1610 a(their) p 1534 1610 a(implem) o(en) n(tation) 11
-1670 y(is) p 60 1670 a(v) o(ery) p 167 1670 a(easy) l(,) p
-283 1670 a(but) p 373 1670 a(without) p 554 1670 a(it) p
-603 1670 a(they) p 713 1670 a(lo) q(ose) p 834 1670 a(principalit) o(y)
-l(.) 84 1730 y(While) p 229 1730 a(these) p 357 1730
-a(features) p 543 1730 a(pro) o(vide) p 720 1730 a(some) p
-845 1730 a(comfort) p 1029 1730 a(in) p 1089 1730 a(writing) p
-1260 1730 a(user) p 1366 1730 a(programs,) p 1598 1730
-a(they) p 1711 1730 a(are) p 1795 1730 a(not) 11 1791
-y(strictly) p 182 1791 a(necessary) p 403 1791 a(for) p
-482 1791 a(the) p 571 1791 a(v) m(arious) p 742 1791
-a(libraries) p 934 1791 a(coming) p 1107 1791 a(with) p
-1223 1791 a(O'Labl) p 1391 1791 a(\(LablTk,) p 1602 1791
-a(LablGL) p 1787 1791 a(and) 11 1851 y(LablGTK\).) 926
-2937 y(4) p eop
-PStoPSsaved restore
-%%Trailer
-end
-userdict /end-hook known{end-hook}if
-%%EOF
diff --git a/testlabl/objvariant.diffs b/testlabl/objvariant.diffs
deleted file mode 100644
index 75deb24cd..000000000
--- a/testlabl/objvariant.diffs
+++ /dev/null
@@ -1,354 +0,0 @@
-? objvariants-3.09.1.diffs
-? objvariants.diffs
-Index: btype.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/btype.ml,v
-retrieving revision 1.37.4.1
-diff -u -r1.37.4.1 btype.ml
---- btype.ml 5 Dec 2005 13:18:42 -0000 1.37.4.1
-+++ btype.ml 16 Jan 2006 02:23:14 -0000
-@@ -177,7 +177,8 @@
- Tvariant row -> iter_row f row
- | Tvar | Tunivar | Tsubst _ | Tconstr _ ->
- Misc.may (fun (_,l) -> List.iter f l) row.row_name;
-- List.iter f row.row_bound
-+ List.iter f row.row_bound;
-+ List.iter (fun (s,k,t) -> f t) row.row_object
- | _ -> assert false
-
- let iter_type_expr f ty =
-@@ -224,7 +225,9 @@
- | Some (path, tl) -> Some (path, List.map f tl) in
- { row_fields = fields; row_more = more;
- row_bound = !bound; row_fixed = row.row_fixed && fixed;
-- row_closed = row.row_closed; row_name = name; }
-+ row_closed = row.row_closed; row_name = name;
-+ row_object = List.map (fun (s,k,t) -> (s,k,f t)) row.row_object;
-+ }
-
- let rec copy_kind = function
- Fvar{contents = Some k} -> copy_kind k
-Index: ctype.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/ctype.ml,v
-retrieving revision 1.197.2.6
-diff -u -r1.197.2.6 ctype.ml
---- ctype.ml 15 Dec 2005 02:28:38 -0000 1.197.2.6
-+++ ctype.ml 16 Jan 2006 02:23:15 -0000
-@@ -1421,7 +1421,7 @@
- newgenty
- (Tvariant
- {row_fields = fields; row_closed = closed; row_more = newvar();
-- row_bound = []; row_fixed = false; row_name = None })
-+ row_bound = []; row_fixed = false; row_name = None; row_object=[]})
-
- (**** Unification ****)
-
-@@ -1724,8 +1724,11 @@
- else None
- in
- let bound = row1.row_bound @ row2.row_bound in
-+ let opairs, _, miss2 = associate_fields row1.row_object row2.row_object in
-+ let row_object = row1.row_object @ miss2 in
- let row0 = {row_fields = []; row_more = more; row_bound = bound;
-- row_closed = closed; row_fixed = fixed; row_name = name} in
-+ row_closed = closed; row_fixed = fixed; row_name = name;
-+ row_object = row_object } in
- let set_more row rest =
- let rest =
- if closed then
-@@ -1758,6 +1761,18 @@
- raise (Unify ((mkvariant [l,f1] true,
- mkvariant [l,f2] true) :: trace)))
- pairs;
-+ List.iter (fun (s,_,ty1,_,ty2) -> unify env ty1 ty2) opairs;
-+ if row_object <> [] then begin
-+ List.iter
-+ (fun (l,f) ->
-+ match row_field_repr f with
-+ Rpresent (Some ty) ->
-+ let fi = build_fields generic_level row_object (newgenvar()) in
-+ unify env (newgenty (Tobject (fi, ref None))) ty
-+ | Rpresent None -> raise (Unify [])
-+ | _ -> ())
-+ (row_repr row1).row_fields
-+ end;
- with exn ->
- log_type rm1; rm1.desc <- md1; log_type rm2; rm2.desc <- md2; raise exn
- end
-@@ -2789,7 +2804,8 @@
- let row =
- { row_fields = List.map fst fields; row_more = newvar();
- row_bound = !bound; row_closed = posi; row_fixed = false;
-- row_name = if c > Unchanged then None else row.row_name }
-+ row_name = if c > Unchanged then None else row.row_name;
-+ row_object = [] }
- in
- (newty (Tvariant row), Changed)
- | Tobject (t1, _) ->
-Index: oprint.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/oprint.ml,v
-retrieving revision 1.22
-diff -u -r1.22 oprint.ml
---- oprint.ml 23 Mar 2005 03:08:37 -0000 1.22
-+++ oprint.ml 16 Jan 2006 02:23:15 -0000
-@@ -185,7 +185,7 @@
- fprintf ppf "@[<2>< %a >@]" (print_fields rest) fields
- | Otyp_stuff s -> fprintf ppf "%s" s
- | Otyp_var (ng, s) -> fprintf ppf "'%s%s" (if ng then "_" else "") s
-- | Otyp_variant (non_gen, row_fields, closed, tags) ->
-+ | Otyp_variant (non_gen, row_fields, closed, tags, obj) ->
- let print_present ppf =
- function
- None | Some [] -> ()
-@@ -198,12 +198,17 @@
- ppf fields
- | Ovar_name (id, tyl) ->
- fprintf ppf "@[%a%a@]" print_typargs tyl print_ident id
-+ and print_object ppf obj =
-+ if obj <> [] then
-+ fprintf ppf "@ as @[<2>< %a >@]" (print_fields (Some false)) obj
- in
-- fprintf ppf "%s[%s@[<hv>@[<hv>%a@]%a ]@]" (if non_gen then "_" else "")
-+ fprintf ppf "%s[%s@[<hv>@[<hv>%a@]%a%a ]@]"
-+ (if non_gen then "_" else "")
- (if closed then if tags = None then " " else "< "
- else if tags = None then "> " else "? ")
- print_fields row_fields
- print_present tags
-+ print_object obj
- | Otyp_alias _ | Otyp_poly _ | Otyp_arrow _ | Otyp_tuple _ as ty ->
- fprintf ppf "@[<1>(%a)@]" print_out_type ty
- | Otyp_abstract | Otyp_sum _ | Otyp_record _ | Otyp_manifest (_, _) -> ()
-Index: outcometree.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/outcometree.mli,v
-retrieving revision 1.14
-diff -u -r1.14 outcometree.mli
---- outcometree.mli 23 Mar 2005 03:08:37 -0000 1.14
-+++ outcometree.mli 16 Jan 2006 02:23:15 -0000
-@@ -59,6 +59,7 @@
- | Otyp_var of bool * string
- | Otyp_variant of
- bool * out_variant * bool * (string list) option
-+ * (string * out_type) list
- | Otyp_poly of string list * out_type
- and out_variant =
- | Ovar_fields of (string * bool * out_type list) list
-Index: printtyp.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/printtyp.ml,v
-retrieving revision 1.139.2.2
-diff -u -r1.139.2.2 printtyp.ml
---- printtyp.ml 7 Dec 2005 23:37:27 -0000 1.139.2.2
-+++ printtyp.ml 16 Jan 2006 02:23:15 -0000
-@@ -244,7 +244,10 @@
- visited_objects := px :: !visited_objects;
- match row.row_name with
- | Some(p, tyl) when namable_row row ->
-- List.iter (mark_loops_rec visited) tyl
-+ List.iter (mark_loops_rec visited) tyl;
-+ if not (static_row row) then
-+ List.iter (fun (s,k,t) -> mark_loops_rec visited t)
-+ row.row_object
- | _ ->
- iter_row (mark_loops_rec visited) {row with row_bound = []}
- end
-@@ -343,25 +346,27 @@
- | _ -> false)
- fields in
- let all_present = List.length present = List.length fields in
-+ let static = row.row_closed && all_present in
-+ let obj =
-+ if static then [] else
-+ List.map (fun (s,k,t) -> (s, tree_of_typexp sch t)) row.row_object
-+ in
-+ let tags = if all_present then None else Some (List.map fst present) in
- begin match row.row_name with
- | Some(p, tyl) when namable_row row ->
- let id = tree_of_path p in
- let args = tree_of_typlist sch tyl in
-- if row.row_closed && all_present then
-+ if static then
- Otyp_constr (id, args)
- else
- let non_gen = is_non_gen sch px in
-- let tags =
-- if all_present then None else Some (List.map fst present) in
- Otyp_variant (non_gen, Ovar_name(tree_of_path p, args),
-- row.row_closed, tags)
-+ row.row_closed, tags, obj)
- | _ ->
-- let non_gen =
-- not (row.row_closed && all_present) && is_non_gen sch px in
-+ let non_gen = not static && is_non_gen sch px in
- let fields = List.map (tree_of_row_field sch) fields in
-- let tags =
-- if all_present then None else Some (List.map fst present) in
-- Otyp_variant (non_gen, Ovar_fields fields, row.row_closed, tags)
-+ Otyp_variant (non_gen, Ovar_fields fields, row.row_closed,
-+ tags, obj)
- end
- | Tobject (fi, nm) ->
- tree_of_typobject sch fi nm
-Index: typecore.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typecore.ml,v
-retrieving revision 1.176.2.2
-diff -u -r1.176.2.2 typecore.ml
---- typecore.ml 11 Dec 2005 09:56:33 -0000 1.176.2.2
-+++ typecore.ml 16 Jan 2006 02:23:15 -0000
-@@ -170,7 +170,8 @@
- (* Force check of well-formedness *)
- unify_pat pat.pat_env pat
- (newty(Tvariant{row_fields=[]; row_more=newvar(); row_closed=false;
-- row_bound=[]; row_fixed=false; row_name=None}));
-+ row_bound=[]; row_fixed=false; row_name=None;
-+ row_object=[]}));
- | _ -> ()
-
- let rec iter_pattern f p =
-@@ -251,7 +252,7 @@
- let ty = may_map (build_as_type env) p' in
- newty (Tvariant{row_fields=[l, Rpresent ty]; row_more=newvar();
- row_bound=[]; row_name=None;
-- row_fixed=false; row_closed=false})
-+ row_fixed=false; row_closed=false; row_object=[]})
- | Tpat_record lpl ->
- let lbl = fst(List.hd lpl) in
- if lbl.lbl_private = Private then p.pat_type else
-@@ -318,7 +319,8 @@
- ([],[]) fields in
- let row =
- { row_fields = List.rev fields; row_more = newvar(); row_bound = !bound;
-- row_closed = false; row_fixed = false; row_name = Some (path, tyl) }
-+ row_closed = false; row_fixed = false; row_name = Some (path, tyl);
-+ row_object = [] }
- in
- let ty = newty (Tvariant row) in
- let gloc = {loc with Location.loc_ghost=true} in
-@@ -428,7 +430,8 @@
- row_closed = false;
- row_more = newvar ();
- row_fixed = false;
-- row_name = None } in
-+ row_name = None;
-+ row_object = [] } in
- rp {
- pat_desc = Tpat_variant(l, arg, row);
- pat_loc = sp.ppat_loc;
-@@ -976,7 +979,8 @@
- row_bound = [];
- row_closed = false;
- row_fixed = false;
-- row_name = None});
-+ row_name = None;
-+ row_object = []});
- exp_env = env }
- | Pexp_record(lid_sexp_list, opt_sexp) ->
- let ty = newvar() in
-@@ -1261,8 +1265,30 @@
- assert false
- end
- | _ ->
-- (Texp_send(obj, Tmeth_name met),
-- filter_method env met Public obj.exp_type)
-+ let obj, met_ty =
-+ match expand_head env obj.exp_type with
-+ {desc = Tvariant _} ->
-+ let exp_ty = newvar () in
-+ let met_ty = filter_method env met Public exp_ty in
-+ let row =
-+ {row_fields=[]; row_more=newvar();
-+ row_bound=[]; row_closed=false;
-+ row_fixed=false; row_name=None;
-+ row_object=[met, Fpresent, met_ty]} in
-+ unify_exp env obj (newty (Tvariant row));
-+ let prim = Primitive.parse_declaration 1 ["%field1"] in
-+ let ty = newty(Tarrow("", obj.exp_type, exp_ty, Cok)) in
-+ let vd = {val_type = ty; val_kind = Val_prim prim} in
-+ let esnd =
-+ {exp_desc=Texp_ident(Path.Pident(Ident.create"snd"), vd);
-+ exp_loc = Location.none; exp_type = ty; exp_env = env}
-+ in
-+ ({obj with exp_type = exp_ty;
-+ exp_desc = Texp_apply(esnd,[Some obj, Required])},
-+ met_ty)
-+ | _ -> (obj, filter_method env met Public obj.exp_type)
-+ in
-+ (Texp_send(obj, Tmeth_name met), met_ty)
- in
- if !Clflags.principal then begin
- end_def ();
-Index: types.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/types.ml,v
-retrieving revision 1.25
-diff -u -r1.25 types.ml
---- types.ml 9 Dec 2004 12:40:53 -0000 1.25
-+++ types.ml 16 Jan 2006 02:23:15 -0000
-@@ -44,7 +44,9 @@
- row_bound: type_expr list;
- row_closed: bool;
- row_fixed: bool;
-- row_name: (Path.t * type_expr list) option }
-+ row_name: (Path.t * type_expr list) option;
-+ row_object: (string * field_kind * type_expr) list;
-+ }
-
- and row_field =
- Rpresent of type_expr option
-Index: types.mli
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/types.mli,v
-retrieving revision 1.25
-diff -u -r1.25 types.mli
---- types.mli 9 Dec 2004 12:40:53 -0000 1.25
-+++ types.mli 16 Jan 2006 02:23:15 -0000
-@@ -43,7 +43,9 @@
- row_bound: type_expr list;
- row_closed: bool;
- row_fixed: bool;
-- row_name: (Path.t * type_expr list) option }
-+ row_name: (Path.t * type_expr list) option;
-+ row_object: (string * field_kind * type_expr) list;
-+ }
-
- and row_field =
- Rpresent of type_expr option
-Index: typetexp.ml
-===================================================================
-RCS file: /net/yquem/devel/caml/repository/csl/typing/typetexp.ml,v
-retrieving revision 1.54
-diff -u -r1.54 typetexp.ml
---- typetexp.ml 22 Jul 2005 06:42:36 -0000 1.54
-+++ typetexp.ml 16 Jan 2006 02:23:15 -0000
-@@ -215,7 +215,8 @@
- in
- let row = { row_closed = true; row_fields = fields;
- row_bound = !bound; row_name = Some (path, args);
-- row_fixed = false; row_more = newvar () } in
-+ row_fixed = false; row_more = newvar ();
-+ row_object = [] } in
- let static = Btype.static_row row in
- let row =
- if static then row else
-@@ -262,7 +263,7 @@
- let mkfield l f =
- newty (Tvariant {row_fields=[l,f]; row_more=newvar();
- row_bound=[]; row_closed=true;
-- row_fixed=false; row_name=None}) in
-+ row_fixed=false; row_name=None; row_object=[]}) in
- let add_typed_field loc l f fields =
- try
- let f' = List.assoc l fields in
-@@ -345,7 +346,7 @@
- let row =
- { row_fields = List.rev fields; row_more = newvar ();
- row_bound = !bound; row_closed = closed;
-- row_fixed = false; row_name = !name } in
-+ row_fixed = false; row_name = !name; row_object = [] } in
- let static = Btype.static_row row in
- let row =
- if static then row else
diff --git a/testlabl/objvariant.ml b/testlabl/objvariant.ml
deleted file mode 100644
index 3233e03c0..000000000
--- a/testlabl/objvariant.ml
+++ /dev/null
@@ -1,42 +0,0 @@
-(* use with [cvs update -r objvariants typing] *)
-
-let f (x : [> ]) = x#m 3;;
-let o = object method m x = x+2 end;;
-f (`A o);;
-let l = [`A o; `B(object method m x = x -2 method y = 3 end)];;
-List.map f l;;
-let g = function `A x -> x#m 3 | `B x -> x#y;;
-List.map g l;;
-fun x -> ignore (x=f); List.map x l;;
-fun (x : [< `A of _ | `B of _] -> int) -> ignore (x=f); List.map x l;;
-
-
-class cvar name =
- object
- method name = name
- method print ppf = Format.pp_print_string ppf name
- end
-
-type var = [`Var of cvar]
-
-class cint n =
- object
- method n = n
- method print ppf = Format.pp_print_int ppf n
- end
-
-class ['a] cadd (e1 : 'a) (e2 : 'a) =
- object
- constraint 'a = [> ]
- method e1 = e1
- method e2 = e2
- method print ppf = Format.fprintf ppf "(%t, %t)" e1#print e2#print
- end
-
-type 'a expr = [var | `Int of cint | `Add of 'a cadd]
-
-type expr1 = expr1 expr
-
-let print = Format.printf "%t@."
-
-let e1 : expr1 = `Add (new cadd (`Var (new cvar "x")) (`Int (new cint 2)))
diff --git a/testlabl/printers.ml b/testlabl/printers.ml
deleted file mode 100644
index c80c42d66..000000000
--- a/testlabl/printers.ml
+++ /dev/null
@@ -1,11 +0,0 @@
-(* $Id$ *)
-
-open Types
-
-let ignore_abbrevs ppf ab =
- let s = match ab with
- Mnil -> "Mnil"
- | Mlink _ -> "Mlink _"
- | Mcons _ -> "Mcons _"
- in
- Format.pp_print_string ppf s
diff --git a/testlabl/tests.ml b/testlabl/tests.ml
deleted file mode 100644
index c39d152fb..000000000
--- a/testlabl/tests.ml
+++ /dev/null
@@ -1,22 +0,0 @@
-(* $Id$ *)
-
-let f1 = function `a x -> x=1 | `b -> true
-let f2 = function `a x -> x | `b -> true
-let f3 = function `b -> true
-let f x = f1 x && f2 x
-
-let sub s ?:pos{=0} ?:len{=String.length s - pos} () =
- String.sub s pos len
-
-let cCAMLtoTKpack_options w = function
- `After v1 -> "-after"
- | `Anchor v1 -> "-anchor"
- | `Before v1 -> "-before"
- | `Expand v1 -> "-expand"
- | `Fill v1 -> "-fill"
- | `In v1 -> "-in"
- | `Ipadx v1 -> "-ipadx"
- | `Ipady v1 -> "-ipady"
- | `Padx v1 -> "-padx"
- | `Pady v1 -> "-pady"
- | `Side v1 -> "-side"
diff --git a/testlabl/valvirt.diffs b/testlabl/valvirt.diffs
deleted file mode 100644
index 2cf55742b..000000000
--- a/testlabl/valvirt.diffs
+++ /dev/null
@@ -1,2349 +0,0 @@
-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 5 Apr 2006 02:25:59 -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 overridden \
- 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 overridden.\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 5 Apr 2006 02:25:59 -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 5 Apr 2006 02:25:59 -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 5 Apr 2006 02:25:59 -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 5 Apr 2006 02:25:59 -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 5 Apr 2006 02:25:59 -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 5 Apr 2006 02:25:59 -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,10 +2354,11 @@
- | 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
-- | CM_Hide_virtual of string
-+ | CM_Hide_virtual of string * string
- | CM_Public_method of string
- | CM_Private_method of string
- | CM_Virtual_method 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)]))
-@@ -2437,7 +2438,7 @@
- end
- in
- if Concr.mem lab sign1.cty_concr then err
-- else CM_Hide_virtual lab::err)
-+ else CM_Hide_virtual ("method", lab) :: err)
- miss1 []
- in
- let missing_method = List.map (fun (m, _, _) -> m) miss2 in
-@@ -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 ->
-@@ -2467,6 +2470,14 @@
- sign2.cty_vars error
- in
- let error =
-+ Vars.fold
-+ (fun lab (_,vr,_) err ->
-+ if vr = Virtual && not (Vars.mem lab sign2.cty_vars) then
-+ CM_Hide_virtual ("instance variable", lab) :: err
-+ else err)
-+ sign1.cty_vars error
-+ in
-+ let error =
- List.fold_right
- (fun e l ->
- if List.mem e missing_method then l else CM_Virtual_method e::l)
-@@ -2516,8 +2527,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)]))
-@@ -2554,7 +2565,7 @@
- end
- in
- if Concr.mem lab sign1.cty_concr then err
-- else CM_Hide_virtual lab::err)
-+ else CM_Hide_virtual ("method", lab) :: err)
- miss1 []
- in
- let missing_method = List.map (fun (m, _, _) -> m) miss2 in
-@@ -2578,11 +2589,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 ->
-@@ -2590,6 +2603,14 @@
- sign2.cty_vars error
- in
- let error =
-+ Vars.fold
-+ (fun lab (_,vr,_) err ->
-+ if vr = Virtual && not (Vars.mem lab sign2.cty_vars) then
-+ CM_Hide_virtual ("instance variable", lab) :: err
-+ else err)
-+ sign1.cty_vars error
-+ in
-+ let error =
- List.fold_right
- (fun e l ->
- if List.mem e missing_method then l else CM_Virtual_method e::l)
-@@ -3279,7 +3300,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 5 Apr 2006 02:25:59 -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
- | 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
-- | CM_Hide_virtual of string
-+ | CM_Hide_virtual of string * string
- | CM_Public_method of string
- | CM_Private_method of string
- | CM_Virtual_method 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 5 Apr 2006 02:25:59 -0000
-@@ -78,14 +78,17 @@
- | 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 ->
- fprintf ppf "@[The first class type has no method %s@]" lab
- | CM_Hide_public lab ->
- fprintf ppf "@[The public method %s cannot be hidden@]" lab
-- | CM_Hide_virtual lab ->
-- fprintf ppf "@[The virtual method %s cannot be hidden@]" lab
-+ | CM_Hide_virtual (k, lab) ->
-+ fprintf ppf "@[The virtual %s %s cannot be hidden@]" k lab
- | CM_Public_method lab ->
- fprintf ppf "@[The public method %s cannot become private" lab
- | CM_Virtual_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 5 Apr 2006 02:25:59 -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 5 Apr 2006 02:25:59 -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 5 Apr 2006 02:26:00 -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 =
-@@ -763,7 +765,9 @@
- List.exists
- (fun (lab, _, ty) ->
- not (lab = dummy_method || Concr.mem lab sign.cty_concr))
-- fields in
-+ fields
-+ || Vars.fold (fun _ (_,vr,_) b -> vr = Virtual || b) sign.cty_vars false
-+ in
-
- Osig_class_type
- (virt, Ident.name id,
-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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:00 -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
-@@ -140,7 +140,8 @@
- | Tstr_recmodule of (Ident.t * module_expr) list
- | Tstr_modtype of Ident.t * module_type
- | Tstr_open of Path.t
-- | Tstr_class of (Ident.t * int * string list * class_expr) list
-+ | Tstr_class of
-+ (Ident.t * int * string list * class_expr * virtual_flag) list
- | Tstr_cltype of (Ident.t * cltype_declaration) list
- | Tstr_include of module_expr * Ident.t 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 5 Apr 2006 02:26:00 -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
-@@ -141,7 +142,8 @@
- | Tstr_recmodule of (Ident.t * module_expr) list
- | Tstr_modtype of Ident.t * module_type
- | Tstr_open of Path.t
-- | Tstr_class of (Ident.t * int * string list * class_expr) list
-+ | Tstr_class of
-+ (Ident.t * int * string list * class_expr * virtual_flag) list
- | Tstr_cltype of (Ident.t * cltype_declaration) list
- | Tstr_include of module_expr * Ident.t list
-
-Index: typing/typemod.ml
-===================================================================
-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 5 Apr 2006 02:26:00 -0000
-@@ -17,6 +17,7 @@
- open Misc
- open Longident
- open Path
-+open Asttypes
- open Parsetree
- open Types
- open Typedtree
-@@ -667,8 +668,9 @@
- let (classes, new_env) = Typeclass.class_declarations env cl in
- let (str_rem, sig_rem, final_env) = type_struct new_env srem in
- (Tstr_class
-- (List.map (fun (i, _,_,_,_,_,_,_, s, m, c) ->
-- (i, s, m, c)) classes) ::
-+ (List.map (fun (i, d, _,_,_,_,_,_, s, m, c) ->
-+ let vf = if d.cty_new = None then Virtual else Concrete in
-+ (i, s, m, c, vf)) classes) ::
- Tstr_cltype
- (List.map (fun (_,_, i, d, _,_,_,_,_,_,_) -> (i, d)) classes) ::
- Tstr_type
-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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:00 -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
-@@ -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 vflag in
- if rebind <> lambda_unit then rebind else
-
- (* 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
-
-- let concrete =
-- ids = [] ||
-- Typeclass.virtual_methods (Ctype.signature_of_class_type cl.cl_type) = []
-+ let concrete = (vflag = Concrete)
- 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 +790,11 @@
-
- (* Wrapper for class compilation *)
-
--let transl_class ids cl_id arity pub_meths cl =
-- oo_wrap cl.cl_env false (transl_class ids cl_id arity pub_meths) cl
-+let transl_class ids cl_id arity pub_meths cl vf =
-+ oo_wrap cl.cl_env false (transl_class ids cl_id arity pub_meths cl) vf
-
- let () =
-- transl_object := (fun id meths cl -> transl_class [] id 0 meths cl)
-+ transl_object := (fun id meths cl -> transl_class [] id 0 meths cl Concrete)
-
- (* Error report *)
-
-Index: bytecomp/translclass.mli
-===================================================================
-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 5 Apr 2006 02:26:00 -0000
-@@ -16,7 +16,8 @@
- open Lambda
-
- val transl_class :
-- Ident.t list -> Ident.t -> int -> string list -> class_expr -> lambda;;
-+ Ident.t list -> Ident.t ->
-+ int -> string list -> class_expr -> Asttypes.virtual_flag -> lambda;;
-
- type error = Illegal_class_expr | Tags of string * string
-
-Index: bytecomp/translmod.ml
-===================================================================
-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 5 Apr 2006 02:26:00 -0000
-@@ -317,10 +317,10 @@
- | Tstr_open path :: rem ->
- transl_structure fields cc rootpath rem
- | Tstr_class cl_list :: rem ->
-- let ids = List.map (fun (i, _, _, _) -> i) cl_list in
-+ let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in
- Lletrec(List.map
-- (fun (id, arity, meths, cl) ->
-- (id, transl_class ids id arity meths cl))
-+ (fun (id, arity, meths, cl, vf) ->
-+ (id, transl_class ids id arity meths cl vf))
- cl_list,
- transl_structure (List.rev ids @ fields) cc rootpath rem)
- | Tstr_cltype cl_list :: rem ->
-@@ -414,11 +414,11 @@
- | Tstr_open path :: rem ->
- transl_store subst rem
- | Tstr_class cl_list :: rem ->
-- let ids = List.map (fun (i, _, _, _) -> i) cl_list in
-+ let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in
- let lam =
- Lletrec(List.map
-- (fun (id, arity, meths, cl) ->
-- (id, transl_class ids id arity meths cl))
-+ (fun (id, arity, meths, cl, vf) ->
-+ (id, transl_class ids id arity meths cl vf))
- cl_list,
- store_idents ids) in
- Lsequence(subst_lambda subst lam,
-@@ -485,7 +485,7 @@
- | Tstr_modtype(id, decl) :: rem -> defined_idents rem
- | Tstr_open path :: rem -> defined_idents rem
- | Tstr_class cl_list :: rem ->
-- List.map (fun (i, _, _, _) -> i) cl_list @ defined_idents rem
-+ List.map (fun (i, _, _, _, _) -> i) cl_list @ defined_idents rem
- | Tstr_cltype cl_list :: rem -> defined_idents rem
- | Tstr_include(modl, ids) :: rem -> ids @ defined_idents rem
-
-@@ -603,14 +603,14 @@
- | Tstr_class cl_list ->
- (* we need to use unique names for the classes because there might
- be a value named identically *)
-- let ids = List.map (fun (i, _, _, _) -> i) cl_list in
-+ let ids = List.map (fun (i, _, _, _, _) -> i) cl_list in
- List.iter set_toplevel_unique_name ids;
- Lletrec(List.map
-- (fun (id, arity, meths, cl) ->
-- (id, transl_class ids id arity meths cl))
-+ (fun (id, arity, meths, cl, vf) ->
-+ (id, transl_class ids id arity meths cl vf))
- cl_list,
- make_sequence
-- (fun (id, _, _, _) -> toploop_setvalue_id id)
-+ (fun (id, _, _, _, _) -> toploop_setvalue_id id)
- cl_list)
- | Tstr_cltype cl_list ->
- lambda_unit
-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 5 Apr 2006 02:26:00 -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 overridden method\n\
-+ \032 M/m enable/disable overridden 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 overridden 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 5 Apr 2006 02:26:00 -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 overridden 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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:00 -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.142
-diff -u -r1.142 sys.ml
---- stdlib/sys.ml 22 Mar 2006 12:39:39 -0000 1.142
-+++ stdlib/sys.ml 5 Apr 2006 02:26:00 -0000
-@@ -78,4 +78,4 @@
-
- (* OCaml version string, must be in the format described in sys.mli. *)
-
--let ocaml_version = "3.10+dev4 (2006-03-22)";;
-+let ocaml_version = "3.10+dev5 (2006-04-05)";;
-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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:00 -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 5 Apr 2006 02:26:01 -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) ->
-@@ -675,7 +674,7 @@
- | Tstr_modtype _ -> ()
- | Tstr_open _ -> ()
- | Tstr_class l ->
-- List.iter l ~f:(fun (id, _, _, cl) -> search_pos_class_expr cl ~pos)
-+ List.iter l ~f:(fun (id, _, _, cl, _) -> search_pos_class_expr cl ~pos)
- | Tstr_cltype _ -> ()
- | Tstr_include (m, _) -> search_pos_module_expr m ~pos
- end
-@@ -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: 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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -0000
-@@ -88,7 +88,7 @@
- ident_type_decl_list
- | Typedtree.Tstr_class info_list ->
- List.iter
-- (fun ((id,_,_,_) as ci) ->
-+ (fun ((id,_,_,_,_) as ci) ->
- Hashtbl.add table (C (Name.from_ident id))
- (Typedtree.Tstr_class [ci]))
- info_list
-@@ -146,7 +146,7 @@
-
- let search_class_exp table name =
- match Hashtbl.find table (C name) with
-- | (Typedtree.Tstr_class [(_,_,_,ce)]) ->
-+ | (Typedtree.Tstr_class [(_,_,_,ce,_)]) ->
- (
- try
- let type_decl = search_type_declaration table name in
-@@ -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 5 Apr 2006 02:26:01 -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
-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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 5 Apr 2006 02:26:01 -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 ]
- ;
-
diff --git a/testlabl/varunion.ml b/testlabl/varunion.ml
deleted file mode 100644
index 30a410f22..000000000
--- a/testlabl/varunion.ml
+++ /dev/null
@@ -1,435 +0,0 @@
-(* cvs update -r varunion parsing typing bytecomp toplevel *)
-
-type t = private [> ];;
-type u = private [> ] ~ [t];;
-type v = [t | u];;
-let f x = (x : t :> v);;
-
-(* bad *)
-module Mix(X: sig type t = private [> ] end)
- (Y: sig type t = private [> ] end) =
- struct type t = [X.t | Y.t] end;;
-
-(* bad *)
-module Mix(X: sig type t = private [> `A of int ] end)
- (Y: sig type t = private [> `A of bool] ~ [X.t] end) =
- struct type t = [X.t | Y.t] end;;
-
-(* ok *)
-module Mix(X: sig type t = private [> `A of int ] end)
- (Y: sig type t = private [> `A of int] ~ [X.t] end) =
- struct type t = [X.t | Y.t] end;;
-
-(* bad *)
-module Mix(X: sig type t = private [> `A of int ] end)
- (Y: sig type t = private [> `B of bool] ~ [X.t] end) =
- struct type t = [X.t | Y.t] end;;
-
-type 'a t = private [> `L of 'a] ~ [`L];;
-
-(* ok *)
-module Mix(X: sig type t = private [> `A of int ] ~ [`B] end)
- (Y: sig type t = private [> `B of bool] ~ [X.t] end) =
- struct type t = [X.t | Y.t] let is_t = function #t -> true | _ -> false end;;
-
-module Mix(X: sig type t = private [> `A of int ] ~ [`B] end)
- (Y: sig type t = private [> `B of bool] ~ [X.t] end) =
- struct
- type t = [X.t | Y.t]
- let which = function #X.t -> `X | #Y.t -> `Y
- end;;
-
-module Mix(I: sig type t = private [> ] ~ [`A;`B] end)
- (X: sig type t = private [> I.t | `A of int ] ~ [`B] end)
- (Y: sig type t = private [> I.t | `B of bool] ~ [X.t] end) =
- struct
- type t = [X.t | Y.t]
- let which = function #X.t -> `X | #Y.t -> `Y
- end;;
-
-(* ok *)
-module M =
- Mix(struct type t = [`C of char] end)
- (struct type t = [`A of int | `C of char] end)
- (struct type t = [`B of bool | `C of char] end);;
-
-(* bad *)
-module M =
- Mix(struct type t = [`B of bool] end)
- (struct type t = [`A of int | `B of bool] end)
- (struct type t = [`B of bool | `C of char] end);;
-
-(* ok *)
-module M1 = struct type t = [`A of int | `C of char] end
-module M2 = struct type t = [`B of bool | `C of char] end
-module I = struct type t = [`C of char] end
-module M = Mix(I)(M1)(M2) ;;
-
-let c = (`C 'c' : M.t) ;;
-
-module M(X : sig type t = private [> `A] end) =
- struct let f (#X.t as x) = x end;;
-
-(* code generation *)
-type t = private [> `A ] ~ [`B];;
-match `B with #t -> 1 | `B -> 2;;
-
-module M : sig type t = private [> `A of int | `B] ~ [`C] end =
- struct type t = [`A of int | `B | `D of bool] end;;
-let f = function (`C | #M.t) -> 1+1 ;;
-let f = function (`A _ | `B #M.t) -> 1+1 ;;
-
-(* expression *)
-module Mix(X:sig type t = private [> ] val show: t -> string end)
- (Y:sig type t = private [> ] ~ [X.t] val show: t -> string end) =
- struct
- type t = [X.t | Y.t]
- let show : t -> string = function
- #X.t as x -> X.show x
- | #Y.t as y -> Y.show y
- end;;
-
-module EStr = struct
- type t = [`Str of string]
- let show (`Str s) = s
-end
-module EInt = struct
- type t = [`Int of int]
- let show (`Int i) = string_of_int i
-end
-module M = Mix(EStr)(EInt);;
-
-module type T = sig type t = private [> ] val show: t -> string end
-module Mix(X:T)(Y:T with type t = private [> ] ~ [X.t]) :
- T with type t = [X.t | Y.t] =
- struct
- type t = [X.t | Y.t]
- let show = function
- #X.t as x -> X.show x
- | #Y.t as y -> Y.show y
- end;;
-module M = Mix(EStr)(EInt);;
-
-(* deep *)
-module M : sig type t = private [> `A] end = struct type t = [`A] end
-module M' : sig type t = private [> ] end = struct type t = [M.t | `A] end;;
-
-(* bad *)
-type t = private [> ]
-type u = private [> `A of int] ~ [t] ;;
-
-(* ok *)
-type t = private [> `A of int]
-type u = private [> `A of int] ~ [t] ;;
-
-module F(X: sig
- type t = private [> ] ~ [`A;`B;`C;`D]
- type u = private [> `A|`B|`C] ~ [t; `D]
-end) : sig type v = private [< X.t | X.u | `D] end = struct
- open X
- let f = function #u -> 1 | #t -> 2 | `D -> 3
- let g = function #u|#t|`D -> 2
- type v = [t|u|`D]
-end
-
-(* ok *)
-module M = struct type t = private [> `A] end;;
-module M' : sig type t = private [> ] ~ [`A] end = M;;
-
-(* ok *)
-module type T = sig type t = private [> ] ~ [`A] end;;
-module type T' = T with type t = private [> `A];;
-
-(* ok *)
-type t = private [> ] ~ [`A]
-let f = function `A x -> x | #t -> 0
-type t' = private [< `A of int | t];;
-
-(* should be ok *)
-module F(X:sig end) :
- sig type t = private [> ] type u = private [> ] ~ [t] end =
- struct type t = [ `A] type u = [`B] end
-module M = F(String)
-let f = function #M.t -> 1 | #M.u -> 2
-let f = function #M.t -> 1 | _ -> 2
-type t = [M.t | M.u]
-let f = function #t -> 1 | _ -> 2;;
-module G(X : sig type t = private [> ] type u = private [> ] ~ [t] end) =
- struct let f = function #X.t -> 1 | _ -> 2 end;;
-module M1 = G(struct module N = F(String) type t = N.t type u = N.u end) ;;
-module M1 = G(struct type t = M.t type u = M.u end) ;;
-(* bad *)
-let f = function #F(String).t -> 1 | _ -> 2;;
-type t = [F(String).t | M.u]
-let f = function #t -> 1 | _ -> 2;;
-module N : sig type t = private [> ] end =
- struct type t = [F(String).t | M.u] end;;
-
-(* compatibility improvement *)
-type a = [`A of int | `B]
-type b = [`A of bool | `B]
-type c = private [> ] ~ [a;b]
-let f = function #c -> 1 | `A x -> truncate x
-type d = private [> ] ~ [a]
-let g = function #d -> 1 | `A x -> truncate x;;
-
-
-(* Expression Problem: functorial form *)
-
-type num = [ `Num of int ]
-
-module type Exp = sig
- type t = private [> num]
- val eval : t -> t
- val show : t -> string
-end
-
-module Num(X : Exp) = struct
- type t = num
- let eval (`Num _ as x) : X.t = x
- let show (`Num n) = string_of_int n
-end
-
-type 'a add = [ `Add of 'a * 'a ]
-
-module Add(X : Exp with type t = private [> num | 'a add] as 'a) = struct
- type t = X.t add
- let show (`Add(e1, e2) : t) = "("^ X.show e1 ^"+"^ X.show e2 ^")"
- let eval (`Add(e1, e2) : t) =
- let e1 = X.eval e1 and e2 = X.eval e2 in
- match e1, e2 with
- `Num n1, `Num n2 -> `Num (n1+n2)
- | `Num 0, e | e, `Num 0 -> e
- | e12 -> `Add e12
-end
-
-type 'a mul = [`Mul of 'a * 'a]
-
-module Mul(X : Exp with type t = private [> num | 'a mul] as 'a) = struct
- type t = X.t mul
- let show (`Mul(e1, e2) : t) = "("^ X.show e1 ^"*"^ X.show e2 ^")"
- let eval (`Mul(e1, e2) : t) =
- let e1 = X.eval e1 and e2 = X.eval e2 in
- match e1, e2 with
- `Num n1, `Num n2 -> `Num (n1*n2)
- | `Num 0, e | e, `Num 0 -> `Num 0
- | `Num 1, e | e, `Num 1 -> e
- | e12 -> `Mul e12
-end
-
-module Ext(X : sig type t = private [> ] end)(Y : sig type t end) = struct
- module type S =
- sig
- type t = private [> ] ~ [ X.t ]
- val eval : t -> Y.t
- val show : t -> string
- end
-end
-
-module Dummy = struct type t = [`Dummy] end
-
-module Mix(E : Exp)(E1 : Ext(Dummy)(E).S)(E2 : Ext(E1)(E).S) =
- struct
- type t = [E1.t | E2.t]
- let eval = function
- #E1.t as x -> E1.eval x
- | #E2.t as x -> E2.eval x
- let show = function
- #E1.t as x -> E1.show x
- | #E2.t as x -> E2.show x
- end
-
-module rec EAdd : (Exp with type t = [num | EAdd.t add]) =
- Mix(EAdd)(Num(EAdd))(Add(EAdd))
-
-(* A bit heavy: one must pass E to everybody *)
-module rec E : Exp with type t = [num | E.t add | E.t mul] =
- Mix(E)(Mix(E)(Num(E))(Add(E)))(Mul(E))
-
-let e = E.eval (`Add(`Mul(`Num 2,`Num 3),`Num 1))
-
-(* Alternatives *)
-(* Direct approach, no need of Mix *)
-module rec E : (Exp with type t = [num | E.t add | E.t mul]) =
- struct
- module E1 = Num(E)
- module E2 = Add(E)
- module E3 = Mul(E)
- type t = E.t
- let show = function
- | #num as x -> E1.show x
- | #add as x -> E2.show x
- | #mul as x -> E3.show x
- let eval = function
- | #num as x -> E1.eval x
- | #add as x -> E2.eval x
- | #mul as x -> E3.eval x
- end
-
-(* Do functor applications in Mix *)
-module type T = sig type t = private [> ] end
-module type Tnum = sig type t = private [> num] end
-
-module Ext(E : Tnum) = struct
- module type S = functor (Y : Exp with type t = E.t) ->
- sig
- type t = private [> num]
- val eval : t -> Y.t
- val show : t -> string
- end
-end
-
-module Ext'(E : Tnum)(X : T) = struct
- module type S = functor (Y : Exp with type t = E.t) ->
- sig
- type t = private [> ] ~ [ X.t ]
- val eval : t -> Y.t
- val show : t -> string
- end
-end
-
-module Mix(E : Exp)(F1 : Ext(E).S)(F2 : Ext'(E)(F1(E)).S) =
- struct
- module E1 = F1(E)
- module E2 = F2(E)
- type t = [E1.t | E2.t]
- let eval = function
- #E1.t as x -> E1.eval x
- | #E2.t as x -> E2.eval x
- let show = function
- #E1.t as x -> E1.show x
- | #E2.t as x -> E2.show x
- end
-
-module Join(E : Exp)(F1 : Ext(E).S)(F2 : Ext'(E)(F1(E)).S)
- (E' : Exp with type t = E.t) =
- Mix(E)(F1)(F2)
-
-module rec EAdd : (Exp with type t = [num | EAdd.t add]) =
- Mix(EAdd)(Num)(Add)
-
-module rec EMul : (Exp with type t = [num | EMul.t mul]) =
- Mix(EMul)(Num)(Mul)
-
-module rec E : (Exp with type t = [num | E.t add | E.t mul]) =
- Mix(E)(Join(E)(Num)(Add))(Mul)
-
-(* Linear extension by the end: not so nice *)
-module LExt(X : T) = struct
- module type S =
- sig
- type t
- val eval : t -> X.t
- val show : t -> string
- end
-end
-module LNum(E: Exp)(X : LExt(E).S with type t = private [> ] ~ [num]) =
- struct
- type t = [num | X.t]
- let show = function
- `Num n -> string_of_int n
- | #X.t as x -> X.show x
- let eval = function
- #num as x -> x
- | #X.t as x -> X.eval x
- end
-module LAdd(E : Exp with type t = private [> num | 'a add] as 'a)
- (X : LExt(E).S with type t = private [> ] ~ [add]) =
- struct
- type t = [E.t add | X.t]
- let show = function
- `Add(e1,e2) -> "("^ E.show e1 ^"+"^ E.show e2 ^")"
- | #X.t as x -> X.show x
- let eval = function
- `Add(e1,e2) ->
- let e1 = E.eval e1 and e2 = E.eval e2 in
- begin match e1, e2 with
- `Num n1, `Num n2 -> `Num (n1+n2)
- | `Num 0, e | e, `Num 0 -> e
- | e12 -> `Add e12
- end
- | #X.t as x -> X.eval x
- end
-module LEnd = struct
- type t = [`Dummy]
- let show `Dummy = ""
- let eval `Dummy = `Dummy
-end
-module rec L : Exp with type t = [num | L.t add | `Dummy] =
- LAdd(L)(LNum(L)(LEnd))
-
-(* Back to first form, but add map *)
-
-module Num(X : Exp) = struct
- type t = num
- let map f x = x
- let eval1 (`Num _ as x) : X.t = x
- let show (`Num n) = string_of_int n
-end
-
-module Add(X : Exp with type t = private [> num | 'a add] as 'a) = struct
- type t = X.t add
- let show (`Add(e1, e2) : t) = "("^ X.show e1 ^"+"^ X.show e2 ^")"
- let map f (`Add(e1, e2) : t) = `Add(f e1, f e2)
- let eval1 (`Add(e1, e2) as e : t) =
- match e1, e2 with
- `Num n1, `Num n2 -> `Num (n1+n2)
- | `Num 0, e | e, `Num 0 -> e
- | _ -> e
-end
-
-module Mul(X : Exp with type t = private [> num | 'a mul] as 'a) = struct
- type t = X.t mul
- let show (`Mul(e1, e2) : t) = "("^ X.show e1 ^"*"^ X.show e2 ^")"
- let map f (`Mul(e1, e2) : t) = `Mul(f e1, f e2)
- let eval1 (`Mul(e1, e2) as e : t) =
- match e1, e2 with
- `Num n1, `Num n2 -> `Num (n1*n2)
- | `Num 0, e | e, `Num 0 -> `Num 0
- | `Num 1, e | e, `Num 1 -> e
- | _ -> e
-end
-
-module Ext(X : sig type t = private [> ] end)(Y : sig type t end) = struct
- module type S =
- sig
- type t = private [> ] ~ [ X.t ]
- val map : (Y.t -> Y.t) -> t -> t
- val eval1 : t -> Y.t
- val show : t -> string
- end
-end
-
-module Mix(E : Exp)(E1 : Ext(Dummy)(E).S)(E2 : Ext(E1)(E).S) =
- struct
- type t = [E1.t | E2.t]
- let map f = function
- #E1.t as x -> (E1.map f x : E1.t :> t)
- | #E2.t as x -> (E2.map f x : E2.t :> t)
- let eval1 = function
- #E1.t as x -> E1.eval1 x
- | #E2.t as x -> E2.eval1 x
- let show = function
- #E1.t as x -> E1.show x
- | #E2.t as x -> E2.show x
- end
-
-module type ET = sig
- type t
- val map : (t -> t) -> t -> t
- val eval1 : t -> t
- val show : t -> string
-end
-
-module Fin(E : ET) = struct
- include E
- let rec eval e = eval1 (map eval e)
-end
-
-module rec EAdd : (Exp with type t = [num | EAdd.t add]) =
- Fin(Mix(EAdd)(Num(EAdd))(Add(EAdd)))
-
-module rec E : Exp with type t = [num | E.t add | E.t mul] =
- Fin(Mix(E)(Mix(E)(Num(E))(Add(E)))(Mul(E)))
-
-let e = E.eval (`Add(`Mul(`Num 2,`Num 3),`Num 1))
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-21 08:08:40 +0000