Commit dfb839fe authored by François Bobot's avatar François Bobot

[Session] add the hability to release and recover a task of a goal

parent fd499728
This diff is collapsed.
......@@ -44,8 +44,10 @@ type expl
*)
type task_option
(** Currently just an option on a task, but later perhaps
we should be able to release a task and rebuild it when needed *)
(** The task can be removed and later reconstructible *)
type 'a hide
(** For internal use *)
type ident_path =
......@@ -81,7 +83,7 @@ type 'a goal = private
mutable goal_checksum : Termcode.checksum; (** checksum of the task *)
mutable goal_shape : Termcode.shape; (** shape of the task *)
mutable goal_verified : bool;
goal_task: task_option;
mutable goal_task: task_option;
mutable goal_expanded : bool;
goal_external_proofs : 'a proof_attempt PHprover.t;
goal_transformations : 'a transf PHstr.t;
......@@ -135,6 +137,7 @@ and 'a theory = private
(** Not mutated after the creation *)
mutable theory_verified : bool;
mutable theory_expanded : bool;
mutable theory_task : Theory.theory hide;
}
and 'a file = private
......@@ -146,6 +149,7 @@ and 'a file = private
(** Not mutated after the creation *)
mutable file_verified : bool;
mutable file_expanded : bool;
mutable file_for_recovery : Theory.theory Mstr.t hide;
}
and 'a session = private
......@@ -264,7 +268,7 @@ val add_metas_to_goal :
exception NoTask
val goal_task : 'key goal -> Task.task
(** Return the task of a goal. Raise NoTask if the goal doesn't contain a task
(equivalent to 'key = notask) *)
(equivalent to 'key = notask if release_task is not used) *)
val goal_task_option : 'key goal -> Task.task option
(** Return the task of a goal. *)
......@@ -440,7 +444,22 @@ val add_file :
val remove_file : 'key file -> unit
(** Remove a file *)
(** {2 Free and recover task} *)
(** Tasks are stored inside the goals. For releasing memory you can remove
them. Later you can recompute them *)
val release_task: 'a goal -> unit
(** remove the task stored in this goal*)
val release_sub_tasks: 'a goal -> unit
(** apply the previous function on this goal and its its sub-goal *)
val recover_theory_tasks: 'a env_session -> 'a theory -> unit
(** Recover all the sub-goal (not only strict) of this theory *)
val goal_task_or_recover: 'a env_session -> 'a goal -> Task.task
(** same as goal_task but recover the task goal and all the one of this
theory if this goal task have been released *)
(** {2 Iterators} *)
......
......@@ -713,12 +713,19 @@ let check_goal_and_children eS eT todo g =
goal_iter_proof_attempt (check_external_proof eS eT todo) g
*)
let check_all eS eT ~callback =
let check_all ?(release=false) eS eT ~callback =
dprintf debug "[Sched] check all@.%a@." print_session eS.session;
let todo = Todo.create [] push_report callback in
Todo.start todo;
session_iter_proof_attempt (check_external_proof eS eT todo)
eS.session;
let check_top_goal g =
goal_iter_proof_attempt (check_external_proof eS eT todo) g;
if release then release_sub_tasks g
in
PHstr.iter (fun _ file ->
List.iter (fun t ->
List.iter check_top_goal t.theory_goals)
file.file_theories)
eS.session.session_files;
Todo.stop todo
......
......@@ -265,6 +265,7 @@ module Make(O: OBSERVER) : sig
*)
val check_all:
?release:bool -> (** Can all the goal be release at the end? def: false *)
O.key env_session -> t ->
callback:((Ident.ident * Whyconf.prover * int * report) list -> unit) ->
unit
......
......@@ -55,6 +55,7 @@ type shape = string
let print_shape = Format.pp_print_string
let string_of_shape x = x
let shape_of_string x = x
let equal_shape (x:string) y = x = y
let debug = Debug.register_info_flag "session_pairing"
~desc:"Print@ debugging@ messages@ about@ reconstruction@ of@ \
......
......@@ -22,6 +22,7 @@ type shape
val print_shape: Format.formatter -> shape -> unit
val string_of_shape: shape -> string
val shape_of_string: string -> shape
val equal_shape: shape -> shape -> bool
(* val t_shape_buf : ?version:int -> Term.term -> shape *)
(** returns the shape of a given term *)
......
......@@ -364,7 +364,7 @@ let add_to_check_no_smoke config found_obs env_session sched =
exit 1
end
in
M.check_all ~callback env_session sched
M.check_all ~release:true ~callback env_session sched
let add_to_check_smoke env_session sched =
let callback report =
......
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