Commit ab9414fc authored by Heiko Becker's avatar Heiko Becker

Simplify some proofs in Coq and IV validation for expression to new semantics in HOL4

parent e40e055c
...@@ -44,3 +44,13 @@ Fixpoint definedVars V (f:cmd V) :NatSet.t := ...@@ -44,3 +44,13 @@ Fixpoint definedVars V (f:cmd V) :NatSet.t :=
| Let x _ g => NatSet.add x (definedVars g) | Let x _ g => NatSet.add x (definedVars g)
| Ret _ => NatSet.empty | Ret _ => NatSet.empty
end. end.
(**
The live variables of a command are all variables which occur on the right
hand side of an assignment or at a return statement
**)
Fixpoint liveVars V (f:cmd V) :NatSet.t :=
match f with
| Let _ e g => NatSet.union (usedVars e) (liveVars g)
| Ret e => usedVars e
end.
\ No newline at end of file
...@@ -60,21 +60,21 @@ Proof. ...@@ -60,21 +60,21 @@ Proof.
rewrite (delta_0_deterministic (evalBinop Plus v1 v2) delta); auto. rewrite (delta_0_deterministic (evalBinop Plus v1 v2) delta); auto.
unfold evalBinop in *; simpl in *. unfold evalBinop in *; simpl in *.
clear delta H2. clear delta H2.
rewrite (meps_0_deterministic H4 e1_real); rewrite (meps_0_deterministic H3 e1_real);
rewrite (meps_0_deterministic H5 e2_real). rewrite (meps_0_deterministic H5 e2_real).
rewrite (meps_0_deterministic H4 e1_real) in plus_real. rewrite (meps_0_deterministic H3 e1_real) in plus_real.
rewrite (meps_0_deterministic H5 e2_real) in plus_real. rewrite (meps_0_deterministic H5 e2_real) in plus_real.
clear H4 H5 v1 v2. clear H3 H5 H6 v1 v2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *) (* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion plus_float; subst. inversion plus_float; subst.
unfold perturb; simpl. unfold perturb; simpl.
inversion H4; subst; inversion H5; subst. inversion H3; subst; inversion H5; subst.
unfold updEnv; simpl. unfold updEnv; simpl.
unfold updEnv in H0,H1; simpl in *. unfold updEnv in H0,H1; simpl in *.
symmetry in H0, H1. symmetry in H0, H1.
inversion H0; inversion H1; subst. inversion H0; inversion H1; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *) (* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear plus_float H4 H5 plus_real e1_real e1_float e2_real e2_float H0 H1. clear plus_float H3 H5 plus_real e1_real e1_float e2_real e2_float H0 H1.
repeat rewrite Rmult_plus_distr_l. repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r. rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus. rewrite Rsub_eq_Ropp_Rplus.
...@@ -123,21 +123,21 @@ Proof. ...@@ -123,21 +123,21 @@ Proof.
rewrite delta_0_deterministic; auto. rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *. unfold evalBinop in *; simpl in *.
clear delta H2. clear delta H2.
rewrite (meps_0_deterministic H4 e1_real); rewrite (meps_0_deterministic H3 e1_real);
rewrite (meps_0_deterministic H5 e2_real). rewrite (meps_0_deterministic H5 e2_real).
rewrite (meps_0_deterministic H4 e1_real) in sub_real. rewrite (meps_0_deterministic H3 e1_real) in sub_real.
rewrite (meps_0_deterministic H5 e2_real) in sub_real. rewrite (meps_0_deterministic H5 e2_real) in sub_real.
clear H4 H5 v1 v2. clear H3 H5 H6 v1 v2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *) (* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion sub_float; subst. inversion sub_float; subst.
unfold perturb; simpl. unfold perturb; simpl.
inversion H4; subst; inversion H5; subst. inversion H3; subst; inversion H5; subst.
unfold updEnv; simpl. unfold updEnv; simpl.
symmetry in H0, H1. symmetry in H0, H1.
unfold updEnv in H0, H1; simpl in H0, H1. unfold updEnv in H0, H1; simpl in H0, H1.
inversion H0; inversion H1; subst. inversion H0; inversion H1; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *) (* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear sub_float H4 H5 sub_real e1_real e1_float e2_real e2_float H0 H1. clear sub_float H3 H5 sub_real e1_real e1_float e2_real e2_float H0 H1.
repeat rewrite Rmult_plus_distr_l. repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r. rewrite Rmult_1_r.
repeat rewrite Rsub_eq_Ropp_Rplus. repeat rewrite Rsub_eq_Ropp_Rplus.
...@@ -177,20 +177,20 @@ Proof. ...@@ -177,20 +177,20 @@ Proof.
rewrite delta_0_deterministic; auto. rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *. unfold evalBinop in *; simpl in *.
clear delta H2. clear delta H2.
rewrite (meps_0_deterministic H4 e1_real); rewrite (meps_0_deterministic H3 e1_real);
rewrite (meps_0_deterministic H5 e2_real). rewrite (meps_0_deterministic H5 e2_real).
rewrite (meps_0_deterministic H4 e1_real) in mult_real. rewrite (meps_0_deterministic H3 e1_real) in mult_real.
rewrite (meps_0_deterministic H5 e2_real) in mult_real. rewrite (meps_0_deterministic H5 e2_real) in mult_real.
clear H4 H5 v1 v2. clear H3 H5 H6 v1 v2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *) (* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion mult_float; subst. inversion mult_float; subst.
unfold perturb; simpl. unfold perturb; simpl.
inversion H4; subst; inversion H5; subst. inversion H3; subst; inversion H5; subst.
symmetry in H0, H1; symmetry in H0, H1;
unfold updEnv in *; simpl in *. unfold updEnv in *; simpl in *.
inversion H0; inversion H1; subst. inversion H0; inversion H1; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *) (* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear mult_float H4 H5 mult_real e1_real e1_float e2_real e2_float H0 H1. clear mult_float H3 H5 mult_real e1_real e1_float e2_real e2_float H0 H1.
repeat rewrite Rmult_plus_distr_l. repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r. rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus. rewrite Rsub_eq_Ropp_Rplus.
...@@ -224,20 +224,20 @@ Proof. ...@@ -224,20 +224,20 @@ Proof.
rewrite delta_0_deterministic; auto. rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *. unfold evalBinop in *; simpl in *.
clear delta H2. clear delta H2.
rewrite (meps_0_deterministic H4 e1_real); rewrite (meps_0_deterministic H3 e1_real);
rewrite (meps_0_deterministic H5 e2_real). rewrite (meps_0_deterministic H5 e2_real).
rewrite (meps_0_deterministic H4 e1_real) in div_real. rewrite (meps_0_deterministic H3 e1_real) in div_real.
rewrite (meps_0_deterministic H5 e2_real) in div_real. rewrite (meps_0_deterministic H5 e2_real) in div_real.
clear H4 H5 v1 v2. clear H3 H5 H6 v1 v2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *) (* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion div_float; subst. inversion div_float; subst.
unfold perturb; simpl. unfold perturb; simpl.
inversion H4; subst; inversion H5; subst. inversion H3; subst; inversion H5; subst.
symmetry in H0, H1; symmetry in H0, H1;
unfold updEnv in *; simpl in *. unfold updEnv in *; simpl in *.
inversion H0; inversion H1; subst. inversion H0; inversion H1; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *) (* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear div_float H4 H5 div_real e1_real e1_float e2_real e2_float H0 H1. clear div_float H3 H5 div_real e1_real e1_float e2_real e2_float H0 H1.
repeat rewrite Rmult_plus_distr_l. repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r. rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus. rewrite Rsub_eq_Ropp_Rplus.
......
(** (**
Formalization of the base expression language for the daisy framework Formalization of the base expression language for the daisy framework
**) **)
...@@ -120,6 +121,7 @@ Inductive eval_exp (eps:R) (E:env) :(exp R) -> R -> Prop := ...@@ -120,6 +121,7 @@ Inductive eval_exp (eps:R) (E:env) :(exp R) -> R -> Prop :=
Rle (Rabs delta) eps -> Rle (Rabs delta) eps ->
eval_exp eps E f1 v1 -> eval_exp eps E f1 v1 ->
eval_exp eps E f2 v2 -> eval_exp eps E f2 v2 ->
((op = Div) -> (~ v2 = 0)%R) ->
eval_exp eps E (Binop op f1 f2) (perturb (evalBinop op v1 v2) delta). eval_exp eps E (Binop op f1 f2) (perturb (evalBinop op v1 v2) delta).
(** (**
......
...@@ -137,32 +137,6 @@ Qed. ...@@ -137,32 +137,6 @@ Qed.
Ltac env_assert absenv e name := Ltac env_assert absenv e name :=
assert (exists iv err, absenv e = (iv,err)) as name by (destruct (absenv e); repeat eexists; auto). assert (exists iv err, absenv e = (iv,err)) as name by (destruct (absenv e); repeat eexists; auto).
Lemma validBoundsDiv_uneq_zero e1 e2 absenv P V ivlo_e2 ivhi_e2 err:
absenv e2 = ((ivlo_e2,ivhi_e2), err) ->
validIntervalbounds (Binop Div e1 e2) absenv P V = true ->
(ivhi_e2 < 0) \/ (0 < ivlo_e2).
Proof.
intros absenv_eq validBounds.
unfold validIntervalbounds in validBounds.
env_assert absenv (Binop Div e1 e2) abs_div; destruct abs_div as [iv_div [err_div abs_div]].
env_assert absenv e1 abs_e1; destruct abs_e1 as [iv_e1 [err_e1 abs_e1]].
rewrite abs_div, abs_e1, absenv_eq in validBounds.
repeat (rewrite <- andb_lazy_alt in validBounds).
apply Is_true_eq_left in validBounds.
apply andb_prop_elim in validBounds.
destruct validBounds as [_ validBounds]; apply andb_prop_elim in validBounds.
destruct validBounds as [nodiv0 _].
apply Is_true_eq_true in nodiv0.
unfold isSupersetIntv in *; simpl in *.
apply le_neq_bool_to_lt_prop; auto.
Qed.
Fixpoint getRetExp (V:Type) (f:cmd V) :=
match f with
|Let x e g => getRetExp g
| Ret e => e
end.
Theorem validIntervalbounds_sound (f:exp Q) (absenv:analysisResult) (P:precond) fVars dVars E: Theorem validIntervalbounds_sound (f:exp Q) (absenv:analysisResult) (P:precond) fVars dVars E:
forall vR, forall vR,
validIntervalbounds f absenv P dVars = true -> validIntervalbounds f absenv P dVars = true ->
...@@ -490,6 +464,12 @@ Proof. ...@@ -490,6 +464,12 @@ Proof.
rewrite <- Q2R_max4 in valid_div_hi; auto. } } rewrite <- Q2R_max4 in valid_div_hi; auto. } }
Qed. Qed.
Fixpoint getRetExp (V:Type) (f:cmd V) :=
match f with
|Let x e g => getRetExp g
| Ret e => e
end.
Theorem validIntervalboundsCmd_sound (f:cmd Q) (absenv:analysisResult): Theorem validIntervalboundsCmd_sound (f:cmd Q) (absenv:analysisResult):
forall E vR fVars dVars outVars elo ehi err P, forall E vR fVars dVars outVars elo ehi err P,
ssa f (NatSet.union fVars dVars) outVars -> ssa f (NatSet.union fVars dVars) outVars ->
...@@ -502,7 +482,7 @@ Theorem validIntervalboundsCmd_sound (f:cmd Q) (absenv:analysisResult): ...@@ -502,7 +482,7 @@ Theorem validIntervalboundsCmd_sound (f:cmd Q) (absenv:analysisResult):
exists vR, exists vR,
E v = Some vR /\ E v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) -> (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
NatSet.Subset (NatSet.diff (Commands.freeVars f) dVars) fVars -> NatSet.Subset (NatSet.diff (freeVars f) dVars) fVars ->
validIntervalboundsCmd f absenv P dVars = true -> validIntervalboundsCmd f absenv P dVars = true ->
absenv (getRetExp f) = ((elo, ehi), err) -> absenv (getRetExp f) = ((elo, ehi), err) ->
(Q2R elo <= vR <= Q2R ehi)%R. (Q2R elo <= vR <= Q2R ehi)%R.
......
...@@ -37,6 +37,7 @@ Proof. ...@@ -37,6 +37,7 @@ Proof.
rewrite NatSet.union_spec; auto. rewrite NatSet.union_spec; auto.
Qed. Qed.
(*
Lemma validVars_non_stuck (e:exp Q) inVars E: Lemma validVars_non_stuck (e:exp Q) inVars E:
NatSet.Subset (usedVars e) inVars -> NatSet.Subset (usedVars e) inVars ->
(forall v, NatSet.In v (usedVars e) -> (forall v, NatSet.In v (usedVars e) ->
...@@ -80,7 +81,7 @@ Proof. ...@@ -80,7 +81,7 @@ Proof.
destruct eval_e2_def as [vR2 eval_e2_def]. destruct eval_e2_def as [vR2 eval_e2_def].
exists (perturb (evalBinop b vR1 vR2) 0); constructor; auto. exists (perturb (evalBinop b vR1 vR2) 0); constructor; auto.
rewrite Rabs_R0; lra. rewrite Rabs_R0; lra.
Qed. Qed. *)
Inductive ssa (V:Type): (cmd V) -> (NatSet.t) -> (NatSet.t) -> Prop := Inductive ssa (V:Type): (cmd V) -> (NatSet.t) -> (NatSet.t) -> Prop :=
ssaLet x e s inVars Vterm: ssaLet x e s inVars Vterm:
...@@ -95,7 +96,7 @@ Inductive ssa (V:Type): (cmd V) -> (NatSet.t) -> (NatSet.t) -> Prop := ...@@ -95,7 +96,7 @@ Inductive ssa (V:Type): (cmd V) -> (NatSet.t) -> (NatSet.t) -> Prop :=
Lemma ssa_subset_freeVars V (f:cmd V) inVars outVars: Lemma ssa_subset_freeVars V (f:cmd V) inVars outVars:
ssa f inVars outVars -> ssa f inVars outVars ->
NatSet.Subset (Commands.freeVars f) inVars. NatSet.Subset (freeVars f) inVars.
Proof. Proof.
intros ssa_f; induction ssa_f. intros ssa_f; induction ssa_f.
- simpl in *. hnf; intros a in_fVars. - simpl in *. hnf; intros a in_fVars.
...@@ -399,6 +400,129 @@ Fixpoint let_subst (f:cmd Q) := ...@@ -399,6 +400,129 @@ Fixpoint let_subst (f:cmd Q) :=
| Ret e1 => Some e1 | Ret e1 => Some e1
end. end.
Lemma eval_subst_subexp E e' n e vR:
NatSet.In n (usedVars e) ->
eval_exp 0 E (toRExp (exp_subst e n e')) vR ->
exists v, eval_exp 0 E (toRExp e') v.
Proof.
revert E e' n vR.
induction e;
intros E e' n' vR n_fVar eval_subst; simpl in *; try eauto.
- case_eq (n =? n'); intros case_n; rewrite case_n in *; eauto.
rewrite NatSet.singleton_spec in n_fVar.
exfalso.
rewrite Nat.eqb_neq in case_n.
apply case_n; auto.
- inversion n_fVar.
- inversion eval_subst; subst;
eapply IHe; eauto.
- inversion eval_subst; subst.
rewrite NatSet.union_spec in n_fVar.
destruct n_fVar as [n_fVar_e1 | n_fVare2];
[eapply IHe1; eauto | eapply IHe2; eauto].
Qed.
Lemma bstep_subst_subexp_any E e x f vR:
NatSet.In x (liveVars f) ->
bstep (toRCmd (map_subst f x e)) E 0 vR ->
exists E' v, eval_exp 0 E' (toRExp e) v.
Proof.
revert E e x vR;
induction f;
intros E e' x vR x_live eval_f.
- inversion eval_f; subst.
simpl in x_live.
rewrite NatSet.union_spec in x_live.
destruct x_live as [x_used | x_live].
+ exists E. eapply eval_subst_subexp; eauto.
+ eapply IHf; eauto.
- simpl in *.
inversion eval_f; subst.
exists E. eapply eval_subst_subexp; eauto.
Qed.
Lemma bstep_subst_subexp_ret E e x e' vR:
NatSet.In x (liveVars (Ret e')) ->
bstep (toRCmd (map_subst (Ret e') x e)) E 0 vR ->
exists v, eval_exp 0 E (toRExp e) v.
Proof.
simpl; intros x_live bstep_ret.
inversion bstep_ret; subst.
eapply eval_subst_subexp; eauto.
Qed.
Lemma no_forward_refs V (f:cmd V) inVars outVars:
ssa f inVars outVars ->
forall v, NatSet.In v (definedVars f) ->
NatSet.mem v inVars = false.
Proof.
intros ssa_f; induction ssa_f; simpl.
- intros v v_defVar.
rewrite NatSet.add_spec in v_defVar.
destruct v_defVar as [v_x | v_defVar].
+ subst; auto.
+ specialize (IHssa_f v v_defVar).
case_eq (NatSet.mem v inVars); intros mem_inVars; try auto.
assert (NatSet.mem v (NatSet.add x inVars) = true) by (rewrite NatSet.mem_spec, NatSet.add_spec, <- NatSet.mem_spec; auto).
congruence.
- intros v v_in_empty; inversion v_in_empty.
Qed.
Lemma bstep_subst_subexp_let E e x y e' g vR:
NatSet.In x (liveVars (Let y e' g)) ->
(forall x, NatSet.In x (usedVars e) ->
exists v, E x = v) ->
bstep (toRCmd (map_subst (Let y e' g) x e)) E 0 vR ->
exists v, eval_exp 0 E (toRExp e) v.
Proof.
revert E e x y e' vR;
induction g;
intros E e0 x y e' vR x_live uedVars_def bstep_f.
- simpl in *.
inversion bstep_f; subst.
specialize (IHg (updEnv y v E) e0 x n e).
rewrite NatSet.union_spec in x_live.
destruct x_live as [x_used | x_live].
+ eapply eval_subst_subexp; eauto.
+ edestruct IHg as [v0 eval_v0]; eauto.
dummy_bind_ok
Theorem let_free_agree f E vR inVars outVars e:
ssa f inVars outVars ->
(forall v, NatSet.In v (definedVars f) ->
NatSet.In v (liveVars f)) ->
let_subst f = Some e ->
bstep (toRCmd (Ret e)) E 0 vR ->
bstep (toRCmd f) E 0 vR.
Proof.
intros ssa_f.
revert E vR e;
induction ssa_f;
intros E vR e_subst dVars_live subst_step bstep_e;
simpl in *.
(* Let Case, prove that the value of the let binding must be used somewhere *)
- case_eq (let_subst s).
+ intros e0 subst_s; rewrite subst_s in *.
inversion subst_step; subst.
clear subst_s subst_step.
inversion bstep_e; subst.
specialize (dVars_live x).
rewrite NatSet.add_spec in dVars_live.
assert (NatSet.In x (NatSet.union (usedVars e) (liveVars s)))
as x_used_or_live
by (apply dVars_live; auto).
rewrite NatSet.union_spec in x_used_or_live.
destruct x_used_or_live as [x_used | x_live].
* specialize (H x x_used).
rewrite <- NatSet.mem_spec in H; congruence.
*
eapply let_b.
Focus 2.
eapply IHssa_f; try auto.
Theorem let_free_form f E vR inVars outVars e: Theorem let_free_form f E vR inVars outVars e:
ssa f inVars outVars -> ssa f inVars outVars ->
bstep (toRCmd f) E 0 vR -> bstep (toRCmd f) E 0 vR ->
......
...@@ -21,23 +21,27 @@ val _ = Datatype ` ...@@ -21,23 +21,27 @@ val _ = Datatype `
result value result value
**) **)
val (bstep_rules, bstep_ind, bstep_cases) = Hol_reln ` val (bstep_rules, bstep_ind, bstep_cases) = Hol_reln `
(!x e s s' E v eps vR. (!x e s E v eps vR.
eval_exp eps E e v /\ eval_exp eps E e v /\
bstep s (updEnv x v E) eps s' vR ==> bstep s (updEnv x v E) eps vR ==>
bstep (Let x e s) E eps s' vR) /\ bstep (Let x e s) E eps vR) /\
(!e E v eps. (!e E v eps.
eval_exp eps E e v ==> eval_exp eps E e v ==>
bstep (Ret e) E eps Nop v)`; bstep (Ret e) E eps v)`;
(** (**
Generate a better case lemma again Generate a better case lemma again
**) **)
val bstep_cases = val bstep_cases =
map (GEN_ALL o SIMP_CONV (srw_ss()) [Once bstep_cases]) map (GEN_ALL o SIMP_CONV (srw_ss()) [Once bstep_cases])
[``bstep (Let x e s) E eps s' VarEnv2``, [``bstep (Let x e s) E eps vR``,
``bstep (Ret e) E eps Nop VarEnv2``] ``bstep (Ret e) E eps vR``]
|> LIST_CONJ |> curry save_thm "bstep_cases"; |> LIST_CONJ |> curry save_thm "bstep_cases";
val [let_b, ret_b] = CONJ_LIST 2 bstep_rules;
save_thm ("let_b", let_b);
save_thm ("ret_b", ret_b);
(** (**
The free variables of a command are all used variables of expressions The free variables of a command are all used variables of expressions
without the let bound variables without the let bound variables
......
...@@ -94,6 +94,13 @@ val eval_exp_cases = ...@@ -94,6 +94,13 @@ val eval_exp_cases =
``eval_exp eps E (Binop n e1 e2) res``] ``eval_exp eps E (Binop n e1 e2) res``]
|> LIST_CONJ |> curry save_thm "eval_exp_cases"; |> LIST_CONJ |> curry save_thm "eval_exp_cases";
val [Var_load, Const_dist, Unop_neg, Unop_inv, Binop_dist] = CONJ_LIST 5 eval_exp_rules;
save_thm ("Var_load", Var_load);
save_thm ("Const_dist", Const_dist);
save_thm ("Unop_neg", Unop_neg);
save_thm ("Unop_inv", Unop_inv);
save_thm ("Binop_dist", Binop_dist);
(** (**
Define the set of "used" variables of an expression to be the set of variables Define the set of "used" variables of an expression to be the set of variables
occuring in it occuring in it
......
...@@ -52,4 +52,26 @@ fun qexistsl_tac termlist = ...@@ -52,4 +52,26 @@ fun qexistsl_tac termlist =
[] => ALL_TAC [] => ALL_TAC
| t::tel => qexists_tac t \\ qexistsl_tac tel; | t::tel => qexists_tac t \\ qexistsl_tac tel;
fun specialize pat_hyp pat_thm =
qpat_x_assum pat_hyp
(fn hyp =>
(qspec_then pat_thm ASSUME_TAC hyp) ORELSE
(qpat_assum pat_thm
(fn asm => ASSUME_TAC (MP hyp asm))));
fun rw_asm pat_asm =
qpat_x_assum pat_asm
(fn asm =>
(once_rewrite_tac [asm]));
fun rw_sym_asm pat_asm =
qpat_x_assum pat_asm
(fn asm =>
(once_rewrite_tac [GSYM asm]));
fun rw_thm_asm pat_asm thm =
qpat_x_assum pat_asm
(fn asm =>
(ASSUME_TAC (ONCE_REWRITE_RULE[thm] asm)));
end end
This diff is collapsed.
...@@ -63,11 +63,11 @@ val (ssa_rules, ssa_ind, ssa_cases) = Hol_reln ` ...@@ -63,11 +63,11 @@ val (ssa_rules, ssa_ind, ssa_cases) = Hol_reln `
(!x e s inVars Vterm. (!x e s inVars Vterm.
(domain (usedVars e)) SUBSET (domain inVars) /\ (domain (usedVars e)) SUBSET (domain inVars) /\
(~ (x IN (domain inVars))) /\ (~ (x IN (domain inVars))) /\
ssa s (Insert x inVars) Vterm ==> (ssa:'a cmd -> num_set -> num_set -> bool) s (Insert x inVars) Vterm ==>
ssa (Let x e s) inVars Vterm) /\ ssa (Let x e s) inVars Vterm) /\
(!e inVars Vterm. (!e inVars Vterm.
(domain (usedVars e))SUBSET (domain inVars) /\ (domain (usedVars e)) SUBSET (domain inVars) /\
(inVars = Vterm) ==> (domain inVars = domain Vterm) ==>
ssa (Ret e) inVars Vterm)`; ssa (Ret e) inVars Vterm)`;
(* (*
...@@ -77,17 +77,317 @@ val ssa_cases = ...@@ -77,17 +77,317 @@ val ssa_cases =
map (GEN_ALL o SIMP_CONV (srw_ss()) [Once ssa_cases]) map (GEN_ALL o SIMP_CONV (srw_ss()) [Once ssa_cases])
[``ssa (Let x e s) inVars Vterm``, [``ssa (Let x e s) inVars Vterm``,
``ssa (Ret e) inVars Vterm``] ``ssa (Ret e) inVars Vterm``]
|> LIST_CONJ |> curry save_thm "ssaPrg_cases"; |> LIST_CONJ |> curry save_thm "ssa_cases";
val [ssaLet, ssaRet] = CONJ_LIST 2 ssa_rules;
save_thm ("ssaLet",ssaLet);
save_thm ("ssaRet",ssaRet);
val ssa_subset_freeVars = store_thm ("ssa_subset_freeVars", val ssa_subset_freeVars = store_thm ("ssa_subset_freeVars",
``!(f:'a cmd) inVars outVars.
ssa f inVars outVars ==>
(domain (freeVars f)) SUBSET (domain inVars)``,
ho_match_mp_tac ssa_ind \\ rw []
>- (once_rewrite_tac [freeVars_def, domain_insert] \\ simp []
\\ once_rewrite_tac [domain_union]
\\ fs[SUBSET_DEF]
\\ rpt strip_tac
>- (first_x_assum match_mp_tac
\\ simp [])
>- (fs [Insert_def, domain_insert]
\\ metis_tac[]))
>- (once_rewrite_tac[freeVars_def]
\\ fs []));
val ssa_equal_set_ind = prove(
``!(f:'a cmd) inVars outVars.
ssa f inVars outVars ==>
(!inVars'.
(domain inVars' = domain inVars) ==>
ssa f inVars' outVars)``,
qspec_then `\f inVars outVars.
inVars'. (domain inVars' = domain inVars) ==> ssa f inVars' outVars` (fn thm => ASSUME_TAC (SIMP_RULE std_ss [] thm)) ssa_ind
\\ first_x_assum match_mp_tac
\\ conj_tac \\ rw[]
>- (match_mp_tac ssaLet \\ fs[]
\\ first_x_assum match_mp_tac