reloading in IDE

share/provers-detection-data.conf.in

@@ -11,7 +11,7 @@ version_bad = "0.92"
 version_bad = "0.91"
 version_bad = "0.9"
 version_bad = "0.8"
-command = "@LOCALBIN@why3-cpulimit %t %m -s %e %f"
+command = "@LOCALBIN@why3-cpulimit %t %m -s %e -proof %f"
 driver = "drivers/alt_ergo_trunk.drv"
 
 [ATP alt-ergo]

src/ide/gconfig.ml

@@ -202,6 +202,7 @@ let iconname_prover = "wizard32"
 let iconname_transf = "configure32"
 let iconname_editor = "edit32"
 let iconname_replay = "refresh32"
+let iconname_reload = "movefile32"
 let iconname_remove = "deletefile32"
 let iconname_cleaning = "trashb32"
 
@@ -227,6 +228,7 @@ let image_prover = ref !image_default
 let image_transf = ref !image_default
 let image_editor = ref !image_default
 let image_replay = ref !image_default
+let image_reload = ref !image_default
 let image_remove = ref !image_default
 let image_cleaning = ref !image_default
 
@@ -253,6 +255,7 @@ let resize_images size =
   image_transf := image ~size iconname_transf;
   image_editor := image ~size iconname_editor;
   image_replay := image ~size iconname_replay;
+  image_reload := image ~size iconname_reload;
   image_remove := image ~size iconname_remove;
   image_cleaning := image ~size iconname_cleaning;
   ()

src/ide/gconfig.mli

@@ -72,6 +72,7 @@ val image_prover : GdkPixbuf.pixbuf ref
 val image_transf : GdkPixbuf.pixbuf ref
 val image_editor : GdkPixbuf.pixbuf ref
 val image_replay : GdkPixbuf.pixbuf ref
+val image_reload : GdkPixbuf.pixbuf ref
 val image_remove : GdkPixbuf.pixbuf ref
 val image_cleaning : GdkPixbuf.pixbuf ref
 

src/ide/newmain.ml

@@ -367,12 +367,15 @@ module M = Session.Make
          | Some r -> Some r#iter
        in
        let iter = goals_model#append ?parent () in
+       goals_model#set ~row:iter ~column:index_column (-1);
        goals_model#get_row_reference (goals_model#get_path iter)
 
 
      let remove row =
        let (_:bool) = goals_model#remove row#iter in ()
 
+     let reset () = goals_model#clear ()
+
      let idle f =
        let (_ : GMain.Idle.id) = GMain.Idle.add f in ()
 
@@ -408,47 +411,57 @@ let set_proof_state ~obsolete a =
 
 let model_index = Hashtbl.create 17
 
-let get_any row = 
-  try 
+let get_any row =
+  try
     let row = goals_model#get_iter row in
     let idx = goals_model#get ~row ~column:index_column in
     Hashtbl.find model_index idx
   with Not_found -> invalid_arg "Gmain.get_index"
 
-let init = 
-  let cpt = ref 0 in 
+let notify any =
+  match any with
+    | M.Goal g ->
+	set_row_status (M.goal_key g) (M.goal_proved g)
+    | M.Theory th ->
+	set_row_status (M.theory_key th) (M.verified th)
+    | M.File file ->
+	set_row_status file.M.file_key file.M.file_verified
+    | M.Proof_attempt a ->
+	set_proof_state ~obsolete:a.M.proof_obsolete a
+    | M.Transformation tr ->
+	set_row_status tr.M.transf_key tr.M.transf_proved
+
+let init =
+  let cpt = ref (-1) in
   fun row any ->
-    incr cpt;
-    Hashtbl.add model_index !cpt any;
-    goals_model#set ~row:row#iter ~column:index_column !cpt;
-    goals_model#set ~row:row#iter ~column:icon_column 
+    let ind = goals_model#get ~row:row#iter ~column:index_column in
+    if ind < 0 then
+      begin
+        incr cpt;
+        Hashtbl.add model_index !cpt any;
+        goals_model#set ~row:row#iter ~column:index_column !cpt
+      end
+    else
+      begin
+        Hashtbl.replace model_index ind any;
+      end;
+    goals_model#set ~row:row#iter ~column:icon_column
       (match any with
 	 | M.Goal _ -> !image_file
-	 | M.Theory _ 
+	 | M.Theory _
 	 | M.File _ -> !image_directory
 	 | M.Proof_attempt _ -> !image_prover
 	 | M.Transformation _ -> !image_transf);
