diff options
author | Alain Frisch <alain@frisch.fr> | 2010-09-09 17:42:23 +0000 |
---|---|---|
committer | Alain Frisch <alain@frisch.fr> | 2010-09-09 17:42:23 +0000 |
commit | 3dadaeff6c47e7a4e347923dda1b914daf38d601 (patch) | |
tree | fd6e8eee1d213c468d609234f23823fc8b1620c0 | |
parent | 0fe17f8d23cf24bbcccf8a9001c7af9530f5bbdc (diff) | |
download | ocaml-3dadaeff6c47e7a4e347923dda1b914daf38d601.tar.gz |
Support for constraints on parametrized types in package types.
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/fstclassmod_parametrized@10675 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r-- | typing/oprint.ml | 12 | ||||
-rw-r--r-- | typing/typetexp.ml | 4 |
2 files changed, 14 insertions, 2 deletions
diff --git a/typing/oprint.ml b/typing/oprint.ml index ca5db71a63..38626e80b6 100644 --- a/typing/oprint.ml +++ b/typing/oprint.ml @@ -219,7 +219,17 @@ and print_simple_out_type ppf = List.iter2 (fun s t -> let sep = if !first then (first := false; "with") else "and" in - fprintf ppf " %s type %s = %a" sep s print_out_type t + match t with + | Otyp_poly (sl, t) -> + fprintf ppf " %s type " sep; + begin match sl with + | [] -> () + | [x] -> fprintf ppf "'%s " x + | l -> fprintf ppf "(%a) " pr_vars l + end; + fprintf ppf "%s = %a" s print_out_type t + | _ -> + assert false ) n tyl; fprintf ppf ")@]" diff --git a/typing/typetexp.ml b/typing/typetexp.ml index 3a72081bb2..5e031308c4 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -133,7 +133,7 @@ let transl_package_type fake loc env (p, l) transl = List.map (fun (_, c) -> match c with - | Pwith_type {ptype_params = []; + | Pwith_type {ptype_params = params; ptype_cstrs = []; ptype_kind = Ptype_abstract; ptype_private = Asttypes.Public; @@ -141,6 +141,8 @@ let transl_package_type fake loc env (p, l) transl = ptype_variance = variance; ptype_loc = loc} when List.for_all (function (false, false) -> true | _ -> false) variance -> + let t = {ptyp_desc = Ptyp_poly(params, t); + ptyp_loc = t.ptyp_loc} in transl t | Pwith_type {ptype_loc = loc} | Pwith_typesubst {ptype_loc = loc} -> |