1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071 |
- (* SPDX-License-Identifier: GPL-2.0 or GPL-3.0
- Copyright © 2019 Ariadne Devos *)
- Require Import S.Lucid.Arrow.
- Require Import Coq.Sets.Ensembles.
- Require Import Coq.Classes.Equivalence.
- (* Define a notion of equivalence for arrow signatures *)
- Section equivalence.
- Variable World : Type.
- Variable A B : Type.
- Definition Domain := ArrowSig World A B.
- Section definition.
- Variable this that : Domain.
- (* Equivalence of pre-conditions *)
- Definition eqv_pre : Prop
- := forall p, pre this p <-> pre that p.
- Definition eqv_rely : Prop
- := forall p w, rely this p w <-> rely that p w.
- Definition eqv_guarantee : Prop
- := forall p w, guarantee this p w <-> guarantee that p w.
- Definition eqv_post : Prop
- := forall p q, post this p q <-> post that p q.
- (* (This probably says nothing about timing,
- cache access ...) *)
- Definition eqv_sig : Prop
- := (eqv_pre /\ eqv_post) /\ (eqv_rely /\ eqv_guarantee).
- End definition.
- Ltac unfold_trans x y z :=
- match goal with
- | H : ?a x y, H1 : ?a y z |- ?a x z =>
- (unfold a; unfold a in H, H1)
- end.
- Lemma eqv_sig_trans : Transitive eqv_sig.
- Proof.
- intros x y z P Q.
- unfold_trans x y z.
- intuition.
- all : unfold_trans x y z.
- all : intros.
- + exact (transitivity (H3 p) (H0 p)).
- + exact (transitivity (H4 p q) (H6 p q)).
- + exact (transitivity (H p w) (H1 p w)).
- + exact (transitivity (H5 p w) (H7 p w)).
- Qed.
- Add Relation Domain eqv_sig
- reflexivity proved by ltac:(firstorder)
- symmetry proved by ltac:(firstorder)
- transitivity proved by eqv_sig_trans
- as eqv_sig_equiv.
- End equivalence.
- Arguments eqv_pre { _ _ _ } _ _.
- Arguments eqv_rely { _ _ _ } _ _.
- Arguments eqv_guarantee { _ _ _ } _ _.
- Arguments eqv_post { _ _ _ } _ _.
- Arguments eqv_sig { _ _ _ } _ _.
|