Commit 1fddf96b authored by Sylvain Dailler's avatar Sylvain Dailler

Clean do clean transformations that are not successful

parent 60f3cf74
...@@ -800,21 +800,27 @@ let schedule_tr_with_same_arguments ...@@ -800,21 +800,27 @@ let schedule_tr_with_same_arguments
let name = get_transf_name s tr in let name = get_transf_name s tr in
schedule_transformation c pn name args ~callback ~notification schedule_transformation c pn name args ~callback ~notification
let clean_session c ~remove = let clean_session c ~remove =
let s = c.controller_session in let s = c.controller_session in
Session_itp.session_iter_proof_attempt (* This function is applied on leafs first for the case of removes *)
(fun id pa -> Session_itp.fold_all_session s
if pn_proved c pa.parent then (fun () any ->
match pa.Session_itp.proof_state with (match any with
| None -> () | APa pa ->
| Some pr -> let pa = Session_itp.get_proof_attempt_node c.controller_session pa in
if pn_proved c pa.parent then
(match pa.Session_itp.proof_state with
| None -> ()
| Some pr ->
if pa.Session_itp.proof_obsolete || if pa.Session_itp.proof_obsolete ||
Call_provers.(pr.pr_answer <> Valid) Call_provers.(pr.pr_answer <> Valid)
then then
remove_subtree c ~removed:remove ~notification:(fun _ -> ()) (APa id)) remove_subtree c ~removed:remove ~notification:(fun _ -> ()) any)
s | ATn tn ->
let pn = get_trans_parent c.controller_session tn in
if pn_proved c pn && not (tn_proved c tn) then
remove_subtree c ~removed:remove ~notification:(fun _ -> ()) (ATn tn)
| _ -> ())) ()
(* This function folds on any subelements of given node and tries to mark all (* This function folds on any subelements of given node and tries to mark all
proof attempts it encounters *) proof attempts it encounters *)
......
...@@ -358,6 +358,10 @@ let fold_all_any s f acc any = ...@@ -358,6 +358,10 @@ let fold_all_any s f acc any =
| ATn tn -> fold_all_any_of_transn s f acc tn | ATn tn -> fold_all_any_of_transn s f acc tn
| APa _ -> f acc any | APa _ -> f acc any
let fold_all_session s f acc =
let files = get_files s in
Hstr.fold (fun _key file acc -> fold_all_any s f acc (AFile file)) files acc
exception RemoveError exception RemoveError
(* Cannot remove a proof_attempt that was scheduled but did not finish yet. (* Cannot remove a proof_attempt that was scheduled but did not finish yet.
......
...@@ -204,3 +204,6 @@ val remove_subtree: session -> any -> notification:(any -> unit) -> unit ...@@ -204,3 +204,6 @@ val remove_subtree: session -> any -> notification:(any -> unit) -> unit
val fold_all_any: session -> ('a -> any -> 'a) -> 'a -> any -> 'a val fold_all_any: session -> ('a -> any -> 'a) -> 'a -> any -> 'a
(** [fold_all_any s f acc any] folds on all the subnodes of any *) (** [fold_all_any s f acc any] folds on all the subnodes of any *)
val fold_all_session: session -> ('a -> any -> 'a) -> 'a -> 'a
(** [fold_all_session s f acc] folds on the whole session *)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment