Equivalence.v 1.7 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071
  1. (* SPDX-License-Identifier: GPL-2.0 or GPL-3.0
  2. Copyright © 2019 Ariadne Devos *)
  3. Require Import S.Lucid.Arrow.
  4. Require Import Coq.Sets.Ensembles.
  5. Require Import Coq.Classes.Equivalence.
  6. (* Define a notion of equivalence for arrow signatures *)
  7. Section equivalence.
  8. Variable World : Type.
  9. Variable A B : Type.
  10. Definition Domain := ArrowSig World A B.
  11. Section definition.
  12. Variable this that : Domain.
  13. (* Equivalence of pre-conditions *)
  14. Definition eqv_pre : Prop
  15. := forall p, pre this p <-> pre that p.
  16. Definition eqv_rely : Prop
  17. := forall p w, rely this p w <-> rely that p w.
  18. Definition eqv_guarantee : Prop
  19. := forall p w, guarantee this p w <-> guarantee that p w.
  20. Definition eqv_post : Prop
  21. := forall p q, post this p q <-> post that p q.
  22. (* (This probably says nothing about timing,
  23. cache access ...) *)
  24. Definition eqv_sig : Prop
  25. := (eqv_pre /\ eqv_post) /\ (eqv_rely /\ eqv_guarantee).
  26. End definition.
  27. Ltac unfold_trans x y z :=
  28. match goal with
  29. | H : ?a x y, H1 : ?a y z |- ?a x z =>
  30. (unfold a; unfold a in H, H1)
  31. end.
  32. Lemma eqv_sig_trans : Transitive eqv_sig.
  33. Proof.
  34. intros x y z P Q.
  35. unfold_trans x y z.
  36. intuition.
  37. all : unfold_trans x y z.
  38. all : intros.
  39. + exact (transitivity (H3 p) (H0 p)).
  40. + exact (transitivity (H4 p q) (H6 p q)).
  41. + exact (transitivity (H p w) (H1 p w)).
  42. + exact (transitivity (H5 p w) (H7 p w)).
  43. Qed.
  44. Add Relation Domain eqv_sig
  45. reflexivity proved by ltac:(firstorder)
  46. symmetry proved by ltac:(firstorder)
  47. transitivity proved by eqv_sig_trans
  48. as eqv_sig_equiv.
  49. End equivalence.
  50. Arguments eqv_pre { _ _ _ } _ _.
  51. Arguments eqv_rely { _ _ _ } _ _.
  52. Arguments eqv_guarantee { _ _ _ } _ _.
  53. Arguments eqv_post { _ _ _ } _ _.
  54. Arguments eqv_sig { _ _ _ } _ _.