Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
caisar
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
pub
caisar
Commits
352a6235
Commit
352a6235
authored
3 years ago
by
Michele Alberti
Browse files
Options
Downloads
Patches
Plain Diff
Compute elapsed time for verifying a goal (in seconds).
parent
5ba5de6a
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
engine.ml
+56
-26
56 additions, 26 deletions
engine.ml
with
56 additions
and
26 deletions
engine.ml
+
56
−
26
View file @
352a6235
...
@@ -25,7 +25,14 @@ type task = {
...
@@ -25,7 +25,14 @@ type task = {
formula
:
string
;
formula
:
string
;
(* Verification result.
(* Verification result.
[None] means no verification yet. *)
[None] means no verification yet. *)
result
:
(
Solver
.
Result
.
t
,
string
)
Result
.
t
option
;
result
:
(
task_result
,
string
)
Result
.
t
option
;
}
(* Result of a well-terminated task. *)
and
task_result
=
{
(* Solver result. *)
solver_result
:
Solver
.
Result
.
t
;
(* Time elapsed to compute the result. *)
elapsed_time
:
float
;
}
}
let
check_availability
solver
config
=
let
check_availability
solver
config
=
...
@@ -137,7 +144,7 @@ let build_command ~raw_options solver config model task =
...
@@ -137,7 +144,7 @@ let build_command ~raw_options solver config model task =
with
Failure
e
->
with
Failure
e
->
Error
(
Format
.
sprintf
"Unexpected failure:@ %s."
e
)
Error
(
Format
.
sprintf
"Unexpected failure:@ %s."
e
)
let
extract_result
solver
~
log
~
output
=
let
extract_
solver_
result
solver
~
log
~
output
=
let
module
S
=
(
val
solver
:
Solver
.
S
)
in
let
module
S
=
(
val
solver
:
Solver
.
S
)
in
Logs
.
info
(
fun
m
->
m
"Extracting result of verification."
);
Logs
.
info
(
fun
m
->
m
"Extracting result of verification."
);
let
output
=
let
output
=
...
@@ -192,26 +199,33 @@ let exec_tasks ~raw_options solver config model tasks_htbl =
...
@@ -192,26 +199,33 @@ let exec_tasks ~raw_options solver config model tasks_htbl =
~
f
:
(
fun
subgoal
->
~
f
:
(
fun
subgoal
->
Format
.
sprintf
", subgoal %d (%s)"
Format
.
sprintf
", subgoal %d (%s)"
subgoal
task
.
id
)));
subgoal
task
.
id
)));
let
res_exec_task
=
let
task_result
=
(* Build the required command-line. *)
(* Build the required command-line. *)
build_command
~
raw_options
solver
config
model
task
build_command
~
raw_options
solver
config
model
task
>>=
fun
(
cmd
,
prop
,
log
,
output
)
->
>>=
fun
(
cmd
,
prop
,
log
,
output
)
->
(* Execute the command. *)
(* Execute the command. *)
Logs
.
info
(
fun
m
->
m
"Executing command `%s'."
cmd
);
Logs
.
info
(
fun
m
->
m
"Executing command `%s'."
cmd
);
try
try
let
start_time
=
Unix
.
gettimeofday
()
in
let
retcode
=
Sys
.
command
cmd
in
let
retcode
=
Sys
.
command
cmd
in
let
elapsed_time
=
Unix
.
gettimeofday
()
-.
start_time
in
(* We extract the solver result first before looking at
(* We extract the solver result first before looking at
[retcode] as the solver may crash after having produced a
[retcode] as the solver may crash after having produced a
result. *)
result. *)
let
result
=
extract_result
solver
~
log
~
output
in
let
solver_result
=
extract_solver_result
solver
~
log
~
output
in
if
retcode
<>
0
if
retcode
<>
0
&&
Solver
.
Result
.
equal
result
Solver
.
Result
.
Failure
&&
Solver
.
Result
.
equal
solver_
result
Solver
.
Result
.
Failure
then
then
Error
(
Format
.
sprintf
"Command `%s' has failed."
cmd
)
Error
(
Format
.
sprintf
"Command `%s' has failed."
cmd
)
else
begin
else
begin
Logs
.
app
(
fun
m
->
m
"Result of `%s': %a."
Logs
.
app
task
.
id
Solver
.
Result
.
pretty
result
);
(
fun
m
->
m
"Result of `%s': %a (%.3fs)."
if
Solver
.
Result
.
equal
result
Solver
.
Result
.
Failure
task
.
id
Solver
.
Result
.
pretty
solver_result
elapsed_time
);
if
Solver
.
Result
.
equal
solver_result
Solver
.
Result
.
Failure
then
then
Logs
.
app
(
fun
m
->
Logs
.
app
(
fun
m
->
m
"See error messages in `%s' for more information."
m
"See error messages in `%s' for more information."
...
@@ -221,12 +235,12 @@ let exec_tasks ~raw_options solver config model tasks_htbl =
...
@@ -221,12 +235,12 @@ let exec_tasks ~raw_options solver config model tasks_htbl =
Utils
.
remove_on_normal_mode
prop
;
Utils
.
remove_on_normal_mode
prop
;
Utils
.
remove_on_normal_mode
output
;
Utils
.
remove_on_normal_mode
output
;
end
;
end
;
Ok
result
Ok
{
solver_result
;
elapsed_time
;
}
end
end
with
_
->
with
_
->
Error
"Unexpected failure."
Error
"Unexpected failure."
in
in
{
task
with
result
=
Some
res_exec_task
;
}));
{
task
with
result
=
Some
task_result
;
}));
tasks_htbl
tasks_htbl
let
consolidate_task_results
solver
tasks_htbl
=
let
consolidate_task_results
solver
tasks_htbl
=
...
@@ -234,29 +248,41 @@ let consolidate_task_results solver tasks_htbl =
...
@@ -234,29 +248,41 @@ let consolidate_task_results solver tasks_htbl =
Hashtbl
.
map
Hashtbl
.
map
tasks_htbl
tasks_htbl
~
f
:
(
fun
tasks
->
~
f
:
(
fun
tasks
->
let
consolidated_result
=
let
consolidated_task_result
=
List
.
fold
tasks
~
init
:
None
List
.
fold
~
init
:
None
~
f
:
(
fun
accum
{
result
;
_
}
->
~
f
:
(
fun
accum
{
result
;
_
}
->
let
result
=
let
task_
result
=
match
result
with
match
result
with
|
None
->
None
|
None
->
|
Some
Ok
result
->
Some
result
None
|
Some
Error
_
->
Some
Failure
|
Some
Ok
result
->
Some
(
result
.
solver_result
,
result
.
elapsed_time
)
|
Some
Error
_
->
Some
(
Failure
,
0
.
)
in
in
match
accum
,
result
with
match
accum
,
task_result
with
|
_
,
None
->
accum
|
_
,
None
->
|
None
,
result
->
result
accum
|
Some
r1
,
Some
r2
->
Some
(
S
.
consolidate
r1
r2
))
|
None
,
result
->
result
|
Some
(
r1
,
t1
)
,
Some
(
r2
,
t2
)
->
Some
(
S
.
consolidate
r1
r2
,
t1
+.
t2
))
tasks
in
in
consolidated_result
,
tasks
)
consolidated_
task_
result
,
tasks
)
let
pretty_summary
tasks_htbl
=
let
pretty_summary
tasks_htbl
=
let
pretty_task_status
fmt
{
id
;
result
;
_
}
=
let
pretty_task_status
fmt
{
id
;
result
;
_
}
=
let
result
=
Option
.
value_exn
result
in
let
result
=
Option
.
value_exn
result
in
let
result_string
=
let
result_string
=
match
result
with
match
result
with
|
Ok
r
->
Format
.
asprintf
"%a"
Solver
.
Result
.
pretty
r
|
Ok
r
->
|
Error
msg
->
msg
Format
.
asprintf
"%a (%.3fs)"
Solver
.
Result
.
pretty
r
.
solver_result
r
.
elapsed_time
|
Error
msg
->
msg
in
in
Format
.
fprintf
fmt
"@[-- %s: @[<hov>%s@]@]"
id
result_string
Format
.
fprintf
fmt
"@[-- %s: @[<hov>%s@]@]"
id
result_string
in
in
...
@@ -269,10 +295,14 @@ let pretty_summary tasks_htbl =
...
@@ -269,10 +295,14 @@ let pretty_summary tasks_htbl =
(
Format
.
pp_print_list
~
pp_sep
:
Format
.
pp_print_space
pretty_task_status
)
(
Format
.
pp_print_list
~
pp_sep
:
Format
.
pp_print_space
pretty_task_status
)
tasks
tasks
in
in
let
pretty_goal_tasks
fmt
(
goalname
,
(
consolidated_result
,
tasks
))
=
let
pretty_goal_tasks
fmt
(
goalname
,
(
consolidated_task_result
,
tasks
))
=
Format
.
fprintf
fmt
"@[<v 2>- %s: @[%a@]%a@]"
let
consolidated_result
,
consolidated_time
=
Option
.
value_exn
consolidated_task_result
in
Format
.
fprintf
fmt
"@[<v 2>- %s: @[%a (%.3fs)@]%a@]"
goalname
goalname
Solver
.
Result
.
pretty
(
Option
.
value_exn
consolidated_result
)
Solver
.
Result
.
pretty
consolidated_result
consolidated_time
pretty_tasks
tasks
pretty_tasks
tasks
in
in
Logs
.
app
(
fun
m
->
Logs
.
app
(
fun
m
->
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment