diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/feedback.ml | 22 | ||||
| -rw-r--r-- | lib/feedback.mli | 16 | ||||
| -rw-r--r-- | lib/flags.ml | 5 | ||||
| -rw-r--r-- | lib/flags.mli | 9 | ||||
| -rw-r--r-- | lib/system.ml | 8 | ||||
| -rw-r--r-- | lib/system.mli | 6 |
6 files changed, 39 insertions, 27 deletions
diff --git a/lib/feedback.ml b/lib/feedback.ml index 54d16a9be3..7a126363cc 100644 --- a/lib/feedback.ml +++ b/lib/feedback.ml @@ -15,6 +15,7 @@ type level = | Warning | Error +type doc_id = int type route_id = int type feedback_content = @@ -35,7 +36,8 @@ type feedback_content = | Message of level * Loc.t option * Pp.t type feedback = { - id : Stateid.t; + doc_id : doc_id; (* The document being concerned *) + span_id : Stateid.t; route : route_id; contents : feedback_content; } @@ -52,23 +54,27 @@ let add_feeder = let del_feeder fid = Hashtbl.remove feeders fid let default_route = 0 -let feedback_id = ref Stateid.dummy +let span_id = ref Stateid.dummy +let doc_id = ref 0 let feedback_route = ref default_route -let set_id_for_feedback ?(route=default_route) i = - feedback_id := i; feedback_route := route +let set_id_for_feedback ?(route=default_route) d i = + doc_id := d; + span_id := i; + feedback_route := route -let feedback ?id ?route what = +let feedback ?did ?id ?route what = let m = { contents = what; - route = Option.default !feedback_route route; - id = Option.default !feedback_id id; + route = Option.default !feedback_route route; + doc_id = Option.default !doc_id did; + span_id = Option.default !span_id id; } in Hashtbl.iter (fun _ f -> f m) feeders (* Logging messages *) let feedback_logger ?loc lvl msg = - feedback ~route:!feedback_route ~id:!feedback_id (Message (lvl, loc, msg)) + feedback ~route:!feedback_route ~id:!span_id (Message (lvl, loc, msg)) let msg_info ?loc x = feedback_logger ?loc Info x let msg_notice ?loc x = feedback_logger ?loc Notice x diff --git a/lib/feedback.mli b/lib/feedback.mli index 45a02d384a..73b84614f1 100644 --- a/lib/feedback.mli +++ b/lib/feedback.mli @@ -17,6 +17,9 @@ type level = | Error +(** Document unique identifier for serialization *) +type doc_id = int + (** Coq "semantic" infos obtained during execution *) type route_id = int @@ -43,7 +46,8 @@ type feedback_content = | Message of level * Loc.t option * Pp.t type feedback = { - id : Stateid.t; (* The document part concerned *) + doc_id : doc_id; (* The document being concerned *) + span_id : Stateid.t; (* The document part concerned *) route : route_id; (* Extra routing info *) contents : feedback_content; (* The payload *) } @@ -60,13 +64,13 @@ val add_feeder : (feedback -> unit) -> int (** [del_feeder fid] removes the feeder with id [fid] *) val del_feeder : int -> 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] *) -val feedback : ?id:Stateid.t -> ?route:route_id -> feedback_content -> unit +(** [feedback ?did ?sid ?route fb] produces feedback [fb], with + [route] and [did, sid] set appropiatedly, if absent, it will use + the defaults set by [set_id_for_feedback] *) +val feedback : ?did:doc_id -> ?id:Stateid.t -> ?route:route_id -> feedback_content -> unit (** [set_id_for_feedback route id] Set the defaults for feedback *) -val set_id_for_feedback : ?route:route_id -> Stateid.t -> unit +val set_id_for_feedback : ?route:route_id -> doc_id -> Stateid.t -> unit (** {6 output functions} diff --git a/lib/flags.ml b/lib/flags.ml index d4be81c61a..a178eb7552 100644 --- a/lib/flags.ml +++ b/lib/flags.ml @@ -43,11 +43,8 @@ let with_extra_values o l f x = let boot = ref false let load_init = ref true -let batch_mode = ref false -type compilation_mode = BuildVo | BuildVio | Vio2Vo -let compilation_mode = ref BuildVo -let compilation_output_name = ref None +let record_aux_file = ref false let test_mode = ref false diff --git a/lib/flags.mli b/lib/flags.mli index 3024c60396..8ec2a80730 100644 --- a/lib/flags.mli +++ b/lib/flags.mli @@ -13,12 +13,9 @@ val boot : bool ref val load_init : bool ref -(* Will affect STM caching *) -val batch_mode : bool ref - -type compilation_mode = BuildVo | BuildVio | Vio2Vo -val compilation_mode : compilation_mode ref -val compilation_output_name : string option ref +(** Set by coqtop to tell the kernel to output to the aux file; will + be eventually removed by cleanups such as PR#1103 *) +val record_aux_file : bool ref (* Flag set when the test-suite is called. Its only effect to display verbose information for `Fail` *) diff --git a/lib/system.ml b/lib/system.ml index 0b64b237da..4b5066ef41 100644 --- a/lib/system.ml +++ b/lib/system.ml @@ -54,6 +54,8 @@ let make_dir_table dir = let filter_dotfiles s f = if f.[0] = '.' then s else StrSet.add f s in Array.fold_left filter_dotfiles StrSet.empty (Sys.readdir dir) +let trust_file_cache = ref true + let exists_in_dir_respecting_case dir bf = let cache_dir dir = let contents = make_dir_table dir in @@ -62,10 +64,10 @@ let exists_in_dir_respecting_case dir bf = let contents, fresh = try (* in batch mode, assume the directory content is still fresh *) - StrMap.find dir !dirmap, !Flags.batch_mode + StrMap.find dir !dirmap, !trust_file_cache with Not_found -> (* in batch mode, we are not yet sure the directory exists *) - if !Flags.batch_mode && not (exists_dir dir) then StrSet.empty, true + if !trust_file_cache && not (exists_dir dir) then StrSet.empty, true else cache_dir dir, true in StrSet.mem bf contents || not fresh && @@ -80,7 +82,7 @@ let file_exists_respecting_case path f = let df = Filename.dirname f in (String.equal df "." || aux df) && exists_in_dir_respecting_case (Filename.concat path df) bf - in (!Flags.batch_mode || Sys.file_exists (Filename.concat path f)) && aux f + in (!trust_file_cache || Sys.file_exists (Filename.concat path f)) && aux f let rec search paths test = match paths with diff --git a/lib/system.mli b/lib/system.mli index 7281de97c9..aa964abebe 100644 --- a/lib/system.mli +++ b/lib/system.mli @@ -54,6 +54,12 @@ val where_in_path_rex : val find_file_in_path : ?warn:bool -> CUnix.load_path -> string -> CUnix.physical_path * string +val trust_file_cache : bool ref +(** [trust_file_cache] indicates whether we trust the underlying + mapped file-system not to change along the execution of Coq. This + assumption greatly speds up file search, but it is often + inconvenient in interactive mode *) + val file_exists_respecting_case : string -> string -> bool (** {6 I/O functions } *) |