follow type aliases

This commit is contained in:
Jeremie Dimino 2013-04-26 14:14:11 +01:00
parent c1bb8be73f
commit c1ec47d83e
1 changed files with 12 additions and 20 deletions

View File

@ -373,7 +373,7 @@ let () =
(* Rewrite Async.Std.Defered.t expressions to (* Rewrite Async.Std.Defered.t expressions to
Async_core.Thread_safe.block_on_async_exn (fun () -> <expr>). *) Async_core.Thread_safe.block_on_async_exn (fun () -> <expr>). *)
let async_rewrite = { Hashtbl.add rewrite_rules (Longident.parse "Async_core.Ivar.Deferred.t") {
required_values = [longident_async_core_thread_safe_block_on_async_exn]; required_values = [longident_async_core_thread_safe_block_on_async_exn];
rewrite = (fun loc e -> { rewrite = (fun loc e -> {
Parsetree.pexp_desc = Parsetree.pexp_desc =
@ -385,10 +385,7 @@ let () =
Parsetree.pexp_loc = loc; Parsetree.pexp_loc = loc;
}); });
enabled = UTop.auto_run_async; enabled = UTop.auto_run_async;
} in }
Hashtbl.add rewrite_rules (Longident.parse "Async_core.Deferred.t") async_rewrite;
Hashtbl.add rewrite_rules (Longident.parse "Async.Std.Deferred.t") async_rewrite
(* Returns whether the argument is a toplevel expression. *) (* Returns whether the argument is a toplevel expression. *)
let is_eval = function let is_eval = function
@ -416,25 +413,20 @@ let rec rule_of_type typ =
match typ.Types.desc with match typ.Types.desc with
| Types.Tlink typ -> | Types.Tlink typ ->
rule_of_type typ rule_of_type typ
| Types.Tconstr (path, _, _) -> | Types.Tconstr (path, _, _) -> begin
if is_persistent_path path then match try Some (Env.find_type path !Toploop.toplevel_env) with Not_found -> None with
try | Some {
Some (Hashtbl.find rewrite_rules (longident_of_path path))
with Not_found ->
rule_of_alias path
else
rule_of_alias path
| _ ->
None
and rule_of_alias path =
match try Some (Env.find_type path !Toploop.toplevel_env) with Not_found -> None with
| Some {
Types.type_kind = Types.Type_abstract; Types.type_kind = Types.Type_abstract;
Types.type_private = Asttypes.Public; Types.type_private = Asttypes.Public;
Types.type_manifest = Some typ; Types.type_manifest = Some typ;
} -> } ->
rule_of_type typ rule_of_type typ
| _ ->
try
Some (Hashtbl.find rewrite_rules (longident_of_path path))
with Not_found ->
None
end
| _ -> | _ ->
None None