Commit 148d00ca authored by Dan Frumin's avatar Dan Frumin

Get rid of some admits

parent cab3db52
......@@ -296,6 +296,48 @@ Fixpoint dcexpr_interp (E: known_locs) (de: dcexpr) : expr :=
| dCUnknown e1 => W.to_expr e1
end.
(** ** Substitution *)
Fixpoint de_subst
(E: known_locs) (x: string) (dv : dval) (de: dexpr) : dexpr :=
match de with
| dEVal _ => de
| dEVar y => if decide (x = y) then dEVal dv else de
| dEPair de1 de2 => dEPair (de_subst E x dv de1) (de_subst E x dv de2)
| dEFst de1 => dEFst (de_subst E x dv de1)
| dESnd de1 => dESnd (de_subst E x dv de1)
| dEUnknown we =>
dEUnknown (W.subst x
(W.Val (dval_interp E dv)
(of_val (dval_interp E dv))
(to_of_val _ )) we)
end.
Fixpoint dce_subst (E: known_locs)
(x: string) (dv : dval) (dce : dcexpr) : dcexpr :=
match dce with
| dCRet de1 => dCRet (de_subst E x dv de1)
| dCBind y de1 de2 =>
if decide (x = y)
then dCBind y (dce_subst E x dv de1) de2
else dCBind y (dce_subst E x dv de1) (dce_subst E x dv de2)
| dCAlloc de1 de2 => dCAlloc (dce_subst E x dv de1) (dce_subst E x dv de2)
| dCLoad de1 => dCLoad (dce_subst E x dv de1)
| dCStore de1 de2 => dCStore (dce_subst E x dv de1) (dce_subst E x dv de2)
| dCBinOp op de1 de2 =>
dCBinOp op (dce_subst E x dv de1) (dce_subst E x dv de2)
| dCPreBinOp op de1 de2 =>
dCPreBinOp op (dce_subst E x dv de1) (dce_subst E x dv de2)
| dCUnOp op de1 => dCUnOp op (dce_subst E x dv de1)
| dCSeq de1 de2 => dCSeq (dce_subst E x dv de1) (dce_subst E x dv de2)
| dCPar de1 de2 => dCPar (dce_subst E x dv de1) (dce_subst E x dv de2)
| dCInvoke v de1 => dCInvoke v (dce_subst E x dv de1)
| dCUnknown we => dCUnknown (W.subst x (W.Val (dval_interp E dv)
(of_val (dval_interp E dv))
(to_of_val _ )) we)
end.
(** Well-formedness of dcexpr w.r.t. known_locs *)
Definition dloc_wf (E: known_locs) (dl : dloc) : bool :=
match dl with
......@@ -330,6 +372,74 @@ Fixpoint dcexpr_wf (X: list string) (E: known_locs) (de: dcexpr) : bool :=
| dCUnknown e => W.is_closed X e
end.
(** Substitution properties *)
(* We need to be able to simplify subst in the following lemma *)
Arguments subst _ _ !_ /.
Lemma de_subst_subst_comm E x de dv :
(dexpr_interp E (de_subst E x dv de)) =
subst x (dval_interp E dv) (dexpr_interp E de).
Proof.
induction de; simplify_eq /=.
- by simpl_subst.
- by destruct (decide (x = s)).
- try (repeat match goal with | [ H: _ = subst _ _ _ |- _ ] => rewrite H
end; by simpl_subst).
- try (repeat match goal with | [ H: _ = subst _ _ _ |- _ ] => rewrite H
end; by simpl_subst).
- try (repeat match goal with | [ H: _ = subst _ _ _ |- _ ] => rewrite H
end; by simpl_subst).
- by rewrite! W.to_expr_subst.
Qed.
Lemma dce_subst_subst_comm E (x: string) (de: dcexpr) (dv: dval) :
dcexpr_interp E (dce_subst E x dv de) =
(subst x (dval_interp E dv) (dcexpr_interp E de))%E.
Proof.
induction de; simplify_eq /=; simpl_subst;
try (repeat match goal with | [ H: _ = subst _ _ _ |- _ ] => rewrite H
end; by simpl_subst).
- by rewrite de_subst_subst_comm.
- destruct (decide (x = s)); simplify_eq /=; rewrite IHde1.
+ rewrite decide_False; naive_solver.
+ rewrite IHde2 decide_True; naive_solver.
Qed.
(* Turn the simplification in subst OFF again *)
Arguments subst : simpl never.
Lemma de_subst_dexpr_wf X E s dv1 de2 :
dval_wf E dv1
dexpr_wf (s::X) E de2
dexpr_wf X E (de_subst E s dv1 de2).
Proof.
revert X. induction de2; intros X Hdv1 Hwf2;
simplify_eq/=; try naive_solver.
- case_match; eauto. simpl.
apply bool_decide_pack.
apply bool_decide_unpack in Hwf2.
set_solver.
- apply W.is_closed_correct in Hwf2.
admit.
Admitted.
Lemma dce_subst_dcexpr_wf X E s dv1 de2 :
dval_wf E dv1
dcexpr_wf (s::X) E de2
dcexpr_wf X E (dce_subst E s dv1 de2).
Proof.
revert X. induction de2; intros X Hdv1 Hwf2;
simplify_eq/=; try naive_solver.
- by apply de_subst_dexpr_wf.
- destruct_and!. case_match; simpl; split_and; eauto.
+ subst.
(* use H0 *)
admit.
+ eapply IHde2_2; eauto.
admit.
- apply W.is_closed_correct in Hwf2.
admit. (* Need W.is_closed_correct in the opposite direction *)
Admitted.
(*TODO: Fuse wf_mono and interp_mono into one lemma for dval and dcexpr *)
Lemma dval_wf_mono (E E': known_locs) (dv: dval) :
......
This diff is collapsed.
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