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
119
Issues
119
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
d9855c53
Commit
d9855c53
authored
Sep 15, 2014
by
MARCHE Claude
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[session] theory checksum is now the combination of checksums of its subtasks.
parent
cde46567
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
114 additions
and
45 deletions
+114
-45
Makefile.in
Makefile.in
+2
-0
examples/use_api/create_session.ml
examples/use_api/create_session.ml
+0
-1
src/session/session.ml
src/session/session.ml
+81
-20
src/session/session.mli
src/session/session.mli
+6
-3
src/session/session_scheduler.ml
src/session/session_scheduler.ml
+3
-12
src/session/termcode.ml
src/session/termcode.ml
+12
-4
src/session/termcode.mli
src/session/termcode.mli
+9
-4
src/why3session/why3session_lib.ml
src/why3session/why3session_lib.ml
+1
-1
No files found.
Makefile.in
View file @
d9855c53
...
...
@@ -1106,6 +1106,7 @@ install_no_local::
cp
-r
lib/isabelle
"
$(LIBDIR)
/why3"
cp
drivers/isabelle-realizations.aux
"
$(DATADIR)
/why3/drivers/"
@
(
if
isabelle components
-l
|
grep
-q
"
$(LIBDIR)
/why3/isabelle
$$
"
;
then
\
echo
"Building the Why3 heap for Isabelle/HOL:"
;
\
isabelle build
-bc
Why3
;
true
;
\
else
\
echo
"[Warning] Cannot pre-build the Isabelle heap because"
;
\
...
...
@@ -1115,6 +1116,7 @@ install_no_local::
install_local
::
@
(
if
isabelle components
-l
|
grep
-q
"
`
pwd
`
/lib/isabelle
$$
"
;
then
\
echo
"Building the Why3 heap for Isabelle/HOL:"
;
\
isabelle build
-bc
Why3
;
true
;
\
else
\
echo
"[Warning] Cannot pre-build the Isabelle heap because"
;
\
...
...
examples/use_api/create_session.ml
View file @
d9855c53
...
...
@@ -63,7 +63,6 @@ let env_session,_,_ =
Session
.
allow_obsolete_goals
=
true
;
Session
.
release_tasks
=
false
;
Session
.
use_shapes_for_pairing_sub_goals
=
false
;
Session
.
theory_is_fully_up_to_date
=
false
;
Session
.
keygen
=
dummy_keygen
;
}
in
...
...
src/session/session.ml
View file @
d9855c53
...
...
@@ -287,6 +287,25 @@ let rec goal_iter_leaf_goal ~unproved_only f g =
g
.
goal_transformations
;
if
!
r
then
f
g
let
rec
fold_all_sub_goals_of_goal
f
acc
g
=
let
acc
=
PHstr
.
fold
(
fun
_
tr
acc
->
List
.
fold_left
(
fold_all_sub_goals_of_goal
f
)
acc
tr
.
transf_goals
)
g
.
goal_transformations
acc
in
let
acc
=
Mmetas_args
.
fold
(
fun
_
m
acc
->
fold_all_sub_goals_of_goal
f
acc
m
.
metas_goal
)
g
.
goal_metas
acc
in
f
acc
g
let
fold_all_sub_goals_of_theory
f
acc
th
=
List
.
fold_left
(
fold_all_sub_goals_of_goal
f
)
acc
th
.
theory_goals
(** iterators not reccursive *)
let
iter_goal
fp
ft
fm
g
=
PHprover
.
iter
(
fun
_
a
->
fp
a
)
g
.
goal_external_proofs
;
...
...
@@ -491,10 +510,10 @@ exception NoTask
let
goal_task
g
=
Opt
.
get_exn
NoTask
g
.
goal_task
let
goal_task_option
g
=
g
.
goal_task
let
goal_expl
g
=
let
goal_expl
g
=
match
g
.
goal_expl
with
|
Some
s
->
s
|
None
->
|
None
->
try
let
_
,_,
l
=
restore_path
g
.
goal_name
in
String
.
concat
"."
l
with
Not_found
->
g
.
goal_name
.
Ident
.
id_string
...
...
@@ -596,9 +615,6 @@ let rec save_goal ctxt fmt g =
"@
\n
@[<v 0>@[<h><goal@ %a%a%a>@]"
save_ident
g
.
goal_name
(
opt_string
"expl"
)
g
.
goal_expl
(* no more checksum in why3session.xml
(opt save_checksum "sum") g.goal_checksum
*)
(
save_bool_def
"expanded"
false
)
g
.
goal_expanded
;
let
sum
=
match
g
.
goal_checksum
with
...
...
@@ -693,15 +709,30 @@ and save_ty fmt ty =
List
.
iter
(
save_ty
fmt
)
l
;
fprintf
fmt
"@]@
\n
</ty_app>"
module
CombinedTheoryChecksum
=
struct
let
b
=
Buffer
.
create
1024
let
f
()
g
=
match
g
.
goal_checksum
with
|
None
->
assert
false
|
Some
c
->
Buffer
.
add_string
b
(
Tc
.
string_of_checksum
c
)
let
compute
th
=
let
()
=
fold_all_sub_goals_of_theory
f
()
th
in
let
c
=
Tc
.
buffer_checksum
b
in
Buffer
.
clear
b
;
c
end
let
save_theory
ctxt
fmt
t
=
let
c
=
CombinedTheoryChecksum
.
compute
t
in
t
.
theory_checksum
<-
Some
c
;
fprintf
fmt
"@
\n
@[<v 1>@[<h><theory@ %a%a%a>@]"
save_ident
t
.
theory_name
(
opt
save_checksum
"sum"
)
t
.
theory_checksum
(
save_bool_def
"expanded"
false
)
t
.
theory_expanded
;
(*
Ident.Slab.iter (save_label fmt) t.theory_name.Ident.id_label;
*)
List
.
iter
(
save_goal
ctxt
fmt
)
t
.
theory_goals
;
fprintf
fmt
"@]@
\n
</theory>"
...
...
@@ -804,7 +835,7 @@ type 'a notify = 'a any -> unit
let
notify
:
'
a
notify
=
fun
_
->
()
let
compute_verified
get
l
=
List
.
fold_left
(
fun
acc
t
->
List
.
fold_left
(
fun
acc
t
->
match
acc
,
get
t
with
|
Some
x
,
Some
y
->
Some
(
x
+.
y
)
|
_
->
None
)
(
Some
0
.
0
)
l
...
...
@@ -947,6 +978,11 @@ let set_obsolete ?(notify=notify) a =
notify
(
Proof_attempt
a
);
check_goal_proved
notify
a
.
proof_parent
let
set_non_obsolete
a
=
a
.
proof_obsolete
<-
false
;
notify
(
Proof_attempt
a
);
check_goal_proved
notify
a
.
proof_parent
let
set_archived
a
b
=
a
.
proof_archived
<-
b
let
get_edited_as_abs
session
pr
=
...
...
@@ -1668,7 +1704,7 @@ let add_file ~keygen env ?format filename =
in
g
::
acc
in
let
add_theory
acc
rfile
thname
theory
=
let
checksum
=
Some
(
Tc
.
theory_checksum
theory
)
in
let
checksum
=
None
(* Some (Tc.theory_checksum theory) *
)
in
let
rtheory
=
raw_add_theory
~
keygen
~
expanded
:
true
~
checksum
rfile
thname
in
...
...
@@ -2000,7 +2036,7 @@ let print_external_proof fmt p =
module
AssoGoals
:
sig
val
set_use_shapes
:
bool
->
unit
val
associate
:
theory_was_fully_up_to_date
:
bool
->
val
associate
:
(* theory_was_fully_up_to_date:bool -> *)
'
a
goal
list
->
'
b
goal
list
->
(
'
b
goal
*
(
'
a
goal
*
bool
)
option
)
list
end
=
struct
...
...
@@ -2033,7 +2069,7 @@ end = struct
let
use_shapes
=
ref
true
let
set_use_shapes
b
=
use_shapes
:=
b
let
associate
~
theory_was_fully_up_to_date
let
associate
(
from_goals
:
'
ffrom
goal
list
)
(
to_goals
:
'
tto
goal
list
)
:
(
'
tto
goal
*
(
'
ffrom
goal
*
bool
)
option
)
list
=
let
from_goals
:
ffrom
goal
list
=
...
...
@@ -2042,7 +2078,6 @@ end = struct
Obj
.
magic
(
to_goals
:
'
tto
goal
list
)
in
let
associated
:
(
tto
goal
*
(
ffrom
goal
*
bool
)
option
)
list
=
AssoGoals
.
associate
~
theory_was_fully_up_to_date
~
use_shapes
:!
use_shapes
from_goals
to_goals
in
(
Obj
.
magic
associated
:
(
'
tto
goal
*
(
'
ffrom
goal
*
bool
)
option
)
list
)
...
...
@@ -2220,7 +2255,9 @@ type 'key update_context =
{
allow_obsolete_goals
:
bool
;
release_tasks
:
bool
;
use_shapes_for_pairing_sub_goals
:
bool
;
(* not used anymore
theory_is_fully_up_to_date : bool;
*)
keygen
:
'
key
keygen
;
}
...
...
@@ -2254,7 +2291,7 @@ let rec recover_sub_tasks ~theories env_session task g =
let
recover_theory_tasks
env_session
th
=
let
theories
=
Opt
.
get_exn
NoTask
th
.
theory_parent
.
file_for_recovery
in
let
theory
=
Opt
.
get_exn
NoTask
th
.
theory_task
in
th
.
theory_checksum
<-
Some
(
Tc
.
theory_checksum
theory
);
th
.
theory_checksum
<-
None
(* Some (Tc.theory_checksum theory) *
)
;
let
tasks
=
List
.
rev
(
Task
.
split_theory
theory
None
None
)
in
List
.
iter2
(
recover_sub_tasks
~
theories
env_session
)
tasks
th
.
theory_goals
...
...
@@ -2304,7 +2341,7 @@ and merge_trans ~ctxt ~theories env to_goal _ from_transf =
Debug
.
dprintf
debug
"[Info] associate_subgoals, shape_version = %d@
\n
"
env
.
session
.
session_shape_version
;
AssoGoals
.
associate
~
theory_was_fully_up_to_date
:
ctxt
.
theory_is_fully_up_to_date
(* ~theory_was_fully_up_to_date:ctxt.theory_is_fully_up_to_date *)
from_transf
.
transf_goals
to_transf
.
transf_goals
in
List
.
iter
(
function
...
...
@@ -2358,6 +2395,7 @@ let merge_theory ~ctxt ~theories env from_th to_th =
to_th
.
theory_name
.
id_string
(
Pp
.
print_option
Tc
.
print_checksum
)
from_th
.
theory_checksum
(
Pp
.
print_option
Tc
.
print_checksum
)
to_th
.
theory_checksum
;
(*
let ctxt = { ctxt with theory_is_fully_up_to_date =
match from_th.theory_checksum, to_th.theory_checksum with
| _, None -> assert false
...
...
@@ -2368,11 +2406,12 @@ let merge_theory ~ctxt ~theories env from_th to_th =
Debug.dprintf debug
"[Theory checksum] fully up to date = %b@."
ctxt.theory_is_fully_up_to_date;
*)
List
.
iter
(
fun
to_goal
->
try
let
to_goal_name
=
try
let
to_goal_name
=
try
let
(
_
,_,
l
)
=
restore_path
to_goal
.
goal_name
in
String
.
concat
"."
l
with
Not_found
->
to_goal
.
goal_name
.
Ident
.
id_string
...
...
@@ -2386,7 +2425,7 @@ let merge_theory ~ctxt ~theories env from_th to_th =
let
goal_obsolete
=
match
to_goal
.
goal_checksum
,
from_goal
.
goal_checksum
with
|
None
,
_
->
assert
false
|
Some
_
,
None
->
not
ctxt
.
theory_is_fully_up_to_date
|
Some
_
,
None
->
true
(* not ctxt.theory_is_fully_up_to_date *)
|
Some
s1
,
Some
s2
->
not
(
Tc
.
equal_checksum
s1
s2
)
in
if
goal_obsolete
then
...
...
@@ -2404,7 +2443,29 @@ let merge_theory ~ctxt ~theories env from_th to_th =
found_missed_goals
:=
true
;
if
ctxt
.
release_tasks
then
release_sub_tasks
to_goal
|
Not_found
->
raise
OutdatedSession
)
to_th
.
theory_goals
)
to_th
.
theory_goals
;
if
not
ctxt
.
use_shapes_for_pairing_sub_goals
then
begin
Debug
.
dprintf
debug
"[Session] since shapes were not used for pairing, we compute the \
checksum of the full theory, to estimate the obsolete status for \
goals.@."
;
let
to_checksum
=
CombinedTheoryChecksum
.
compute
to_th
in
let
same_checksum
=
match
from_th
.
theory_checksum
with
|
None
->
false
|
Some
c
->
Tc
.
equal_checksum
c
to_checksum
in
Debug
.
dprintf
debug
"[Session] from_checksum = %a, to_checksum = %a@."
(
Pp
.
print_option
save_checksum
)
from_th
.
theory_checksum
save_checksum
to_checksum
;
if
same_checksum
then
(* we set all_goals as non obsolete *)
theory_iter_proof_attempt
set_non_obsolete
to_th
end
let
merge_file
~
ctxt
~
theories
env
from_f
to_f
=
Debug
.
dprintf
debug
"[Info] merge_file, shape_version = %d@
\n
"
...
...
@@ -2622,7 +2683,7 @@ and add_transf_to_goal ~keygen env to_goal from_transf =
Debug
.
dprintf
debug
"[Info] associate_subgoals, shape_version = %d@
\n
"
env
.
session
.
session_shape_version
;
AssoGoals
.
associate
~
theory_was_fully_up_to_date
:
false
(* ~theory_was_fully_up_to_date:false *)
from_transf
.
transf_goals
to_transf
.
transf_goals
in
List
.
iter
(
function
|
(
to_goal
,
Some
(
from_goal
,
_obsolete
))
->
...
...
src/session/session.mli
View file @
d9855c53
...
...
@@ -244,7 +244,7 @@ type 'key update_context =
{
allow_obsolete_goals
:
bool
;
release_tasks
:
bool
;
use_shapes_for_pairing_sub_goals
:
bool
;
theory_is_fully_up_to_date
:
bool
;
(* theory_is_fully_up_to_date : bool;*)
keygen
:
'
key
keygen
;
}
...
...
@@ -511,6 +511,9 @@ val goal_iter_leaf_goal :
(** iter all the goals which are a leaf
(no transformations are applied on it) *)
val
fold_all_sub_goals_of_theory
:
(
'
a
->
'
key
goal
->
'
a
)
->
'
a
->
'
key
theory
->
'
a
(** {3 not recursive} *)
val
iter_goal
:
...
...
@@ -522,8 +525,8 @@ val iter_transf :
(
'
key
goal
->
unit
)
->
'
key
transf
->
unit
val
iter_metas
:
(
'
key
goal
->
unit
)
->
'
key
metas
->
unit
val
iter_theory
:
(
'
key
goal
->
unit
)
->
'
key
theory
->
unit
val
iter_theory
:
(
'
key
goal
->
unit
)
->
'
key
theory
->
unit
(
** [iter_theory f th] applies [f] to all root goals of theory [th] *)
val
iter_file
:
(
'
key
theory
->
unit
)
->
'
key
file
->
unit
val
iter_session
:
...
...
src/session/session_scheduler.ml
View file @
d9855c53
...
...
@@ -319,7 +319,9 @@ let update_session ~allow_obsolete ~release ~use_shapes
allow_obsolete_goals
=
allow_obsolete
;
release_tasks
=
release
;
use_shapes_for_pairing_sub_goals
=
use_shapes
;
(*
theory_is_fully_up_to_date = false; (* dummy initialisation *)
*)
keygen
=
O
.
create
;
}
in
...
...
@@ -777,18 +779,7 @@ let transformation_on_goal_aux eS tr keep_dumb_transformation g =
let
subgoals
=
Trans
.
apply_transform
tr
eS
.
env
gtask
in
let
b
=
keep_dumb_transformation
||
match
subgoals
with
|
[
task
]
->
(* let s1 = task_checksum (get_task g) in *)
(* let s2 = task_checksum task in *)
(* (\* *)
(* eprintf "Transformation returned only one task.
sum before = %s, sum after = %s@." (task_checksum g.task)
(task_checksum task); *)
(* eprintf "addresses: %x %x@." (Obj.magic g.task)
(Obj.magic task); *)
(* *\) *)
(* s1 <> s2 *)
not
(
Task
.
task_equal
task
gtask
)
|
[
task
]
->
not
(
Task
.
task_equal
task
gtask
)
|
_
->
true
in
if
b
then
...
...
src/session/termcode.ml
View file @
d9855c53
...
...
@@ -396,6 +396,10 @@ let checksum_of_string x = x
let
equal_checksum
x
y
=
(
x
:
checksum
)
=
y
let
dumb_checksum
=
""
let
buffer_checksum
b
=
let
s
=
Buffer
.
contents
b
in
Digest
.
to_hex
(
Digest
.
string
s
)
type
checksum_version
=
CV1
|
CV2
module
Checksum
=
struct
...
...
@@ -584,9 +588,11 @@ module Checksum = struct
Ident
.
Wid
.
set
table
t
.
Theory
.
th_name
v
;
v
(* not used anymore
let theory ~version t = match version with
| CV1 -> assert false
| CV2 -> theory_v2 t
*)
let
task_v1
=
let
c
=
ref
0
in
...
...
@@ -637,6 +643,7 @@ let task_checksum ?(version=current_shape_version) t =
in
Checksum
.
task
~
version
t
(* not used anymore
let theory_checksum ?(version=current_shape_version) t =
let version = match version with
| 1 | 2 | 3 -> CV1
...
...
@@ -644,6 +651,7 @@ let theory_checksum ?(version=current_shape_version) t =
| _ -> assert false
in
Checksum.theory ~version t
*)
(*************************************************************)
(* Pairing of new and old subgoals *)
...
...
@@ -785,19 +793,19 @@ module Pairing(Old: S)(New: S) = struct
end
;
Array
.
to_list
result
let
simple_associate
~
obsolete
oldgoals
newgoals
=
let
simple_associate
(* ~obsolete *)
oldgoals
newgoals
=
let
rec
aux
acc
o
n
=
match
o
,
n
with
|
_
,
[]
->
acc
|
[]
,
n
::
rem_n
->
aux
((
n
,
None
)
::
acc
)
[]
rem_n
|
o
::
rem_o
,
n
::
rem_n
->
aux
((
n
,
Some
(
o
,
obsolet
e
))
::
acc
)
rem_o
rem_n
|
o
::
rem_o
,
n
::
rem_n
->
aux
((
n
,
Some
(
o
,
tru
e
))
::
acc
)
rem_o
rem_n
in
aux
[]
oldgoals
newgoals
let
associate
~
theory_was_fully_up_to_date
~
use_shapes
=
let
associate
(* ~theory_was_fully_up_to_date *)
~
use_shapes
=
if
use_shapes
then
associate
else
simple_associate
~
obsolete
:
(
not
theory_was_fully_up_to_date
)
simple_associate
(* ~obsolete:(not theory_was_fully_up_to_date) *
)
end
src/session/termcode.mli
View file @
d9855c53
...
...
@@ -42,9 +42,13 @@ val checksum_of_string: string -> checksum
val
equal_checksum
:
checksum
->
checksum
->
bool
val
dumb_checksum
:
checksum
val
buffer_checksum
:
Buffer
.
t
->
checksum
val
task_checksum
:
?
version
:
int
->
Task
.
task
->
checksum
(* not used anymore
val theory_checksum : ?version:int -> Theory.theory -> checksum
*)
(** Pairing algorithm *)
...
...
@@ -56,20 +60,21 @@ module type S = sig
end
module
Pairing
(
Old
:
S
)(
New
:
S
)
:
sig
val
associate
:
theory_was_fully_up_to_date
:
bool
->
use_shapes
:
bool
->
val
associate
:
(* theory_was_fully_up_to_date:bool -> *)
use_shapes
:
bool
->
Old
.
t
list
->
New
.
t
list
->
(
New
.
t
*
(
Old
.
t
*
bool
)
option
)
list
(** Associate new goals to (possibly) old goals
Each new goal is mapped either to
- [None]: no old goal associated
- [Some (h, false)]: the matching is exact (same checksums)
- [Some (h, true)]: inexact matching (thus proofs for the new goal
- [Some (h, true)]: inexact matching (thus proofs for the new goal
must be assumed obsolete)
if [use_shapes] is set, the clever algorithm matching shapes is used,
otherwise a simple association in the given order of goals is done.
if [theory_was_fully_up_to_date] is set, then all resulting
goals are marked as non-obsolete, whatever their checksums are.
(* if [theory_was_fully_up_to_date] is set, then all resulting *)
(* goals are marked as non-obsolete, whatever their checksums are. *)
Note: in the output, goals appear in the same order as in [newgoals] *)
...
...
src/why3session/why3session_lib.ml
View file @
d9855c53
...
...
@@ -79,7 +79,7 @@ let read_update_session ~allow_obsolete env config fname =
S
.
allow_obsolete_goals
=
allow_obsolete
;
S
.
release_tasks
=
false
;
S
.
use_shapes_for_pairing_sub_goals
=
use_shapes
;
S
.
theory_is_fully_up_to_date
=
false
;
(* S.theory_is_fully_up_to_date = false; *)
S
.
keygen
=
fun
?
parent
:_
_
->
()
;
}
in
...
...
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