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

session controller entrance

parent 633ba1d2
......@@ -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)) \
......
......@@ -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
*)
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
(********************************************************************)
(* *)
(* 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
*)
This diff is collapsed.
......@@ -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
......
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