mirror of
https://github.com/achlipala/frap.git
synced 2024-11-10 00:07:51 +00:00
Connecting: parameterizing translation in a way that should support loops later
This commit is contained in:
parent
ca6d577f84
commit
d537e28266
1 changed files with 46 additions and 21 deletions
67
Connecting.v
67
Connecting.v
|
@ -1154,21 +1154,27 @@ Module MixedToDeep(Import BW : BIT_WIDTH).
|
||||||
| WhileLoop _ s1 => couldWrite x s1
|
| WhileLoop _ s1 => couldWrite x s1
|
||||||
end.
|
end.
|
||||||
|
|
||||||
Inductive translate (out : var) : valuation -> forall {A}, cmd A -> stmt -> Prop :=
|
Inductive translate_result (out : var) (V : valuation) (v : wrd) : stmt -> Prop :=
|
||||||
| TrReturn : forall V (A : Set) (v : A) e,
|
| TrReturn : forall e,
|
||||||
translate_exp V v e
|
translate_exp V v e
|
||||||
-> translate out V (Return v) (Assign out e)
|
-> translate_result out V v (Assign out e)
|
||||||
| TrReturned : forall V v,
|
| TrReturned :
|
||||||
V $? out = Some v
|
V $? out = Some v
|
||||||
-> translate out V (Return v) Skip
|
-> translate_result out V v Skip.
|
||||||
|
|
||||||
|
Inductive translate {RT : Set} (translate_return : valuation -> RT -> stmt -> Prop)
|
||||||
|
: valuation -> forall {A}, cmd A -> stmt -> Prop :=
|
||||||
|
| TrDone : forall V (v : RT) s,
|
||||||
|
translate_return V v s
|
||||||
|
-> translate translate_return V (Return v) s
|
||||||
| TrAssign : forall V (B : Set) (v : wrd) (c : wrd -> cmd B) e x s1,
|
| TrAssign : forall V (B : Set) (v : wrd) (c : wrd -> cmd B) e x s1,
|
||||||
translate_exp V v e
|
translate_exp V v e
|
||||||
-> (forall w, translate out (V $+ (x, w)) (c w) s1)
|
-> (forall w, translate translate_return (V $+ (x, w)) (c w) s1)
|
||||||
-> translate out V (Bind (Return v) c) (Seq (Assign x e) s1)
|
-> translate translate_return V (Bind (Return v) c) (Seq (Assign x e) s1)
|
||||||
| TrAssigned : forall V (B : Set) (v : wrd) (c : wrd -> cmd B) x s1,
|
| TrAssigned : forall V (B : Set) (v : wrd) (c : wrd -> cmd B) x s1,
|
||||||
V $? x = Some v
|
V $? x = Some v
|
||||||
-> translate out (V $+ (x, v)) (c v) s1
|
-> translate translate_return (V $+ (x, v)) (c v) s1
|
||||||
-> translate out V (Bind (Return v) c) (Seq Skip s1).
|
-> translate translate_return V (Bind (Return v) c) (Seq Skip s1).
|
||||||
|
|
||||||
Example adder (a b c : wrd) :=
|
Example adder (a b c : wrd) :=
|
||||||
Bind (Return (a ^+ b)) (fun ab => Return (ab ^+ c)).
|
Bind (Return (a ^+ b)) (fun ab => Return (ab ^+ c)).
|
||||||
|
@ -1189,14 +1195,14 @@ Module MixedToDeep(Import BW : BIT_WIDTH).
|
||||||
| context[add _ ?y v] => apply TrVar with (x := y); simplify; equality
|
| context[add _ ?y v] => apply TrVar with (x := y); simplify; equality
|
||||||
end
|
end
|
||||||
|
|
||||||
| [ |- translate _ _ (Return _) _ ] => apply TrReturn
|
| [ |- translate _ _ (Return _) _ ] => apply TrDone; apply TrReturn
|
||||||
| [ |- translate _ ?V (Bind (Return _) _) _ ] =>
|
| [ |- translate _ ?V (Bind (Return _) _) _ ] =>
|
||||||
freshFor V ltac:(fun y =>
|
freshFor V ltac:(fun y =>
|
||||||
eapply TrAssign with (x := y); [ | intro ])
|
eapply TrAssign with (x := y); [ | intro ])
|
||||||
end.
|
end.
|
||||||
|
|
||||||
Lemma translate_adder : sig (fun s =>
|
Lemma translate_adder : sig (fun s =>
|
||||||
forall a b c, translate "result" ($0 $+ ("a", a) $+ ("b", b) $+ ("c", c)) (adder a b c) s).
|
forall a b c, translate (translate_result "result") ($0 $+ ("a", a) $+ ("b", b) $+ ("c", c)) (adder a b c) s).
|
||||||
Proof.
|
Proof.
|
||||||
eexists; simplify.
|
eexists; simplify.
|
||||||
unfold adder.
|
unfold adder.
|
||||||
|
@ -1214,7 +1220,7 @@ Module MixedToDeep(Import BW : BIT_WIDTH).
|
||||||
|
|
||||||
Inductive translated : forall {A}, DE.heap * valuation * stmt -> ME.heap * cmd A -> Prop :=
|
Inductive translated : forall {A}, DE.heap * valuation * stmt -> ME.heap * cmd A -> Prop :=
|
||||||
| Translated : forall A H h V s (c : cmd A),
|
| Translated : forall A H h V s (c : cmd A),
|
||||||
translate "result" V c s
|
translate (translate_result "result") V c s
|
||||||
-> heaps_compat H h
|
-> heaps_compat H h
|
||||||
-> translated (H, V, s) (h, c).
|
-> translated (H, V, s) (h, c).
|
||||||
|
|
||||||
|
@ -1250,21 +1256,28 @@ Module MixedToDeep(Import BW : BIT_WIDTH).
|
||||||
Lemma step_translate : forall H V s H' V' s',
|
Lemma step_translate : forall H V s H' V' s',
|
||||||
DE.step (H, V, s) (H', V', s')
|
DE.step (H, V, s) (H', V', s')
|
||||||
-> forall h (c : cmd wrd) out,
|
-> forall h (c : cmd wrd) out,
|
||||||
translate out V c s
|
translate (translate_result out) V c s
|
||||||
-> heaps_compat H h
|
-> heaps_compat H h
|
||||||
-> exists c' h', ME.step^* (h, c) (h', c')
|
-> exists c' h', ME.step^* (h, c) (h', c')
|
||||||
/\ translate out V' c' s'
|
/\ translate (translate_result out) V' c' s'
|
||||||
/\ heaps_compat H' h'.
|
/\ heaps_compat H' h'.
|
||||||
Proof.
|
Proof.
|
||||||
induct 1; invert 1; simplify.
|
induct 1; invert 1; simplify.
|
||||||
|
|
||||||
|
invert H3.
|
||||||
apply inj_pair2 in H1; subst.
|
apply inj_pair2 in H1; subst.
|
||||||
eapply eval_translate in H5; eauto; subst.
|
eapply eval_translate in H4; eauto; subst.
|
||||||
do 2 eexists; propositional.
|
do 2 eexists; propositional.
|
||||||
eauto.
|
eauto.
|
||||||
apply TrReturned; simplify; auto.
|
apply TrDone; apply TrReturned; simplify; auto.
|
||||||
assumption.
|
assumption.
|
||||||
|
|
||||||
|
invert H6.
|
||||||
|
|
||||||
|
invert H6.
|
||||||
|
|
||||||
|
invert H2.
|
||||||
|
|
||||||
apply inj_pair2 in H0; subst.
|
apply inj_pair2 in H0; subst.
|
||||||
do 2 eexists; propositional.
|
do 2 eexists; propositional.
|
||||||
eapply TrcFront.
|
eapply TrcFront.
|
||||||
|
@ -1276,13 +1289,16 @@ Module MixedToDeep(Import BW : BIT_WIDTH).
|
||||||
symmetry; assumption.
|
symmetry; assumption.
|
||||||
assumption.
|
assumption.
|
||||||
|
|
||||||
|
invert H4.
|
||||||
|
|
||||||
apply inj_pair2 in H2; subst.
|
apply inj_pair2 in H2; subst.
|
||||||
invert H0.
|
invert H0.
|
||||||
do 2 eexists; propositional.
|
do 2 eexists; propositional.
|
||||||
eauto.
|
eauto.
|
||||||
eapply TrAssigned with (x := x).
|
eapply TrAssigned.
|
||||||
eapply eval_translate in H7; eauto.
|
instantiate (1 := x).
|
||||||
simplify.
|
simplify.
|
||||||
|
eapply eval_translate in H7; eauto.
|
||||||
subst.
|
subst.
|
||||||
reflexivity.
|
reflexivity.
|
||||||
match goal with
|
match goal with
|
||||||
|
@ -1292,10 +1308,18 @@ Module MixedToDeep(Import BW : BIT_WIDTH).
|
||||||
assumption.
|
assumption.
|
||||||
|
|
||||||
invert H0.
|
invert H0.
|
||||||
|
|
||||||
|
invert H4.
|
||||||
|
|
||||||
|
invert H3.
|
||||||
|
|
||||||
|
invert H4.
|
||||||
|
|
||||||
|
invert H3.
|
||||||
Qed.
|
Qed.
|
||||||
|
|
||||||
Theorem translated_simulates : forall H V c h s,
|
Theorem translated_simulates : forall H V c h s,
|
||||||
translate "result" V c s
|
translate (translate_result "result") V c s
|
||||||
-> heaps_compat H h
|
-> heaps_compat H h
|
||||||
-> simulates (translated (A := wrd)) (DE.trsys_of H V s) (ME.multistep_trsys_of h c).
|
-> simulates (translated (A := wrd)) (DE.trsys_of H V s) (ME.multistep_trsys_of h c).
|
||||||
Proof.
|
Proof.
|
||||||
|
@ -1333,7 +1357,7 @@ Module MixedToDeep(Import BW : BIT_WIDTH).
|
||||||
|
|
||||||
Lemma not_stuck : forall A h (c : cmd A) h' c',
|
Lemma not_stuck : forall A h (c : cmd A) h' c',
|
||||||
step (h, c) (h', c')
|
step (h, c) (h', c')
|
||||||
-> forall out V s, translate out V c s
|
-> forall out V s, translate (translate_result out) V c s
|
||||||
-> forall H, exists p', DE.step (H, V, s) p'.
|
-> forall H, exists p', DE.step (H, V, s) p'.
|
||||||
Proof.
|
Proof.
|
||||||
induct 1; invert 1; simplify.
|
induct 1; invert 1; simplify.
|
||||||
|
@ -1359,7 +1383,7 @@ Module MixedToDeep(Import BW : BIT_WIDTH).
|
||||||
hoare_triple P c Q
|
hoare_triple P c Q
|
||||||
-> P h
|
-> P h
|
||||||
-> heaps_compat H h
|
-> heaps_compat H h
|
||||||
-> translate "result" V c s
|
-> translate (translate_result "result") V c s
|
||||||
-> V $? "result" = None
|
-> V $? "result" = None
|
||||||
-> invariantFor (DE.trsys_of H V s)
|
-> invariantFor (DE.trsys_of H V s)
|
||||||
(fun p => snd p = Skip
|
(fun p => snd p = Skip
|
||||||
|
@ -1380,6 +1404,7 @@ Module MixedToDeep(Import BW : BIT_WIDTH).
|
||||||
apply inj_pair2 in H8; subst.
|
apply inj_pair2 in H8; subst.
|
||||||
invert H11.
|
invert H11.
|
||||||
apply inj_pair2 in H6; subst.
|
apply inj_pair2 in H6; subst.
|
||||||
|
invert H8.
|
||||||
right; eexists.
|
right; eexists.
|
||||||
econstructor; eauto.
|
econstructor; eauto.
|
||||||
auto.
|
auto.
|
||||||
|
|
Loading…
Reference in a new issue