End logic.
(* Local definitions, for proving subsequent lemmas. *)
Local Ltac charge_split := apply landR.
Local Ltac charge_search_prems found :=
match goal with
| |- ?X |-- ?Y =>
solve [ found
| apply landL1 ; charge_search_prems found
| apply landL2 ; charge_search_prems found ]
end.
Local Ltac charge_assumption :=
charge_search_prems reflexivity.
Local Ltac charge_intro :=
first [ apply lforallR; intro
| apply limplAdj_true
| apply limplAdj ].
Local Ltac charge_intros :=
repeat match goal with
| |- _ |-- _ -->> _ =>
charge_intro
| |- _ |-- @lforall _ _ _ _ =>
charge_intro
end.
Local Ltac charge_trivial := apply ltrueR.
Local Ltac charge_use :=
first [ eapply lapply; [ charge_assumption | ]
| eapply lapply2; [ charge_assumption | | ]
| eapply lapply3; [ charge_assumption | | | ]
| eapply lapply4; [ charge_assumption | | | | ]
| eapply lapply5; [ charge_assumption | | | | | ] ].
Local Ltac ends_with H ABC C :=
let rec go k ABC :=
match ABC with
| C => k
| _ -->> ?BC =>
let k' := (k; first [ apply landAdj_true in H | apply landAdj in H ]) in
go k' BC
end
in
go ltac:(idtac) ABC.
Local Ltac charge_apply H :=
match type of H with
| _ |-- ?X =>
match goal with
| |- _ |-- ?Y =>
ends_with H X Y ; etransitivity ; [ | eapply H ]
end
end.
Local Ltac charge_tauto :=
repeat charge_split ;
solve [ charge_assumption
| charge_trivial
| charge_intro; repeat charge_intro; charge_tauto
| charge_split; solve [ charge_tauto ]
| match goal with
| H : _ |-- _ |- _ =>
charge_apply H ; charge_tauto
end
| charge_use ; charge_tauto ].
Section logic2.
Context {L : Type}.
Context {ILO : ILogicOps L}.
Context {IL : ILogic L}.
Definition liff (A B : L) : L :=
(A -->> B) //\\ (B -->> A).
Local Notation "x <<-->> y" := (liff x y) (at level 78).

(* Specifications: *)
Lemma ltrue_liff : forall A B,
|-- A <<-->> B <-> A -|- B.
Lemma land_cancel : forall A B C,
A |-- B <<-->> C ->
A //\\ B -|- A //\\ C.
Lemma uncurry : forall P Q R,
(P //\\ Q -->> R) -|- (P -->> Q -->> R).
Lemma forget_prem : forall P Q,
|-- P -> Q |-- P.
Lemma land_limpl_specialize_ap : forall P Q L R G,
L //\\ R |-- P ->
L //\\ Q //\\ R |-- G ->
L //\\ (P -->> Q) //\\ R |-- G.
Lemma land_limpl_specializeR_ap : forall P Q R G,
R |-- P ->
Q //\\ R |-- G ->
(P -->> Q) //\\ R |-- G.
Lemma land_limpl_specializeL_ap : forall P Q R G,
R |-- P ->
Q //\\ R |-- G ->
R //\\ (P -->> Q) |-- G.
Lemma landA_ap : forall P Q R G,
(P //\\ Q) //\\ R |-- G ->
P //\\ Q //\\ R |-- G.
Lemma land_lexists_ap : forall T (P : T -> L) Q R S,
(forall x, S //\\ P x //\\ Q |-- R) ->
S //\\ (lexists P) //\\ Q |-- R.
Lemma land_lexistsL_ap : forall T (P : T -> L) R S,
(forall x, S //\\ P x |-- R) ->
S //\\ (lexists P) |-- R.
Lemma land_lexistsR_ap : forall T (P : T -> L) R S,
(forall x, P x //\\ S |-- R) ->
lexists P //\\ S |-- R.