session controller entrance

Makefile.in

@@ -190,8 +190,9 @@ LIB_WHYML = mlw_ty mlw_expr mlw_decl mlw_pretty mlw_wp mlw_module \
 	    mlw_dexpr mlw_typing mlw_driver mlw_exec mlw_ocaml \
 	    mlw_main mlw_interp
 
-LIB_SESSION = compress xml termcode session session_itp session_tools strategy \
-              strategy_parser session_scheduler
+LIB_SESSION = compress xml termcode session session_itp			\
+              controller_itp session_tools strategy strategy_parser	\
+              session_scheduler
 
 LIBMODULES =  $(addprefix src/util/, $(LIB_UTIL)) \
 	      $(addprefix src/core/, $(LIB_CORE)) \

examples/use_api/itp.ml

@@ -15,8 +15,6 @@ Small text-based interactive prover using new Why3 session format, to be run in
 
 ******************)
 
-(*
-
 #load "unix.cma";;
 #load "nums.cma";;
 #load "dynlink.cma";;
@@ -30,11 +28,8 @@ Small text-based interactive prover using new Why3 session format, to be run in
 #directory "../../lib/why3";;
 #load_rec "why3.cma";;
 
- *)
-
 open Format
 
-
 (* opening the Why3 library *)
 open Why3
 
@@ -67,15 +62,40 @@ let provers =
     provers
     []
 
+open Session_itp;;
+open Format;;
+
+let (s,b) = Session_itp.load_session "../bitwalker/why3session.xml";;
+
+let th = Session_itp.get_theories s;;
+
+let (_,_,id) = match th with
+    (n, (thn, _::_::x::_)::_)::_ -> (n,thn,x);;
 
-let (s,b) = Session_itp.load_session "../bitwalker/why3session.xml"
+let t = Session_itp.get_tree s id;;
+
+printf "%a@." (print_tree s) t;;
+
+(* let n = Session_itp.get_node s 19;;
+
+let s' = Session_itp.graft_transf s n "blabla" [] [];;
+
+let t = Session_itp.get_tree s;;
+
+let _ = Session_itp.remove_transformation s s';;
+
+let _ = remove_transformation s (get_trans s 15);;
 
 let t = Session_itp.get_tree s;;
 
 let my_session = Session_itp.empty_session "test.xml";;
 
+let s' = Session_itp.graft_transf s n "blabla" [] [];;
+
+   let t = Session_itp.get_tree s;; *)
+
 (* excerpt from src/session/session.ml *)
-let read_file env ?format fn =
+ let read_file env ?format fn =
   let theories = Env.read_file Env.base_language env ?format fn in
   let ltheories =
     Stdlib.Mstr.fold
@@ -88,31 +108,42 @@ let read_file env ?format fn =
            | None   -> (Loc.dummy_position,th_name,th)::acc)
       theories []
   in
-  List.sort
-    (fun (l1,_,_) (l2,_,_) -> Loc.compare l1 l2)
-    ltheories,theories
+  let th =  List.sort
+      (fun (l1,_,_) (l2,_,_) -> Loc.compare l1 l2)
+      ltheories
+  in
+  List.map (fun (_,_,a) -> a) th;;
+
+let my_session = empty_session ();;
 
 (* adds a file in the new session *)
 let file : unit (* Session_itp.file *) =
   let fname = "../logic/hello_proof.why" in
   try
-    let ordered_theories,theories = read_file env fname in
-    Session_itp.add_file my_session fname ordered_theories;
+    let theories = read_file env fname in
+    add_file_section my_session fname theories None;
   with e ->
     eprintf "@[Error while reading file@ '%s':@ %a@.@]" fname
       Exn_printer.exn_printer e;
-    exit 1
+    exit 1;;
+
+(* explore the theories in that file *)
+let theories = get_theories my_session;;
+let () = eprintf "%d theories found@." (List.length theories)
 
+let (_,_,id) = match theories with
+    (n, (thn, x::_)::_)::_ -> (n,thn,x);;
 
+let t = Session_itp.get_tree my_session id;;
 
+print_session my_session;;
 
+let l = graft_transf my_session id "toto" [] [];;
 
-(* explore the theories in that file *)
-let theories = file.Session.file_theories
-let () = eprintf "%d theories found@." (List.length theories)
+printf "%a@." (print_tree my_session) t;;
 
 (* add proof attempts for each goals in the theories *)
