QRC1.QRC1Equiv

From QRC1 Require Import Language QRC1.
From Coq Require Import Setoid Equivalence Morphisms ssreflect.

Open Scope qsp_scope.

Definition QRC1Equiv (sig : signature) : relation (formula sig) :=
  fun (A B : formula sig) => ((|- A ~> B) /\ (|- B ~> A))%type.
Notation "|- A <~> B" := (QRC1Equiv _ A B) (at level 85, format "|- A <~> B")
  : qsp_scope.

Lemma QRC1Equiv_refl (sig : signature) :
  reflexive (formula sig) (QRC1Equiv sig).
Proof. by []. Qed.

Lemma QRC1Equiv_sym (sig : signature) :
  symmetric (formula sig) (QRC1Equiv sig).
Proof. by move=> A B [pAB pBA]; split. Qed.

Lemma QRC1Equiv_trans (sig : signature) :
  transitive (formula sig) (QRC1Equiv sig).
Proof.
  move=> A B C [pAB pBA] [pBC pCB]; split.
    by apply: (Cut pAB).
  by apply: (Cut pCB).
Qed.

Add Parametric Relation (sig : signature) : (formula sig) (QRC1Equiv sig)
  reflexivity proved by (QRC1Equiv_refl sig)
  symmetry proved by (QRC1Equiv_sym sig)
  transitivity proved by (QRC1Equiv_trans sig)
    as QRC1Equiv_rel.

(* As of Coq 8.14 the locality of the Instances must be set, but then it      *)
(* stops working with older Coq versions. For now we just ignore the warning. *)
Set Warnings "-deprecated-instance-without-locality".

Instance QRC1Equiv_impl_QRC1Proof (sig : signature) (A : formula sig) :
  Proper (QRC1Equiv sig ==> Basics.impl) (QRC1Proof A).
Proof. by move=> B C [pBC pCB] pAB; apply: (Cut pAB). Qed.

Instance QRC1Equiv_flipimpl_QRC1Proof (sig : signature) (A : formula sig) :
  Proper (QRC1Equiv sig ==> Basics.flip Basics.impl) (QRC1Proof A).
Proof. by move=> B C [pBC pCB] pAC; apply: (Cut pAC). Qed.

Instance QRC1Equiv_QRC1Equiv_impl_QRC1Proof (sig : signature) :
  Proper (QRC1Equiv sig ==> QRC1Equiv sig ==> Basics.impl) (@QRC1Proof sig).
Proof.
  move=> A B [pAB pBA] C D [pCD pDC] pAC.
  by apply: (Cut pBA); apply: (Cut pAC).
Qed.

Set Warnings "deprecated-instance-without-locality".

(* To debug typeclass resolution (use Fail if needed): *)
(* Typeclasses eauto := debug. *)

Close Scope qsp_scope.

From mathcomp Require Import all_ssreflect finmap.

Section BigConj.

Open Scope qsp_scope.
Open Scope fset.

Variable sig : signature.
Notation formula := (formula sig).

Definition bigConj (fs : seq formula) : formula :=
  \big[@Conj _/T _]_(A <- fs) A.
Notation "//\\ fs" := (bigConj fs) (at level 5, format "//\\ fs") : qsp_scope.

Lemma bigConj1 (A : formula) :
  |- //\\ [:: A] <~> A.
Proof.
  rewrite /bigConj big_cons big_nil; split=> //.
  by apply: ConjI.
Qed.

Lemma QRC1Proof_bigConj (A : formula) (fs : seq formula) :
  |- A ~> //\\ fs <-> {in fs, forall B, |- A ~> B}.
Proof.
  rewrite /bigConj; elim: fs A => [A | B fs IHfs A].
    by rewrite big_nil.
  rewrite big_cons; split.
    move=> pABfs /= C; rewrite inE => /orP [/eqP -> |].
      by apply: (Cut pABfs).
    move: C; rewrite -[forall C, _]/({in fs, forall C, |- A ~> C}) -IHfs.
    by apply: (Cut pABfs).
  move=> inBfs; apply: ConjI.
    by apply: inBfs; rewrite inE eqxx.
  rewrite IHfs => C Cinfs.
  by apply: inBfs; rewrite inE Cinfs orbT.
Qed.

Lemma bigConj_QRC1Proof (A : formula) (fs : seq formula) :
  A \in fs -> |- //\\ fs ~> A.
Proof.
  elim: fs => [// | B fs IH].
  rewrite inE => /orP [/eqP -> | Ainfs].
    by rewrite /bigConj big_cons.
  rewrite /bigConj big_cons.
  by apply: (Cut _ (IH Ainfs)).
Qed.

End BigConj.

Notation "//\\ fs" := (bigConj _ fs)
  (at level 5, format "//\\ fs") : qsp_scope.