-    goals_model#set ~row:row#iter ~column:name_column 
+    goals_model#set ~row:row#iter ~column:name_column
       (match any with
 	 | M.Goal g -> M.goal_expl g
 	 | M.Theory th -> M.theory_name th
 	 | M.File f -> Filename.basename f.M.file_name
 	 | M.Proof_attempt a -> let p = a.M.prover in
 	   p.Session.prover_name ^ " " ^ p.Session.prover_version
-	 | M.Transformation tr -> Session.transformation_id tr.M.transf)
+	 | M.Transformation tr -> Session.transformation_id tr.M.transf);
+    notify any
 
-let notify any =
-  match any with
-    | M.Goal g ->
-	set_row_status (M.goal_key g) (M.goal_proved g)
-    | M.Theory th ->
-	set_row_status (M.theory_key th) (M.verified th)
-    | M.File file ->
-	set_row_status file.M.file_key file.M.file_verified
-    | M.Proof_attempt a ->
-	set_proof_state ~obsolete:false a
-    | M.Transformation tr ->
-	set_row_status tr.M.transf_key tr.M.transf_proved
 
 
 (********************)
@@ -490,7 +503,7 @@ let () =
 let () =
   try
     eprintf "Opening session...@?";
-    M.open_session ~env:gconfig.env ~provers:gconfig.provers 
+    M.open_session ~env:gconfig.env ~provers:gconfig.provers
       ~init ~notify project_dir;
     M.maximum_running_proofs := gconfig.max_running_processes;
     eprintf " done@."
@@ -567,7 +580,7 @@ let replay_obsolete_proofs () =
   List.iter
     (fun row ->
        let a = get_any row in
-       M.replay ~obsolete_only:true 
+       M.replay ~obsolete_only:true
          ~context_unproved_goals_only:!context_unproved_goals_only a)
     goals_view#selection#get_selected_rows
 
@@ -685,14 +698,14 @@ let exit_function () =
       match l with
 	| [] -> ()
 	| f :: _ ->
-	    eprintf "first element is a '%s' with %d sub-elements@." 
+	    eprintf "first element is a '%s' with %d sub-elements@."
 	      f.Xml.name (List.length f.Xml.elements);
-	    
+
     with e -> eprintf "test reloading failed with exception %s@."
       (Printexc.to_string e)
   end;
   let ret = Sys.command "xmllint --noout --dtdvalid share/why3session.dtd essai.xml" in
-  if ret = 0 then eprintf "DTD validation succeeded, good!@."; 
+  if ret = 0 then eprintf "DTD validation succeeded, good!@.";
   *)
   M.save_session ();
   GMain.quit ()
@@ -911,7 +924,7 @@ let () =
   let () = b#set_image i#coerce in
   let (_ : GtkSignal.id) =
     b#connect#pressed ~callback:inline_selected_goals
-  in 
+  in
   ()
 
 
@@ -1091,13 +1104,13 @@ let select_row p =
   match a with
     | M.Goal g ->
 	let callback = function
-	  | [t] -> 
+	  | [t] ->
               let task_text = Pp.string_of Pretty.print_task t in
               task_view#source_buffer#set_text task_text;
               task_view#scroll_to_mark `INSERT;
               scroll_to_source_goal g
 	  | _ -> assert false
-	in	
+	in
         M.apply_transformation ~callback intro_transformation (M.get_task g)
 
     | M.Theory th ->
@@ -1177,6 +1190,18 @@ let () =
     b#connect#pressed ~callback:replay_obsolete_proofs
   in ()
 
+let () =
+  let b = GButton.button ~packing:tools_box#add ~label:"Reload" () in
+  b#misc#set_tooltip_markup "Reloads the files";
+
+  let i = GMisc.image ~pixbuf:(!image_reload) () in
+  let () = b#set_image i#coerce in
+  let (_ : GtkSignal.id) =
+    b#connect#pressed ~callback:(fun () -> 
+                                   current_file := "";
+                                   M.reload_all gconfig.provers)
+  in ()
+
 (*************)
 (* removing  *)
 (*************)

src/ide/replay.ml

@@ -56,7 +56,7 @@ let loadpath = (Whyconf.loadpath (Whyconf.get_main config))
 
 let env = Lexer.create_env loadpath
 
-let provers = Whyconf.get_provers config 
+let provers = Whyconf.get_provers config
 
 let provers =
   Util.Mstr.fold (Session.get_prover_data env) provers Util.Mstr.empty