-
+(*
 let add_proofs_attempts g =
   List.iter
     (fun (p,d) ->
@@ -136,3 +167,4 @@ let () =
 
 (* save the session on disk *)
 let () = Session.save_session config env_session.Session.session
+*)

src/session/controller_itp.ml

+open Session_itp
+
+(** State of a proof *)
+type proof_attempt_status =
+    | Unedited (** editor not yet run for interactive proof *)
+    | JustEdited (** edited but not run yet *)
+    | Interrupted (** external proof has never completed *)
+    | Scheduled (** external proof attempt is scheduled *)
+    | Running (** external proof attempt is in progress *)
+    | Done of Call_provers.prover_result (** external proof done *)
+    | InternalFailure of exn (** external proof aborted by internal error *)
+
+type transformation_status = TSscheduled of transID | TSdone of transID | TSfailed
+
+let schedule_proof_attempt s id pr ~timelimit ~callback =
+  graft_proof_attempt s id pr ~timelimit;
+  callback Scheduled
+
+let schedule_transformations s id name args ~callback =
+  let tid = graft_transf s id name args in
+  callback (TSscheduled tid)
+
+let read_file env ?format fn =
+  let theories = Env.read_file Env.base_language env ?format fn in
+  let ltheories =
+    Stdlib.Mstr.fold
+      (fun name th acc ->
+        (* Hack : with WP [name] and [th.Theory.th_name.Ident.id_string] *)
+        let th_name =
+          Ident.id_register (Ident.id_derive name th.Theory.th_name) in
+         match th.Theory.th_name.Ident.id_loc with
+           | Some l -> (l,th_name,th)::acc
+           | None   -> (Loc.dummy_position,th_name,th)::acc)
+      theories []
+  in
+  let th =  List.sort
+      (fun (l1,_,_) (l2,_,_) -> Loc.compare l1 l2)
+      ltheories
+  in
+  List.map (fun (_,_,a) -> a) th
+
+let add_file_to_session env s ?format fname =
+  let theories = read_file env ?format fname in
+  add_file_section s fname theories None

src/session/controller_itp.mli

+(********************************************************************)
+(*                                                                  *)
+(*  The Why3 Verification Platform   /   The Why3 Development Team  *)
+(*  Copyright 2010-2015   --   INRIA - CNRS - Paris-Sud University  *)
+(*                                                                  *)
+(*  This software is distributed under the terms of the GNU Lesser  *)
+(*  General Public License version 2.1, with the special exception  *)
+(*  on linking described in file LICENSE.                           *)
+(*                                                                  *)
+(********************************************************************)
+
+open Session_itp
+
+(** State of a proof *)
+type proof_attempt_status =
+    | Unedited (** editor not yet run for interactive proof *)
+    | JustEdited (** edited but not run yet *)
+    | Interrupted (** external proof has never completed *)
+    | Scheduled (** external proof attempt is scheduled *)
+    | Running (** external proof attempt is in progress *)
+    | Done of Call_provers.prover_result (** external proof done *)
+    | InternalFailure of exn (** external proof aborted by internal error *)
+
+val schedule_proof_attempt :
+  session ->
+  proofNodeID ->
+  Whyconf.prover ->
+  timelimit:int ->
+  callback:(proof_attempt_status -> unit) -> unit
+(** [schedule_proof_attempt s id p tl cb] schedules a proof attempt for
+   a goal specified by [id] with the prover [p] with time limit [tl];
+   the function [cb] will be called each time the proof attempt status
+   changes. Typically at Scheduled, then Running, then Done. If there
+   is already a proof attempt with [p] it is updated. *)
+
+type transformation_status = TSscheduled of transID | TSdone of transID | TSfailed
+
+val schedule_transformations :
+  session ->
+  proofNodeID ->
+  string ->
+  trans_arg list ->
+  callback:(transformation_status -> unit) -> unit
+(** [schedule_transformations s id cb] schedules a transformation for a
+   goal specified by [id]; the function [cb] will be called each time
+   the transformation status changes. Typically at Scheluded, then
+   Done tid.*)
+
+val add_file_to_session : Env.env -> session -> string -> unit
+(** [add_file_to_session env s ?fmt fname] parses the source file
+    [fname] and add the resulting theories to the session [s] *)
+
+val reload_session_files : session -> unit
+(** reload the given session with the given environnement :
+    - the files are reloaded
+    - apply again the transformation
+    - if some goals appear try to find to which goal
+    in the given session it corresponds.
+
+    The last case meant that the session was obsolete.
+    It is authorized if [allow_obsolete] is [true],
+    otherwise the exception {!OutdatedSession} is raised.
+    If the session was obsolete is indicated by
+    the second result.
+    If the merge generated new unpaired goals is indicated by
+    the third result.
+
+    raises [OutdatedSession] if the session is obsolete and
+    [allow_obsolete] is false
+*)

src/session/session_itp.mli

@@ -15,35 +15,62 @@ type trans_arg
 *)
 
 type tree =
