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

Use tuple comparisons, present since cppo 1.1.2.

This commit is contained in:
Peter Zotov 2014-11-17 17:58:12 +03:00
parent b7259ae286
commit 970b308126
7 changed files with 35 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
_tags
View File

@ -1,9 +1,6 @@
# -*- conf -*- # -*- conf -*-
# Use compiler interfaces <src/**/*.ml{,i}>: cppo_V_OCAML, package(compiler-libs)
<src/**/*.ml{,i}>: package(compiler-libs)
# Use camlp5
<src/camlp5/**/*.ml{,i}>: use_camlp5 <src/camlp5/**/*.ml{,i}>: use_camlp5
# OASIS_START # OASIS_START

9
myocamlbuild.ml
View File

@ -34,15 +34,6 @@ let () =
let env = BaseEnvLight.load () in let env = BaseEnvLight.load () in
let stdlib = BaseEnvLight.var_get "standard_library" env in let stdlib = BaseEnvLight.var_get "standard_library" env in
let ocaml_version =
Scanf.sscanf Sys.ocaml_version "%d.%d.%d" (fun major minor patchlevel ->
(* e.g. #define OCAML_VERSION 040201 *)
Printf.sprintf "OCAML_VERSION %d" (major * 10000 + minor * 100 + patchlevel))
in
(* Cppo *)
flag ["cppo"] & S[A"-D"; A ocaml_version];
let paths = [A "-I"; A "+camlp5"] in let paths = [A "-I"; A "+camlp5"] in
flag ["ocaml"; "compile"; "use_camlp5"] & S paths; flag ["ocaml"; "compile"; "use_camlp5"] & S paths;
flag ["ocaml"; "ocamldep"; "use_camlp5"] & S paths; flag ["ocaml"; "ocamldep"; "use_camlp5"] & S paths;

2
opam
View File

@ -23,7 +23,7 @@ depends: [
"lambda-term" {>= "1.2"} "lambda-term" {>= "1.2"}
"lwt" "lwt"
"react" {>= "1.0.0"} "react" {>= "1.0.0"}
"cppo" {>= "1.0.1"} "cppo" {>= "1.1.2"}
"oasis" {>= "0.3.0"} "oasis" {>= "0.3.0"}
] ]
depopts: [ depopts: [

2
src/camlp4/uTop_camlp4.cppo.ml
View File

@ -13,7 +13,7 @@ open Camlp4.PreCast
module Ast2pt = Camlp4.Struct.Camlp4Ast2OCamlAst.Make(Ast) module Ast2pt = Camlp4.Struct.Camlp4Ast2OCamlAst.Make(Ast)
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
external cast_toplevel_phrase : Camlp4_import.Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase = "%identity" external cast_toplevel_phrase : Camlp4_import.Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase = "%identity"
#else #else
let cast_toplevel_phrase x = x let cast_toplevel_phrase x = x

4
src/lib/uTop.cppo.ml
View File

@ -249,7 +249,7 @@ let parse_default parse str eos_is_error =
| Syntaxerr.Variable_in_scope (loc, var) -> | Syntaxerr.Variable_in_scope (loc, var) ->
Error ([mkloc loc], Error ([mkloc loc],
Printf.sprintf "In this scoped type, variable '%s is reserved for the local type %s." var var) Printf.sprintf "In this scoped type, variable '%s is reserved for the local type %s." var var)
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Syntaxerr.Not_expecting (loc, nonterm) -> | Syntaxerr.Not_expecting (loc, nonterm) ->
Error ([mkloc loc], Error ([mkloc loc],
Printf.sprintf "Syntax error: %s not expected" nonterm) Printf.sprintf "Syntax error: %s not expected" nonterm)
@ -309,7 +309,7 @@ let check_phrase phrase =
(* Construct "let _ () = let module _ = struct <items> end in ()" in order to test (* Construct "let _ () = let module _ = struct <items> end in ()" in order to test
the typing and compilation of [items] without evaluating them. *) the typing and compilation of [items] without evaluating them. *)
let unit = with_loc loc (Longident.Lident "()") in let unit = with_loc loc (Longident.Lident "()") in
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
let structure = { let structure = {
pmod_loc = loc; pmod_loc = loc;
pmod_desc = Pmod_structure (item :: items); pmod_desc = Pmod_structure (item :: items);

32
src/lib/uTop_complete.cppo.ml
View File

@ -302,7 +302,7 @@ let list_directories dir =
String_set.empty String_set.empty
(try Sys.readdir (if dir = "" then Filename.current_dir_name else dir) with Sys_error _ -> [||])) (try Sys.readdir (if dir = "" then Filename.current_dir_name else dir) with Sys_error _ -> [||]))
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
let path () = let path () =
let path_separator = let path_separator =
match Sys.os_type with match Sys.os_type with
@ -394,7 +394,7 @@ let visible_modules () =
acc) acc)
String_set.empty !Config.load_path) String_set.empty !Config.load_path)
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
let field_name { ld_id = id } = Ident.name id let field_name { ld_id = id } = Ident.name id
let constructor_name { cd_id = id } = Ident.name id let constructor_name { cd_id = id } = Ident.name id
#else #else
@ -410,7 +410,7 @@ let add_fields_of_type decl acc =
List.fold_left (fun acc field -> add (field_name field) acc) acc fields List.fold_left (fun acc field -> add (field_name field) acc) acc fields
| Type_abstract -> | Type_abstract ->
acc acc
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Type_open -> | Type_open ->
acc acc
#endif #endif
@ -423,7 +423,7 @@ let add_names_of_type decl acc =
List.fold_left (fun acc field -> add (field_name field) acc) acc fields List.fold_left (fun acc field -> add (field_name field) acc) acc fields
| Type_abstract -> | Type_abstract ->
acc acc
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Type_open -> | Type_open ->
acc acc
#endif #endif
@ -433,7 +433,7 @@ let rec names_of_module_type = function
List.fold_left List.fold_left
(fun acc decl -> match decl with (fun acc decl -> match decl with
| Sig_value (id, _) | Sig_value (id, _)
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Sig_typext (id, _, _) | Sig_typext (id, _, _)
#else #else
| Sig_exception (id, _) | Sig_exception (id, _)
@ -448,7 +448,7 @@ let rec names_of_module_type = function
String_set.empty decls String_set.empty decls
| Mty_ident path -> begin | Mty_ident path -> begin
match lookup_env Env.find_modtype path !Toploop.toplevel_env with match lookup_env Env.find_modtype path !Toploop.toplevel_env with
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
| Some Modtype_abstract -> String_set.empty | Some Modtype_abstract -> String_set.empty
| Some Modtype_manifest module_type -> names_of_module_type module_type | Some Modtype_manifest module_type -> names_of_module_type module_type
#else #else
@ -457,7 +457,7 @@ let rec names_of_module_type = function
#endif #endif
| None -> String_set.empty | None -> String_set.empty
end end
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Mty_alias path -> begin | Mty_alias path -> begin
match lookup_env Env.find_module path !Toploop.toplevel_env with match lookup_env Env.find_module path !Toploop.toplevel_env with
| None -> String_set.empty | None -> String_set.empty
@ -472,7 +472,7 @@ let rec fields_of_module_type = function
List.fold_left List.fold_left
(fun acc decl -> match decl with (fun acc decl -> match decl with
| Sig_value (id, _) | Sig_value (id, _)
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Sig_typext (id, _, _) | Sig_typext (id, _, _)
#else #else
| Sig_exception (id, _) | Sig_exception (id, _)
@ -487,7 +487,7 @@ let rec fields_of_module_type = function
String_set.empty decls String_set.empty decls
| Mty_ident path -> begin | Mty_ident path -> begin
match lookup_env Env.find_modtype path !Toploop.toplevel_env with match lookup_env Env.find_modtype path !Toploop.toplevel_env with
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
| Some Modtype_abstract -> String_set.empty | Some Modtype_abstract -> String_set.empty
| Some Modtype_manifest module_type -> fields_of_module_type module_type | Some Modtype_manifest module_type -> fields_of_module_type module_type
#else #else
@ -496,7 +496,7 @@ let rec fields_of_module_type = function
#endif #endif
| None -> String_set.empty | None -> String_set.empty
end end
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Mty_alias path -> begin | Mty_alias path -> begin
match lookup_env Env.find_module path !Toploop.toplevel_env with match lookup_env Env.find_module path !Toploop.toplevel_env with
| None -> String_set.empty | None -> String_set.empty
@ -506,7 +506,7 @@ let rec fields_of_module_type = function
| _ -> | _ ->
String_set.empty String_set.empty
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
let lookup_module = Env.lookup_module let lookup_module = Env.lookup_module
let find_module = Env.find_module let find_module = Env.find_module
#else #else
@ -551,7 +551,7 @@ let list_global_names () =
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) ->
loop (add_names_of_type decl (add (Ident.name id) acc)) summary loop (add_names_of_type decl (add (Ident.name id) acc)) summary
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Env.Env_extension(summary, id, _) -> | Env.Env_extension(summary, id, _) ->
#else #else
| Env.Env_exception(summary, id, _) -> | Env.Env_exception(summary, id, _) ->
@ -565,7 +565,7 @@ let list_global_names () =
loop (add (Ident.name id) acc) summary loop (add (Ident.name id) acc) summary
| Env.Env_cltype(summary, id, _) -> | Env.Env_cltype(summary, id, _) ->
loop (add (Ident.name id) acc) summary loop (add (Ident.name id) acc) summary
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Env.Env_functor_arg(summary, id) -> | Env.Env_functor_arg(summary, id) ->
loop (add (Ident.name id) acc) summary loop (add (Ident.name id) acc) summary
#endif #endif
@ -616,7 +616,7 @@ let list_global_fields () =
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) ->
loop (add_fields_of_type decl (add (Ident.name id) acc)) summary loop (add_fields_of_type decl (add (Ident.name id) acc)) summary
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Env.Env_extension(summary, id, _) -> | Env.Env_extension(summary, id, _) ->
#else #else
| Env.Env_exception(summary, id, _) -> | Env.Env_exception(summary, id, _) ->
@ -624,7 +624,7 @@ let list_global_fields () =
loop (add (Ident.name id) acc) summary loop (add (Ident.name id) acc) summary
| Env.Env_module(summary, id, _) -> | Env.Env_module(summary, id, _) ->
loop (add (Ident.name id) acc) summary loop (add (Ident.name id) acc) summary
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Env.Env_functor_arg(summary, id) -> | Env.Env_functor_arg(summary, id) ->
loop (add (Ident.name id) acc) summary loop (add (Ident.name id) acc) summary
#endif #endif
@ -886,7 +886,7 @@ let complete ~syntax ~phrase_terminator ~input =
(loc.idx2 - Zed_utf8.length name, (loc.idx2 - Zed_utf8.length name,
List.map (function (w, Directory) -> (w, "") | (w, File) -> (w, "\"" ^ phrase_terminator)) result) List.map (function (w, Directory) -> (w, "") | (w, File) -> (w, "\"" ^ phrase_terminator)) result)
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
(* Completion on #ppx. *) (* Completion on #ppx. *)
| [(Symbol "#", _); (Lident ("ppx"), _); (String false, loc)] -> | [(Symbol "#", _); (Lident ("ppx"), _); (String false, loc)] ->
let file = String.sub input (loc.ofs1 + 1) (String.length input - loc.ofs1 - 1) in let file = String.sub input (loc.ofs1 + 1) (String.length input - loc.ofs1 - 1) in

28
src/lib/uTop_main.cppo.ml
View File

@ -97,7 +97,7 @@ let parse_and_check input eos_is_error =
let buf = Buffer.create 32 in let buf = Buffer.create 32 in
let preprocess input = let preprocess input =
match input with match input with
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| UTop.Value (Parsetree.Ptop_def pstr) -> | UTop.Value (Parsetree.Ptop_def pstr) ->
begin try begin try
let pstr = Pparse.apply_rewriters ~tool_name:"ocaml" let pstr = Pparse.apply_rewriters ~tool_name:"ocaml"
@ -269,13 +269,13 @@ let rec map_items unwrap wrap items =
| Outcometree.Osig_class (_, name, _, _, rs) | Outcometree.Osig_class (_, name, _, _, rs)
| Outcometree.Osig_class_type (_, name, _, _, rs) | Outcometree.Osig_class_type (_, name, _, _, rs)
| Outcometree.Osig_module (name, _, rs) | Outcometree.Osig_module (name, _, rs)
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Outcometree.Osig_type ({ Outcometree.otype_name = name }, rs) -> | Outcometree.Osig_type ({ Outcometree.otype_name = name }, rs) ->
#else #else
| Outcometree.Osig_type ((name, _, _, _, _), rs) -> | Outcometree.Osig_type ((name, _, _, _, _), rs) ->
#endif #endif
(name, rs) (name, rs)
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _) | Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _)
#else #else
| Outcometree.Osig_exception (name, _) | Outcometree.Osig_exception (name, _)
@ -316,7 +316,7 @@ let rec map_items unwrap wrap items =
wrap (Outcometree.Osig_type (oty, Outcometree.Orec_first)) extra :: items' wrap (Outcometree.Osig_type (oty, Outcometree.Orec_first)) extra :: items'
else else
items items
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
| Outcometree.Osig_typext _ | Outcometree.Osig_typext _
#else #else
| Outcometree.Osig_exception _ | Outcometree.Osig_exception _
@ -379,7 +379,7 @@ let longident_async_thread_safe_block_on_async_exn =
Longident.parse "Async.Std.Thread_safe.block_on_async_exn" Longident.parse "Async.Std.Thread_safe.block_on_async_exn"
let longident_unit = Longident.Lident "()" let longident_unit = Longident.Lident "()"
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
(* Wrap <expr> into: fun () -> <expr> *) (* Wrap <expr> into: fun () -> <expr> *)
let wrap_unit loc e = let wrap_unit loc e =
let i = with_loc loc longident_unit in let i = with_loc loc longident_unit in
@ -398,7 +398,7 @@ let () =
Hashtbl.add rewrite_rules (Longident.Ldot (Longident.Lident "Lwt", "t")) { Hashtbl.add rewrite_rules (Longident.Ldot (Longident.Lident "Lwt", "t")) {
required_values = [longident_lwt_main_run]; required_values = [longident_lwt_main_run];
rewrite = (fun loc e -> rewrite = (fun loc e ->
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
{ Parsetree.pexp_desc = { Parsetree.pexp_desc =
Parsetree.Pexp_apply Parsetree.Pexp_apply
({ Parsetree.pexp_desc = Parsetree.Pexp_ident (with_loc loc longident_lwt_main_run); ({ Parsetree.pexp_desc = Parsetree.Pexp_ident (with_loc loc longident_lwt_main_run);
@ -420,7 +420,7 @@ let () =
let rule = { let rule = {
required_values = [longident_async_thread_safe_block_on_async_exn]; required_values = [longident_async_thread_safe_block_on_async_exn];
rewrite = (fun loc e -> rewrite = (fun loc e ->
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
{ Parsetree.pexp_desc = { Parsetree.pexp_desc =
Parsetree.Pexp_apply Parsetree.Pexp_apply
({ Parsetree.pexp_desc = Parsetree.Pexp_ident ({ Parsetree.pexp_desc = Parsetree.Pexp_ident
@ -494,7 +494,7 @@ let is_persistent_in_env longident =
with Not_found -> with Not_found ->
false false
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
let rewrite_str_item pstr_item tstr_item = let rewrite_str_item pstr_item tstr_item =
match pstr_item, tstr_item.Typedtree.str_desc with match pstr_item, tstr_item.Typedtree.str_desc with
| ({ Parsetree.pstr_desc = Parsetree.Pstr_eval e; | ({ Parsetree.pstr_desc = Parsetree.Pstr_eval e;
@ -688,7 +688,7 @@ let read_input_classic prompt buffer len =
else else
Lwt_io.read_char_opt Lwt_io.stdin >>= function Lwt_io.read_char_opt Lwt_io.stdin >>= function
| Some c -> | Some c ->
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
Bytes.set buffer i c; Bytes.set buffer i c;
#else #else
buffer.[i] <- c; buffer.[i] <- c;
@ -818,7 +818,7 @@ module Emacs(M : sig end) = struct
(* Rewrite toplevel expressions. *) (* Rewrite toplevel expressions. *)
let phrase = rewrite phrase in let phrase = rewrite phrase in
try try
#if OCAML_VERSION > 040001 #if OCAML_VERSION > (4, 00, 1)
Env.reset_cache_toplevel (); Env.reset_cache_toplevel ();
#endif #endif
ignore (Toploop.execute_phrase true Format.std_formatter phrase); ignore (Toploop.execute_phrase true Format.std_formatter phrase);
@ -1032,7 +1032,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
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
let (path, mod_typ) = Env.lookup_module id env in let (path, mod_typ) = Env.lookup_module id env in
#else #else
let path = Env.lookup_module id env ~load:true in let path = Env.lookup_module id env ~load:true in
@ -1049,7 +1049,7 @@ let typeof sid =
try try
let cstr_desc = Env.lookup_constructor id env in let cstr_desc = Env.lookup_constructor id env in
match cstr_desc.Types.cstr_tag with match cstr_desc.Types.cstr_tag with
#if OCAML_VERSION < 040200 #if OCAML_VERSION < (4, 02, 0)
| Types.Cstr_exception (_path, loc) -> | Types.Cstr_exception (_path, loc) ->
let path, exn_decl = Typedecl.transl_exn_rebind env loc id in let path, exn_decl = Typedecl.transl_exn_rebind env loc id in
let id = Ident.create (Path.name path) in let id = Ident.create (Path.name path) in
@ -1145,11 +1145,11 @@ let args = Arg.align [
"-noassert", Arg.Set Clflags.noassert, " Do not compile assertion checks"; "-noassert", Arg.Set Clflags.noassert, " Do not compile assertion checks";
"-nolabels", Arg.Set Clflags.classic, " Ignore non-optional labels in types"; "-nolabels", Arg.Set Clflags.classic, " Ignore non-optional labels in types";
"-nostdlib", Arg.Set Clflags.no_std_include, " Do not add default directory to the list of include directories"; "-nostdlib", Arg.Set Clflags.no_std_include, " Do not add default directory to the list of include directories";
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
"-ppx", Arg.String (fun ppx -> Clflags.all_ppx := ppx :: !Clflags.all_ppx), "<command> Pipe abstract syntax trees through preprocessor <command>"; "-ppx", Arg.String (fun ppx -> Clflags.all_ppx := ppx :: !Clflags.all_ppx), "<command> Pipe abstract syntax trees through preprocessor <command>";
#endif #endif
"-principal", Arg.Set Clflags.principal, " Check principality of type inference"; "-principal", Arg.Set Clflags.principal, " Check principality of type inference";
#if OCAML_VERSION >= 040200 #if OCAML_VERSION >= (4, 02, 0)
"-safe-string", Arg.Clear Clflags.unsafe_string, " Make strings immutable"; "-safe-string", Arg.Clear Clflags.unsafe_string, " Make strings immutable";
#endif #endif
"-short-paths", Arg.Clear Clflags.real_paths, " Shorten paths in types (the default)"; "-short-paths", Arg.Clear Clflags.real_paths, " Shorten paths in types (the default)";