diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/cErrors.ml | 4 | ||||
| -rw-r--r-- | lib/cWarnings.ml | 2 | ||||
| -rw-r--r-- | lib/feedback.ml | 5 | ||||
| -rw-r--r-- | lib/feedback.mli | 3 | ||||
| -rw-r--r-- | lib/flags.ml | 28 | ||||
| -rw-r--r-- | lib/flags.mli | 2 |
6 files changed, 31 insertions, 13 deletions
diff --git a/lib/cErrors.ml b/lib/cErrors.ml index 1459141d1e..c69c7e4001 100644 --- a/lib/cErrors.ml +++ b/lib/cErrors.ml @@ -93,7 +93,9 @@ let print_backtrace e = match Backtrace.get_backtrace e with let print_anomaly askreport e = if askreport then - hov 0 (str "Anomaly: " ++ raw_anomaly e ++ spc () ++ str "Please report.") + hov 0 (str "Anomaly: " ++ raw_anomaly e ++ spc () ++ + strbrk "Please report at " ++ str Coq_config.wwwbugtracker ++ + str ".") else hov 0 (raw_anomaly e) diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml index 78fa84f333..720f54606c 100644 --- a/lib/cWarnings.ml +++ b/lib/cWarnings.ml @@ -21,7 +21,7 @@ let warnings : (string, t) Hashtbl.t = Hashtbl.create 97 let categories : (string, string list) Hashtbl.t = Hashtbl.create 97 let current_loc = ref Loc.ghost -let flags = ref "" +let flags = ref "default" let set_current_loc = (:=) current_loc diff --git a/lib/feedback.ml b/lib/feedback.ml index 4bda936f2b..dd1ca2af36 100644 --- a/lib/feedback.ml +++ b/lib/feedback.ml @@ -128,6 +128,11 @@ let msg_debug ?loc x = !logger ?loc Debug x let feeders = ref [] let add_feeder f = feeders := f :: !feeders +let debug_feeder = function + | { contents = Message (Debug, loc, pp) } -> + msg_debug ?loc (Pp.str (Richpp.raw_print pp)) + | _ -> () + let feedback_id = ref (Edit 0) let feedback_route = ref default_route diff --git a/lib/feedback.mli b/lib/feedback.mli index d19517bb94..48b1c19a67 100644 --- a/lib/feedback.mli +++ b/lib/feedback.mli @@ -86,6 +86,9 @@ val emacs_logger : logger (** [add_feeder] feeders observe the feedback *) val add_feeder : (feedback -> unit) -> unit +(** Prints feedback messages of kind Message(Debug,_) using msg_debug *) +val debug_feeder : feedback -> unit + (** [feedback ?id ?route fb] produces feedback fb, with [route] and [id] set appropiatedly, if absent, it will use the defaults set by [set_id_for_feedback] *) diff --git a/lib/flags.ml b/lib/flags.ml index 13525165ab..65873e5214 100644 --- a/lib/flags.ml +++ b/lib/flags.ml @@ -112,17 +112,22 @@ type compat_version = V8_2 | V8_3 | V8_4 | V8_5 | Current let compat_version = ref Current -let version_strictly_greater v = match !compat_version, v with -| V8_2, (V8_2 | V8_3 | V8_4 | V8_5 | Current) -> false -| V8_3, (V8_3 | V8_4 | V8_5 | Current) -> false -| V8_4, (V8_4 | V8_5 | Current) -> false -| V8_5, (V8_5 | Current) -> false -| Current, Current -> false -| V8_3, V8_2 -> true -| V8_4, (V8_2 | V8_3) -> true -| V8_5, (V8_2 | V8_3 | V8_4) -> true -| Current, (V8_2 | V8_3 | V8_4 | V8_5) -> true - +let version_compare v1 v2 = match v1, v2 with +| V8_2, V8_2 -> 0 +| V8_2, (V8_3 | V8_4 | V8_5 | Current) -> -1 +| V8_3, V8_2 -> 1 +| V8_3, V8_3 -> 0 +| V8_3, (V8_4 | V8_5 | Current) -> -1 +| V8_4, (V8_2 | V8_3) -> 1 +| V8_4, V8_4 -> 0 +| V8_4, (V8_5 | Current) -> -1 +| V8_5, (V8_2 | V8_3 | V8_4) -> 1 +| V8_5, V8_5 -> 0 +| V8_5, Current -> -1 +| Current, Current -> 0 +| Current, (V8_2 | V8_3 | V8_4 | V8_5) -> 1 + +let version_strictly_greater v = version_compare !compat_version v > 0 let version_less_or_equal v = not (version_strictly_greater v) let pr_version = function @@ -226,6 +231,7 @@ let print_mod_uid = ref false let tactic_context_compat = ref false let profile_ltac = ref false +let profile_ltac_cutoff = ref 2.0 let dump_bytecode = ref false let set_dump_bytecode = (:=) dump_bytecode diff --git a/lib/flags.mli b/lib/flags.mli index 8fe64d24fa..9dc0c9c048 100644 --- a/lib/flags.mli +++ b/lib/flags.mli @@ -64,6 +64,7 @@ val univ_print : bool ref type compat_version = V8_2 | V8_3 | V8_4 | V8_5 | Current val compat_version : compat_version ref +val version_compare : compat_version -> compat_version -> int val version_strictly_greater : compat_version -> bool val version_less_or_equal : compat_version -> bool val pr_version : compat_version -> string @@ -149,6 +150,7 @@ val tactic_context_compat : bool ref context vs. appcontext) is set. *) val profile_ltac : bool ref +val profile_ltac_cutoff : float ref (** Dump the bytecode after compilation (for debugging purposes) *) val dump_bytecode : bool ref |