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 -*-
# Use compiler interfaces
<src/**/*.ml{,i}>: package(compiler-libs)
# Use camlp5
<src/**/*.ml{,i}>: cppo_V_OCAML, package(compiler-libs)
<src/camlp5/**/*.ml{,i}>: use_camlp5
# OASIS_START

9
myocamlbuild.ml
View File

@ -34,15 +34,6 @@ let () =
let env = BaseEnvLight.load () 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
flag ["ocaml"; "compile"; "use_camlp5"] & S paths;
flag ["ocaml"; "ocamldep"; "use_camlp5"] & S paths;

2
opam
View File

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

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

@ -13,7 +13,7 @@ open Camlp4.PreCast
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"
#else
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) ->
Error ([mkloc loc],
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) ->
Error ([mkloc loc],
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
the typing and compilation of [items] without evaluating them. *)
let unit = with_loc loc (Longident.Lident "()") in
#if OCAML_VERSION < 040200
#if OCAML_VERSION < (4, 02, 0)
let structure = {
pmod_loc = loc;
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
(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_separator =
match Sys.os_type with
@ -394,7 +394,7 @@ let visible_modules () =
acc)
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 constructor_name { cd_id = id } = Ident.name id
#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
| Type_abstract ->
acc
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Type_open ->
acc
#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
| Type_abstract ->
acc
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Type_open ->
acc
#endif
@ -433,7 +433,7 @@ let rec names_of_module_type = function
List.fold_left
(fun acc decl -> match decl with
| Sig_value (id, _)
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Sig_typext (id, _, _)
#else
| Sig_exception (id, _)
@ -448,7 +448,7 @@ let rec names_of_module_type = function
String_set.empty decls
| Mty_ident path -> begin
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_manifest module_type -> names_of_module_type module_type
#else
@ -457,7 +457,7 @@ let rec names_of_module_type = function
#endif
| None -> String_set.empty
end
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Mty_alias path -> begin
match lookup_env Env.find_module path !Toploop.toplevel_env with
| None -> String_set.empty
@ -472,7 +472,7 @@ let rec fields_of_module_type = function
List.fold_left
(fun acc decl -> match decl with
| Sig_value (id, _)
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Sig_typext (id, _, _)
#else
| Sig_exception (id, _)
@ -487,7 +487,7 @@ let rec fields_of_module_type = function
String_set.empty decls
| Mty_ident path -> begin
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_manifest module_type -> fields_of_module_type module_type
#else
@ -496,7 +496,7 @@ let rec fields_of_module_type = function
#endif
| None -> String_set.empty
end
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Mty_alias path -> begin
match lookup_env Env.find_module path !Toploop.toplevel_env with
| None -> String_set.empty
@ -506,7 +506,7 @@ let rec fields_of_module_type = function
| _ ->
String_set.empty
#if OCAML_VERSION < 040200
#if OCAML_VERSION < (4, 02, 0)
let lookup_module = Env.lookup_module
let find_module = Env.find_module
#else
@ -551,7 +551,7 @@ 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 >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Env.Env_extension(summary, id, _) ->
#else
| Env.Env_exception(summary, id, _) ->
@ -565,7 +565,7 @@ let list_global_names () =
loop (add (Ident.name id) acc) summary
| Env.Env_cltype(summary, id, _) ->
loop (add (Ident.name id) acc) summary
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Env.Env_functor_arg(summary, id) ->
loop (add (Ident.name id) acc) summary
#endif
@ -616,7 +616,7 @@ 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 >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Env.Env_extension(summary, id, _) ->
#else
| Env.Env_exception(summary, id, _) ->
@ -624,7 +624,7 @@ let list_global_fields () =
loop (add (Ident.name id) acc) summary
| Env.Env_module(summary, id, _) ->
loop (add (Ident.name id) acc) summary
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Env.Env_functor_arg(summary, id) ->
loop (add (Ident.name id) acc) summary
#endif
@ -886,7 +886,7 @@ let complete ~syntax ~phrase_terminator ~input =
(loc.idx2 - Zed_utf8.length name,
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. *)
| [(Symbol "#", _); (Lident ("ppx"), _); (String false, loc)] ->
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 preprocess input =
match input with
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| UTop.Value (Parsetree.Ptop_def pstr) ->
begin try
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_type (_, 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) ->
#else
| Outcometree.Osig_type ((name, _, _, _, _), rs) ->
#endif
(name, rs)
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _)
#else
| 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'
else
items
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
| Outcometree.Osig_typext _
#else
| 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"
let longident_unit = Longident.Lident "()"
#if OCAML_VERSION < 040200
#if OCAML_VERSION < (4, 02, 0)
(* Wrap <expr> into: fun () -> <expr> *)
let wrap_unit loc e =
let i = with_loc loc longident_unit in
@ -398,7 +398,7 @@ let () =
Hashtbl.add rewrite_rules (Longident.Ldot (Longident.Lident "Lwt", "t")) {
required_values = [longident_lwt_main_run];
rewrite = (fun loc e ->
#if OCAML_VERSION < 040200
#if OCAML_VERSION < (4, 02, 0)
{ Parsetree.pexp_desc =
Parsetree.Pexp_apply
({ Parsetree.pexp_desc = Parsetree.Pexp_ident (with_loc loc longident_lwt_main_run);
@ -420,7 +420,7 @@ let () =
let rule = {
required_values = [longident_async_thread_safe_block_on_async_exn];
rewrite = (fun loc e ->
#if OCAML_VERSION < 040200
#if OCAML_VERSION < (4, 02, 0)
{ Parsetree.pexp_desc =
Parsetree.Pexp_apply
({ Parsetree.pexp_desc = Parsetree.Pexp_ident
@ -494,7 +494,7 @@ let is_persistent_in_env longident =
with Not_found ->
false
#if OCAML_VERSION < 040200
#if OCAML_VERSION < (4, 02, 0)
let rewrite_str_item pstr_item tstr_item =
match pstr_item, tstr_item.Typedtree.str_desc with
| ({ Parsetree.pstr_desc = Parsetree.Pstr_eval e;
@ -688,7 +688,7 @@ let read_input_classic prompt buffer len =
else
Lwt_io.read_char_opt Lwt_io.stdin >>= function
| Some c ->
#if OCAML_VERSION >= 040200
#if OCAML_VERSION >= (4, 02, 0)
Bytes.set buffer i c;
#else
buffer.[i] <- c;
@ -818,7 +818,7 @@ module Emacs(M : sig end) = struct
(* Rewrite toplevel expressions. *)
let phrase = rewrite phrase in
try
#if OCAML_VERSION > 040001
#if OCAML_VERSION > (4, 00, 1)
Env.reset_cache_toplevel ();
#endif
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)
with Not_found ->
try
#if OCAML_VERSION < 040200
#if OCAML_VERSION < (4, 02, 0)
let (path, mod_typ) = Env.lookup_module id env in
#else
let path = Env.lookup_module id env ~load:true in
@ -1049,7 +1049,7 @@ let typeof sid =
try
let cstr_desc = Env.lookup_constructor id env in
match cstr_desc.Types.cstr_tag with
#if OCAML_VERSION < 040200
#if OCAML_VERSION < (4, 02, 0)
| Types.Cstr_exception (_path, loc) ->
let path, exn_decl = Typedecl.transl_exn_rebind env loc id 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";
"-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";
#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>";
#endif
"-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";
#endif
"-short-paths", Arg.Clear Clflags.real_paths, " Shorten paths in types (the default)";