diff options
Diffstat (limited to 'typing/printtyp.ml')
| -rw-r--r-- | typing/printtyp.ml | 49 |
1 files changed, 24 insertions, 25 deletions
diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 1f7e501984..cd3a631b8a 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -247,28 +247,22 @@ let rec uniq = function let rec normalize_type_path ?(cache=false) env p = try - let desc = Env.find_type p env in - if desc.type_private = Private || desc.type_newtype_level <> None then - (p, Id) - else match desc.type_manifest with - Some ty -> - let params = List.map repr desc.type_params in - begin match repr ty with - {desc = Tconstr (p1, tyl, _)} -> - let tyl = List.map repr tyl in - if List.length params = List.length tyl - && List.for_all2 (==) params tyl - then normalize_type_path ~cache env p1 - else if cache || List.length params <= List.length tyl - || not (uniq tyl) then (p, Id) - else - let l1 = List.map (index params) tyl in - let (p2, s2) = normalize_type_path ~cache env p1 in - (p2, compose l1 s2) - | ty -> - (p, Nth (index params ty)) - end - | None -> (p, Id) + let (params, ty, _) = Env.find_type_expansion p env in + let params = List.map repr params in + match repr ty with + {desc = Tconstr (p1, tyl, _)} -> + let tyl = List.map repr tyl in + if List.length params = List.length tyl + && List.for_all2 (==) params tyl + then normalize_type_path ~cache env p1 + else if cache || List.length params <= List.length tyl + || not (uniq tyl) then (p, Id) + else + let l1 = List.map (index params) tyl in + let (p2, s2) = normalize_type_path ~cache env p1 in + (p2, compose l1 s2) + | ty -> + (p, Nth (index params ty)) with Not_found -> (p, Id) @@ -1116,9 +1110,14 @@ let rec tree_of_modtype = function | Mty_signature sg -> Omty_signature (tree_of_signature sg) | Mty_functor(param, ty_arg, ty_res) -> - Omty_functor - (Ident.name param, tree_of_modtype ty_arg, - wrap_env (Env.add_module param ty_arg) tree_of_modtype ty_res) + let res = + match ty_arg with None -> tree_of_modtype ty_res + | Some mty -> + wrap_env (Env.add_module ~arg:true param mty) tree_of_modtype ty_res + in + Omty_functor (Ident.name param, may_map tree_of_modtype ty_arg, res) + | Mty_alias p -> + Omty_alias (tree_of_path p) and tree_of_signature sg = wrap_env (fun env -> env) (tree_of_signature_rec !printing_env) sg |