diff options
| author | Jérôme Vouillon <Jerome.Vouillon@pps.jussieu.fr> | 1996-05-14 15:38:36 +0000 |
|---|---|---|
| committer | Jérôme Vouillon <Jerome.Vouillon@pps.jussieu.fr> | 1996-05-14 15:38:36 +0000 |
| commit | de40cbf0b6f57051526137afe3e262de63fbf930 (patch) | |
| tree | d1a1890c53717f786e11f1571c853ea2189e5520 /typing | |
| parent | 6de5fc3e393f06a29435a6e3b79d3f83bfcf9d3e (diff) | |
| download | ocaml-de40cbf0b6f57051526137afe3e262de63fbf930.tar.gz | |
On peut maintenant masquer des variables d'instances dans les interfaces.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@810 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'typing')
| -rw-r--r-- | typing/includecore.ml | 37 |
1 files changed, 26 insertions, 11 deletions
diff --git a/typing/includecore.ml b/typing/includecore.ml index f25e238d06..d88157d3e7 100644 --- a/typing/includecore.ml +++ b/typing/includecore.ml @@ -74,17 +74,31 @@ let exception_declarations env ed1 ed2 = (* Inclusion between class types *) let vars desc = - Ctype.newgenty (Tobject ( + Ctype.newgenty (Ttuple( Vars.fold (fun lab (mut, ty) rem -> - let ty' = Ctype.newgenty - (Ttuple [if mut = Asttypes.Mutable then Predef.type_mutable - else Ctype.newgenty Tvar; - ty]) - in - Ctype.newgenty (Tfield (lab, ty', rem))) - desc.cty_vars (Ctype.newgenty Tnil), - ref None)) + (if mut = Asttypes.Mutable then Predef.type_unit + else Ctype.newgenty Tvar) + ::ty::rem) + desc.cty_vars [])) + +let encode_val (mut, ty) rem = + begin match mut with + Asttypes.Mutable -> Predef.type_unit + | Asttypes.Immutable -> Ctype.newgenty Tvar + end + ::ty::rem + +let vars vars1 vars2 = + Vars.fold + (fun lab v2 (vl1, vl2) -> + (begin try + encode_val (Vars.find lab vars1) vl1 + with Not_found -> + vl1 + end, + encode_val v2 vl2)) + vars2 ([], []) let class_type env d1 d2 = (* Same abbreviations *) @@ -100,6 +114,7 @@ let class_type env d1 d2 = (d1.cty_new <> None or d2.cty_new = None) & (* Less general *) - let t1 = Ctype.newgenty (Ttuple (d1.cty_self::vars d1::d1.cty_args)) in - let t2 = Ctype.newgenty (Ttuple (d2.cty_self::vars d2::d2.cty_args)) in + let (v1, v2) = vars d1.cty_vars d2.cty_vars in + let t1 = Ctype.newgenty (Ttuple (d1.cty_self::v1@d1.cty_args)) in + let t2 = Ctype.newgenty (Ttuple (d2.cty_self::v2@d2.cty_args)) in Ctype.moregeneral env t1 t2 |