diff options
| -rw-r--r-- | typing/env.ml | 4 | ||||
| -rw-r--r-- | typing/printtyp.ml | 17 |
2 files changed, 17 insertions, 4 deletions
diff --git a/typing/env.ml b/typing/env.ml index 91e9cab55f..a3a0814d46 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -981,7 +981,9 @@ let iter_env_cont = ref [] let rec scrape_alias_safe env mty = match mty with - | Mty_alias (Pident id) when Ident.persistent id -> false + | Mty_alias (Pident id) + when Ident.persistent id + && not (Hashtbl.mem persistent_structures (Ident.name id)) -> false | Mty_alias path -> (* PR#6600: find_module may raise Not_found *) scrape_alias_safe env (find_module path env).md_type | _ -> true diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 52fddd478e..8788b8ad07 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -272,10 +272,21 @@ let rec normalize_type_path ?(cache=false) env p = with Not_found -> (p, Id) +let penality s = + if s <> "" && s.[0] = '_' then + 10 + else + try + for i = 0 to String.length s - 2 do + if s.[i] = '_' && s.[i + 1] = '_' then + raise Exit + done; + 1 + with Exit -> 10 + let rec path_size = function Pident id -> - (let s = Ident.name id in if s <> "" && s.[0] = '_' then 10 else 1), - -Ident.binding_time id + penality (Ident.name id), -Ident.binding_time id | Pdot (p, _, _) -> let (l, b) = path_size p in (1+l, b) | Papply (p1, p2) -> @@ -355,7 +366,7 @@ let best_type_path p = let (p', s) = normalize_type_path !printing_env p in let get_path () = get_best_path (PathMap.find p' !printing_map) in while !printing_cont <> [] && - try ignore (get_path ()); false with Not_found -> true + try fst (path_size (get_path ())) > !printing_depth with Not_found -> true do printing_cont := List.map snd (Env.run_iter_cont !printing_cont); incr printing_depth; |