Mentions légales du service
Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
why3
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Deploy
Releases
Container registry
Monitor
Service Desk
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Why3
why3
Commits
119bd405
Commit
119bd405
authored
6 years ago
by
Sylvain Dailler
Browse files
Options
Downloads
Patches
Plain Diff
Rewriting of destruct transformation to prepare for future improvements
parent
c7a7bd6e
No related branches found
No related tags found
1 merge request
!58
231 destruct
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
src/core/trans.ml
+59
-0
59 additions, 0 deletions
src/core/trans.ml
src/core/trans.mli
+26
-0
26 additions, 0 deletions
src/core/trans.mli
src/transform/destruct.ml
+68
-78
68 additions, 78 deletions
src/transform/destruct.ml
with
153 additions
and
78 deletions
src/core/trans.ml
+
59
−
0
View file @
119bd405
...
...
@@ -137,6 +137,65 @@ let decl_l = gen_decl_l Task.add_decl
let
tdecl
=
gen_decl
add_tdecl
let
tdecl_l
=
gen_decl_l
add_tdecl
type
diff_decl
=
|
Goal_decl
of
Decl
.
decl
|
Normal_decl
of
Decl
.
decl
let
decl_goal_l
(
fn
:
decl
->
diff_decl
list
list
)
=
(* Same algo as for gen_decl_l so it can be generalized to tdecl *)
let
fn
=
store_decl
fn
in
let
is_goal
d
=
match
d
.
d_node
with
|
Dprop
(
Pgoal
,
_
,
_
)
->
true
|
_
->
false
in
let
fn
task
(
changed_goal
,
task_uc
)
=
match
task
.
task_decl
.
td_node
with
|
Decl
d
when
is_goal
d
->
begin
match
changed_goal
with
|
None
->
List
.
map
(
fun
x
->
List
.
fold_left
(
fun
(
changed_goal
,
task_uc
)
typed_decl
->
match
typed_decl
with
|
Goal_decl
_
->
(* TODO: disallowing the creation of a new goal when
analysing the goal itself: to be improved ? *)
assert
false
|
Normal_decl
d
->
(
changed_goal
,
Task
.
add_decl
task_uc
d
)
)
(
changed_goal
,
task_uc
)
x
)
(
fn
d
)
|
Some
new_goal
->
[
changed_goal
,
Task
.
add_decl
task_uc
new_goal
]
end
|
Decl
d
->
List
.
map
(
fun
x
->
List
.
fold_left
(
fun
(
changed_goal
,
task_uc
)
typed_decl
->
match
typed_decl
with
|
Goal_decl
d
->
if
changed_goal
<>
None
then
(* TODO: Unsure of soundness of this function when several
goals are created in same branch. To be improved ? *)
assert
false
else
begin
assert
(
is_goal
d
);
(
Some
d
,
task_uc
)
end
|
Normal_decl
d
->
(
changed_goal
,
Task
.
add_decl
task_uc
d
))
(
changed_goal
,
task_uc
)
x
)
(
fn
d
)
|
_
->
[
changed_goal
,
add_tdecl
task_uc
task
.
task_decl
]
in
fold_map_l
fn
None
let
apply_to_goal
fn
d
=
match
d
.
d_node
with
|
Dprop
(
Pgoal
,
pr
,
f
)
->
fn
pr
f
|
_
->
assert
false
...
...
This diff is collapsed.
Click to expand it.
src/core/trans.mli
+
26
−
0
View file @
119bd405
...
...
@@ -71,6 +71,32 @@ val decl_l : (decl -> decl list list) -> task -> task tlist
duplicate the task on each declaration and probably run forever.
*)
type
diff_decl
=
|
Goal_decl
of
Decl
.
decl
|
Normal_decl
of
Decl
.
decl
val
decl_goal_l
:
(
decl
->
diff_decl
list
list
)
->
task
->
task
tlist
(** [decl_goal_l f t1 t2] does the same as decl_l except that it can
differentiate a new axiom added to a task from a new goal added to a task.
In case of a new axiom, everything works as in decl_l. When a new goal [ng]
is generated, it is remembered so that it can replace the old_goal when the
end of the task is encountered.
Example of use of this feature in the code of [destruct]:
H1: p1 -> p2
H2: p3
H3: ...
-------------
Goal: True
In [destruct H1], we know that we will add a new goal [p1] before we read
through the entire task, so we need to be able to generate a new goal.
Current disallowed cases:
- Creating a goal twice in the same branch
- Creating a goal when analysing the goal of [t2]
*)
val
tdecl
:
(
decl
->
tdecl
list
)
->
task
->
task
trans
val
tdecl_l
:
(
decl
->
tdecl
list
list
)
->
task
->
task
tlist
...
...
This diff is collapsed.
Click to expand it.
src/transform/destruct.ml
+
68
−
78
View file @
119bd405
...
...
@@ -11,6 +11,7 @@
open
Term
open
Decl
open
Trans
open
Args_wrapper
open
Generic_arg_trans_utils
...
...
@@ -70,7 +71,7 @@ let rec compounds_of acc (t: term) =
its destruction in the context.
When replace is set to true, a susbtitution is done when x is an lsymbol.
*)
let
destruct_alg
replace
(
x
:
term
)
:
Task
.
task
Trans
.
tlist
=
let
destruct_alg
replace
(
x
:
term
)
:
Task
.
task
tlist
=
let
ty
=
x
.
t_ty
in
(* We list all the constants used in x so that we know the first place in the
task where we can introduce hypothesis about the destruction of x. *)
...
...
@@ -84,7 +85,7 @@ let destruct_alg replace (x: term) : Task.task Trans.tlist =
match
ty
.
Ty
.
ty_node
with
|
Ty
.
Tyvar
_
->
raise
(
Cannot_infer_type
"destruct"
)
|
Ty
.
Tyapp
(
ts
,
_
)
->
let
trans
=
Trans
.
decl_l
(
fun
d
->
let
trans
=
decl_l
(
fun
d
->
match
d
.
d_node
with
(* TODO not necessary to check this first: this can be optimized *)
|
_
when
(
not
!
defined
)
&&
Term
.
Sls
.
is_empty
!
ls_of_x
->
...
...
@@ -122,93 +123,82 @@ let destruct_alg replace (x: term) : Task.task Trans.tlist =
|
_
->
[[
d
]])
None
in
if
replace
&&
is_lsymbol
x
then
Trans
.
compose_l
trans
(
Trans
.
singleton
(
Subst
.
subst
[
x
]))
compose_l
trans
(
singleton
(
Subst
.
subst
[
x
]))
else
trans
end
(* Destruct the head term of an hypothesis if it is either
conjunction, disjunction or exists *)
let
destruct
pr
:
Task
.
task
Trans
.
tlist
=
let
new_decl
=
ref
None
in
(* This transformation destructs the hypothesis pr. In case pr is an
implication H : A -> B, the destruction creates two task (one with H
removed and one with H : B). It also fills new_decl with A.
The next transformation replace the first goal with A. *)
let
tr_decl
=
Trans
.
decl_l
(
fun
d
->
match
d
.
d_node
with
|
Dprop
(
Paxiom
,
dpr
,
ht
)
when
Ident
.
id_equal
dpr
.
pr_name
pr
.
pr_name
->
(* [destruct_term ~original_decl ~decl_name t]: This destroys a headterm and
generate an appropriate lists of goals/declarations that can be used by
decl_goal_l.
[original_decl] referenced the declaration corresponding to [t] in the task.
It exists only to keep the exists hypothesis. TODO remove ?
[decl_name] is the name of the [original_decl]. It is here only to name new
hypotheses.
*)
let
destruct_term
~
original_decl
~
decl_name
(
t
:
term
)
=
let
create_destruct_axiom
t
=
let
new_pr
=
create_prsymbol
(
Ident
.
id_clone
decl_name
)
in
create_prop_decl
Paxiom
new_pr
t
in
let
create_destruct_goal
t
=
let
new_pr
=
create_prsymbol
(
Ident
.
id_clone
decl_name
)
in
create_prop_decl
Pgoal
new_pr
t
in
match
t
.
t_node
with
|
Tbinop
(
Tand
,
t1
,
t2
)
->
let
t1
=
create_destruct_axiom
t1
in
let
t2
=
create_destruct_axiom
t2
in
[[
Normal_decl
t1
;
Normal_decl
t2
]]
|
Tbinop
(
Tor
,
t1
,
t2
)
->
let
t1
=
create_destruct_axiom
t1
in
let
t2
=
create_destruct_axiom
t2
in
[[
Normal_decl
t1
];[
Normal_decl
t2
]]
|
Tbinop
(
Timplies
,
t1
,
t2
)
->
begin
match
ht
.
t_node
with
|
Tbinop
(
Tand
,
t1
,
t2
)
->
let
new_pr1
=
create_prsymbol
(
Ident
.
id_clone
dpr
.
pr_name
)
in
let
new_decl1
=
create_prop_decl
Paxiom
new_pr1
t1
in
let
new_pr2
=
create_prsymbol
(
Ident
.
id_clone
dpr
.
pr_name
)
in
let
new_decl2
=
create_prop_decl
Paxiom
new_pr2
t2
in
[[
new_decl1
;
new_decl2
]]
|
Tbinop
(
Tor
,
t1
,
t2
)
->
let
new_pr1
=
create_prsymbol
(
Ident
.
id_clone
dpr
.
pr_name
)
in
let
new_decl1
=
create_prop_decl
Paxiom
new_pr1
t1
in
let
new_pr2
=
create_prsymbol
(
Ident
.
id_clone
dpr
.
pr_name
)
in
let
new_decl2
=
create_prop_decl
Paxiom
new_pr2
t2
in
[[
new_decl1
];[
new_decl2
]]
|
Tbinop
(
Timplies
,
t1
,
t2
)
->
begin
let
new_pr2
=
create_prsymbol
(
Ident
.
id_clone
dpr
.
pr_name
)
in
let
new_decl2
=
create_prop_decl
Paxiom
new_pr2
t2
in
new_decl
:=
Some
t1
;
(* Creates a task with hypothesis removes (need to prove t1) and one
with hypothesis replaced by t2 (needs to prove current goal).
Example: "false -> false" *)
[]
::
[[
new_decl2
]]
end
|
Tquant
(
Texists
,
tb
)
->
begin
let
(
vsl
,
tr
,
te
)
=
Term
.
t_open_quant
tb
in
match
vsl
with
|
x
::
tl
->
let
ls
=
create_lsymbol
(
Ident
.
id_clone
x
.
vs_name
)
[]
(
Some
x
.
vs_ty
)
in
let
tx
=
fs_app
ls
[]
x
.
vs_ty
in
let
x_decl
=
create_param_decl
ls
in
(
try
let
part_t
=
t_subst_single
x
tx
te
in
let
new_t
=
t_quant_close
Texists
tl
tr
part_t
in
let
new_pr
=
create_prsymbol
(
Ident
.
id_clone
dpr
.
pr_name
)
in
let
new_decl
=
create_prop_decl
Paxiom
new_pr
new_t
in
[[
d
;
x_decl
;
new_decl
]]
with
|
Ty
.
TypeMismatch
(
ty1
,
ty2
)
->
raise
(
Arg_trans_type
(
"destruct_exists"
,
ty1
,
ty2
)))
|
[]
->
raise
(
Arg_trans
(
"destruct_exists"
))
end
|
_
->
raise
(
Arg_trans
(
"destruct"
))
let
t1
=
create_destruct_goal
t1
in
let
t2
=
create_destruct_axiom
t2
in
(* Creates a task with hypothesis removes (need to prove t1) and one
with hypothesis replaced by t2 (needs to prove current goal).
Example: "false -> false" *)
[[
Goal_decl
t1
];
[
Normal_decl
t2
]]
end
|
_
->
[[
d
]])
None
in
Trans
.
store
(
fun
task
->
let
goal
,
task
=
Task
.
task_separate_goal
task
in
let
new_tasks
=
Trans
.
apply
tr_decl
task
in
match
!
new_decl
with
|
None
->
(* Normal destruct case (not implication): add goal back to tasks *)
List
.
map
(
fun
task
->
Task
.
add_tdecl
task
goal
)
new_tasks
|
Some
new_decl
->
match
new_tasks
with
(* Destruct case for an implication. The first goal should be new_decl,
the second one is unchanged. *)
|
first_task
::
second_task
::
[]
->
let
pr
=
create_prsymbol
(
gen_ident
"G"
)
in
let
new_goal
=
create_goal
~
expl
:
destruct_expl
pr
new_decl
in
let
first_goal
=
Task
.
add_decl
first_task
new_goal
in
let
second_goal
=
Task
.
add_tdecl
second_task
goal
in
first_goal
::
second_goal
::
[]
|
_
->
assert
false
)
|
Tquant
(
Texists
,
tb
)
->
let
(
vsl
,
tr
,
te
)
=
Term
.
t_open_quant
tb
in
begin
match
vsl
with
|
x
::
tl
->
let
ls
=
create_lsymbol
(
Ident
.
id_clone
x
.
vs_name
)
[]
(
Some
x
.
vs_ty
)
in
let
tx
=
fs_app
ls
[]
x
.
vs_ty
in
let
x_decl
=
create_param_decl
ls
in
(
try
let
part_t
=
t_subst_single
x
tx
te
in
let
new_t
=
t_quant_close
Texists
tl
tr
part_t
in
let
new_t
=
create_destruct_axiom
new_t
in
[[
Normal_decl
original_decl
;
Normal_decl
x_decl
;
Normal_decl
new_t
]]
with
|
Ty
.
TypeMismatch
(
ty1
,
ty2
)
->
raise
(
Arg_trans_type
(
"destruct_exists"
,
ty1
,
ty2
)))
|
[]
->
raise
(
Arg_trans
(
"destruct_exists"
))
end
|
_
->
raise
(
Arg_trans
(
"destruct"
))
(* Destruct the head term of an hypothesis if it is either
conjunction, disjunction or exists *)
let
destruct
pr
:
Task
.
task
tlist
=
decl_goal_l
(
fun
d
->
match
d
.
d_node
with
|
Dprop
(
Paxiom
,
dpr
,
ht
)
when
Ident
.
id_equal
dpr
.
pr_name
pr
.
pr_name
->
destruct_term
~
original_decl
:
d
~
decl_name
:
dpr
.
pr_name
ht
|
_
->
[[
Normal_decl
d
]])
None
(* from task [delta, name:forall x.A |- G,
build the task [delta,name:forall x.A,name':A[x -> t]] |- G] *)
let
instantiate
(
pr
:
Decl
.
prsymbol
)
lt
=
let
r
=
ref
[]
in
Trans
.
decl
decl
(
fun
d
->
match
d
.
d_node
with
|
Dprop
(
pk
,
dpr
,
ht
)
when
Ident
.
id_equal
dpr
.
pr_name
pr
.
pr_name
->
...
...
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