diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2014-03-23 00:06:41 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2014-03-23 00:06:41 +0000 |
| commit | e39065c72b1bbff99ba7ac04c56c9e1f729d170b (patch) | |
| tree | 2a2d8b75b9a01ea7c5cfcb0f4bbf087efb7b0650 /typing/env.ml | |
| parent | 13027032932cce2533fcb52677af1288b5dc8268 (diff) | |
Optimize Env.find_module further for PR#6350
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14483 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'typing/env.ml')
| -rw-r--r-- | typing/env.ml | 28 |
1 files changed, 18 insertions, 10 deletions
diff --git a/typing/env.ml b/typing/env.ml index 1a3396572..938d438ec 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -453,7 +453,7 @@ let find_type p env = let find_type_descrs p env = snd (find_type_full p env) -let find_module path env = +let find_module ~alias path env = match path with Pident id -> begin try @@ -479,14 +479,20 @@ let find_module path env = let desc1 = find_module_descr p1 env in begin match EnvLazy.force !components_of_module_maker' desc1 with Functor_comps f -> - md begin try - Hashtbl.find f.fcomp_subst_cache p2 - with Not_found -> - let mty = - Subst.modtype (Subst.add_module f.fcomp_param p2 f.fcomp_subst) - f.fcomp_res in - Hashtbl.add f.fcomp_subst_cache p2 mty; - mty + md begin match f.fcomp_res with + | Mty_alias p -> + Mty_alias (Subst.module_path f.fcomp_subst p) + | mty -> + if alias then mty else + try + Hashtbl.find f.fcomp_subst_cache p2 + with Not_found -> + let mty = + Subst.modtype + (Subst.add_module f.fcomp_param p2 f.fcomp_subst) + f.fcomp_res in + Hashtbl.add f.fcomp_subst_cache p2 mty; + mty end | Structure_comps c -> raise Not_found @@ -509,7 +515,7 @@ let rec normalize_path lax env path = Papply(normalize_path lax env p1, normalize_path true env p2) | _ -> path in - try match find_module path env with + try match find_module ~alias:true path env with {md_type=Mty_alias path1} -> let path' = normalize_path lax env path1 in if lax || !Clflags.transparent_modules then path' else @@ -529,6 +535,8 @@ let normalize_path oloc env path = | Some loc -> raise (Error(Missing_module(loc, path, normalize_path true env path))) +let find_module = find_module ~alias:false + (* Find the manifest type associated to a type when appropriate: - the type should be public or should have a private row, - the type should have an associated manifest type. *) |