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
......@@ -43,4 +43,14 @@ Fixpoint definedVars V (f:cmd V) :NatSet.t :=
match f with
| Let x _ g => NatSet.add x (definedVars g)
| Ret _ => NatSet.empty
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.
rewrite (delta_0_deterministic (evalBinop Plus v1 v2) delta); auto.
unfold evalBinop in *; simpl in *.
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 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.
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 *)
inversion plus_float; subst.
unfold perturb; simpl.
inversion H4; subst; inversion H5; subst.
inversion H3; subst; inversion H5; subst.
unfold updEnv; simpl.
unfold updEnv in H0,H1; simpl in *.
symmetry in H0, H1.
inversion H0; inversion H1; subst.
(* 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.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......@@ -123,21 +123,21 @@ Proof.
rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *.
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 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.
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 *)
inversion sub_float; subst.
unfold perturb; simpl.
inversion H4; subst; inversion H5; subst.
inversion H3; subst; inversion H5; subst.
unfold updEnv; simpl.
symmetry in H0, H1.
unfold updEnv in H0, H1; simpl in H0, H1.
inversion H0; inversion H1; subst.
(* 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.
rewrite Rmult_1_r.
repeat rewrite Rsub_eq_Ropp_Rplus.
......@@ -177,20 +177,20 @@ Proof.
rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *.
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 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.
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 *)
inversion mult_float; subst.
unfold perturb; simpl.
inversion H4; subst; inversion H5; subst.
inversion H3; subst; inversion H5; subst.
symmetry in H0, H1;
unfold updEnv in *; simpl in *.
inversion H0; inversion H1; subst.
(* 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.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......@@ -224,20 +224,20 @@ Proof.
rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *.
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 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.
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 *)
inversion div_float; subst.
unfold perturb; simpl.
inversion H4; subst; inversion H5; subst.
inversion H3; subst; inversion H5; subst.
symmetry in H0, H1;
unfold updEnv in *; simpl in *.
inversion H0; inversion H1; subst.
(* 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.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......
(**
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 :=
Rle (Rabs delta) eps ->
eval_exp eps E f1 v1 ->
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).
(**
......
......@@ -137,32 +137,6 @@ Qed.
Ltac env_assert absenv e name :=
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:
forall vR,
validIntervalbounds f absenv P dVars = true ->
......@@ -490,6 +464,12 @@ Proof.
rewrite <- Q2R_max4 in valid_div_hi; auto. } }
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):
forall E vR fVars dVars outVars elo ehi err P,
ssa f (NatSet.union fVars dVars) outVars ->
......@@ -502,7 +482,7 @@ Theorem validIntervalboundsCmd_sound (f:cmd Q) (absenv:analysisResult):
exists vR,
E v = Some vR /\
(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 ->
absenv (getRetExp f) = ((elo, ehi), err) ->
(Q2R elo <= vR <= Q2R ehi)%R.
......
......@@ -37,6 +37,7 @@ Proof.
rewrite NatSet.union_spec; auto.
Qed.
(*
Lemma validVars_non_stuck (e:exp Q) inVars E:
NatSet.Subset (usedVars e) inVars ->
(forall v, NatSet.In v (usedVars e) ->
......@@ -80,7 +81,7 @@ Proof.
destruct eval_e2_def as [vR2 eval_e2_def].
exists (perturb (evalBinop b vR1 vR2) 0); constructor; auto.
rewrite Rabs_R0; lra.
Qed.
Qed. *)
Inductive ssa (V:Type): (cmd V) -> (NatSet.t) -> (NatSet.t) -> Prop :=
ssaLet x e s inVars Vterm:
......@@ -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:
ssa f inVars outVars ->
NatSet.Subset (Commands.freeVars f) inVars.
NatSet.Subset (freeVars f) inVars.
Proof.
intros ssa_f; induction ssa_f.
- simpl in *. hnf; intros a in_fVars.
......@@ -399,6 +400,129 @@ Fixpoint let_subst (f:cmd Q) :=
| Ret e1 => Some e1
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:
ssa f inVars outVars ->
bstep (toRCmd f) E 0 vR ->
......
......@@ -21,23 +21,27 @@ val _ = Datatype `
result value
**)
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 /\
bstep s (updEnv x v E) eps s' vR ==>
bstep (Let x e s) E eps s' vR) /\
bstep s (updEnv x v E) eps vR ==>
bstep (Let x e s) E eps vR) /\
(!e E v eps.
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
**)
val bstep_cases =
map (GEN_ALL o SIMP_CONV (srw_ss()) [Once bstep_cases])
[``bstep (Let x e s) E eps s' VarEnv2``,
``bstep (Ret e) E eps Nop VarEnv2``]
[``bstep (Let x e s) E eps vR``,
``bstep (Ret e) E eps vR``]
|> 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
without the let bound variables
......
......@@ -94,6 +94,13 @@ val eval_exp_cases =
``eval_exp eps E (Binop n e1 e2) res``]
|> 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
occuring in it
......
......@@ -52,4 +52,26 @@ fun qexistsl_tac termlist =
[] => ALL_TAC
| 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
......@@ -6,285 +6,293 @@
The function is used in CertificateChecker.v to build the full checker.
**)
open preamble
open simpLib realTheory realLib RealArith
open AbbrevsTheory ExpressionsTheory RealSimpsTheory
open simpLib realTheory realLib RealArith pred_setTheory sptreeTheory
open AbbrevsTheory ExpressionsTheory RealSimpsTheory DaisyTactics
open ExpressionAbbrevsTheory IntervalArithTheory CommandsTheory ssaPrgsTheory
val _ = new_theory "IntervalValidation";
val freeVars_def = Define `
(freeVars (Const n) = []) /\
(freeVars (Var v) = []) /\
(freeVars (Param v) = [v] ) /\
(freeVars (Unop op f1) = freeVars f1) /\
(freeVars (Binop op f1 f2) = APPEND (freeVars f1) (freeVars f2))`;
val validIntervalbounds_def = Define `
validIntervalbounds e (absenv:analysisResult) (P:precond) (validVars:num set) =
let (intv, _) = absenv e in
validIntervalbounds e (absenv:analysisResult) (P:precond) (validVars:num_set) =
let (intv, _) = absenv e in
case e of
| Var v => v IN validVars
| Param v => isSupersetInterval (P v) intv
| Var v =>
if (lookup v validVars = SOME ())
then T
else (isSupersetInterval (P v) intv /\ IVlo (P v) <= IVhi (P v))
| Const n => isSupersetInterval (n,n) intv
| Unop op f =>
let rec = validIntervalbounds f absenv P validVars in
(if validIntervalbounds f absenv P validVars
then
let (iv, _) = absenv f in
let opres =
case op of
| Neg =>
let new_iv = negateInterval iv in
isSupersetInterval new_iv intv
| Inv =>
let nodiv0 = IVhi iv < 0 \/ 0 < IVlo iv in
let new_iv = invertInterval iv in
isSupersetInterval new_iv intv /\ nodiv0
in
rec /\ opres
| Binop op f1 f2 =>
let rec = (validIntervalbounds f1 absenv P validVars /\ validIntervalbounds f2 absenv P validVars) in
let (iv1, _ ) = absenv f1 in
let (iv2, _) = absenv f2 in
let opres =
case op of
| Plus =>
let new_iv = addInterval iv1 iv2 in
isSupersetInterval new_iv intv
| Sub =>
let new_iv = subtractInterval iv1 iv2 in
isSupersetInterval new_iv intv
| Mult =>
let new_iv = multInterval iv1 iv2 in
isSupersetInterval new_iv intv
| Div =>
let nodiv0 = IVhi iv2 < 0 \/ 0 < IVlo iv2 in
let new_iv = divideInterval iv1 iv2 in
isSupersetInterval new_iv intv /\ nodiv0
in
rec /\ opres `;
case op of
| Neg =>
let new_iv = negateInterval iv in
isSupersetInterval new_iv intv
| Inv =>
if IVhi iv < 0 \/ 0 < IVlo iv
then
let new_iv = invertInterval iv in
isSupersetInterval new_iv intv
else
F
else F)
| Binop op f1 f2 =>
(if (validIntervalbounds f1 absenv P validVars /\ validIntervalbounds f2 absenv P validVars)
then
let (iv1, _ ) = absenv f1 in
let (iv2, _) = absenv f2 in
case op of
| Plus =>
let new_iv = addInterval iv1 iv2 in
isSupersetInterval new_iv intv
| Sub =>
let new_iv = subtractInterval iv1 iv2 in
isSupersetInterval new_iv intv
| Mult =>
let new_iv = multInterval iv1 iv2 in
isSupersetInterval new_iv intv
| Div =>
if (IVhi iv2 < 0 \/ 0 < IVlo iv2)
then
let new_iv = divideInterval iv1 iv2 in
isSupersetInterval new_iv intv
else F
else F)`;
val validIntervalboundsCmd_def = Define `
validIntervalboundsCmd (f:real cmd) (absenv:analysisResult) (P:precond) (validVars:num set) =
case f of
| Let x e g =>
(validIntervalbounds e absenv P validVars /\
(FST (absenv e) = FST (absenv (Var x))) /\
validIntervalboundsCmd g absenv P (x INSERT validVars))
validIntervalboundsCmd (f:real cmd) (absenv:analysisResult) (P:precond) (validVars:num_set) =
case f of
| Let x e g =>
if (validIntervalbounds e absenv P validVars /\
(FST (absenv e) = FST (absenv (Var x))))
then validIntervalboundsCmd g absenv P (Insert x validVars)
else F
| Ret e =>
(validIntervalbounds e absenv P validVars /\
(FST (absenv e) = FST (absenv (Var 0))))
| Nop => F`;
(FST (absenv e) = FST (absenv (Var 0))))`;
val ivbounds_approximatesPrecond_sound = store_thm ("ivbounds_approximatesPrecond_sound",
``!(f:real exp) (absenv:analysisResult) (P:precond) (V:num set).
``!(f:real exp) (absenv:analysisResult) (P:precond) (V:num_set).
validIntervalbounds f absenv P V ==>
(!(v:num). MEM v (freeVars f) ==>
isSupersetInterval (P v) (FST (absenv (Param v))))``,
Induct_on `f` \\ rpt strip_tac \\ fs [freeVars_def]
>- (rule_assum_tac (ONCE_REWRITE_RULE [validIntervalbounds_def]) \\
Cases_on `absenv (Param n)` \\ fs[])
>- (first_x_assum (fn thm => qspecl_then [`absenv`, `P`, `V`] ASSUME_TAC thm) \\
Q.PAT_UNDISCH_TAC `MEM v (freeVars f)`\\
first_x_assum match_mp_tac \\
qpat_assum `validIntervalbounds (Unop u f) absenv P V`
(fn th => ASSUME_TAC (ASM_SIMP_RULE bool_ss [] (ONCE_REWRITE_RULE [validIntervalbounds_def] th))) \\
simp [] \\
Cases_on `absenv (Unop u f)` \\
Cases_on `u` \\ Cases_on `absenv f` \\ fs[])
>- (rpt (first_x_assum (fn thm => qspecl_then [`absenv`, `P`, `V`] ASSUME_TAC thm)) \\
Q.PAT_UNDISCH_TAC `MEM v (freeVars f)` \\
first_x_assum match_mp_tac \\
qpat_assum `validIntervalbounds (Binop b f f') absenv P V`
(fn th => ASSUME_TAC (ASM_SIMP_RULE bool_ss [] (ONCE_REWRITE_RULE [validIntervalbounds_def] th))) \\
simp [] \\
Cases_on `absenv (Binop b f f')` \\
Cases_on `b` \\ Cases_on `absenv f` \\ Cases_on `absenv f'` \\ fs[])
>- (rpt (first_x_assum (fn thm => qspecl_then [`absenv`, `P`, `V`] ASSUME_TAC thm)) \\
Q.PAT_UNDISCH_TAC `MEM v (freeVars f')` \\
first_x_assum match_mp_tac \\
qpat_assum `validIntervalbounds (Binop b f f') absenv P V`
(fn th => ASSUME_TAC (ASM_SIMP_RULE bool_ss [] (ONCE_REWRITE_RULE [validIntervalbounds_def] th))) \\
simp [] \\
Cases_on `absenv (Binop b f f')` \\
Cases_on `b` \\ Cases_on `absenv f` \\ Cases_on `absenv f'` \\ fs[]));
(!(v:num). v IN ((domain (usedVars f)) DIFF (domain V)) ==>
isSupersetInterval (P v) (FST (absenv (Var v))))``,
Induct_on `f` \\ once_rewrite_tac [usedVars_def] \\ rpt strip_tac \\ fs[]
>- (rule_assum_tac (ONCE_REWRITE_RULE [validIntervalbounds_def])
\\ fs [domain_lookup, usedVars_def, lookup_insert]
\\ `v = n` by (Cases_on `v = n` \\ fs[lookup_def])
\\ rveq
\\ Cases_on `absenv (Var n)`
\\ Cases_on `lookup n V`
\\ fs[])
>- (rpt (first_x_assum (fn thm => qspecl_then [`absenv`, `P`, `V`] ASSUME_TAC thm))
\\ `validIntervalbounds f absenv P V`
by (qpat_x_assum `validIntervalbounds _ _ _ _` (fn thm => ASSUME_TAC (ONCE_REWRITE_RULE [validIntervalbounds_def] thm))
\\ Cases_on `absenv (Unop u f)` \\ fs[])