aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMaxime Dénès2017-04-05 18:18:56 +0200
committerMaxime Dénès2017-04-06 16:07:17 +0200
commit48c44b55b76e75aa2af9f82753c6ffe7531790c8 (patch)
tree8fe915bd35b77ab231c90e67adf67d6a029155e4
parent33f40197e6b7bef02c8df2dc0a0066f8144b66d6 (diff)
Fix a few programming pearls related to Time, Fail and Redirect.
This fixes a few clear bugs, but the STM code handling Time, Fail and Redirect before par: still needs to be rewritten. It does not implement the same semantics as the vernac interpreter for Fail Fail [c] and ignores Redirect. This commit was already reviewed with Enrico and tested on Travis.
-rw-r--r--stm/stm.ml11
-rw-r--r--toplevel/vernacentries.ml2
2 files changed, 7 insertions, 6 deletions
diff --git a/stm/stm.ml b/stm/stm.ml
index 56243b76f9..3efad70fb2 100644
--- a/stm/stm.ml
+++ b/stm/stm.ml
@@ -1746,12 +1746,13 @@ end = struct (* {{{ *)
{ indentation; verbose; loc; expr = e; strlen }
=
let e, time, fail =
- let rec find time fail = function
- | VernacTime (_,e) | VernacRedirect (_,(_,e)) -> find true fail e
- | VernacFail e -> find time true e
- | _ -> e, time, fail in find false false e in
+ let rec find ~time ~fail = function
+ | VernacTime (_,e) -> find ~time:true ~fail e
+ | VernacRedirect (_,(_,e)) -> find ~time ~fail e
+ | VernacFail e -> find ~time ~fail:true e
+ | e -> e, time, fail in find ~time:false ~fail:false e in
Hooks.call Hooks.with_fail fail (fun () ->
- (if time then System.with_time false else (fun x -> x)) (fun () ->
+ (if time then System.with_time !Flags.time else (fun x -> x)) (fun () ->
ignore(TaskQueue.with_n_workers nworkers (fun queue ->
Proof_global.with_current_proof (fun _ p ->
let goals, _, _, _, _ = Proof.proof p in
diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml
index 6736d83293..3df6d7a580 100644
--- a/toplevel/vernacentries.ml
+++ b/toplevel/vernacentries.ml
@@ -2218,7 +2218,7 @@ let interp ?(verbosely=true) ?proof (loc,c) =
current_timeout := Some n;
aux ?locality ?polymorphism isprogcmd v
| VernacRedirect (s, (_,v)) ->
- Feedback.with_output_to_file s (aux false) v
+ Feedback.with_output_to_file s (aux ?locality ?polymorphism isprogcmd) v
| VernacTime (_,v) ->
System.with_time !Flags.time
(aux ?locality ?polymorphism isprogcmd) v;