add icon for proof status + some stuff

src/session/controller_itp.ml

@@ -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

src/session/controller_itp.mli

@@ -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

src/session/session_itp.ml

@@ -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;

src/session/session_itp.mli

@@ -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