diff options
| author | Enrico Tassi | 2020-11-17 18:52:30 +0100 |
|---|---|---|
| committer | Enrico Tassi | 2021-01-27 09:45:48 +0100 |
| commit | 1fd4c22d493715f154f6b79dc7f6e4efd44ff185 (patch) | |
| tree | 6b0383f0fd01ce7218fe4782aac6bb7f3c79c64c | |
| parent | 0c185094d40d10dc43f1432ef708a329fae25751 (diff) | |
[ltac] break dependency on the STM
| -rw-r--r-- | lib/stateid.ml | 3 | ||||
| -rw-r--r-- | lib/stateid.mli | 7 | ||||
| -rw-r--r-- | plugins/ltac/profile_ltac.ml | 6 | ||||
| -rw-r--r-- | stm/stm.ml | 3 |
4 files changed, 14 insertions, 5 deletions
diff --git a/lib/stateid.ml b/lib/stateid.ml index a1328f156c..2a41cb7866 100644 --- a/lib/stateid.ml +++ b/lib/stateid.ml @@ -45,3 +45,6 @@ type ('a,'b) request = { name : string } +let is_valid_ref = ref (fun ~doc:_ (_ : t) -> true) +let is_valid ~doc id = !is_valid_ref ~doc id +let set_is_valid f = is_valid_ref := f diff --git a/lib/stateid.mli b/lib/stateid.mli index 9b2de9c894..4563710f84 100644 --- a/lib/stateid.mli +++ b/lib/stateid.mli @@ -42,3 +42,10 @@ type ('a,'b) request = { name : string } +(* Asks the document manager is the given state is valid (or belongs to an + old version of the document) *) +val is_valid : doc:int -> t -> bool + +(* By default [is_valid] always answers true, but a document manager supporting + undo operations like the STM can override this. *) +val set_is_valid : (doc:int -> t -> bool) -> unit diff --git a/plugins/ltac/profile_ltac.ml b/plugins/ltac/profile_ltac.ml index aa2449d962..937d579012 100644 --- a/plugins/ltac/profile_ltac.ml +++ b/plugins/ltac/profile_ltac.ml @@ -436,11 +436,7 @@ let finish_timing ~prefix name = (* ******************** *) let print_results_filter ~cutoff ~filter = - (* The STM doesn't provide yet a proper document query and traversal - API, thus we need to re-check if some states are current anymore - (due to backtracking) using the `state_of_id` API. *) - let valid (did,id) _ = Stm.(state_of_id ~doc:(get_doc did) id) <> `Expired in - data := SM.filter valid !data; + data := SM.filter (fun (doc,id) _ -> Stateid.is_valid ~doc id) !data; let results = SM.fold (fun _ -> merge_roots ~disjoint:true) !data (empty_treenode root) in let results = merge_roots results Local.(CList.last !stack) in diff --git a/stm/stm.ml b/stm/stm.ml index 0b00524bd5..27f2b6fc5c 100644 --- a/stm/stm.ml +++ b/stm/stm.ml @@ -801,6 +801,9 @@ let state_of_id ~doc id = | EmptyState | ParsingState _ -> `Valid None with VCS.Expired -> `Expired +let () = + Stateid.set_is_valid (fun ~doc id -> state_of_id ~doc id <> `Expired) + (****** A cache: fills in the nodes of the VCS document with their value ******) module State : sig |