Update for 4.02.

This commit is contained in:
Peter Zotov 2014-05-06 20:18:39 +04:00
parent 42b50ce138
commit 5305027a36
2 changed files with 40 additions and 6 deletions

View File

@ -388,6 +388,10 @@ let add_fields_of_type decl acc =
List.fold_left (fun acc field -> add (field_name field) acc) acc fields
| Type_abstract ->
acc
#if ocaml_version >= (4, 02, 0)
| Type_open ->
acc
#endif
let add_names_of_type decl acc =
match decl.type_kind with
@ -397,6 +401,10 @@ let add_names_of_type decl acc =
List.fold_left (fun acc field -> add (field_name field) acc) acc fields
| Type_abstract ->
acc
#if ocaml_version >= (4, 02, 0)
| Type_open ->
acc
#endif
#if ocaml_version >= (4, 0, 0)
@ -405,7 +413,11 @@ let rec names_of_module_type = function
List.fold_left
(fun acc decl -> match decl with
| Sig_value (id, _)
#if ocaml_version >= (4, 02, 0)
| Sig_typext (id, _, _)
#else
| Sig_exception (id, _)
#endif
| Sig_module (id, _, _)
| Sig_modtype (id, _)
| Sig_class (id, _, _)
@ -433,7 +445,11 @@ let rec fields_of_module_type = function
List.fold_left
(fun acc decl -> match decl with
| Sig_value (id, _)
#if ocaml_version >= (4, 02, 0)
| Sig_typext (id, _, _)
#else
| Sig_exception (id, _)
#endif
| Sig_module (id, _, _)
| Sig_modtype (id, _)
| Sig_class (id, _, _)
@ -551,7 +567,11 @@ let list_global_names () =
loop (add (Ident.name id) acc) summary
| Env.Env_type(summary, id, decl) ->
loop (add_names_of_type decl (add (Ident.name id) acc)) summary
#if ocaml_version >= (4, 02, 0)
| Env.Env_extension(summary, id, _) ->
#else
| Env.Env_exception(summary, id, _) ->
#endif
loop (add (Ident.name id) acc) summary
| Env.Env_module(summary, id, _) ->
loop (add (Ident.name id) acc) summary
@ -612,7 +632,11 @@ let list_global_fields () =
loop (add (Ident.name id) acc) summary
| Env.Env_type(summary, id, decl) ->
loop (add_fields_of_type decl (add (Ident.name id) acc)) summary
#if ocaml_version >= (4, 02, 0)
| Env.Env_extension(summary, id, _) ->
#else
| Env.Env_exception(summary, id, _) ->
#endif
loop (add (Ident.name id) acc) summary
| Env.Env_module(summary, id, _) ->
loop (add (Ident.name id) acc) summary

View File

@ -242,9 +242,17 @@ let rec map_items unwrap wrap items =
| Outcometree.Osig_class (_, name, _, _, rs)
| Outcometree.Osig_class_type (_, name, _, _, rs)
| Outcometree.Osig_module (name, _, rs)
#if ocaml_version >= (4, 02, 0)
| Outcometree.Osig_type ({ Outcometree.otype_name = name }, rs) ->
#else
| Outcometree.Osig_type ((name, _, _, _, _), rs) ->
#endif
(name, rs)
#if ocaml_version >= (4, 02, 0)
| Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _)
#else
| Outcometree.Osig_exception (name, _)
#endif
| Outcometree.Osig_modtype (name, _)
| Outcometree.Osig_value (name, _, _) ->
(name, Outcometree.Orec_not)
@ -276,12 +284,16 @@ let rec map_items unwrap wrap items =
wrap (Outcometree.Osig_module (name, a, Outcometree.Orec_first)) extra :: items'
else
items
| Outcometree.Osig_type ((name, a, b, c, d), rs) ->
| Outcometree.Osig_type (oty, rs) ->
if rs = Outcometree.Orec_next then
wrap (Outcometree.Osig_type ((name, a, b, c, d), Outcometree.Orec_first)) extra :: items'
wrap (Outcometree.Osig_type (oty, Outcometree.Orec_first)) extra :: items'
else
items
#if ocaml_version >= (4, 02, 0)
| Outcometree.Osig_typext _
#else
| Outcometree.Osig_exception _
#endif
| Outcometree.Osig_modtype _
| Outcometree.Osig_value _ ->
items
@ -1011,7 +1023,7 @@ let typeof sid =
Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
with Not_found ->
try
#if ocaml_version < (4, 2, 0)
#if ocaml_version < (4, 02, 0)
let (path, mod_typ) = Env.lookup_module id env in
#else
let path = Env.lookup_module id env in
@ -1028,13 +1040,11 @@ let typeof sid =
try
let cstr_desc = Env.lookup_constructor id env in
match cstr_desc.Types.cstr_tag with
#if ocaml_version < (4, 02, 0)
| Types.Cstr_exception (_path, loc) ->
#if ocaml_version < (4, 2, 0)
let path, exn_decl = Typedecl.transl_exn_rebind env loc id in
let id = Ident.create (Path.name path) in
Some (Printtyp.tree_of_exception_declaration id exn_decl)
#else
None
#endif
| _ ->
let (path, ty_decl) = from_type_desc cstr_desc.Types.cstr_res.Types.desc in