Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
why3
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
121
Issues
121
List
Boards
Labels
Service Desk
Milestones
Merge Requests
17
Merge Requests
17
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Why3
why3
Commits
4922dbf0
Commit
4922dbf0
authored
Feb 17, 2011
by
François Bobot
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
remove polymorphism in bench/prepare db incorporation
parent
e16b146a
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
156 additions
and
102 deletions
+156
-102
Makefile.in
Makefile.in
+3
-3
src/bench/bench.ml
src/bench/bench.ml
+55
-22
src/bench/bench.mli
src/bench/bench.mli
+61
-44
src/bench/benchrc.ml
src/bench/benchrc.ml
+16
-13
src/bench/benchrc.mli
src/bench/benchrc.mli
+3
-9
src/bench/whybench.ml
src/bench/whybench.ml
+18
-11
No files found.
Makefile.in
View file @
4922dbf0
...
...
@@ -485,7 +485,7 @@ BENCH_FILES = bench benchrc whybench
BENCHMODULES
:=
$(
addprefix
src/bench/,
$(BENCH_FILES)
)
BENCHMODULES
:=
src/ide/worker
$(BENCHMODULES)
BENCHMODULES
:=
src/ide/worker
src/ide/db
$(BENCHMODULES)
BENCHML
=
$(
addsuffix
.ml,
$(BENCHMODULES)
)
BENCHMLI
=
$(
addsuffix
.mli,
$(BENCHMODULES)
)
...
...
@@ -499,8 +499,8 @@ $(BENCHCMO) $(BENCHCMX): INCLUDES += -I src/ide -I src/bench -I @SQLITE3LIB@
byte
:
bin/why3bench.byte
opt
:
bin/why3bench.opt
bin/why3bench.opt bin/why3bench.byte
:
INCLUDES += -thread -I +threads
bin/why3bench.opt bin/why3bench.byte
:
EXTLIBS += threads
bin/why3bench.opt bin/why3bench.byte
:
INCLUDES += -thread -I +threads
-I +sqlite3
bin/why3bench.opt bin/why3bench.byte
:
EXTLIBS += threads
sqlite3
bin/why3bench.opt
:
src/why.cmxa $(PGMCMX) $(BENCHCMX)
$(
if
$(QUIET)
, @echo
'Linking $@'
&&
)
\
...
...
src/bench/bench.ml
View file @
4922dbf0
...
...
@@ -27,20 +27,36 @@ open Driver
open
Call_provers
open
Scheduler
type
'
a
tool
=
{
tval
:
'
a
;
ttrans
:
task
trans
;
type
tool_id
=
{
tool_name
:
string
;
prover_name
:
string
;
tool_db
:
Db
.
prover_id
option
;
}
(* tool_name, prover_name *)
type
prob_id
=
{
prob_name
:
string
;
prob_file
:
string
;
prob_theory
:
string
;
prob_db
:
Db
.
goal
option
;
}
(* prob_name, file_name, theory name *)
type
tool
=
{
tval
:
tool_id
;
ttrans
:
(
task
trans
*
(
Db
.
transf_id
option
))
list
;
tdriver
:
driver
;
tcommand
:
string
;
tenv
:
env
;
tuse
:
task
;
tuse_trans
:
Db
.
transf_id
option
;
ttime
:
int
;
tmem
:
int
;
}
type
'
a
prob
=
{
ptask
:
env
->
task
->
(
'
a
*
task
)
list
;
(** needed for tenv *)
ptrans
:
env
->
task
list
trans
;
type
prob
=
{
ptask
:
env
->
task
->
(
prob_id
*
task
)
list
;
(** needed for tenv *)
ptrans
:
env
->
(
task
list
trans
*
(
Db
.
transf_id
option
))
list
;
}
...
...
@@ -48,20 +64,19 @@ type why_result =
|
InternalFailure
of
exn
|
Done
of
prover_result
let
print_why_result
fmt
=
function
|
InternalFailure
exn
->
Format
.
fprintf
fmt
"InternalFailure %a"
Exn_printer
.
exn_printer
exn
|
Done
pr
->
Call_provers
.
print_prover_result
fmt
pr
type
result
=
{
tool
:
tool_id
;
prob
:
prob_id
;
task
:
Decl
.
prsymbol
;
idtask
:
int
;
result
:
why_result
}
type
(
'
a
,
'
b
)
result
=
{
tool
:
'
a
;
prob
:
'
b
;
task
:
Decl
.
prsymbol
;
idtask
:
int
;
result
:
why_result
}
type
(
'
a
,
'
b
)
callback
=
'
a
->
'
b
->
task
->
int
->
why_result
->
unit
type
callback
=
tool_id
->
prob_id
->
task
->
int
->
why_result
->
unit
let
debug_call
=
Debug
.
register_flag
"call"
let
debug
=
Debug
.
register_flag
"bench_core"
...
...
@@ -118,6 +133,23 @@ let new_external_proof =
Mutex
.
unlock
queue_lock
;
done
let
apply_trans
(
task
,_
db_goal
)
(
trans
,_
db_trans
)
=
let
task
=
Trans
.
apply
trans
task
in
((
task
:
task
)
,
None
)
let
apply_transl
(
task
,_
db_goal
)
(
trans
,_
db_trans
)
=
let
tasks
=
Trans
.
apply
trans
task
in
List
.
map
(
fun
task
->
(
task
:
task
)
,
None
)
tasks
let
rec
apply_transll
trl
acc
(
task
,
db_goal
)
=
match
trl
with
|
[]
->
(
task
,
db_goal
)
::
acc
|
tr
::
trl
->
let
tl
=
apply_transl
(
task
,
db_goal
)
tr
in
List
.
fold_left
(
apply_transll
trl
)
acc
tl
let
call
callback
tool
prob
=
(** Prove goal *)
let
call
pval
i
task
=
...
...
@@ -133,11 +165,12 @@ let call callback tool prob =
in
(** Apply trans *)
let
iter_task
(
pval
,
task
)
=
let
trans
=
Trans
.
compose_l
(
prob
.
ptrans
tool
.
tenv
)
(
Trans
.
singleton
tool
.
ttrans
)
in
let
tl
=
Trans
.
apply
trans
task
in
let
iter
i
task
=
call
pval
i
task
;
succ
i
in
ignore
(
List
.
fold_left
iter
0
(
List
.
rev
tl
))
in
let
translist
=
prob
.
ptrans
tool
.
tenv
in
let
tasks
=
apply_transll
translist
[]
(
task
,
pval
.
prob_db
)
in
let
tasks
=
List
.
map
(
fun
task
->
List
.
fold_left
apply_trans
task
tool
.
ttrans
)
tasks
in
let
iter
i
(
task
,_
db_goal
)
=
call
pval
i
task
;
succ
i
in
ignore
(
List
.
fold_left
iter
0
(
List
.
rev
tasks
))
in
(** Split *)
let
ths
=
prob
.
ptask
tool
.
tenv
tool
.
tuse
in
List
.
iter
iter_task
ths
...
...
@@ -210,11 +243,11 @@ type output =
(** In a file *)
|
Csv
of
string
type
(
'
a
,
'
b
)
bench
=
type
bench
=
{
bname
:
string
;
btools
:
'
a
tool
list
;
bprobs
:
'
b
prob
list
;
btools
:
tool
list
;
bprobs
:
prob
list
;
boutputs
:
output
list
;
}
...
...
src/bench/bench.mli
View file @
4922dbf0
...
...
@@ -31,21 +31,37 @@ val maximum_running_proofs: int ref
(** bound on the number of prover processes running in parallel.
default is 2 *)
type
'
a
tool
=
{
tval
:
'
a
;
ttrans
:
task
trans
;
type
tool_id
=
{
tool_name
:
string
;
prover_name
:
string
;
tool_db
:
Db
.
prover_id
option
;
}
(* tool_name, prover_name *)
type
prob_id
=
{
prob_name
:
string
;
prob_file
:
string
;
prob_theory
:
string
;
prob_db
:
Db
.
goal
option
;
}
(* prob_name, file_name, theory name *)
type
tool
=
{
tval
:
tool_id
;
ttrans
:
(
task
trans
*
(
Db
.
transf_id
option
))
list
;
tdriver
:
driver
;
tcommand
:
string
;
tenv
:
env
;
(** Allow to compare axiomatic easily *)
tuse
:
task
;
tuse_trans
:
Db
.
transf_id
option
;
ttime
:
int
;
tmem
:
int
;
}
type
'
a
prob
=
{
ptask
:
env
->
task
->
(
'
a
*
task
)
list
;
(** needed for tenv and tuse *)
ptrans
:
env
->
task
list
trans
;
(** perhaps should be merged in
ptask *)
type
prob
=
{
ptask
:
env
->
task
->
(
prob_id
*
task
)
list
;
(** needed for tenv and tuse *)
ptrans
:
env
->
(
task
list
trans
*
(
Db
.
transf_id
option
))
list
;
}
type
why_result
=
...
...
@@ -53,35 +69,35 @@ type why_result =
|
Done
of
prover_result
val
print_why_result
:
Format
.
formatter
->
why_result
->
unit
type
result
=
{
tool
:
tool_id
;
prob
:
prob_id
;
task
:
Decl
.
prsymbol
;
idtask
:
int
;
result
:
why_result
}
type
(
'
a
,
'
b
)
result
=
{
tool
:
'
a
;
prob
:
'
b
;
task
:
Decl
.
prsymbol
;
idtask
:
int
;
result
:
why_result
}
type
(
'
a
,
'
b
)
callback
=
'
a
->
'
b
->
task
->
int
->
why_result
->
unit
type
callback
=
tool_id
->
prob_id
->
task
->
int
->
why_result
->
unit
val
all_list_tp
:
?
callback
:
(
'
a
,
'
b
)
callback
->
'
a
tool
list
->
'
b
prob
list
->
(
'
a
,
'
b
)
result
list
?
callback
:
callback
->
tool
list
->
prob
list
->
result
list
val
all_list_pt
:
?
callback
:
(
'
a
,
'
b
)
callback
->
'
a
tool
list
->
'
b
prob
list
->
(
'
a
,
'
b
)
result
list
?
callback
:
callback
->
tool
list
->
prob
list
->
result
list
val
all_array
:
?
callback
:
(
'
a
,
'
b
)
callback
->
'
a
tool
array
->
'
b
prob
array
->
(
'
a
,
'
b
)
result
list
array
array
?
callback
:
callback
->
tool
array
->
prob
array
->
result
list
array
array
val
any
:
?
callback
:
(
'
a
,
'
b
)
callback
->
(
'
a
tool
*
'
b
prob
)
list
->
(
'
a
,
'
b
)
result
list
?
callback
:
callback
->
(
tool
*
prob
)
list
->
result
list
val
all_list_tools
:
?
callback
:
(
'
a
,
'
b
)
callback
->
'
a
tool
list
->
'
b
prob
list
->
(
'
a
*
(
'
a
,
'
b
)
result
list
)
list
?
callback
:
callback
->
tool
list
->
prob
list
->
(
tool_id
*
result
list
)
list
type
output
=
...
...
@@ -91,25 +107,25 @@ type output =
(** In a file *)
|
Csv
of
string
type
(
'
a
,
'
b
)
bench
=
type
bench
=
{
bname
:
string
;
btools
:
'
a
tool
list
;
bprobs
:
'
b
prob
list
;
btools
:
tool
list
;
bprobs
:
prob
list
;
boutputs
:
output
list
;
}
val
run_bench
:
?
callback
:
(
'
a
,
'
b
)
callback
->
(
'
a
,
'
b
)
bench
->
(
'
a
,
'
b
)
result
list
?
callback
:
callback
->
bench
->
result
list
val
run_benchs
:
?
callback
:
(
'
a
,
'
b
)
callback
->
(
'
a
,
'
b
)
bench
list
->
(
(
'
a
,
'
b
)
bench
*
(
'
a
,
'
b
)
result
list
)
list
?
callback
:
callback
->
bench
list
->
(
bench
*
result
list
)
list
val
run_benchs_tools
:
?
callback
:
(
'
a
,
'
b
)
callback
->
(
'
a
,
'
b
)
bench
list
->
(
(
'
a
,
'
b
)
bench
*
(
'
a
*
(
'
a
,
'
b
)
result
list
)
list
)
list
?
callback
:
callback
->
bench
list
->
(
bench
*
(
tool_id
*
result
list
)
list
)
list
type
nb_avg
=
int
*
float
...
...
@@ -125,25 +141,26 @@ type tool_res =
val
print_tool_res
:
Format
.
formatter
->
tool_res
->
unit
val
compute_average
:
(
'
a
,
'
b
)
result
list
->
tool_res
val
compute_average
:
result
list
->
tool_res
val
compute_timeline
:
float
->
float
->
float
->
(
'
a
,
'
b
)
result
list
->
int
list
float
->
float
->
float
->
result
list
->
int
list
(** [compute_timeline start end step results] *)
val
filter_timeline
:
(
'
a
,
'
b
)
result
list
->
(
'
a
,
'
b
)
result
list
val
filter_timeline
:
result
list
->
result
list
val
max_time
:
(
'
a
,
'
b
)
result
list
->
float
val
max_time
:
result
list
->
float
open
Format
val
print_csv
:
(
'
b
->
'
b
->
int
)
->
(
formatter
->
'
a
->
unit
)
->
(
formatter
->
'
b
->
unit
)
->
(
prob_id
->
prob_id
->
int
)
->
(
formatter
->
tool_id
->
unit
)
->
(
formatter
->
prob_id
->
unit
)
->
formatter
->
(
'
a
*
(
'
a
,
'
b
)
result
list
)
list
->
unit
(
tool_id
*
result
list
)
list
->
unit
val
print_output
:
(
'
b
->
'
b
->
int
)
->
(
formatter
->
'
a
->
unit
)
->
(
formatter
->
'
b
->
unit
)
->
(
'
a
,
'
b
)
bench
*
(
'
a
*
(
'
a
,
'
b
)
result
list
)
list
->
unit
(
prob_id
->
prob_id
->
int
)
->
(
formatter
->
tool_id
->
unit
)
->
(
formatter
->
prob_id
->
unit
)
->
bench
*
(
tool_id
*
result
list
)
list
->
unit
src/bench/benchrc.ml
View file @
4922dbf0
...
...
@@ -27,9 +27,9 @@ open Theory
type
id_tool
=
(
string
*
string
)
type
id_prob
=
(
string
*
string
*
string
)
type
benchrc
=
{
tools
:
id_tool
tool
list
Mstr
.
t
;
probs
:
id_prob
prob
list
Mstr
.
t
;
benchs
:
(
id_tool
,
id_prob
)
bench
Mstr
.
t
type
benchrc
=
{
tools
:
tool
list
Mstr
.
t
;
probs
:
prob
list
Mstr
.
t
;
benchs
:
bench
Mstr
.
t
}
open
Whyconf
...
...
@@ -54,9 +54,9 @@ let read_tools absf wc map (name,section) =
let
env
=
Lexer
.
create_env
loadpath
in
(* transformations *)
let
transforms
=
get_stringl
~
default
:
[]
section
"transform"
in
let
lookup
acc
t
=
Trans
.
compose
(
Trans
.
lookup_transform
t
env
)
acc
in
let
transforms
=
List
.
fold_left
lookup
Trans
.
identity
transforms
in
let
lookup
acc
t
=
(
Trans
.
lookup_transform
t
env
,
None
)
::
acc
in
let
transforms
=
List
.
fold_left
lookup
[]
transforms
in
let
transforms
=
List
.
rev
transforms
in
(* use *)
let
use
=
get_stringl
~
default
:
[]
section
"use"
in
let
load_use
task
s
=
...
...
@@ -84,12 +84,13 @@ let read_tools absf wc map (name,section) =
let
load_driver
(
n
,
d
,
c
)
=
n
,
Driver
.
load_driver
env
d
,
c
in
let
provers
=
List
.
map
load_driver
provers
in
let
create_tool
(
n
,
driver
,
command
)
=
{
tval
=
name
,
n
;
{
tval
=
{
tool_name
=
name
;
prover_name
=
n
;
tool_db
=
None
}
;
ttrans
=
transforms
;
tdriver
=
driver
;
tcommand
=
command
;
tenv
=
env
;
tuse
=
use
;
tuse_trans
=
None
;
ttime
=
timelimit
;
tmem
=
memlimit
}
in
...
...
@@ -99,12 +100,12 @@ let read_probs absf map (name,section) =
(* transformations *)
let
transforms
=
get_stringl
~
default
:
[]
section
"transform"
in
let
gen_trans
env
=
let
lookup
acc
t
=
Trans
.
compose_l
(
try
Trans
.
singleton
(
Trans
.
lookup_transform
t
env
)
with
Trans
.
UnknownTrans
_
->
Trans
.
lookup_transform_l
t
env
)
acc
let
lookup
acc
t
=
(
(
try
Trans
.
singleton
(
Trans
.
lookup_transform
t
env
)
with
Trans
.
UnknownTrans
_
->
Trans
.
lookup_transform_l
t
env
)
,
None
)
::
acc
in
let
transforms
=
List
.
fold_left
lookup
Trans
.
identity_l
transforms
in
transforms
let
transforms
=
List
.
fold_left
lookup
[]
transforms
in
List
.
rev
transforms
in
(* format *)
let
format
=
get_stringo
section
"format"
in
...
...
@@ -117,7 +118,9 @@ let read_probs absf map (name,section) =
let
m
=
Env
.
read_channel
?
format
:
format
env
fname
cin
in
close_in
cin
;
let
ths
=
Mnm
.
bindings
m
in
List
.
rev_map
(
fun
(
n
,
th
)
->
((
name
,
fname
,
n
)
,
th
))
ths
let
prob_id
n
=
{
prob_name
=
name
;
prob_file
=
fname
;
prob_theory
=
n
;
prob_db
=
None
}
in
List
.
rev_map
(
fun
(
n
,
th
)
->
(
prob_id
n
,
th
))
ths
in
let
map
(
name
,
th
)
=
name
,
Task
.
split_theory
th
None
task
in
let
fold
acc
(
n
,
l
)
=
...
...
src/bench/benchrc.mli
View file @
4922dbf0
...
...
@@ -44,15 +44,9 @@ open Why
open
Util
type
id_tool
=
(
string
*
string
)
(* tool_name, prover_name *)
type
id_prob
=
(
string
*
string
*
string
)
(* prob_name, file_name, theory name *)
type
benchrc
=
{
tools
:
id_tool
tool
list
Mstr
.
t
;
probs
:
id_prob
prob
list
Mstr
.
t
;
benchs
:
(
id_tool
,
id_prob
)
bench
Mstr
.
t
type
benchrc
=
{
tools
:
tool
list
Mstr
.
t
;
probs
:
prob
list
Mstr
.
t
;
benchs
:
bench
Mstr
.
t
}
val
read_file
:
Whyconf
.
config
->
string
->
benchrc
src/bench/whybench.ml
View file @
4922dbf0
...
...
@@ -310,12 +310,13 @@ let () =
let
prover
=
try
Mstr
.
find
s
(
get_provers
config
)
with
|
Not_found
->
eprintf
"Prover %s not found.@."
s
;
exit
1
in
{
B
.
tval
=
"cmdline"
,
s
;
ttrans
=
Trans
.
identity
;
{
B
.
tval
=
{
B
.
tool_name
=
"cmdline"
;
prover_name
=
s
;
tool_db
=
None
}
;
ttrans
=
[
Trans
.
identity
,
None
]
;
tdriver
=
load_driver
env
prover
.
driver
;
tcommand
=
prover
.
command
;
tenv
=
env
;
tuse
=
!
opt_task
;
tuse_trans
=
None
;
ttime
=
of_option
!
opt_timelimit
;
tmem
=
of_option
!
opt_memlimit
;
}
in
...
...
@@ -324,11 +325,11 @@ let () =
Debug
.
dprintf
debug
"Load transformations@."
;
let
transl
=
let
lookup
acc
t
=
Trans
.
compose_l
(
try
Trans
.
singleton
(
Trans
.
lookup_transform
t
env
)
with
Trans
.
UnknownTrans
_
->
Trans
.
lookup_transform_l
t
env
)
acc
let
lookup
acc
t
=
(
(
try
Trans
.
singleton
(
Trans
.
lookup_transform
t
env
)
with
Trans
.
UnknownTrans
_
->
Trans
.
lookup_transform_l
t
env
)
,
None
)
::
acc
in
List
.
fold_left
lookup
Trans
.
identity_l
!
opt_trans
in
List
.
rev
(
List
.
fold_left
lookup
[]
!
opt_trans
)
in
let
fold_prob
acc
=
function
|
None
,
_
->
acc
...
...
@@ -343,7 +344,10 @@ let () =
let
th
=
Mnm
.
bindings
m
in
let
map
(
name
,
th
)
=
name
,
Task
.
split_theory
th
None
task
in
let
fold
acc
(
n
,
l
)
=
List
.
rev_append
(
List
.
map
(
fun
v
->
((
"cmdline"
,
""
,
n
)
,
v
))
l
)
acc
in
let
prob_id
=
{
B
.
prob_name
=
"cmdline"
;
prob_file
=
""
;
prob_theory
=
n
;
prob_db
=
None
}
in
List
.
rev_append
(
List
.
map
(
fun
v
->
(
prob_id
,
v
))
l
)
acc
in
th
|>
List
.
map
map
|>
List
.
fold_left
fold
[]
in
{
B
.
ptask
=
gen
;
ptrans
=
fun
_
->
transl
;
...
...
@@ -375,7 +379,7 @@ let () =
let
nb_done
=
ref
0
in
let
nb_valid
=
ref
0
in
let
nb_failure
=
ref
0
in
let
callback
(
_
,
tool
)
(
_
,
file
,
prob
)
task
i
res
=
let
callback
tool_id
prob_id
task
i
res
=
if
not
!
opt_quiet
then
begin
begin
match
res
with
|
B
.
Done
{
Call_provers
.
pr_answer
=
ans
}
->
incr
nb_done
;
...
...
@@ -388,15 +392,18 @@ let () =
!
nb_done
!
nb_valid
!
nb_failure
end
;
Debug
.
dprintf
debug
"%s.%s %a %i with %s : %a@."
file
prob
Pretty
.
print_pr
(
task_goal
task
)
i
tool
prob_id
.
B
.
prob_file
prob_id
.
B
.
prob_theory
Pretty
.
print_pr
(
task_goal
task
)
i
tool_id
.
B
.
tool_name
B
.
print_why_result
res
;
in
let
benchs
=
List
.
map
(
fun
b
->
List
.
map
snd
(
Mstr
.
bindings
b
.
Benchrc
.
benchs
))
!
benchs
in
let
bl
=
B
.
run_benchs_tools
~
callback
(
list_flatten_rev
benchs
)
in
let
print_tool
fmt
(
t
,
s
)
=
fprintf
fmt
"%s.%s"
t
s
in
let
print_prob
fmt
(
b
,
f
,
t
)
=
fprintf
fmt
"%s.%s.%s"
b
f
t
in
let
print_tool
fmt
tool_id
=
fprintf
fmt
"%s.%s"
tool_id
.
B
.
tool_name
tool_id
.
B
.
prover_name
in
let
print_prob
fmt
prob_id
=
fprintf
fmt
"%s.%s.%s"
prob_id
.
B
.
prob_name
prob_id
.
B
.
prob_file
prob_id
.
B
.
prob_theory
in
let
cmp
=
compare
in
List
.
iter
(
B
.
print_output
cmp
print_tool
print_prob
)
bl
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment