compatible with 4.10
This commit is contained in:
parent
83ee76fc39
commit
5ca427f2d2
|
@ -342,7 +342,13 @@ let check_phrase phrase =
|
||||||
(fun () ->
|
(fun () ->
|
||||||
Str.eval
|
Str.eval
|
||||||
(Exp.fun_ nolabel None (Pat.construct unit None)
|
(Exp.fun_ nolabel None (Pat.construct unit None)
|
||||||
(Exp.letmodule (with_loc loc "_")
|
(Exp.letmodule (with_loc loc
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
(Some "_")
|
||||||
|
#else
|
||||||
|
"_"
|
||||||
|
#endif
|
||||||
|
)
|
||||||
(Mod.structure (item :: items))
|
(Mod.structure (item :: items))
|
||||||
(Exp.construct unit None))))
|
(Exp.construct unit None))))
|
||||||
in
|
in
|
||||||
|
|
|
@ -516,8 +516,14 @@ let rec fields_of_module_type = function
|
||||||
String_set.empty
|
String_set.empty
|
||||||
|
|
||||||
let lookup_module id env =
|
let lookup_module id env =
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
let path, decl = Env.find_module_by_name id env in
|
||||||
|
(path, decl.md_type)
|
||||||
|
#else
|
||||||
let path = Env.lookup_module id env ~load:true in
|
let path = Env.lookup_module id env ~load:true in
|
||||||
(path, (Env.find_module path env).md_type)
|
(path, (Env.find_module path env).md_type)
|
||||||
|
#endif
|
||||||
|
|
||||||
let find_module path env = (Env.find_module path env).md_type
|
let find_module path env = (Env.find_module path env).md_type
|
||||||
|
|
||||||
let names_of_module longident =
|
let names_of_module longident =
|
||||||
|
@ -551,6 +557,10 @@ let fields_of_module longident =
|
||||||
let list_global_names () =
|
let list_global_names () =
|
||||||
let rec loop acc = function
|
let rec loop acc = function
|
||||||
| Env.Env_empty -> acc
|
| Env.Env_empty -> acc
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
| Env.Env_value_unbound _-> acc
|
||||||
|
| Env.Env_module_unbound _-> acc
|
||||||
|
#endif
|
||||||
| Env.Env_value(summary, id, _) ->
|
| Env.Env_value(summary, id, _) ->
|
||||||
loop (add (Ident.name id) acc) summary
|
loop (add (Ident.name id) acc) summary
|
||||||
| Env.Env_type(summary, id, decl) ->
|
| Env.Env_type(summary, id, decl) ->
|
||||||
|
@ -579,8 +589,8 @@ let list_global_names () =
|
||||||
| Env.Env_constraints (summary, _) ->
|
| Env.Env_constraints (summary, _) ->
|
||||||
loop acc summary
|
loop acc summary
|
||||||
#endif
|
#endif
|
||||||
#if OCAML_VERSION >= (4, 08, 0)
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
| Env.Env_copy_types (summary, _) ->
|
| Env.Env_copy_types summary ->
|
||||||
loop acc summary
|
loop acc summary
|
||||||
#else
|
#else
|
||||||
#if OCAML_VERSION >= (4, 06, 0)
|
#if OCAML_VERSION >= (4, 06, 0)
|
||||||
|
@ -626,6 +636,10 @@ let replace x y set =
|
||||||
let list_global_fields () =
|
let list_global_fields () =
|
||||||
let rec loop acc = function
|
let rec loop acc = function
|
||||||
| Env.Env_empty -> acc
|
| Env.Env_empty -> acc
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
| Env.Env_value_unbound _-> acc
|
||||||
|
| Env.Env_module_unbound _-> acc
|
||||||
|
#endif
|
||||||
| Env.Env_value(summary, id, _) ->
|
| Env.Env_value(summary, id, _) ->
|
||||||
loop (add (Ident.name id) acc) summary
|
loop (add (Ident.name id) acc) summary
|
||||||
| Env.Env_type(summary, id, decl) ->
|
| Env.Env_type(summary, id, decl) ->
|
||||||
|
@ -654,10 +668,15 @@ let list_global_fields () =
|
||||||
| Env.Env_constraints (summary, _) ->
|
| Env.Env_constraints (summary, _) ->
|
||||||
loop acc summary
|
loop acc summary
|
||||||
#endif
|
#endif
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
| Env.Env_copy_types summary ->
|
||||||
|
loop acc summary
|
||||||
|
#else
|
||||||
#if OCAML_VERSION >= (4, 06, 0)
|
#if OCAML_VERSION >= (4, 06, 0)
|
||||||
| Env.Env_copy_types (summary, _) ->
|
| Env.Env_copy_types (summary, _) ->
|
||||||
loop acc summary
|
loop acc summary
|
||||||
#endif
|
#endif
|
||||||
|
#endif
|
||||||
#if OCAML_VERSION >= (4, 07, 0)
|
#if OCAML_VERSION >= (4, 07, 0)
|
||||||
#if OCAML_VERSION >= (4, 08, 0)
|
#if OCAML_VERSION >= (4, 08, 0)
|
||||||
| Env.Env_open(summary, path) ->
|
| Env.Env_open(summary, path) ->
|
||||||
|
@ -748,7 +767,14 @@ let rec find_object meths type_expr =
|
||||||
None
|
None
|
||||||
|
|
||||||
let methods_of_object longident meths =
|
let methods_of_object longident meths =
|
||||||
match lookup_env Env.lookup_value longident !Toploop.toplevel_env with
|
let lookup_value=
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
Env.find_value_by_name
|
||||||
|
#else
|
||||||
|
Env.lookup_value
|
||||||
|
#endif
|
||||||
|
in
|
||||||
|
match lookup_env lookup_value longident !Toploop.toplevel_env with
|
||||||
| None ->
|
| None ->
|
||||||
[]
|
[]
|
||||||
| Some (path, { val_type = type_expr }) ->
|
| Some (path, { val_type = type_expr }) ->
|
||||||
|
@ -797,7 +823,14 @@ let rec labels_of_type acc type_expr =
|
||||||
String_map.bindings acc
|
String_map.bindings acc
|
||||||
|
|
||||||
let labels_of_function longident meths =
|
let labels_of_function longident meths =
|
||||||
match lookup_env Env.lookup_value longident !Toploop.toplevel_env with
|
let lookup_value=
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
Env.find_value_by_name
|
||||||
|
#else
|
||||||
|
Env.lookup_value
|
||||||
|
#endif
|
||||||
|
in
|
||||||
|
match lookup_env lookup_value longident !Toploop.toplevel_env with
|
||||||
| None ->
|
| None ->
|
||||||
[]
|
[]
|
||||||
| Some (path, { val_type = type_expr }) ->
|
| Some (path, { val_type = type_expr }) ->
|
||||||
|
@ -808,7 +841,14 @@ let labels_of_function longident meths =
|
||||||
labels_of_type String_map.empty type_expr
|
labels_of_type String_map.empty type_expr
|
||||||
|
|
||||||
let labels_of_newclass longident =
|
let labels_of_newclass longident =
|
||||||
match lookup_env Env.lookup_class longident !Toploop.toplevel_env with
|
let lookup_class=
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
Env.find_class_by_name
|
||||||
|
#else
|
||||||
|
Env.lookup_class
|
||||||
|
#endif
|
||||||
|
in
|
||||||
|
match lookup_env lookup_class longident !Toploop.toplevel_env with
|
||||||
| None ->
|
| None ->
|
||||||
[]
|
[]
|
||||||
| Some (path, { cty_new = None }) ->
|
| Some (path, { cty_new = None }) ->
|
||||||
|
|
|
@ -482,6 +482,10 @@ let rewrite_rules = [
|
||||||
}
|
}
|
||||||
]
|
]
|
||||||
|
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
let lookup_type longident env =
|
||||||
|
Env.find_type_by_name longident env
|
||||||
|
#else
|
||||||
#if OCAML_VERSION >= (4, 04, 0)
|
#if OCAML_VERSION >= (4, 04, 0)
|
||||||
let lookup_type longident env =
|
let lookup_type longident env =
|
||||||
let path = Env.lookup_type longident env in
|
let path = Env.lookup_type longident env in
|
||||||
|
@ -489,6 +493,7 @@ let lookup_type longident env =
|
||||||
#else
|
#else
|
||||||
let lookup_type = Env.lookup_type
|
let lookup_type = Env.lookup_type
|
||||||
#endif
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
let rule_path rule =
|
let rule_path rule =
|
||||||
match rule.path_to_rewrite with
|
match rule.path_to_rewrite with
|
||||||
|
@ -527,8 +532,15 @@ let rec is_persistent_path = function
|
||||||
(* Check that the given long identifier is present in the environment
|
(* Check that the given long identifier is present in the environment
|
||||||
and is persistent. *)
|
and is persistent. *)
|
||||||
let is_persistent_in_env longident =
|
let is_persistent_in_env longident =
|
||||||
|
let lookup_value=
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
Env.find_value_by_name
|
||||||
|
#else
|
||||||
|
Env.lookup_value
|
||||||
|
#endif
|
||||||
|
in
|
||||||
try
|
try
|
||||||
is_persistent_path (fst (Env.lookup_value longident !Toploop.toplevel_env))
|
is_persistent_path (fst (lookup_value longident !Toploop.toplevel_env))
|
||||||
with Not_found ->
|
with Not_found ->
|
||||||
false
|
false
|
||||||
|
|
||||||
|
@ -622,26 +634,22 @@ let bind_expressions name phrase =
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
|
||||||
#if OCAML_VERSION >= (4, 04, 0)
|
#if OCAML_VERSION >= (4, 04, 0)
|
||||||
|
|
||||||
|
#if OCAML_VERSION >= (4, 09, 0)
|
||||||
|
module Persistent_signature = Persistent_env.Persistent_signature
|
||||||
|
#else
|
||||||
|
module Persistent_signature = Env.Persistent_signature
|
||||||
|
#endif
|
||||||
|
|
||||||
let execute_phrase =
|
let execute_phrase =
|
||||||
let new_cmis = ref []in
|
let new_cmis = ref []in
|
||||||
|
let default_load = !Persistent_signature.load in
|
||||||
let default_load =
|
|
||||||
#if OCAML_VERSION >= (4, 09, 0)
|
|
||||||
!Persistent_env.Persistent_signature.load
|
|
||||||
#else
|
|
||||||
!Env.Persistent_signature.load
|
|
||||||
#endif
|
|
||||||
in
|
|
||||||
let load ~unit_name =
|
let load ~unit_name =
|
||||||
let res = default_load ~unit_name in
|
let res = default_load ~unit_name in
|
||||||
(match res with None -> () | Some x -> new_cmis := x.cmi :: !new_cmis);
|
(match res with None -> () | Some x -> new_cmis := x.cmi :: !new_cmis);
|
||||||
res
|
res
|
||||||
in
|
in
|
||||||
#if OCAML_VERSION >= (4, 09, 0)
|
Persistent_signature.load := load;
|
||||||
Persistent_env.Persistent_signature.load := load;
|
|
||||||
#else
|
|
||||||
Env.Persistent_signature.load := load;
|
|
||||||
#endif
|
|
||||||
|
|
||||||
let rec collect_printers path signature acc =
|
let rec collect_printers path signature acc =
|
||||||
List.fold_left (fun acc item ->
|
List.fold_left (fun acc item ->
|
||||||
|
@ -1173,6 +1181,22 @@ end
|
||||||
let typeof sid =
|
let typeof sid =
|
||||||
let id = Longident.parse sid in
|
let id = Longident.parse sid in
|
||||||
let env = !Toploop.toplevel_env in
|
let env = !Toploop.toplevel_env in
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
let lookup_value= Env.find_value_by_name
|
||||||
|
and lookup_label= Env.find_label_by_name
|
||||||
|
and lookup_modtype= Env.find_modtype_by_name
|
||||||
|
and lookup_module id env =
|
||||||
|
let path, decl = Env.find_module_by_name id env in
|
||||||
|
(path, decl.md_type)
|
||||||
|
#else
|
||||||
|
let lookup_value= Env.lookup_value
|
||||||
|
and lookup_label= Env.lookup_label
|
||||||
|
and lookup_modtype= Env.lookup_modtype
|
||||||
|
and lookup_module id env =
|
||||||
|
let path = Env.lookup_module id env ~load:true in
|
||||||
|
(path, (Env.find_module path env).md_type)
|
||||||
|
#endif
|
||||||
|
in
|
||||||
let from_type_desc = function
|
let from_type_desc = function
|
||||||
| Types.Tconstr (path, _, _) ->
|
| Types.Tconstr (path, _, _) ->
|
||||||
let typ_decl = Env.find_type path env in
|
let typ_decl = Env.find_type path env in
|
||||||
|
@ -1190,7 +1214,7 @@ let typeof sid =
|
||||||
Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
|
Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
|
||||||
with Not_found ->
|
with Not_found ->
|
||||||
try
|
try
|
||||||
let (path, val_descr) = Env.lookup_value id env in
|
let (path, val_descr) = lookup_value id env in
|
||||||
#if OCAML_VERSION >= (4, 08, 0)
|
#if OCAML_VERSION >= (4, 08, 0)
|
||||||
let id = Ident.create_local (Path.name path) in
|
let id = Ident.create_local (Path.name path) in
|
||||||
#else
|
#else
|
||||||
|
@ -1199,7 +1223,7 @@ let typeof sid =
|
||||||
Some (Printtyp.tree_of_value_description id val_descr)
|
Some (Printtyp.tree_of_value_description id val_descr)
|
||||||
with Not_found ->
|
with Not_found ->
|
||||||
try
|
try
|
||||||
let lbl_desc = Env.lookup_label id env in
|
let lbl_desc = lookup_label id env in
|
||||||
let (path, ty_decl) = from_type_desc lbl_desc.Types.lbl_res.Types.desc in
|
let (path, ty_decl) = from_type_desc lbl_desc.Types.lbl_res.Types.desc in
|
||||||
#if OCAML_VERSION >= (4, 08, 0)
|
#if OCAML_VERSION >= (4, 08, 0)
|
||||||
let id = Ident.create_local (Path.name path) in
|
let id = Ident.create_local (Path.name path) in
|
||||||
|
@ -1209,8 +1233,7 @@ let typeof sid =
|
||||||
Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
|
Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
|
||||||
with Not_found ->
|
with Not_found ->
|
||||||
try
|
try
|
||||||
let path = Env.lookup_module id env ~load:true in
|
let path, mod_typ = lookup_module id env in
|
||||||
let mod_typ = (Env.find_module path env).Types.md_type in
|
|
||||||
#if OCAML_VERSION >= (4, 08, 0)
|
#if OCAML_VERSION >= (4, 08, 0)
|
||||||
let id = Ident.create_local (Path.name path) in
|
let id = Ident.create_local (Path.name path) in
|
||||||
#else
|
#else
|
||||||
|
@ -1219,7 +1242,7 @@ let typeof sid =
|
||||||
Some (Printtyp.tree_of_module id mod_typ Types.Trec_not)
|
Some (Printtyp.tree_of_module id mod_typ Types.Trec_not)
|
||||||
with Not_found ->
|
with Not_found ->
|
||||||
try
|
try
|
||||||
let (path, mty_decl) = Env.lookup_modtype id env in
|
let (path, mty_decl) = lookup_modtype id env in
|
||||||
#if OCAML_VERSION >= (4, 08, 0)
|
#if OCAML_VERSION >= (4, 08, 0)
|
||||||
let id = Ident.create_local (Path.name path) in
|
let id = Ident.create_local (Path.name path) in
|
||||||
#else
|
#else
|
||||||
|
@ -1228,7 +1251,11 @@ let typeof sid =
|
||||||
Some (Printtyp.tree_of_modtype_declaration id mty_decl)
|
Some (Printtyp.tree_of_modtype_declaration id mty_decl)
|
||||||
with Not_found ->
|
with Not_found ->
|
||||||
try
|
try
|
||||||
|
#if OCAML_VERSION >= (4, 10, 0)
|
||||||
|
let cstr_desc = Env.find_constructor_by_name id env in
|
||||||
|
#else
|
||||||
let cstr_desc = Env.lookup_constructor id env in
|
let cstr_desc = Env.lookup_constructor id env in
|
||||||
|
#endif
|
||||||
match cstr_desc.Types.cstr_tag with
|
match cstr_desc.Types.cstr_tag with
|
||||||
| _ ->
|
| _ ->
|
||||||
let (path, ty_decl) = from_type_desc cstr_desc.Types.cstr_res.Types.desc in
|
let (path, ty_decl) = from_type_desc cstr_desc.Types.cstr_res.Types.desc in
|
||||||
|
|
Loading…
Reference in New Issue