Commit 70ec029f authored by charguer's avatar charguer

progress cf liftted

parent a35bc4c0
......@@ -579,3 +579,75 @@ Notation "r `^` f `<-` v" :=
(at level 69, no associativity, f at level 0,
format "r `^` f `<-` v") : trm_scope.
(*------------------------------------------------------------------*)
(* ** Definition of the CF generator *)
Definition cf_def cf (t:Trm) :=
match t with
| Trm_val v => local (cf_val v)
| Trm_if v t1 t2 => local (cf_if v (cf t1) (cf t2))
| Trm_let x t1 t2 => local (cf_let (cf t1) (fun `{EA:Enc A} (X:A) => cf (Subst_Trm x X t2)))
| Trm_let_fix f x t1 t2 => local (cf_fix
(fun F `{EA:Enc A} (X:A) => cf (subst_Trm f F (Subst_Trm x X t1)))
(fun F => cf (subst_Trm f F t2)))
| Trm_app f v => local (cf_app f v)
| _ => local (cf_fail)
end.
Definition cf := FixFun cf_def.
Ltac smath := simpl; math.
Hint Extern 1 (lt _ _) => smath.
Lemma cf_unfold : forall t,
cf t = cf_def cf t.
Proof using.
applys~ (FixFun_fix (measure Trm_size)). auto with wf.
intros f1 f2 t IH. unfold measure in IH. unfold cf_def.
destruct t; fequals.
{ rewrite~ IH. rewrite~ IH. }
{ rewrite~ IH. fequals.
apply func_ext_dep_3. intros A1 EA1 X.
rewrite~ IH. unfold Subst_Trm. rewrite~ Trm_size_subst. }
{ fequals.
{ apply func_ext_dep_4. intros F A1 EA1 X.
rewrite~ IH. unfold Subst_Trm. do 2 rewrite~ Trm_size_subst. }
{ apply func_ext_1. intros X. rewrite~ IH. rewrite~ Trm_size_subst. } }
Qed.
(********************************************************************)
(* ** Soundness proof *)
(*------------------------------------------------------------------*)
(* ** Soundness predicate *)
Definition sound_for (t:trm) (F:formula) :=
forall H `{EA:Enc A} (Q:A->hprop), 'F H Q -> Triple t H Q.
(*------------------------------------------------------------------*)
(* ** Soundness of local *)
Lemma local_sound : forall t (F:formula),
sound_for t F ->
sound_for t (local F).
Admitted.
(*------------------------------------------------------------------*)
(* ** Soundness predicate *)
Lemma cf_sound : forall (t:Trm),
sound_for t (cf t).
Proof using.
intros t. induction_wf: Trm_size t.
rewrite cf_unfold. destruct t; simpl;
applys local_sound; intros H A EA Q P.
{ destruct P as (V&EV&HV). applys~ Rule_val V. }
Abort.
......@@ -257,7 +257,7 @@ Definition cf_fix0 (F1of : val -> formula)
Definition cf_fix1 (F1of : val -> val -> formula)
(F2of : val -> formula) : formula := fun H Q =>
forall (F:val),
(forall X, (F1of F X) ===> app F [X]) ->
(forall X1, (F1of F X1) ===> app F [X1]) ->
(F2of F) H Q.
(* LATER
......@@ -337,7 +337,7 @@ Proof using.
{ applys func_equal_1.
{ rename v0 into xs. destruct xs as [|x [|]]; fequals.
{ applys func_ext_1. intros F. rewrite~ IH. do 2 rewrite~ Trm_size_subst. }
{ applys func_ext_2. intros F X. rewrite~ IH. do 2 rewrite~ Trm_size_subst. }
{ applys func_ext_2. intros F X1. rewrite~ IH. do 2 rewrite~ Trm_size_subst. }
{ applys func_ext_2. intros F Xs. rewrite~ IH. do 2 rewrite~ Trm_size_subst. } }
{ apply func_ext_1. intros F. rewrite~ IH. rewrite~ Trm_size_subst. } }
Qed.
......@@ -446,7 +446,7 @@ Proof using. intros. applys* cf_sound_induction. Qed.
(*------------------------------------------------------------------*)
(* ** Soundness proof, usable version *)
(* ** Soundness result, practical versions *)
Theorem cf_sound : forall (t:trm) H Q,
cf (Trm_of_trm t) H Q ->
......@@ -456,11 +456,6 @@ Proof using.
applys~ cf_sound_final.
Qed.
(********************************************************************)
(* ** Practical proofs using characteristic formulae *)
Theorem cf_sound_app : forall n F vs (f:var) (xs:vars) (t:trm) H Q,
F = val_fix f xs t ->
List.length xs = List.length vs ->
......
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