Commit 8a427f54 authored by Sylvain Dailler's avatar Sylvain Dailler

destruct: first step simplification

parent 255164f9
......@@ -52,19 +52,23 @@
</theory>
<theory name="Unsoundness">
<goal name="t1">
<transf name="destruct_rec" arg1="H">
<goal name="t1.0">
<transf name="destruct_rec" arg1="H1">
<goal name="t1.0.0" expl="destruct premise">
</goal>
<goal name="t1.0.1">
</goal>
</transf>
</goal>
</transf>
</goal>
</theory>
<theory name="Incompleteness">
<goal name="t1">
<transf name="destruct_rec" arg1="H">
<goal name="t1.0" expl="destruct premise">
<proof prover="0"><result status="unknown" time="0.00"/></proof>
</goal>
<goal name="t1.1" expl="destruct premise">
<proof prover="0"><result status="unknown" time="0.00"/></proof>
</goal>
<goal name="t1.2" proved="true">
<proof prover="0"><result status="valid" time="0.00"/></proof>
<goal name="t1.0">
<proof prover="0" obsolete="true"><result status="valid" time="0.00"/></proof>
</goal>
</transf>
</goal>
......@@ -141,29 +145,5 @@
</transf>
</goal>
</theory>
<theory name="Tsurfail">
<goal name="t">
<transf name="destruct_rec" arg1="H">
<goal name="t.0" expl="destruct premise">
</goal>
<goal name="t.1" expl="destruct premise">
</goal>
<goal name="t.2">
</goal>
</transf>
</goal>
</theory>
<theory name="Tfail">
<goal name="G">
<transf name="destruct_rec" arg1="H">
<goal name="G.0" expl="destruct premise">
</goal>
<goal name="G.1" expl="destruct premise">
</goal>
<goal name="G.2">
</goal>
</transf>
</goal>
</theory>
</file>
</why3session>
......@@ -149,24 +149,22 @@ let destruct_term ~recursive (t: term) =
l.ls_constr <> 0
in
(* Check if a new goal is created in the branch *)
let contains_goal l =
List.exists (fun x -> match x with | Goal_term _ -> true | _ -> false) l
in
(* Main function *)
let rec destruct_term (t: term) =
let destruct_term_exception t =
(* Main recursive function:
[toplevel] when true, removing implications is allowed. Become false as
soon as we destruct non-implication construct
*)
let rec destruct_term ~toplevel (t: term) =
let destruct_term_exception ~toplevel t =
if not recursive then [[Axiom_term t]] else
match destruct_term t with
match destruct_term ~toplevel t with
| exception _ -> [[Axiom_term t]]
| l -> l
in
match t.t_node with
| Tbinop (Tand, t1, t2) ->
let l1 = destruct_term_exception t1 in
let l2 = destruct_term_exception t2 in
let l1 = destruct_term_exception ~toplevel:false t1 in
let l2 = destruct_term_exception ~toplevel:false t2 in
(* For each parallel branch of l1 we have to append *all* parallel
branch of l2 which are not new goals. In case of new goals, we are
not allowed to use the left/right conclusions to prove the goal.
......@@ -177,25 +175,19 @@ let destruct_term ~recursive (t: term) =
(* TODO efficiency: this is not expected to work on very large terms
with tons of Tand/Tor. *)
List.fold_left (fun par_acc seq_list1 ->
if contains_goal seq_list1 then
par_acc @ [seq_list1]
else
List.fold_left (fun par_acc seq_list2 ->
if contains_goal seq_list2 then
par_acc @ [seq_list2]
else
par_acc @ [seq_list1 @ seq_list2]) par_acc l2
List.fold_left (fun par_acc seq_list2 ->
par_acc @ [seq_list1 @ seq_list2]) par_acc l2
) [] l1
| Tbinop (Tor, t1, t2) ->
let l1 = destruct_term_exception t1 in
let l2 = destruct_term_exception t2 in
let l1 = destruct_term_exception ~toplevel:false t1 in
let l2 = destruct_term_exception ~toplevel:false t2 in
(* The two branch are completely disjoint. We just concatenate them to
ensure they are done in parallel *)
l1 @ l2
| Tbinop (Timplies, t1, t2) ->
| Tbinop (Timplies, t1, t2) when toplevel ->
(* The premises is converted to a goal. The rest is recursively
destructed in parallel. *)
let l2 = destruct_term_exception t2 in
let l2 = destruct_term_exception ~toplevel t2 in
[Goal_term t1] :: l2
| Tquant (Texists, tb) ->
let (vsl, tr, te) = Term.t_open_quant tb in
......@@ -209,7 +201,7 @@ let destruct_term ~recursive (t: term) =
let new_t = t_quant_close Texists tl tr part_t in
(* The recursive call is done after new symbols are introduced so we
readd the new decls to every generated list. *)
let l_t = destruct_term_exception new_t in
let l_t = destruct_term_exception ~toplevel:false new_t in
List.map (fun x -> Param x_decl :: x) l_t
with
| Ty.TypeMismatch (ty1, ty2) ->
......@@ -237,7 +229,7 @@ let destruct_term ~recursive (t: term) =
| Tnot {t_node = Tapp (ls,
[{t_node = Tapp (cs1, _); _}; {t_node = Tapp (cs2, _); _}]); _}
when ls_equal ls ps_equ && is_constructor cs1 && is_constructor cs2 ->
(* Cs1 [l1] <> Cs2 [l2] *)
(* Cs1 [l1] = Cs2 [l2] *)
if ls_equal cs1 cs2 then
[[Axiom_term t]]
else
......@@ -245,7 +237,7 @@ let destruct_term ~recursive (t: term) =
[[]]
| _ -> raise (Arg_trans ("destruct"))
in
destruct_term t
destruct_term ~toplevel:true t
(* Destruct the head term of an hypothesis if it is either
conjunction, disjunction or exists *)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment