aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorGravatar Maxime Dénès <mail@maximedenes.fr>2015-01-13 15:40:58 +0100
committerGravatar Maxime Dénès <mail@maximedenes.fr>2015-01-13 15:40:58 +0100
commit4cc324272b1f08d150417bf5333a51a39ce36336 (patch)
treeebf54592a1acb38cdf077da875581a3c655517ec
parent2ae01e839df66f13ff1d3bc974cea50a33126c59 (diff)
Made -print-mod-uid more silent and robust.
This is a follow-up on Pierre's 5d80a385.
-rw-r--r--library/library.ml8
-rw-r--r--library/library.mli3
-rw-r--r--tools/coq_makefile.ml4
-rw-r--r--toplevel/coqtop.ml6
4 files changed, 16 insertions, 5 deletions
diff --git a/library/library.ml b/library/library.ml
index 78912dbbf..f1bc49187 100644
--- a/library/library.ml
+++ b/library/library.ml
@@ -451,8 +451,6 @@ let rec_intern_by_filename_only id f =
let m = try intern_from_file f with Sys_error s -> error s in
(* Only the base name is expected to match *)
check_library_short_name f m.library_name id;
- if !Flags.print_mod_uid then
- print_endline (Nativecode.mod_uid_of_dirpath m.library_name);
(* We check no other file containing same library is loaded *)
if library_is_loaded m.library_name then
begin
@@ -466,6 +464,12 @@ let rec_intern_by_filename_only id f =
let needed = List.map (fun dir -> dir, DPMap.find dir contents) needed in
m.library_name, needed
+let native_name_from_filename f =
+ let paths = Loadpath.get_paths () in
+ let ch = System.with_magic_number_check raw_intern_library f in
+ let (lmd : seg_lib), pos, digest_lmd = System.marshal_in_segment f ch in
+ Nativecode.mod_uid_of_dirpath lmd.md_name
+
let rec_intern_library_from_file idopt f =
(* A name is specified, we have to check it contains library id *)
let paths = Loadpath.get_paths () in
diff --git a/library/library.mli b/library/library.mli
index 0a3b7d10d..13d83a5c0 100644
--- a/library/library.mli
+++ b/library/library.mli
@@ -78,3 +78,6 @@ val try_locate_qualified_library : qualid located -> DirPath.t * string
(** {6 Statistics: display the memory use of a library. } *)
val mem : DirPath.t -> Pp.std_ppcmds
+
+(** {6 Native compiler. } *)
+val native_name_from_filename : string -> string
diff --git a/tools/coq_makefile.ml b/tools/coq_makefile.ml
index 65ba57ca8..b73fdba1e 100644
--- a/tools/coq_makefile.ml
+++ b/tools/coq_makefile.ml
@@ -506,8 +506,8 @@ let parameters () =
print "TIMED=\nTIMECMD=\nSTDTIME?=/usr/bin/time -f \"$* (user: %U mem: %M ko)\"\n";
print "TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD))\n\n";
print "vo_to_obj = $(addsuffix .o,$(foreach vo,$(1),\\\n";
- print " $(addprefix $(dir $(vo)),.coq-native/$(filter-out Warning: Error:,$(firstword \\\n";
- print " $(shell $(COQBIN)coqtop -batch -quiet -print-mod-uid $(vo:.vo=)))))))\n\n"
+ print " $(addprefix $(dir $(vo)),$(addprefix .coq-native/,$(filter-out Warning: Error:,$(firstword \\\n";
+ print " $(shell $(COQBIN)coqtop -batch -quiet -print-mod-uid $(vo))))))))\n\n"
let include_dirs (inc_ml,inc_i,inc_r) =
let parse_ml_includes l = List.map (fun (x,_) -> "-I \"" ^ x ^ "\"") l in
diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml
index 401c046ee..9f670c731 100644
--- a/toplevel/coqtop.ml
+++ b/toplevel/coqtop.ml
@@ -375,6 +375,10 @@ let schedule_vio_compilation () =
if !vio_files <> [] && not !vio_checking then
Vio_checking.schedule_vio_compilation !vio_files_j !vio_files
+let print_native_name s =
+ (* We ignore even critical errors because this mode has to be super silent *)
+ try print_endline (Library.native_name_from_filename s) with _ -> ()
+
let parse_args arglist =
let args = ref arglist in
let extras = ref [] in
@@ -457,7 +461,7 @@ let parse_args arglist =
|"-load-vernac-source"|"-l" -> add_load_vernacular false (next ())
|"-load-vernac-source-verbose"|"-lv" -> add_load_vernacular true (next ())
|"-outputstate" -> set_outputstate (next ())
- |"-print-mod-uid" -> Flags.print_mod_uid := true; add_require (next ())
+ |"-print-mod-uid" -> print_native_name (next ()); exit 0
|"-require" -> add_require (next ())
|"-top" -> set_toplevel_name (dirpath_of_string (next ()))
|"-with-geoproof" -> Coq_config.with_geoproof := get_bool opt (next ())