Commit 1b799e39 authored by François Bobot's avatar François Bobot

whybench : First try for a tool and an API for making bench

The final goal is to compare provers, axiomatics and
transformations on specified goals. We also want to have different output

Bench.tool represents the provers, axiomatics or transformations that we
want to compare.
Bench.prob represents on what we want to compare them. The final task are
generated from an environnement and possibly with transformations.

Currently only provers can be compared.
parent a972a513
...@@ -443,6 +443,58 @@ install_no_local:: ...@@ -443,6 +443,58 @@ install_no_local::
endif endif
###############
# BENCH
###############
BENCH_FILES = bench whybench
BENCHMODULES := $(addprefix src/bench/, $(BENCH_FILES))
BENCHMODULES := src/ide/scheduler $(BENCHMODULES)
BENCHML = $(addsuffix .ml, $(BENCHMODULES))
BENCHMLI = $(addsuffix .mli, $(BENCHMODULES))
BENCHCMO = $(addsuffix .cmo, $(BENCHMODULES))
BENCHCMX = $(addsuffix .cmx, $(BENCHMODULES))
$(BENCHCMO) $(BENCHCMX): INCLUDES += -I src/ide -I src/bench -I +sqlite3
# build targets
byte: bin/whybench.byte
opt: bin/whybench.opt
bin/whybench.opt bin/whybench.byte: INCLUDES += -thread -I +threads
bin/whybench.opt bin/whybench.byte: EXTLIBS += threads
bin/whybench.opt: src/why.cmxa $(PGMCMX) $(BENCHCMX)
$(if $(QUIET), @echo 'Linking $@' &&) \
$(OCAMLOPT) $(OFLAGS) -o $@ $(EXTCMXA) $^
$(STRIP) $@
bin/whybench.byte: src/why.cma $(PGMCMO) $(BENCHCMO)
$(if $(QUIET),@echo 'Linking $@' &&) \
$(OCAMLC) $(BFLAGS) -o $@ $(EXTCMA) $^
# depend and clean targets
include .depend.bench
.depend.bench:
$(OCAMLDEP) -slash -I src -I src/bench -I src/ide $(BENCHML) $(BENCHMLI) > $@
depend: .depend.bench
clean::
rm -f src/bench/*.cm[iox] src/bench/*.o
rm -f src/bench/*.annot src/bench/*~
rm -f bin/whybench.byte bin/whybench.opt
rm -f .depend.bench
install_no_local::
cp -f bin/whybench.@OCAMLBEST@ $(BINDIR)/why3bench
############## ##############
# Coq plugin # Coq plugin
############## ##############
......
open Thread
open Why
open Env
open Theory
open Task
open Trans
open Driver
open Call_provers
open Scheduler
type 'a tool = {
tval : 'a;
ttrans : task trans;
tdriver : driver;
tcommand : string;
tenv : env;
tuse : task;
ttime : int;
tmem : int;
}
type 'a prob = {
ptask : env -> task -> ('a * task) list; (** needed for tenv *)
ptrans : task list trans;
}
type ('a,'b) result = {tool : 'a;
prob : 'b;
task : task;
idtask : int;
result : prover_result}
type ('a,'b) callback = 'a -> 'b -> task -> int -> proof_attempt_status -> unit
let debug = Debug.register_flag "call"
module MTask :
sig
type shared
val create : unit -> shared
val start : shared -> unit
val stop : shared -> unit
val lock : shared -> unit
val unlock : shared -> unit
val wait : shared -> unit
end
=
struct
type shared =
{ m : Mutex.t; c : Condition.t;
mutable nb_task : int;
}
let create () =
{ m = Mutex.create ();
c = Condition.create ();
nb_task = 0}
let start s = Mutex.lock s.m; s.nb_task <- s.nb_task + 1; Mutex.unlock s.m
let stop s = Mutex.lock s.m; s.nb_task <- s.nb_task - 1;
Mutex.unlock s.m; if s.nb_task = 0 then Condition.signal s.c
let wait s = Mutex.lock s.m; Condition.wait s.c s.m
let lock s = Mutex.lock s.m
let unlock s = Mutex.unlock s.m
end
let call s callback tool prob =
(** Prove goal *)
let call cb task =
schedule_proof_attempt ~debug:(Debug.test_flag debug)
~timelimit:(tool.ttime) ~memlimit:(tool.tmem)
~command:(tool.tcommand) ~driver:(tool.tdriver)
~callback:cb task in
let iter pval i task =
MTask.start s;
let cb res = callback pval i task res;
match res with Done _ | InternalFailure _ -> MTask.stop s | _ -> () in
call cb task; succ i in
let trans_cb pval tl =
ignore (List.fold_left (iter pval) 0 (List.rev tl)); MTask.stop s in
(** Apply trans *)
let iter_task (pval,task) =
MTask.start s;
let trans = Trans.compose_l prob.ptrans (Trans.singleton tool.ttrans) in
apply_transformation_l ~callback:(trans_cb pval) trans task in
(** Split *)
let ths = prob.ptask tool.tenv tool.tuse in
MTask.start s;
List.iter iter_task ths;
MTask.stop s
let general ?(callback=fun _ _ _ _ _ -> ()) iter add =
let s = MTask.create () in
iter (fun v tool prob ->
let cb pval i task res =
callback tool.tval pval task i res;
match res with
| Done r -> MTask.lock s;
add v {tool = tool.tval; prob = pval; task = task;
idtask = i; result = r};
MTask.unlock s
| _ -> () in
call s cb tool prob);
MTask.wait s
let any ?callback toolprob =
let l = ref [] in
general ?callback (fun f -> List.iter (fun (t,p) -> f () t p) toolprob)
(fun () r -> l:=r::!l);
!l
let all_list ?callback tools probs =
let l = ref [] in
general ?callback (fun f ->
List.iter (fun t -> List.iter (fun p -> f () t p) probs) tools)
(fun () r -> l:=r::!l);
!l
let all_array ?callback tools probs =
let m = Array.make_matrix (Array.length tools) (Array.length probs)
[] in
general ?callback (fun f ->
Array.iteri (fun i t -> Array.iteri (fun j p -> f (i,j) t p) probs) tools)
(fun (i,j) r -> m.(i).(j) <- r::m.(i).(j));
m
open Why
open Env
open Theory
open Task
open Trans
open Driver
open Call_provers
open Scheduler
type 'a tool = {
tval : 'a;
ttrans : task trans;
tdriver : driver;
tcommand : string;
tenv : env; (** Allow to compare axiomatic easily *)
tuse : task;
ttime : int;
tmem : int;
}
type 'a prob = {
ptask : env -> task -> ('a * task) list; (** needed for tenv and tuse *)
ptrans : task list trans;
}
type ('a,'b) result = {tool : 'a;
prob : 'b;
task : task;
idtask : int;
result : prover_result}
type ('a,'b) callback = 'a -> 'b -> task -> int -> proof_attempt_status -> unit
val all_list :
?callback:('a,'b) callback ->
'a tool list -> 'b prob list -> ('a,'b) result list
val all_array :
?callback:('a,'b) callback ->
'a tool array -> 'b prob array -> ('a,'b) result list array array
val any :
?callback:('a,'b) callback ->
('a tool * 'b prob) list -> ('a,'b) result list
This diff is collapsed.
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