haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

better detection of Lwt.t values 

Ignore-this: c1fb44905029d45646301f66bb3ca078

darcs-hash:20120222172522-c41ad-e4fb0b9b6d0245d4aa958c69bcce3969c822795a
This commit is contained in:
Jeremie Dimino 2012-02-22 18:25:22 +01:00
parent f819014eb9
commit a196bb8802
1 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/lib/uTop_main.ml
View File

@ -216,6 +216,15 @@ let is_eval = function
| { Parsetree.pstr_desc = Parsetree.Pstr_eval _ } -> true | { Parsetree.pstr_desc = Parsetree.Pstr_eval _ } -> true
| _ -> false | _ -> false
let rec is_lwt_t typ =
match typ.Types.desc with
| Types.Tlink typ ->
is_lwt_t typ
| Types.Tconstr (Path.Pdot (Path.Pident id, "t", -1), _, _) ->
Ident.persistent id && Ident.name id = "Lwt"
| _ ->
false
let insert_lwt_main_run phrase = let insert_lwt_main_run phrase =
match phrase with match phrase with
| Parsetree.Ptop_def pstr -> | Parsetree.Ptop_def pstr ->
@ -237,13 +246,8 @@ let insert_lwt_main_run phrase =
(fun pstr_item tstr_item -> (fun pstr_item tstr_item ->
match pstr_item, tstr_item with match pstr_item, tstr_item with
| { Parsetree.pstr_desc = Parsetree.Pstr_eval e; Parsetree.pstr_loc = loc }, | { Parsetree.pstr_desc = Parsetree.Pstr_eval e; Parsetree.pstr_loc = loc },
Typedtree.Tstr_eval { Typedtree.Tstr_eval { Typedtree.exp_type = typ } when is_lwt_t typ ->
Typedtree.exp_type = { {
Types.desc =
Types.Tconstr (Path.Pdot (Path.Pident id, "t", -1), _, _)
}
} ->
if Ident.persistent id && Ident.name id = "Lwt" then {
Parsetree.pstr_desc = Parsetree.pstr_desc =
Parsetree.Pstr_eval { Parsetree.Pstr_eval {
Parsetree.pexp_desc = Parsetree.pexp_desc =
@ -253,8 +257,7 @@ let insert_lwt_main_run phrase =
Parsetree.pexp_loc = loc; Parsetree.pexp_loc = loc;
}; };
Parsetree.pstr_loc = loc; Parsetree.pstr_loc = loc;
} else }
pstr_item
| _ -> | _ ->
pstr_item) pstr_item)
pstr tstr) pstr tstr)