Commit ea12e95d authored by Clément Fumex's avatar Clément Fumex

add icon for proof status + some stuff

parent 3f6d7e32
This diff is collapsed.
......@@ -79,7 +79,7 @@ let th_proved c th =
Hid.find_def c.proof_state.th_state false (theory_name th)
(* Update the result of the theory according to its children *)
let update_theory th ps =
let update_theory_proof_state ps th =
let goals = theory_goals th in
Hid.replace ps.th_state (theory_name th)
(List.for_all (fun id -> Hpn.find_def ps.pn_state false id) goals)
......@@ -105,7 +105,7 @@ and propagate_trans c (tid: Session_itp.transID) =
and update_proof c id =
match get_proof_parent c.controller_session id with
| Theory th -> update_theory th c.proof_state
| Theory th -> update_theory_proof_state c.proof_state th
| Trans tid -> propagate_trans c tid
(* [update_proof_node c id b] Update the whole proof_state
......@@ -120,7 +120,34 @@ let update_trans_node c id b =
Htn.replace c.proof_state.tn_state id b;
propagate_proof c (get_trans_parent c.controller_session id)
(* init proof state after reload *)
let rec reload_goal_proof_state ps c g =
let ses = c.controller_session in
let tr_list = get_transformations ses g in
let pa_list = get_proof_attempts ses g in
let proved = List.exists (reload_trans_proof_state ps c) tr_list in
let proved = List.exists reload_pa_proof_state pa_list || proved in
Hpn.replace c.proof_state.pn_state g proved;
proved
and reload_trans_proof_state ps c tr =
let proof_list = get_sub_tasks c.controller_session tr in
let proved = List.for_all (reload_goal_proof_state ps c) proof_list in
Htn.replace c.proof_state.tn_state tr proved;
proved
and reload_pa_proof_state pa =
match pa.proof_obsolete, pa.Session_itp.proof_state with
| false, Some pr when pr.Call_provers.pr_answer = Call_provers.Valid -> true
| _ -> false
(* to be called after reload *)
let reload_theory_proof_state c th =
let ps = c.proof_state in
let goals = theory_goals th in
let proved = List.for_all (reload_goal_proof_state ps c) goals in
Hid.replace ps.th_state (theory_name th)
proved
(* printing *)
......@@ -233,8 +260,11 @@ let merge_file (old_ses : session) (c : controller) env ~use_shapes _ file =
with _ -> (* TODO: filter only syntax error and typing errors *)
[]
in
add_file_section
c.controller_session ~use_shapes ~merge:(old_ses,old_theories,env) file_name new_theories format
merge_file_section
c.controller_session ~use_shapes ~old_ses ~old_theories ~env file_name new_theories format;
Stdlib.Hstr.iter
(fun _ f -> List.iter (reload_theory_proof_state c) f.file_theories)
(get_files c.controller_session)
let reload_files (c : controller) (env : Env.env) ~use_shapes =
......@@ -406,11 +436,15 @@ let schedule_transformation_r c id name args ~callback =
let schedule_transformation c id name args ~callback =
let callback s = (match s with
| TSdone tid -> update_trans_node c tid false
(*(get_sub_tasks c.controller_session tid = [])*)
(* TODO need to change schedule transformation to get the id ? *)
| TSfailed -> ()
| _ -> ()); callback s in
| TSdone tid ->
let has_subtasks =
match get_sub_tasks c.controller_session tid with
| [] -> true
| _ -> false
in
update_trans_node c tid has_subtasks
| TSfailed -> ()
| _ -> ()); callback s in
schedule_transformation_r c id name args ~callback
open Strategy
......
......@@ -75,14 +75,6 @@ type controller = private
val create_controller : Env.env -> Session_itp.session -> controller
(** [update_proof_node c id b] Update the whole proof_state
of c according to the result (id, b) *)
val update_proof_node: controller -> Session_itp.proofNodeID -> bool -> unit
(** [update_trans_node c id b] Update the whole proof_state of c
according to the result (id,b) *)
val update_trans_node: controller -> Session_itp.transID -> bool -> unit
(** Used to find if a proof/trans node or theory is proved or not *)
val tn_proved: controller -> Session_itp.transID -> bool
val pn_proved: controller -> Session_itp.proofNodeID -> bool
......
......@@ -1085,42 +1085,53 @@ let make_theory_section ~use_shapes ?merge (s:session) (th:Theory.theory) : the
end;
theory
(* add a why file from a session, if merge is provided try to merge
its theories with the previous ones with matching names *)
let add_file_section ~use_shapes ?merge (s:session) (fn:string) (theories:Theory.theory list) format
(* add a why file to a session *)
let add_file_section ~use_shapes (s:session) (fn:string) (theories:Theory.theory list) format : unit =
let fn = Sysutil.relativize_filename s.session_dir fn in
if Hstr.mem s.session_files fn then
Debug.dprintf debug "[session] file %s already in database@." fn
else
let theories = List.map (make_theory_section ~use_shapes s) theories in
let f = { file_name = fn;
file_format = format;
file_theories = theories;
file_detached_theories = [] }
in
Hstr.add s.session_files fn f
(* add a why file to a session and try to merge its theories with the
provided ones with matching names *)
let merge_file_section ~use_shapes ~old_ses ~old_theories ~env
(s:session) (fn:string) (theories:Theory.theory list) format
: unit =
let fn = Sysutil.relativize_filename s.session_dir fn in
if Hstr.mem s.session_files fn then
Debug.dprintf debug "[session] file %s already in database@." fn
else
let theories,detached =
match merge with
| Some (old_ses, old_th, env) ->
let old_th_table = Hstr.create 7 in
List.iter
(fun th -> Hstr.add old_th_table th.theory_name.Ident.id_string th)
old_th;
let add_theory (th: Theory.theory) =
try
(* look for a theory with same name *)
let theory_name = th.Theory.th_name.Ident.id_string in
(* if we found one, we remove it from the table and merge it *)
let old_th = Hstr.find old_th_table theory_name in
Hstr.remove old_th_table theory_name;
make_theory_section ~use_shapes ~merge:(old_ses,old_th,env) s th
with Not_found ->
(* if no theory was found we make a new theory section *)
make_theory_section ~use_shapes s th
in
let theories = List.map add_theory theories in
(* we save the remaining, detached *)
let detached = Hstr.fold
(fun _key th tl ->
(save_detached_theory old_ses th s) :: tl)
old_th_table [] in
theories, detached
| None ->
List.map (make_theory_section ~use_shapes s) theories, []
let old_th_table = Hstr.create 7 in
List.iter
(fun th -> Hstr.add old_th_table th.theory_name.Ident.id_string th)
old_theories;
let add_theory (th: Theory.theory) =
try
(* look for a theory with same name *)
let theory_name = th.Theory.th_name.Ident.id_string in
(* if we found one, we remove it from the table and merge it *)
let old_th = Hstr.find old_th_table theory_name in
Hstr.remove old_th_table theory_name;
make_theory_section ~use_shapes ~merge:(old_ses,old_th,env) s th
with Not_found ->
(* if no theory was found we make a new theory section *)
make_theory_section ~use_shapes s th
in
let theories = List.map add_theory theories in
(* we save the remaining, detached *)
let detached = Hstr.fold
(fun _key th tl ->
(save_detached_theory old_ses th s) :: tl)
old_th_table [] in
theories, detached
in
let f = { file_name = fn;
file_format = format;
......
......@@ -84,15 +84,24 @@ val empty_session : ?shape_version:int -> string -> session
argument *)
val add_file_section :
use_shapes:bool -> ?merge:session*theory list*Env.env -> session ->
string -> (Theory.theory list) -> Env.fformat option -> unit
use_shapes:bool -> session -> string -> (Theory.theory list) ->
Env.fformat option -> unit
(** [add_file_section ~merge:(old_s,old_ths,env) s fn ths] adds a new
'file' section in session [s], named [fn], containing fresh theory
subsections corresponding to theories [ths]. The tasks of each
theory nodes generated are computed using [Task.split_theory]. For
each theory whose name is identical to one theory of old_ths, it
is attempted to associate the old goals, proof_attempts and
transformations to the goals of the new theory *)
theory nodes generated are computed using [Task.split_theory]. *)
val merge_file_section :
use_shapes:bool -> old_ses:session -> old_theories:theory list ->
env:Env.env -> session -> string -> Theory.theory list ->
Env.fformat option -> unit
(** [merge_file_section ~old_s ~old_theories ~env ~pn_callpack s fn
ths] adds a new 'file' section in session [s], named [fn],
containing fresh theory subsections corresponding to theories
[ths]. For each theory whose name is identical to one theory of
old_ths, it is attempted to associate the old goals,
proof_attempts and transformations to the goals of the new
theory *)
val graft_proof_attempt : session -> proofNodeID -> Whyconf.prover ->
timelimit:int -> proofAttemptID
......
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