Remove compatibility with pre-4.01.0.

This commit is contained in:
Peter Zotov 2014-10-20 16:45:26 +04:00
parent 1205520aff
commit 6f7ac4559f
4 changed files with 8 additions and 107 deletions

10
opam
View File

@ -11,14 +11,14 @@ build: [
build-doc: [["ocaml" "setup.ml" "-doc"]]
remove: [["ocamlfind" "remove" "utop"]]
depends: [
"ocamlfind"
"ocamlfind" {>= "1.4.0"}
"lambda-term" {>= "1.2"}
"lwt"
"react" {>= "1.0.0"}
"cppo" {>= "1.0.1"}
"oasis" {>= "0.3.0"}
"react" {>= "1.0.0"}
"cppo" {>= "1.0.1"}
"oasis" {>= "0.3.0"}
]
depopts: [
"camlp4"
]
ocaml-version: [>= "4.01"]
available: [ ocaml-version >= "4.01" ]

View File

@ -191,11 +191,7 @@ type 'a result =
exception Need_more
#if OCAML_VERSION <= 031201
let input_name = ""
#else
let input_name = "//toplevel//"
#endif
let lexbuf_of_string eof str =
let pos = ref 0 in
@ -246,14 +242,12 @@ let parse_default parse str eos_is_error =
| Syntaxerr.Other loc ->
Error ([mkloc loc],
"Syntax error")
#if OCAML_VERSION >= 040100
| Syntaxerr.Expecting (loc, nonterm) ->
Error ([mkloc loc],
Printf.sprintf "Syntax error: %s expected." nonterm)
| Syntaxerr.Variable_in_scope (loc, var) ->
Error ([mkloc loc],
Printf.sprintf "In this scoped type, variable '%s is reserved for the local type %s." var var)
#endif
#if OCAML_VERSION >= 040200
| Syntaxerr.Not_expecting (loc, nonterm) ->
Error ([mkloc loc],
@ -288,14 +282,10 @@ let rec last head tail =
| head :: tail ->
last head tail
#if OCAML_VERSION >= 040000
let with_loc loc str = {
Location.txt = str;
Location.loc = loc;
}
#else
let with_loc loc str = str
#endif
(* Check that the given phrase can be evaluated without typing/compile
errors. *)
@ -361,9 +351,7 @@ let check_phrase phrase =
try
let _ =
discard_formatters [Format.err_formatter] (fun () ->
#if OCAML_VERSION > 040001
Env.reset_cache_toplevel ();
#endif
Toploop.execute_phrase false null check_phrase)
in
(* The phrase is safe. *)
@ -660,13 +648,11 @@ let () =
let topfind_log, set_topfind_log = S.create ~eq:(fun _ _ -> false) []
#if FINDLIB_VERSION >= 010400
let () =
let real_log = !Topfind.log in
Topfind.log := fun str ->
set_topfind_log (str :: S.value topfind_log);
if S.value topfind_verbose then real_log str
#endif
let () =
Hashtbl.add

View File

@ -397,9 +397,6 @@ let visible_modules () =
#if OCAML_VERSION >= 040200
let field_name { ld_id = id } = Ident.name id
let constructor_name { cd_id = id } = Ident.name id
#elif OCAML_VERSION >= 040000
let field_name (id, _, _) = Ident.name id
let constructor_name (id, _, _) = Ident.name id
#else
let field_name (name, _, _) = name
let constructor_name (name, _) = name
@ -431,8 +428,6 @@ let add_names_of_type decl acc =
acc
#endif
#if OCAML_VERSION >= 040000
let rec names_of_module_type = function
| Mty_signature decls ->
List.fold_left
@ -511,56 +506,6 @@ let rec fields_of_module_type = function
| _ ->
String_set.empty
#else
let rec names_of_module_type = function
| Tmty_signature decls ->
List.fold_left
(fun acc decl -> match decl with
| Tsig_value(id, _)
| Tsig_exception(id, _)
| Tsig_module(id, _, _)
| Tsig_modtype(id, _)
| Tsig_class(id, _, _)
| Tsig_cltype(id, _, _) ->
add (Ident.name id) acc
| Tsig_type(id, decl, _) ->
add_names_of_type decl (add (Ident.name id) acc))
String_set.empty decls
| Tmty_ident path -> begin
match lookup_env Env.find_modtype path !Toploop.toplevel_env with
| Some Tmodtype_abstract -> String_set.empty
| Some Tmodtype_manifest module_type -> names_of_module_type module_type
| None -> String_set.empty
end
| _ ->
String_set.empty
let rec fields_of_module_type = function
| Tmty_signature decls ->
List.fold_left
(fun acc decl -> match decl with
| Tsig_value(id, _)
| Tsig_exception(id, _)
| Tsig_module(id, _, _)
| Tsig_modtype(id, _)
| Tsig_class(id, _, _)
| Tsig_cltype(id, _, _) ->
acc
| Tsig_type(id, decl, _) ->
add_fields_of_type decl acc)
String_set.empty decls
| Tmty_ident path -> begin
match lookup_env Env.find_modtype path !Toploop.toplevel_env with
| Some Tmodtype_abstract -> String_set.empty
| Some Tmodtype_manifest module_type -> fields_of_module_type module_type
| None -> String_set.empty
end
| _ ->
String_set.empty
#endif
#if OCAML_VERSION < 040200
let lookup_module = Env.lookup_module
let find_module = Env.find_module

View File

@ -355,14 +355,10 @@ let () =
| Toplevel expression rewriting |
+-----------------------------------------------------------------+ *)
#if OCAML_VERSION >= 040000
let with_loc loc str = {
Location.txt = str;
Location.loc = loc;
}
#else
let with_loc loc str = str
#endif
(* A rule for rewriting a toplevel expression. *)
type rewrite_rule = {
@ -498,17 +494,9 @@ let is_persistent_in_env longident =
with Not_found ->
false
#if OCAML_VERSION >= 040000
let str_items_of_typed_structure tstr = tstr.Typedtree.str_items
let str_desc_of_typed_str_item tstr = tstr.Typedtree.str_desc
#else
let str_items_of_typed_structure tstr = tstr
let str_desc_of_typed_str_item tstr = tstr
#endif
#if OCAML_VERSION < 040200
let rewrite_str_item pstr_item tstr_item =
match pstr_item, str_desc_of_typed_str_item tstr_item with
match pstr_item, tstr_item.Typedtree.str_desc with
| ({ Parsetree.pstr_desc = Parsetree.Pstr_eval e;
Parsetree.pstr_loc = loc },
Typedtree.Tstr_eval { Typedtree.exp_type = typ }) -> begin
@ -526,7 +514,7 @@ let rewrite_str_item pstr_item tstr_item =
pstr_item
#else
let rewrite_str_item pstr_item tstr_item =
match pstr_item, str_desc_of_typed_str_item tstr_item with
match pstr_item, tstr_item.Typedtree.str_desc with
| ({ Parsetree.pstr_desc = Parsetree.Pstr_eval (e, _);
Parsetree.pstr_loc = loc },
Typedtree.Tstr_eval ({ Typedtree.exp_type = typ }, _)) -> begin
@ -549,8 +537,7 @@ let rewrite phrase =
| Parsetree.Ptop_def pstr ->
if (UTop.get_auto_run_lwt () || UTop.get_auto_run_async ()) && List.exists is_eval pstr then
let tstr, _, _ = Typemod.type_structure !Toploop.toplevel_env pstr Location.none in
let tstr = str_items_of_typed_structure tstr in
Parsetree.Ptop_def (List.map2 rewrite_str_item pstr tstr)
Parsetree.Ptop_def (List.map2 rewrite_str_item pstr tstr.Typedtree.str_items)
else
Parsetree.Ptop_def pstr
| Parsetree.Ptop_dir _ ->
@ -620,13 +607,9 @@ let rec loop term =
let pp = Format.formatter_of_buffer buffer in
Format.pp_set_margin pp (LTerm.size term).cols;
(try
#if OCAML_VERSION > 040001
Env.reset_cache_toplevel ();
#endif
if !Clflags.dump_parsetree then Printast.top_phrase pp phrase;
#if OCAML_VERSION > 040001
if !Clflags.dump_source then Pprintast.top_phrase pp phrase;
#endif
ignore (Toploop.execute_phrase true pp phrase);
(* Flush everything. *)
Format.pp_print_flush Format.std_formatter ();
@ -1022,8 +1005,6 @@ end
| Extra macros |
+-----------------------------------------------------------------+ *)
#if OCAML_VERSION > 040001
let typeof sid =
let id = Longident.parse sid in
let env = !Toploop.toplevel_env in
@ -1093,13 +1074,10 @@ let typeof sid =
let str = Buffer.contents buf in
Lwt_main.run (Lazy.force LTerm.stdout >>= fun term -> render_out_phrase term str)
let () =
Hashtbl.add Toploop.directive_table "typeof"
(Toploop.Directive_string typeof)
#endif
(* +-----------------------------------------------------------------+
| Entry point |
+-----------------------------------------------------------------+ *)
@ -1159,9 +1137,7 @@ let print_version_num () =
let autoload = ref true
let args = Arg.align [
#if OCAML_VERSION >= 031300
"-absname", Arg.Set Location.absname, " Show absolute filenames in error message";
#endif
"-I", Arg.String (fun dir -> Clflags.include_dirs := Misc.expand_directory Config.standard_library dir :: !Clflags.include_dirs), "<dir> Add <dir> to the list of include directories";
"-init", Arg.String (fun s -> Clflags.init_file := Some s), "<file> Load <file> instead of default init file";
"-labels", Arg.Clear Clflags.classic, " Use commuting label mode";
@ -1176,10 +1152,8 @@ let args = Arg.align [
#if OCAML_VERSION >= 040200
"-safe-string", Arg.Clear Clflags.unsafe_string, " Make strings immutable";
#endif
#if OCAML_VERSION >= 040100
"-short-paths", Arg.Clear Clflags.real_paths, " Shorten paths in types (the default)";
"-no-short-paths", Arg.Set Clflags.real_paths, " Do not shorten paths in types";
#endif
"-rectypes", Arg.Set Clflags.recursive_types, " Allow arbitrary recursive types";
"-stdin", Arg.Unit (fun () -> run_script ""), " Read script from standard input";
"-strict-sequence", Arg.Set Clflags.strict_sequence, " Left-hand part of a sequence must have type unit";
@ -1213,14 +1187,10 @@ let args = Arg.align [
"-require", Arg.String (fun s -> preload := `Packages (UTop.split_words s) :: !preload),
"<package> Load this package";
"-dparsetree", Arg.Set Clflags.dump_parsetree, " Dump OCaml AST after rewriting";
#if OCAML_VERSION >= 040100
"-dsource", Arg.Set Clflags.dump_source, " Dump OCaml source after rewriting";
#endif
]
#if OCAML_VERSION >= 040100
let () = Clflags.real_paths := false
#endif
let app_name = Filename.basename Sys.executable_name
let usage = Printf.sprintf "Usage: %s <options> <object-files> [script-file [arguments]]\noptions are:" app_name