-  Tree of
-    (int * string * int * (int * string * int * tree list) list)
+    Tree of
+      (proofNodeID * string * (transID * string * tree list) list)
 
-val get_tree : session -> (string * (string * tree list) list) list
+val get_theories : session -> (string * (string * proofNodeID list) list) list
+(** [get_theories s] returns a list of pairs [name,l] where [name] is a
+    file name and [l] is a list of pairs [thnmae,l'] where [thname] is
+    a theory name and [l'] is the list of goal ids *)
+
+val get_tree : session -> proofNodeID -> tree
+(** [get_tree s id] returns the proof tree of the goal identified by
+    [id] *)
+
+(* temp *)
+val get_node : session -> int -> proofNodeID
+val get_trans : session -> int -> transID
+val print_tree : session -> Format.formatter -> tree -> unit
+val print_session : session -> unit
+
+(* val get_proof_attempts : session -> proofNodeID -> proof_attempt Whyconf.Hprover.t *)
+val get_transformations : session -> proofNodeID -> transID list
+val get_sub_tasks : session -> transID -> proofNodeID list
 
 (* Note for big brother Andrei: grafting is the opposite of pruning *)
 
-val empty_session : ?shape_version:int -> string -> session
+val empty_session : ?shape_version:int -> unit -> session
 
 val add_file_section :
-  session -> string -> ?format:string -> Theory.theory list -> unit
+  session -> string -> (Theory.theory list) -> Env.fformat option -> unit
 (** [add_file_section 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] *)
 
-val graft_proof_attempt : session -> proofNodeID -> proof_attempt -> unit
-(** [graft_proof_attempt s id pa] adds the proof attempt [pa] as a
-    child of the task [id] of the session [s]. *)
+val graft_proof_attempt : session -> proofNodeID -> Whyconf.prover ->
+  timelimit:int -> unit
+(** [graft_proof_attempt s id pr t] adds a proof attempt with prover
+    [pr] and timelimit [t] in the session [s] as a child of the task
+    [id]. If there allready a proof attempt with the same prover,
+    it updates it with the new timelimit. *)
+
+val update_proof_attempt : session -> proofNodeID -> Whyconf.prover ->
+  Call_provers.prover_result option -> unit
+(** [update_proof_attempt s id pr st] update the status of the
+    corresponding proof attempt with [st]. *)
 
 val graft_transf : session -> proofNodeID -> string -> trans_arg list ->
-  Task.task list -> unit
-(** [graft_transf s id name l tl] adds the transformation [name] as a
+   transID
+(** [graft_transf s id name l] adds the transformation [name] as a
     child of the task [id] of the session [s]. [l] is the list of
-    argument of the transformation; [tl] is the resulting list of
-    tasks *)
+    argument of the transformation. The subtasks are initialized to
+    the empty list *)
 
+val set_transf_tasks : session -> transID -> Task.task list -> unit
+(** [set_transf_tasks s id tl] sets the tasks of the transformation node
+    [id] to [tl] *)
 
-(*
 val remove_proof_attempt : session -> proofNodeID -> Whyconf.prover -> unit
 (** [remove_proof_attempt s id pr] removes the proof attempt from the
     prover [pr] from the proof node [id] of the session [s] *)
@@ -51,13 +78,10 @@ val remove_proof_attempt : session -> proofNodeID -> Whyconf.prover -> unit
 val remove_transformation : session -> transID -> unit
 (** [remove_transformation s id] removes the transformation [id]
     from the session [s] *)
-
 (*
 val save_session : string -> session -> unit
  *)
 (** [save_session f s] Save the session [s] in file [f] *)
- *)
-
 
 val load_session : string -> session * bool
 (** [load_session f] load a session from a file [f]; all the tasks are