Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
f4f6c6c1
Commit
f4f6c6c1
authored
Dec 30, 2015
by
David Hauzar
Browse files
Merge branch 'counter-examples'
parents
2a6e896f
01fab6cc
Changes
22
Hide whitespace changes
Inline
Side-by-side
doc/manpages.tex
View file @
f4f6c6c1
...
...
@@ -450,6 +450,20 @@ are grouped together under several tabs.
decision by clicking on it.
\end{description}
% \subsection{Displaying Counterexamples}
%
% how to use counterexamples - explain labels, projections, the option --get-ce of why3prove and the setting in why3ide
%
% problem with set logic and counterexamples
%
% which provers
%
% where it is displayed
%
% how to interpret the display
%
% example
\subsection
{
Additional Command-Line Options
}
The
\texttt
{
ide
}
command also accepts the following options described for the command
\texttt
{
prove
}
in Section~
\ref
{
sec:proveoptions
}
.
...
...
drivers/cvc4_15.drv
View file @
f4f6c6c1
...
...
@@ -12,9 +12,6 @@ prelude "(set-logic AUFBVDTLIRA)"
does not seem to include DT
*)
(* Counterexamples: makes it possible to get rid of more quantifiers while introducing premises *)
(* transformation "split_intro" *)
(* Counterexamples: set model parser *)
model_parser "smtv2"
...
...
@@ -24,9 +21,7 @@ import "discrimination.gen"
transformation "inline_trivial"
transformation "eliminate_builtin"
(* temporarily disabled: too much experimental
transformation "detect_polymorphism"
*)
transformation "eliminate_definition_if_poly"
transformation "eliminate_inductive"
transformation "eliminate_algebraic_if_poly"
...
...
examples/tests/cvc4-models.mlw
View file @
f4f6c6c1
...
...
@@ -22,7 +22,11 @@ module M
ensures { !x < old !x }
=
incr x;
while "model" "model_trace:cond" !x > 0 do invariant { !x >= 0 } variant { !x } x := !x - 1 done
while "model" "model_trace:cond" !x > 0 do
invariant { !x >= 0 }
variant { !x }
x := !x - 1
done
(**************************************
** Getting counterexamples for maps **
...
...
examples/use_api/create_session.ml
View file @
f4f6c6c1
...
...
@@ -93,6 +93,7 @@ let add_proofs_attempts g =
~
obsolete
:
true
~
archived
:
false
~
timelimit
:
5
~
steplimit
:
(
-
1
)
~
memlimit
:
1000
~
edit
:
None
g
p
.
Whyconf
.
prover
Session
.
Scheduled
...
...
@@ -106,5 +107,3 @@ let () =
(* save the session on disk *)
let
()
=
Session
.
save_session
config
env_session
.
Session
.
session
src/coq-tactic/why3tac.ml4
View file @
f4f6c6c1
...
...
@@ -1285,7 +1285,7 @@ let why3tac ?(timelimit=timelimit) s gl =
match res.pr_answer with
| Valid -> admit_as_an_axiom gl
| Invalid -> error "Invalid"
| Unknown
s
-> error ("Don't know: " ^ s)
|
Call_provers.
Unknown
(s, _)
-> error ("Don't know: " ^ s)
| Call_provers.Failure s -> error ("Failure: " ^ s)
| Call_provers.Timeout -> error "Timeout"
| OutOfMemory -> error "Out Of Memory"
...
...
src/driver/call_provers.ml
View file @
f4f6c6c1
...
...
@@ -16,6 +16,29 @@ let debug = Debug.register_info_flag "call_prover"
~
desc
:
"Print@ debugging@ messages@ about@ prover@ calls@ \
and@ keep@ temporary@ files."
type
reason_unknown
=
|
Resourceout
|
Other
type
prover_answer
=
|
Valid
|
Invalid
|
Timeout
|
OutOfMemory
|
StepLimitExceeded
|
Unknown
of
(
string
*
reason_unknown
option
)
|
Failure
of
string
|
HighFailure
type
prover_result
=
{
pr_answer
:
prover_answer
;
pr_status
:
Unix
.
process_status
;
pr_output
:
string
;
pr_time
:
float
;
pr_steps
:
int
;
(* -1 if unknown *)
pr_model
:
model
;
}
(** time regexp "%h:%m:%s" *)
type
timeunit
=
|
Hour
...
...
@@ -83,26 +106,15 @@ let rec grep_steps out = function
with
_
->
grep_steps
out
l
end
(** *)
type
prover_answer
=
|
Valid
|
Invalid
|
Timeout
|
OutOfMemory
|
StepLimitExceeded
|
Unknown
of
string
|
Failure
of
string
|
HighFailure
type
prover_result
=
{
pr_answer
:
prover_answer
;
pr_status
:
Unix
.
process_status
;
pr_output
:
string
;
pr_time
:
float
;
pr_steps
:
int
;
(* -1 if unknown *)
pr_model
:
model
;
}
let
grep_reason_unknown
out
=
try
let
re
=
Str
.
regexp
"^(:reason-unknown
\\
([^)]*
\\
)"
in
ignore
(
Str
.
search_forward
re
out
0
);
match
(
Str
.
matched_group
1
out
)
with
|
"resourceout"
->
Resourceout
|
_
->
Other
with
Not_found
->
Other
type
prover_result_parser
=
{
prp_regexps
:
(
Str
.
regexp
*
prover_answer
)
list
;
...
...
@@ -112,15 +124,20 @@ type prover_result_parser = {
prp_model_parser
:
Model_parser
.
model_parser
;
}
let
print_unknown_reason
fmt
r
=
match
r
with
|
Some
Resourceout
->
fprintf
fmt
" because of resource limit reached "
|
_
->
()
let
print_prover_answer
fmt
=
function
|
Valid
->
fprintf
fmt
"Valid"
|
Invalid
->
fprintf
fmt
"Invalid"
|
Timeout
->
fprintf
fmt
"Timeout"
|
OutOfMemory
->
fprintf
fmt
"Ouf Of Memory"
|
StepLimitExceeded
->
fprintf
fmt
"Step limit exceeded"
|
Unknown
""
->
fprintf
fmt
"Unknown
"
|
Unknown
(
""
,
r
)
->
fprintf
fmt
"Unknown
%a"
print_unknown_reason
r
|
Failure
""
->
fprintf
fmt
"Failure"
|
Unknown
s
->
fprintf
fmt
"Unknown (%s)"
s
|
Unknown
(
s
,
r
)
->
fprintf
fmt
"Unknown
%a
(%s)"
print_unknown_reason
r
s
|
Failure
s
->
fprintf
fmt
"Failure (%s)"
s
|
HighFailure
->
fprintf
fmt
"HighFailure"
...
...
@@ -151,7 +168,7 @@ let rec grep out l = match l with
ignore
(
Str
.
search_forward
re
out
0
);
match
pa
with
|
Valid
|
Invalid
|
Timeout
|
OutOfMemory
|
StepLimitExceeded
->
pa
|
Unknown
s
->
Unknown
(
Str
.
replace_matched
s
out
)
|
Unknown
(
s
,
ru
)
->
Unknown
(
(
Str
.
replace_matched
s
out
)
,
ru
)
|
Failure
s
->
Failure
(
Str
.
replace_matched
s
out
)
|
HighFailure
->
assert
false
with
Not_found
->
grep
out
l
end
...
...
@@ -188,6 +205,10 @@ let parse_prover_run res_parser time out ret on_timelimit timelimit ~printer_map
Debug
.
dprintf
debug
"Call_provers: prover output:@
\n
%s@."
out
;
let
time
=
Opt
.
get_def
(
time
)
(
grep_time
out
res_parser
.
prp_timeregexps
)
in
let
steps
=
Opt
.
get_def
(
-
1
)
(
grep_steps
out
res_parser
.
prp_stepregexps
)
in
let
reason_unknown
=
grep_reason_unknown
out
in
let
ans
=
match
ans
with
|
Unknown
(
s
,
_
)
->
Unknown
(
s
,
Some
reason_unknown
)
|
_
->
ans
in
let
ans
=
match
ans
with
|
Unknown
_
|
HighFailure
when
on_timelimit
&&
timelimit
>
0
&&
time
>=
(
0
.
9
*.
float
timelimit
)
->
Timeout
...
...
src/driver/call_provers.mli
View file @
f4f6c6c1
...
...
@@ -15,6 +15,13 @@ open Model_parser
(** {2 data types for prover answers} *)
(** The reason why unknown was reported *)
type
reason_unknown
=
|
Resourceout
(** Out of resources *)
|
Other
(** Other reason *)
type
prover_answer
=
|
Valid
(** The task is valid according to the prover *)
...
...
@@ -26,7 +33,7 @@ type prover_answer =
(** the task runs out of memory *)
|
StepLimitExceeded
(** the task required more steps than the limit provided *)
|
Unknown
of
string
|
Unknown
of
(
string
*
reason_unknown
option
)
(** The prover can't determine if the task is valid *)
|
Failure
of
string
(** The prover reports a failure *)
...
...
@@ -45,8 +52,8 @@ type prover_result = {
(** The time taken by the prover *)
pr_steps
:
int
;
(** The number of steps taken by the prover (-1 if not available) *)
(** The model produced by a the solver *)
pr_model
:
model
;
(** The model produced by a the solver *)
}
val
print_prover_answer
:
Format
.
formatter
->
prover_answer
->
unit
...
...
src/driver/driver.ml
View file @
f4f6c6c1
...
...
@@ -92,7 +92,7 @@ let load_driver = let driver_tag = ref (-1) in fun env file extra_files ->
|
RegexpOutOfMemory
s
->
add_to_list
regexps
(
Str
.
regexp
s
,
OutOfMemory
)
|
RegexpStepLimitExceeded
s
->
add_to_list
regexps
(
Str
.
regexp
s
,
StepLimitExceeded
)
|
RegexpUnknown
(
s
,
t
)
->
add_to_list
regexps
(
Str
.
regexp
s
,
Unknown
t
)
|
RegexpUnknown
(
s
,
t
)
->
add_to_list
regexps
(
Str
.
regexp
s
,
Unknown
(
t
,
None
)
)
|
RegexpFailure
(
s
,
t
)
->
add_to_list
regexps
(
Str
.
regexp
s
,
Failure
t
)
|
TimeRegexp
r
->
add_to_list
timeregexps
(
Call_provers
.
timeregexp
r
)
|
StepRegexp
(
r
,
ns
)
->
...
...
@@ -103,7 +103,7 @@ let load_driver = let driver_tag = ref (-1) in fun env file extra_files ->
|
ExitCodeOutOfMemory
s
->
add_to_list
exitcodes
(
s
,
OutOfMemory
)
|
ExitCodeStepLimitExceeded
s
->
add_to_list
exitcodes
(
s
,
StepLimitExceeded
)
|
ExitCodeUnknown
(
s
,
t
)
->
add_to_list
exitcodes
(
s
,
Unknown
t
)
|
ExitCodeUnknown
(
s
,
t
)
->
add_to_list
exitcodes
(
s
,
Unknown
(
t
,
None
)
)
|
ExitCodeFailure
(
s
,
t
)
->
add_to_list
exitcodes
(
s
,
Failure
t
)
|
Filename
s
->
set_or_raise
loc
filename
s
"filename"
|
Printer
s
->
set_or_raise
loc
printer
s
"printer"
...
...
src/driver/parse_smtv2_model_lexer.mll
View file @
f4f6c6c1
...
...
@@ -13,6 +13,7 @@ rule token = parse
{
token
lexbuf
}
|
space
+
as
space_str
{
SPACE
(
space_str
)
}
|
"mk_t__ref"
(
num
*
)
{
MK_T_REF
}
|
"store"
{
STORE
}
|
"const"
{
CONST
}
|
"as"
{
AS
}
...
...
src/driver/parse_smtv2_model_parser.mly
View file @
f4f6c6c1
...
...
@@ -13,6 +13,7 @@
%
token
<
string
*
string
>
DEC_STR
%
token
<
string
*
string
>
MINUS_DEC_STR
%
token
LPAREN
RPAREN
%
token
MK_T_REF
%
token
EOF
%%
...
...
@@ -53,6 +54,7 @@ text_without_int:
|
AS
{
"as"
}
value
:
|
LPAREN
MK_T_REF
SPACE
value
RPAREN
{
$
4
}
|
integer
{
$
1
}
|
decimal
{
$
1
}
|
other_val_str
{
Model_parser
.
Unparsed
$
1
}
...
...
src/ide/gmain.ml
View file @
f4f6c6c1
...
...
@@ -1016,7 +1016,7 @@ let prover_on_selected_goals pr =
M
.
run_prover
(
env_session
()
)
sched
~
context_unproved_goals_only
:!
context_unproved_goals_only
~
cntexample
~
timelimit
~
memlimit
~
cntexample
~
timelimit
~
steplimit
:
(
-
1
)
~
memlimit
pr
a
with
e
->
eprintf
"@[Exception raised while running a prover:@ %a@.@]"
...
...
@@ -1541,11 +1541,11 @@ let test_strategy () =
Whyconf
.
filter_one_prover
config
fp
in
[
|
Strategy
.
Icall_prover
(
altergo
.
Whyconf
.
prover
,
1
,
1000
);
Strategy
.
Icall_prover
(
cvc4
.
Whyconf
.
prover
,
1
,
1000
);
Strategy
.
Icall_prover
(
altergo
.
Whyconf
.
prover
,
1
,
-
1
,
1000
);
Strategy
.
Icall_prover
(
cvc4
.
Whyconf
.
prover
,
1
,
0
,
1000
);
Strategy
.
Itransform
(
split_transformation
,
0
);
(* goto 0 on success *)
Strategy
.
Icall_prover
(
altergo
.
Whyconf
.
prover
,
10
,
4000
);
Strategy
.
Icall_prover
(
cvc4
.
Whyconf
.
prover
,
10
,
4000
);
Strategy
.
Icall_prover
(
altergo
.
Whyconf
.
prover
,
10
,
-
1
,
4000
);
Strategy
.
Icall_prover
(
cvc4
.
Whyconf
.
prover
,
10
,
-
1
,
4000
);
|
]
(*
...
...
src/printer/smtv2.ml
View file @
f4f6c6c1
...
...
@@ -176,11 +176,33 @@ let model_label = Ident.create_label "model"
let
model_vc_term_label
=
Ident
.
create_label
"model_vc"
(* This label identifies the term that triggers the VC. *)
let
add_model_element
el
info_model
=
(** Add element el (term) to info_model.
If an element with the same hash (the same set of labels + the same
location) as the element el already exists in info_model, replace it with el.
The reason is that we do not want to display two model elements with the same
name in the same location and usually it is better to display the last one.
Note that two model elements can have the same name and location if why is used
as an intemediate language and the locations are locations in the source language.
Then, more why constructs (terms) can represent a single construct in the source
language and more terms have thus the same model name and location. This happens,
e.g., if why code is generated from SPARK. There, the first iteration of while
cycle is unrolled in some cases. If the task contains both a term representing a
variable in the first iteration of unrolled loop and a term representing the variable
in the subsequent loop iterations, only the latter is relevant for the counterexample
and it is the one that comes after the former one (and that is why we always keep the
last term).
*)
let
info_model
=
S
.
remove
el
info_model
in
S
.
add
el
info_model
let
collect_model_ls
info
ls
=
if
ls
.
ls_args
=
[]
&&
Slab
.
mem
model_label
ls
.
ls_name
.
id_label
then
let
t
=
t_app
ls
[]
ls
.
ls_value
in
info
.
info_model
<-
S
.
add
add
_model_element
(
t_label
?
loc
:
ls
.
ls_name
.
id_loc
ls
.
ls_name
.
id_label
t
)
info
.
info_model
let
model_trace_regexp
=
Str
.
regexp
"model_trace:"
...
...
@@ -267,7 +289,7 @@ let rec print_term info fmt t =
debug_print_term
"Printing term: "
t
;
if
Slab
.
mem
model_label
t
.
t_label
then
info
.
info_model
<-
S
.
add
t
info
.
info_model
;
info
.
info_model
<-
add
_model_element
t
info
.
info_model
;
check_enter_vc_term
t
info
;
...
...
@@ -318,7 +340,7 @@ let rec print_term info fmt t =
model_trace_for_postcondition
~
labels
:
ls
.
ls_name
.
id_label
info
in
let
_t_check_pos
=
t_label
~
loc
labels
t
in
(* TODO: temporarily disable collecting variables inside the term triggering VC *)
(*info.info_model <-
S.
add t_check_pos info.info_model;*)
(*info.info_model <- add
_model_element
t_check_pos info.info_model;*)
()
end
;
fprintf
fmt
"@[%a@]"
print_ident
ls
.
ls_name
...
...
@@ -361,7 +383,7 @@ let rec print_term info fmt t =
and
print_fmla
info
fmt
f
=
debug_print_term
"Printing formula: "
f
;
if
Slab
.
mem
model_label
f
.
t_label
then
info
.
info_model
<-
S
.
add
f
info
.
info_model
;
info
.
info_model
<-
add
_model_element
f
info
.
info_model
;
check_enter_vc_term
f
info
;
...
...
@@ -560,6 +582,8 @@ let print_prop_decl vc_loc cntexample args info fmt k pr f = match k with
let
model_list
=
S
.
elements
info
.
info_model
in
fprintf
fmt
"@[(check-sat)@]@
\n
"
;
print_info_model
cntexample
fmt
model_list
info
;
(* (get-info :reason-unknown) *)
fprintf
fmt
"@[(get-info :reason-unknown)@]@
\n
"
;
args
.
printer_mapping
<-
{
lsymbol_m
=
args
.
printer_mapping
.
lsymbol_m
;
vc_term_loc
=
vc_loc
;
...
...
src/session/session.ml
View file @
f4f6c6c1
...
...
@@ -158,6 +158,7 @@ and 'a proof_attempt =
proof_parent
:
'
a
goal
;
mutable
proof_state
:
proof_attempt_status
;
mutable
proof_timelimit
:
int
;
mutable
proof_steplimit
:
int
;
mutable
proof_memlimit
:
int
;
mutable
proof_obsolete
:
bool
;
mutable
proof_archived
:
bool
;
...
...
@@ -490,10 +491,10 @@ let get_used_provers_with_stats session =
(
fun
pa
->
(* record mostly used pa.proof_timelimit pa.proof_memlimit *)
let
prover
=
pa
.
proof_prover
in
let
timelimits
,
memlimits
=
let
timelimits
,
steplimits
,
memlimits
=
try
PHprover
.
find
prover_table
prover
with
Not_found
->
let
x
=
(
Hashtbl
.
create
5
,
Hashtbl
.
create
5
)
in
let
x
=
(
Hashtbl
.
create
5
,
Hashtbl
.
create
5
,
Hashtbl
.
create
5
)
in
PHprover
.
add
prover_table
prover
x
;
x
in
...
...
@@ -501,11 +502,16 @@ let get_used_provers_with_stats session =
try
Hashtbl
.
find
timelimits
pa
.
proof_timelimit
with
Not_found
->
0
in
let
sf
=
try
Hashtbl
.
find
steplimits
pa
.
proof_steplimit
with
Not_found
->
0
in
let
mf
=
try
Hashtbl
.
find
memlimits
pa
.
proof_timelimit
with
Not_found
->
0
in
Hashtbl
.
replace
timelimits
pa
.
proof_timelimit
(
tf
+
1
);
Hashtbl
.
replace
steplimits
pa
.
proof_steplimit
(
sf
+
1
);
Hashtbl
.
replace
memlimits
pa
.
proof_memlimit
(
mf
+
1
))
session
;
prover_table
...
...
@@ -578,11 +584,12 @@ let save_int_def name def fmt n =
let
opt_string
=
opt
save_string
let
save_proof_attempt
fmt
((
id
,
tl
,
ml
)
,
a
)
=
let
save_proof_attempt
fmt
((
id
,
tl
,
sl
,
ml
)
,
a
)
=
fprintf
fmt
"@
\n
@[<h><proof@ prover=
\"
%i
\"
%a%a%a%a%a>"
"@
\n
@[<h><proof@ prover=
\"
%i
\"
%a%a%a%a%a
%a
>"
id
(
save_int_def
"timelimit"
tl
)
a
.
proof_timelimit
(
save_int_def
"steplimit"
sl
)
a
.
proof_steplimit
(
save_int_def
"memlimit"
ml
)
a
.
proof_memlimit
(
opt_string
"edited"
)
a
.
proof_edited_as
(
save_bool_def
"obsolete"
false
)
a
.
proof_obsolete
...
...
@@ -603,7 +610,7 @@ module Compr = Compress.Compress_z
type
save_ctxt
=
{
prover_ids
:
int
PHprover
.
t
;
provers
:
(
int
*
int
*
int
)
Mprover
.
t
;
provers
:
(
int
*
int
*
int
*
int
)
Mprover
.
t
;
ch_shapes
:
Compr
.
out_channel
;
}
...
...
@@ -633,7 +640,7 @@ let rec save_goal ctxt fmt g =
let
l
=
PHprover
.
fold
(
fun
_
a
acc
->
(
Mprover
.
find
a
.
proof_prover
ctxt
.
provers
,
a
)
::
acc
)
g
.
goal_external_proofs
[]
in
let
l
=
List
.
sort
(
fun
((
i1
,_,_
)
,_
)
((
i2
,_,_
)
,_
)
->
compare
i1
i2
)
l
in
let
l
=
List
.
sort
(
fun
((
i1
,_,_
,_
)
,_
)
((
i2
,_,_
,_
)
,_
)
->
compare
i1
i2
)
l
in
List
.
iter
(
save_proof_attempt
fmt
)
l
;
let
l
=
PHstr
.
fold
(
fun
_
t
acc
->
t
::
acc
)
g
.
goal_transformations
[]
in
let
l
=
List
.
sort
(
fun
t1
t2
->
compare
t1
.
transf_name
t2
.
transf_name
)
l
in
...
...
@@ -746,13 +753,19 @@ let save_file ctxt fmt _ f =
List
.
iter
(
save_theory
ctxt
fmt
)
f
.
file_theories
;
fprintf
fmt
"@]@
\n
</file>"
let
get_prover_to_save
prover_ids
p
(
timelimits
,
memlimits
)
provers
=
let
get_prover_to_save
prover_ids
p
(
timelimits
,
steplimits
,
memlimits
)
provers
=
let
mostfrequent_timelimit
,_
=
Hashtbl
.
fold
(
fun
t
f
((
_
,
f'
)
as
t'
)
->
if
f
>
f'
then
(
t
,
f
)
else
t'
)
timelimits
(
0
,
0
)
in
let
mostfrequent_steplimit
,_
=
Hashtbl
.
fold
(
fun
s
f
((
_
,
f'
)
as
s'
)
->
if
f
>
f'
then
(
s
,
f
)
else
s'
)
steplimits
(
0
,
0
)
in
let
mostfrequent_memlimit
,_
=
Hashtbl
.
fold
(
fun
m
f
((
_
,
f'
)
as
m'
)
->
if
f
>
f'
then
(
m
,
f
)
else
m'
)
...
...
@@ -778,17 +791,17 @@ let get_prover_to_save prover_ids p (timelimits,memlimits) provers =
PHprover
.
add
prover_ids
p
!
id
;
!
id
in
Mprover
.
add
p
(
id
,
mostfrequent_timelimit
,
mostfrequent_memlimit
)
provers
Mprover
.
add
p
(
id
,
mostfrequent_timelimit
,
mostfrequent_
steplimit
,
mostfrequent_
memlimit
)
provers
let
save_prover
fmt
id
(
p
,
mostfrequent_timelimit
,
mostfrequent_memlimit
)
=
let
save_prover
fmt
id
(
p
,
mostfrequent_timelimit
,
mostfrequent_
steplimit
,
mostfrequent_
memlimit
)
=
fprintf
fmt
"@
\n
@[<h><prover@ id=
\"
%i
\"
@ name=
\"
%a
\"
@ \
version=
\"
%a
\"
%a@ timelimit=
\"
%d
\"
@ memlimit=
\"
%d
\"
/>@]"
version=
\"
%a
\"
%a@ timelimit=
\"
%d
\"
@
steplimit=
\"
%d
\"
@
memlimit=
\"
%d
\"
/>@]"
id
save_string
p
.
C
.
prover_name
save_string
p
.
C
.
prover_version
(
fun
fmt
s
->
if
s
<>
""
then
fprintf
fmt
"@ alternative=
\"
%a
\"
"
save_string
s
)
p
.
C
.
prover_altern
mostfrequent_timelimit
mostfrequent_memlimit
mostfrequent_timelimit
mostfrequent_steplimit
mostfrequent_memlimit
let
save
fname
shfname
_config
session
=
let
ch
=
open_out
fname
in
...
...
@@ -811,8 +824,8 @@ let save fname shfname _config session =
in
let
provers_to_save
=
Mprover
.
fold
(
fun
p
(
id
,
mostfrequent_timelimit
,
mostfrequent_memlimit
)
acc
->
Mint
.
add
id
(
p
,
mostfrequent_timelimit
,
mostfrequent_memlimit
)
acc
)
(
fun
p
(
id
,
mostfrequent_timelimit
,
mostfrequent_
steplimit
,
mostfrequent_
memlimit
)
acc
->
Mint
.
add
id
(
p
,
mostfrequent_timelimit
,
mostfrequent_
steplimit
,
mostfrequent_
memlimit
)
acc
)
provers
Mint
.
empty
in
Mint
.
iter
(
save_prover
fmt
)
provers_to_save
;
...
...
@@ -936,7 +949,7 @@ type 'a keygen = ?parent:'a -> unit -> 'a
let
add_external_proof
?
(
notify
=
notify
)
~
(
keygen
:
'
a
keygen
)
~
obsolete
~
archived
~
timelimit
~
memlimit
~
edit
(
g
:
'
a
goal
)
p
result
=
~
archived
~
timelimit
~
steplimit
~
memlimit
~
edit
(
g
:
'
a
goal
)
p
result
=
assert
(
edit
<>
Some
""
);
let
key
=
keygen
~
parent
:
g
.
goal_key
()
in
let
a
=
{
proof_prover
=
p
;
...
...
@@ -946,6 +959,7 @@ let add_external_proof
proof_archived
=
archived
;
proof_state
=
result
;
proof_timelimit
=
timelimit
;
proof_steplimit
=
steplimit
;
proof_memlimit
=
memlimit
;
proof_edited_as
=
edit
;
}
...
...
@@ -1168,7 +1182,7 @@ let load_result r =
match
status
with
|
"valid"
->
Call_provers
.
Valid
|
"invalid"
->
Call_provers
.
Invalid
|
"unknown"
->
Call_provers
.
Unknown
""
|
"unknown"
->
Call_provers
.
Unknown
(
""
,
None
)
|
"timeout"
->
Call_provers
.
Timeout
|
"outofmemory"
->
Call_provers
.
OutOfMemory
|
"failure"
->
Call_provers
.
Failure
""
...
...
@@ -1194,7 +1208,7 @@ let load_result r =
Call_provers
.
pr_output
=
""
;
Call_provers
.
pr_status
=
Unix
.
WEXITED
0
;
Call_provers
.
pr_steps
=
steps
;
Call_provers
.
pr_model
=
Model_parser
.
default_model
Call_provers
.
pr_model
=
Model_parser
.
default_model
;
}
|
"undone"
->
Interrupted
|
"unedited"
->
Unedited
...
...
@@ -1231,7 +1245,7 @@ let load_ident elt =
Ident
.
id_register
preid
type
'
key
load_ctxt
=
{
old_provers
:
(
Whyconf
.
prover
*
int
*
int
)
Mint
.
t
;
old_provers
:
(
Whyconf
.
prover
*
int
*
int
*
int
)
Mint
.
t
;
keygen
:
'
key
keygen
;
}
...
...
@@ -1265,7 +1279,7 @@ and load_proof_or_transf ctxt mg a =
let
prover
=
string_attribute
"prover"
a
in
try
let
prover
=
int_of_string
prover
in
let
(
p
,
timelimit
,
memlimit
)
=
Mint
.
find
prover
ctxt
.
old_provers
in
let
(
p
,
timelimit
,
steplimit
,
memlimit
)
=
Mint
.
find
prover
ctxt
.
old_provers
in
let
res
=
match
a
.
Xml
.
elements
with
|
[
r
]
->
load_result
r
|
[]
->
Interrupted
...
...
@@ -1278,6 +1292,7 @@ and load_proof_or_transf ctxt mg a =
let
obsolete
=
bool_attribute
"obsolete"
a
false
in
let
archived
=
bool_attribute
"archived"
a
false
in
let
timelimit
=
int_attribute_def
"timelimit"
a
timelimit
in
let
steplimit
=
int_attribute_def
"steplimit"
a
steplimit
in
let
memlimit
=
int_attribute_def
"memlimit"
a
memlimit
in
(*
if timelimit < 0 then begin
...
...
@@ -1289,7 +1304,7 @@ and load_proof_or_transf ctxt mg a =
*)
let
(
_
:
'
a
proof_attempt
)
=
add_external_proof
~
keygen
:
ctxt
.
keygen
~
archived
~
obsolete
~
timelimit
~
memlimit
~
edit
mg
p
res
~
timelimit
~
steplimit
~
memlimit
~
edit
mg
p
res
in
()
with
Failure
_
|
Not_found
->
...
...
@@ -1476,11 +1491,12 @@ let load_file ~keygen session old_provers f =
let
version
=
string_attribute
"version"
f
in
let
altern
=
string_attribute_def
"alternative"
f
""
in
let
timelimit
=
int_attribute_def
"timelimit"
f
5
in
let
steplimit
=
int_attribute_def
"steplimit"
f
1
in
let
memlimit
=
int_attribute_def
"memlimit"
f
1000
in
let
p
=
{
C
.
prover_name
=
name
;
prover_version
=
version
;
prover_altern
=
altern
}
in
Mint
.
add
id
(
p
,
timelimit
,
memlimit
)
old_provers
Mint
.
add
id
(
p
,
timelimit
,
steplimit
,
memlimit
)
old_provers
with
Failure
_
->
Warning
.
emit
"[Warning] Session.load_file: unexpected non-numeric prover id '%s'@."
id
;
old_provers
...
...
@@ -1500,7 +1516,7 @@ let load_session ~keygen session xml =
List
.
fold_left
(
load_file
~
keygen
session
)
Mint
.
empty
xml
.
Xml
.
elements
in
Mint
.
iter
(
fun
id
(
p
,_,_
)
->
(
fun
id
(
p
,_,_
,_
)
->
Debug
.
dprintf
debug
"prover %d: %a@."
id
Whyconf
.
print_prover
p
;
PHprover
.
replace
session
.
session_prover_ids
p
id
)
old_provers
;
...
...
@@ -1909,7 +1925,7 @@ let ft_of_pa a =
But since it will be perhaps removed...
*)
let
copy_external_proof
?
notify
~
keygen
?
obsolete
?
archived
?
timelimit
?
memlimit
?
edit
?
notify
~
keygen
?
obsolete
?
archived
?
timelimit
?
steplimit
?
memlimit
?
edit
?
goal
?
prover
?
attempt_status
?
env_session
?
session
a
=
let
session
=
match
env_session
with
|
Some
eS
->
Some
eS
.
session
...
...
@@ -1917,6 +1933,7 @@ let copy_external_proof
let
obsolete
=
Opt
.
get_def
a
.
proof_obsolete
obsolete
in
let
archived
=
Opt
.
get_def
a
.
proof_archived
archived
in
let
timelimit
=
Opt
.
get_def
a
.
proof_timelimit
timelimit
in
let
steplimit
=
Opt
.
get_def
a
.
proof_steplimit
steplimit
in
let
memlimit
=
Opt
.
get_def
a
.
proof_memlimit
memlimit
in
let
pas
=
Opt
.
get_def
a
.
proof_state
attempt_status
in
let
ngoal
=
Opt
.
get_def
a
.
proof_parent
goal
in
...
...
@@ -1964,7 +1981,7 @@ let copy_external_proof
Some
(
dst_file
)
in
add_external_proof
?
notify
~
keygen
~
obsolete
~
archived
~
timelimit
~
memlimit
~
edit
ngoal
nprover
pas
~
obsolete
~
archived
~
timelimit
~
steplimit
~
memlimit
~
edit
ngoal
nprover
pas
exception
UnloadableProver
of
Whyconf
.
prover
...
...
@@ -2021,10 +2038,10 @@ let print_attempt_status fmt = function
|
InternalFailure
_
->
pp_print_string
fmt
"Failure"
let
print_external_proof
fmt
p
=
fprintf
fmt
"%a - %a (%i, %i)%s%s%s"
fprintf
fmt
"%a - %a (%i,
%i,
%i)%s%s%s"
Whyconf
.
print_prover
p
.
proof_prover
print_attempt_status
p
.
proof_state
p
.
proof_timelimit
p
.
proof_memlimit
p
.
proof_timelimit
p
.
proof_steplimit
p
.
proof_memlimit
(
if
p
.
proof_obsolete
then
" obsolete"
else
""
)
(
if
p
.
proof_archived
then
" archived"
else
""
)
(
if
p
.
proof_edited_as
<>
None
then
" edited"
else
""
)
...
...
@@ -2060,6 +2077,7 @@ let merge_proof ~keygen obsolete to_goal _ from_proof =
~
obsolete
~
archived
:
from_proof
.
proof_archived
~
timelimit
:
from_proof
.
proof_timelimit
~
steplimit
:
from_proof
.
proof_steplimit
~
memlimit
:
from_proof
.
proof_memlimit
~
edit
:
from_proof
.
proof_edited_as
to_goal
...
...