@@ -71,13 +71,15 @@ module M = Session.Make
   (struct
      type key = int
 
-     let create ?parent () = 
+     let create ?parent () =
        match parent with
          | None -> 0
          | Some  n -> n+1
 
      let remove _row = ()
 
+     let reset () = ()
+
      let idle f =
        match !idle_handler with
          | None -> idle_handler := Some f;
@@ -115,16 +117,16 @@ let main_loop () =
     else
       (* attempt to run the idle handler *)
       match !idle_handler with
-        | None -> 
-            begin 
-              let ms = 
+        | None ->
+            begin
+              let ms =
                 match !timeout_handler with
                   | None -> raise Exit
                   | Some(ms,_) -> ms
               in
               usleep (ms -. time)
             end
-        | Some f -> 
+        | Some f ->
             let b = f () in
             if b then () else
               begin
@@ -136,8 +138,8 @@ open Format
 
 let model_index = Hashtbl.create 257
 
-let init = 
-  let cpt = ref 0 in 
+let init =
+  let cpt = ref 0 in
   fun _row any ->
     incr cpt;
     Hashtbl.add model_index !cpt any;
@@ -152,7 +154,7 @@ let init =
     in
     printf "Item '%s' loaded@." name
 
-let string_of_result result = 
+let string_of_result result =
   match result with
     | Session.Undone -> "undone"
     | Session.Scheduled -> "scheduled"
@@ -166,7 +168,7 @@ let string_of_result result =
 	| Call_provers.Failure _ -> "failure"
 	| Call_provers.HighFailure -> "high failure"
 
-let print_result fmt res = 
+let print_result fmt res =
   let t = match res with
     | Session.Done { Call_provers.pr_time = time } ->
 	Format.sprintf "(%.2f)" time
@@ -186,8 +188,8 @@ let notify any =
           file.M.file_verified
     | M.Proof_attempt a ->
         let p = a.M.prover in
-	printf "Proof with '%s %s' gives %a@." 
-	  p.Session.prover_name p.Session.prover_version 
+	printf "Proof with '%s %s' gives %a@."
+	  p.Session.prover_name p.Session.prover_version
           print_result a.M.proof_state
     | M.Transformation tr ->
 	printf "Transformation '%s' proved: %b@."
@@ -220,12 +222,12 @@ let main () =
   try
     eprintf "Opening session...@?";
     M.open_session ~env ~provers ~init ~notify project_dir;
-    M.maximum_running_proofs := 
+    M.maximum_running_proofs :=
       Whyconf.running_provers_max (Whyconf.get_main config);
     eprintf " done@.";
     let files = M.get_all_files () in
-    List.iter 
-      (fun f -> 
+    List.iter
+      (fun f ->
          eprintf "Replaying file '%s'@." f.M.file_name;
          M.replay ~obsolete_only:false
            ~context_unproved_goals_only:false (M.File f)) files;

src/ide/session.mli

@@ -69,6 +69,9 @@ module type OBSERVER = sig
   val remove: key -> unit
     (** removes a key *)
 
+  val reset: unit -> unit
+    (** deletes all keys *)
+
   val timeout: ms:int -> (unit -> bool) -> unit
     (** a handler for functions that must be called after a given time
 	elapsed, in milliseconds. When the given function returns
@@ -149,18 +152,20 @@ module Make(O: OBSERVER) : sig
     env:Env.env ->
     provers:prover_data Util.Mstr.t ->
     init:(O.key -> any -> unit) ->
-    notify:(any -> unit) -> string -> unit
+    notify:(any -> unit) -> 
+    string -> unit
     (** starts a new proof session, using directory given as argument 
         this reloads the previous session database if any.
 
         Opening a session must be done prior to any other actions.
         And it cannot be done twice.
 
+	the [notify] function is a function that will be called at each
+	update of element of the state
+
 	the [init] function is a function that will be called at each
 	creation of element of the state
 
-	the [notify] function is a function that will be called at each
-	update of element of the state
     *)
 
   val maximum_running_proofs : int ref
@@ -216,6 +221,11 @@ module Make(O: OBSERVER) : sig
         if context_unproved_goals_only is set then reruns only proofs with result was 'valid'
     *)
 
+  val reload_all: prover_data Util.Mstr.t -> unit
+    (** reloads all the files 
+        If for a given file, the parsing or typing fails, then
+        then old version is kept, but marked obsolete
+    *)
 (*
 TODO