(* $Id: Step2.v,v 1.3 2000/11/10 11:27:35 freek Exp $ *)

Require Export Rational.
Require Export RRefl_corr.

(* Tex_Prose
\section{The {\tt Step2} tactic}
Some definition and lemmas used by a tactic for equational reasoning.
*)

Hint rational : rational :=
  Extern 0 (cs_eq (csg_crr (cm_crr (cg_crr (cr_crr ?)))) ? ?) Rational.

Tactic Definition Algebra2 :=
  [<:tactic:<Auto with
    algebra_t algebra_r rational algebra algebra_c algebra_s>>].

(* Begin_Tex_Verb *)
Definition implies := [p,q:Prop]p->q : Prop->Prop->Prop.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma fold_implies : (p,q:Prop)(p->q)==(implies p q).
(* End_Tex_Verb *)
Unfold implies.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma eq_wd_implies :
  (S:CSetoid)(x,y,x',y':S)(x[=]x')->(y[=]y')->(implies x'[=]y' x[=]y).
(* End_Tex_Verb *)
Unfold implies.
Intros.
Apply eq_transitive_unfolded with x'.
Assumption.
Apply eq_transitive_unfolded with y'.
Assumption.
Apply eq_symmetric_unfolded.
Assumption.
Qed.

(* Begin_Tex_Verb *)
Lemma ap_wd_implies :
  (S:CSetoid)(x,y,x',y':S)(x[=]x')->(y[=]y')->(implies x'[#]y' x[#]y).
(* End_Tex_Verb *)
Unfold implies.
Intros.
Apply ap_well_def_lft_unfolded with x'.
Apply ap_well_def_rht_unfolded with y'.
Assumption.
Apply eq_symmetric_unfolded.
Assumption.
Apply eq_symmetric_unfolded.
Assumption.
Qed.

Hints Resolve eq_wd_implies ap_wd_implies : algebra_t.

Tactic Definition Step2 [$e] :=
  [<:tactic:<Cut $e; [Rewrite fold_implies; Algebra2; Fail |
    Idtac]>>].


