(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
(** In this file, we prove properties about hedges. These properties are in section 6.1 of the paper "On Bisimulations for the Spi-Calculus" by J. Borgström and U. Nestmann. However, we consider here an extended message language. *)
(** Author: Sébastien Briais (sebastien.briais@epfl.ch) *)
Unset Standard Proposition Elimination Names.
(** We assume to have a (countably infinite) set of names. *)
Hypothesis Nam : Set.
(** We define three operators for building messages. *)
Inductive op : Set :=
| Pub : op
| Priv : op
| Hash : op.
simple destruct o1; simple destruct o2; try auto;
try (right; red in |- *; intro; inversion H).
Qed.
(** The inversion of an operator. *)
Definition inv_op (o : op) : op :=
match o with
| Pub => Priv
| Priv => Pub
| _ => o
end.
(** A message is either a name, or an encrypted message, or a pair of messages, or an operator applied to a message. *)
Inductive Msg : Set :=
| MNam : Nam -> Msg
| MEnc : Msg -> Msg -> Msg
| MPair : Msg -> Msg -> Msg
| Mop : op -> Msg -> Msg.
(** Inversion of a message. This is to manage public/private keys. *)
Definition inv (M : Msg) : Msg :=
match M with
| Mop op M => Mop (inv_op op) M
| _ => M
end.
simple induction M; simpl in |- *; trivial.
simple destruct o; simpl in |- *; trivial.
Qed.
(** A hedge is a set of pairs of message. *)
Definition hedge := Msg -> Msg -> Prop.
intros.
apply (classic (h M N)).
Qed.
(** g is included in h iff whenever (M,N) is in g then (M,N) is in h *)
Definition inclusion (g h : hedge) := forall M N : Msg, g M N -> h M N.
(** g = h iff g is included in h and h is included in g *)
Definition equal (g h : hedge) := inclusion g h /\ inclusion h g.
unfold inclusion in |- *.
trivial.
Qed.
unfold inclusion in |- *.
intros.
apply H0.
apply H; trivial.
Qed.
unfold equal in |- *.
tauto.
Qed.
unfold equal in |- *.
intro.
split; apply inclusion_refl.
Qed.
unfold equal in |- *.
intros.
elim H.
tauto.
Qed.
unfold equal in |- *.
intros.
elim H.
elim H0.
intros.
split; apply inclusion_trans with g; trivial.
Qed.
(** union and intersection of hedges *)
Definition union (g h : hedge) (M N : Msg) := g M N \/ h M N.
Definition inter (g h : hedge) (M N : Msg) := g M N /\ h M N.
unfold union in |- *.
unfold equal in |- *.
intros.
unfold inclusion in |- *.
tauto.
Qed.
unfold inter in |- *.
unfold equal in |- *.
intros.
unfold inclusion in |- *.
tauto.
Qed.
unfold union in |- *.
unfold inclusion in |- *.
tauto.
Qed.
unfold union in |- *.
unfold inclusion in |- *.
tauto.
Qed.
unfold inter in |- *.
unfold inclusion in |- *.
tauto.
Qed.
unfold inter in |- *.
unfold inclusion in |- *.
tauto.
Qed.
unfold inclusion in |- *.
unfold union in |- *.
intros.
case H1.
apply H.
apply H0.
Qed.
intros.
unfold union in |- *.
unfold inter in |- *.
unfold inclusion in |- *.
tauto.
Qed.
(** The synthesis S(h) of h : it contains all the messages that can be synthetised by the hedge. *)
Inductive synthesis (h : hedge) : hedge :=
| SynInc : forall M N : Msg, h M N -> synthesis h M N
| SynEnc :
forall M N K L : Msg,
synthesis h M N -> synthesis h K L -> synthesis h (MEnc M K) (MEnc N L)
| SynPair :
forall M1 N1 M2 N2 : Msg,
synthesis h M1 N1 ->
synthesis h M2 N2 -> synthesis h (MPair M1 M2) (MPair N1 N2)
| SynOp :
forall (o : op) (M N : Msg),
synthesis h M N -> synthesis h (Mop o M) (Mop o N).
intros.
inversion H.
trivial.
Qed.
intros.
inversion H.
trivial.
Qed.
unfold inclusion in |- *.
intros.
apply SynInc.
trivial.
Qed.
(** g <= h if S(g) is included in S(h) *)
Definition le_h (g h : hedge) := inclusion (synthesis g) (synthesis h).
(** g ~ h if g <= h and h <= g *)
Definition equiv_h (g h : hedge) := le_h g h /\ le_h h g.
unfold le_h in |- *.
intro.
apply inclusion_refl.
Qed.
unfold le_h in |- *.
intros.
apply inclusion_trans with (synthesis g); trivial.
Qed.
unfold equiv_h in |- *.
tauto.
Qed.
unfold equiv_h in |- *.
intro.
split; apply le_h_refl.
Qed.
unfold equiv_h in |- *.
intros.
elim H.
elim H0.
intros.
split; apply le_h_trans with g; trivial.
Qed.
unfold equiv_h in |- *.
tauto.
Qed.
unfold le_h in |- *.
intros.
apply inclusion_trans with (synthesis g); trivial.
apply h_incl_syn.
Qed.
unfold le_h in |- *.
unfold inclusion in |- *.
intros.
induction  H0
as
[M
N
H0|
M
N
K
L
H0_1
HrecH0_1
H0_0
HrecH0_0|
M1
N1
M2
N2
H0_1
HrecH0_1
H0_0
HrecH0_0|
o
M
N
H0
HrecH0].
apply H; trivial.
apply SynEnc; trivial.
apply SynPair; trivial.
apply SynOp; trivial.
Qed.
split.
apply le_h_impl_incl_syn.
apply incl_syn_impl_le_h.
Qed.
intros.
apply incl_syn_impl_le_h.
apply inclusion_trans with h; trivial.
apply h_incl_syn.
Qed.
unfold equal in |- *.
unfold equiv_h in |- *.
intros.
elim H.
intros.
split.
apply inclusion_impl_le_h; trivial.
apply inclusion_impl_le_h; trivial.
Qed.
intros.
apply incl_syn_impl_le_h.
apply union_intro; apply le_h_impl_incl_syn; trivial.
Qed.
intros.
apply le_h_le_h_impl_union_le_h.
apply le_h_trans with h1; trivial.
apply inclusion_impl_le_h; apply hedge_left_union.
apply le_h_trans with h2; trivial.
apply inclusion_impl_le_h; apply hedge_right_union.
Qed.
(** we define how to analyse 'one time' a hedge h: all the pairs are splitted and the encrypted messages are decrypted if the keys are in the synthesis of h *)
Inductive analysis (h : hedge) : hedge :=
| AnaInc : forall M N : Msg, h M N -> analysis h M N
| AnaSplitL :
forall M1 M2 N1 N2 : Msg,
analysis h (MPair M1 M2) (MPair N1 N2) -> analysis h M1 N1
| AnaSplitR :
forall M1 M2 N1 N2 : Msg,
analysis h (MPair M1 M2) (MPair N1 N2) -> analysis h M2 N2
| AnaDec :
forall M N K L : Msg,
analysis h (MEnc M K) (MEnc N L) ->
synthesis h (inv K) (inv L) -> analysis h M N.
intros g h.
unfold inclusion in |- *.
intros.
induction  H0
as
[M N H0| M1 M2 N1 N2 H0 HrecH0| M1 M2 N1 N2 H0 HrecH0| M N K L H0 HrecH0 H1].
apply AnaInc.
apply H; trivial.
apply (AnaSplitL h M1 M2 N1 N2).
trivial.
apply (AnaSplitR h M1 M2 N1 N2).
trivial.
apply (AnaDec h M N K L).
trivial.
generalize (inclusion_impl_le_h g h H).
unfold le_h in |- *.
unfold inclusion in |- *.
intros.
auto.
Qed.
(** We define an infinite sequence (analysis_seq h n) where the n-th term is the n-th analysis of h *)
Fixpoint analysis_seq (h : hedge) (n : nat) {struct n} : hedge :=
match n with
| O => h
| S n => analysis (analysis_seq h n)
end.
simple induction n.
simpl in |- *.
intros.
unfold inclusion in |- *.
intros.
apply AnaInc; trivial.
intros.
simpl in |- *.
unfold inclusion in |- *.
intros.
apply AnaInc.
trivial.
Qed.
simple induction p.
simpl in |- *.
intros.
apply inclusion_refl.
intros.
replace (S n + n0) with (S (n + n0)); try auto with arith.
apply inclusion_trans with (analysis_seq h (n + n0)); trivial.
apply analysis_seq_grow_S.
Qed.
intros.
cut (exists p : nat, m = p + n).
intro.
elim H0.
intro p.
intro.
rewrite H1.
apply analysis_seq_grows.
exists (m - n).
rewrite plus_comm.
apply le_plus_minus.
trivial.
Qed.
(** reduce remove from h all the redundancy: a pair (M,N) is kept in (reduce h) iff it cannot be 'strictly' synthetised by h *)
Definition reduce (h : hedge) (M N : Msg) :=
h M N /\
match M with
| MEnc M' K =>
match N with
| MEnc N' L => ~ synthesis h M' N' \/ ~ synthesis h K L
| _ => True
end
| MPair M1 M2 =>
match N with
| MPair N1 N2 => ~ synthesis h M1 N1 \/ ~ synthesis h M2 N2
| _ => True
end
| Mop opM M' =>
match N with
| Mop opN N' => opM <> opN \/ ~ synthesis h M' N'
| _ => True
end
| _ => True
end.
unfold inclusion in |- *.
unfold reduce in |- *.
tauto.
Qed.
unfold le_h in |- *.
unfold inclusion in |- *.
intro.
simple induction M.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H.
tauto.
intro M'.
intro.
intro K.
intro.
simple destruct N.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H1.
tauto.
intros N' L.
intros.
case (hedge_mem_dec (synthesis h) M' N').
case (hedge_mem_dec (synthesis h) K L).
intros.
apply SynEnc.
apply H; trivial.
apply H0; trivial.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H1.
split; tauto.
tauto.
intro.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H1; tauto.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H1; tauto.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H1; tauto.
intro M1.
intro.
intro M2.
intro.
simple destruct N.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H1; tauto.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H1; tauto.
intros N1 N2.
intro.
case (hedge_mem_dec (synthesis h) M1 N1).
case (hedge_mem_dec (synthesis h) M2 N2).
intros.
apply SynPair.
apply H; trivial.
apply H0; trivial.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H1; tauto.
intro.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H1; tauto.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H1; tauto.
intros oM M'.
intro.
simple destruct N.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H0; tauto.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H0; tauto.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H0; tauto.
intros oN N'.
intro.
case (op_eq_dec oM oN).
intro.
rewrite e in H0.
rewrite e.
case (hedge_mem_dec (synthesis h) M' N').
intro.
apply SynOp.
apply H; trivial.
intros.
apply SynInc.
unfold reduce in |- *; simpl in |- *.
inversion H0; tauto.
intros.
apply SynInc.
unfold reduce in |- *.
inversion H0; tauto.
Qed.
unfold equiv_h in |- *.
intro.
split.
apply h_le_h_red.
apply inclusion_impl_le_h.
apply red_incl_h.
Qed.
unfold le_h in |- *.
unfold inclusion in |- *.
unfold reduce in |- *.
intros g h H H0.
intros M N.
case M.
intros.
elim H1; auto.
case N; intros; elim H1; auto.
intros.
split; auto.
case H3.
intro; left; red in |- *; intro; apply H4; auto.
intro; right; red in |- *; intro; apply H4; auto.
case N; intros; elim H1; auto.
split; auto.
case H3.
intro; left; red in |- *; intro; apply H4; auto.
intro; right; red in |- *; intro; apply H4; auto.
case N; intros; elim H1; auto.
split; auto.
case H3; try tauto.
intros.
right; red in |- *; intro; apply H4; auto.
Qed.
unfold equal in |- *.
intros.
split.
apply inclusion_le_h_reduce_inclusion.
tauto.
apply inclusion_impl_le_h; tauto.
apply inclusion_le_h_reduce_inclusion; try tauto.
apply inclusion_impl_le_h; tauto.
Qed.
unfold le_h in |- *.
unfold inclusion in |- *.
intros.
generalize H1.
generalize (H M N H1).
unfold reduce in |- *.
case M; try tauto.
case N; try tauto.
intros.
elim H3.
split; trivial.
case H5.
intro.
left.
red in |- *; intro.
apply H6.
generalize (inclusion_impl_le_h (reduce g) g (red_incl_h g)).
unfold le_h in |- *.
unfold inclusion in |- *.
intros.
apply H8.
apply H0.
trivial.
intro.
right; red in |- *; intro; apply H6.
generalize (inclusion_impl_le_h (reduce g) g (red_incl_h g)).
unfold le_h in |- *.
unfold inclusion in |- *.
intros.
apply H8.
apply H0.
trivial.
case N; try tauto.
intros.
split; trivial.
elim H3; intros.
case H5.
left; red in |- *; intro; apply H6.
generalize (inclusion_impl_le_h (reduce g) g (red_incl_h g)).
unfold le_h in |- *.
unfold inclusion in |- *; auto.
right; red in |- *; intro; apply H6.
generalize (inclusion_impl_le_h (reduce g) g (red_incl_h g)).
unfold le_h in |- *.
unfold inclusion in |- *; auto.
case N; try tauto.
intros.
split; trivial.
elim H3.
intros.
case H5; try tauto.
right.
red in |- *; intro.
apply H6.
generalize (inclusion_impl_le_h (reduce g) g (red_incl_h g)).
unfold le_h in |- *.
unfold inclusion in |- *; auto.
Qed.
unfold equal in |- *.
intro.
split; try apply red_incl_h.
apply inclusion_le_h_impl_inclusion_red.
apply inclusion_refl.
apply le_h_refl.
Qed.
unfold equiv_h in |- *.
unfold inclusion in |- *.
intros.
elim H.
intros.
generalize (le_h_impl_incl_syn (reduce g) h H1).
unfold inclusion in |- *.
intros.
generalize (H3 M N H0).
generalize H0.
unfold reduce in |- *.
case M.
intros.
apply nam_left_syn; trivial.
case N.
intros.
apply nam_right_syn; trivial.
intros.
elim H4.
intros.
inversion H5.
trivial.
case H7.
intro.
cut False; try tauto.
apply H14.
generalize
(le_h_trans h (reduce g) g H2
(inclusion_impl_le_h (reduce g) g (red_incl_h g))).
unfold le_h in |- *.
unfold inclusion in |- *.
auto.
intro.
cut False; try tauto.
apply H14.
generalize
(le_h_trans h (reduce g) g H2
(inclusion_impl_le_h (reduce g) g (red_incl_h g))).
unfold le_h in |- *.
unfold inclusion in |- *.
auto.
intros.
inversion H5; trivial.
intros.
inversion H5; trivial.
case N.
intros.
inversion H5; trivial.
intros.
inversion H5; trivial.
intros.
inversion H5; trivial.
elim H4.
intros.
case H13.
intro.
cut False.
tauto.
apply H14.
generalize
(le_h_trans h (reduce g) g H2
(inclusion_impl_le_h (reduce g) g (red_incl_h g))).
unfold le_h in |- *.
unfold inclusion in |- *.
auto.
intro.
cut False; try tauto.
apply H14.
generalize
(le_h_trans h (reduce g) g H2
(inclusion_impl_le_h (reduce g) g (red_incl_h g))).
unfold le_h in |- *.
unfold inclusion in |- *; auto.
intros.
inversion H5; trivial.
case N.
intros.
inversion H5; trivial.
intros.
inversion H5; trivial.
intros.
inversion H5; trivial.
intros.
elim H4.
intros.
case (op_eq_dec o0 o).
intro.
rewrite e.
rewrite e in H5.
inversion H5; trivial.
case H7.
intro.
tauto.
intro.
cut False; try tauto.
apply H12.
generalize
(le_h_trans h (reduce g) g H2
(inclusion_impl_le_h (reduce g) g (red_incl_h g))).
unfold le_h in |- *.
unfold inclusion in |- *.
auto.
intro.
inversion H5; trivial.
tauto.
Qed.
intros.
apply le_h_trans with h.
apply le_h_trans with g; trivial.
apply inclusion_impl_le_h.
apply red_incl_h.
apply h_le_h_red.
Qed.
(** h is stable under analysis iff (analysis h) is included in h *)
Definition stable_analysis (h : hedge) := inclusion (analysis h) h.
intro.
unfold stable_analysis in |- *.
unfold equal in |- *.
intro.
split; trivial.
unfold inclusion in |- *.
intros.
apply AnaInc.
trivial.
Qed.
intros.
unfold stable_analysis in |- *.
apply inclusion_analysis_inclusion.
unfold stable_analysis in H; trivial.
Qed.
intros.
induction  p as [| p Hrecp].
simpl in |- *.
trivial.
simpl in |- *.
apply stable_impl_ana_stable.
trivial.
Qed.
intros.
induction  p as [| p Hrecp].
simpl in |- *.
apply equal_refl.
apply equal_trans with (analysis_seq h (p + n)).
trivial.
simpl in |- *.
apply stable_closed.
apply stable_ana_stable.
trivial.
Qed.
(** h could be an analysis of g iff g is included in h and h is stable under analysis *)
Definition analysis_cond (g h : hedge) := inclusion g h /\ stable_analysis h.
intros.
induction  n as [| n Hrecn].
simpl in |- *.
unfold analysis_cond in H.
tauto.
simpl in |- *.
generalize (inclusion_analysis_inclusion (analysis_seq g n) h Hrecn).
intro.
apply inclusion_trans with (analysis h); trivial.
unfold analysis_cond in H.
unfold stable_analysis in H.
tauto.
Qed.
(** h is an analysis of g if h could be an analysis of g and if for all other candidates h' which could be an analysis of g, h is included in h' *)
Definition is_analysis (g h : hedge) :=
analysis_cond g h /\
(forall h' : hedge, analysis_cond g h' -> inclusion h h').
unfold is_analysis in |- *.
intros.
apply analysis_seq_incl_analysis_cond.
tauto.
Qed.
unfold is_analysis in |- *.
unfold equal in |- *.
intros.
elim H.
elim H0.
intros.
split.
apply H4; trivial.
apply H2; trivial.
Qed.
unfold is_analysis in |- *.
unfold analysis_cond in |- *.
intros.
elim H.
elim H0.
intros.
elim H1.
elim H3.
intros.
split.
split; trivial.
apply inclusion_trans with h; trivial.
intros.
apply inclusion_trans with h.
apply H2.
split; trivial.
apply inclusion_refl.
apply H4; tauto.
Qed.
intros.
apply analysis_unique with g; trivial.
apply analysis_trans with h; trivial.
Qed.
unfold is_analysis in |- *.
unfold analysis_cond in |- *.
intros.
split.
split; trivial.
apply inclusion_trans with (analysis_seq h 0).
simpl in |- *.
apply inclusion_refl.
replace n with (n + 0); try auto with arith.
apply analysis_seq_grows.
intros.
apply analysis_seq_incl_analysis_cond.
unfold analysis_cond in |- *.
trivial.
Qed.
(** we define the analysis A(h) of h as being the infinite union of the sequence (analysis_seq h) *)
Definition analysis_def (h : hedge) (M N : Msg) :=
exists n : nat, analysis_seq h n M N.
intros.
unfold analysis_def in |- *.
intros.
induction  H
as
[M
N
H|
M
N
K
L
H1
HrecH1
H0
HrecH0|
M1
N1
M2
N2
H1
HrecH1
H0
HrecH0|
o
M
N
H
HrecH].
elim H.
intro n.
intro.
exists n.
apply SynInc.
trivial.
elim HrecH1.
intro n1.
intro.
elim HrecH0.
intro n2.
intro.
exists (max n1 n2).
apply SynEnc.
generalize
(inclusion_impl_le_h (analysis_seq h n1) (analysis_seq h (max n1 n2))
(analysis_seq_increase n1 (max n1 n2) h (le_max_l n1 n2))).
unfold le_h in |- *; auto.
generalize
(inclusion_impl_le_h (analysis_seq h n2) (analysis_seq h (max n1 n2))
(analysis_seq_increase n2 (max n1 n2) h (le_max_r n1 n2))).
unfold le_h in |- *; auto.
elim HrecH0; elim HrecH1.
intro n1.
intro.
intro n2.
intro.
exists (max n1 n2).
apply SynPair.
generalize
(inclusion_impl_le_h (analysis_seq h n1) (analysis_seq h (max n1 n2))
(analysis_seq_increase n1 (max n1 n2) h (le_max_l n1 n2))).
unfold le_h in |- *; auto.
generalize
(inclusion_impl_le_h (analysis_seq h n2) (analysis_seq h (max n1 n2))
(analysis_seq_increase n2 (max n1 n2) h (le_max_r n1 n2))).
unfold le_h in |- *; auto.
elim HrecH.
intro n.
intro.
exists n.
apply SynOp.
trivial.
Qed.
unfold is_analysis in |- *.
split.
unfold analysis_cond in |- *.
split.
unfold inclusion in |- *.
intros.
unfold analysis_def in |- *.
exists 0.
simpl in |- *.
trivial.
unfold stable_analysis in |- *.
unfold inclusion in |- *.
unfold analysis_def in |- *.
intros.
induction  H
as [M N H| M1 M2 N1 N2 H HrecH| M1 M2 N1 N2 H HrecH| M N K L H HrecH H0].
trivial.
elim HrecH.
intro n.
intro.
exists (S n).
simpl in |- *.
apply (AnaSplitL (analysis_seq h n) M1 M2 N1 N2).
apply AnaInc.
trivial.
elim HrecH.
intro n.
intro.
exists (S n).
apply (AnaSplitR (analysis_seq h n) M1 M2 N1 N2).
apply AnaInc; trivial.
elim HrecH.
intro n1.
intro.
generalize (synthesis_analysis_seq h (inv K) (inv L) H0).
intro.
elim H2.
intro n2.
intro.
exists (S (max n1 n2)).
simpl in |- *.
apply (AnaDec (analysis_seq h (max n1 n2)) M N K L).
apply AnaInc.
generalize (analysis_seq_increase n1 (max n1 n2) h (le_max_l n1 n2)).
unfold inclusion in |- *; auto.
generalize
(inclusion_impl_le_h (analysis_seq h n2) (analysis_seq h (max n1 n2))
(analysis_seq_increase n2 (max n1 n2) h (le_max_r n1 n2))).
unfold le_h in |- *; auto.
intros.
unfold inclusion in |- *.
unfold analysis_def in |- *.
intros.
elim H0.
intro n.
intro.
generalize (analysis_seq_incl_analysis_cond h h' H n).
unfold inclusion in |- *; auto.
Qed.
(** the irreducibles I(h) of h is (reduce (A(h))) *)
Definition irreducible (h : hedge) := reduce (analysis_def h).
intros h M N K L.
unfold irreducible in |- *.
unfold reduce in |- *.
tauto.
Qed.
unfold irreducible in |- *.
unfold reduce in |- *.
tauto.
Qed.
unfold irreducible in |- *.
unfold reduce in |- *.
intros.
red in |- *.
intro.
elim H.
intro.
intro.
cut (analysis_def h M1 N1 /\ analysis_def h M2 N2).
intro.
elim H2.
intros.
case H1; intro H5; apply H5; trivial.
apply SynInc; trivial.
apply SynInc; trivial.
cut (is_analysis h (analysis_def h)); try apply analysis_is_analysis.
unfold is_analysis in |- *.
intros.
elim H2.
unfold analysis_cond in |- *.
intros.
elim H3.
intros.
unfold stable_analysis in H6.
unfold inclusion in H6.
split; apply H6.
apply (AnaSplitL (analysis_def h) M1 M2 N1 N2); apply AnaInc; trivial.
apply (AnaSplitR (analysis_def h) M1 M2 N1 N2); apply AnaInc; trivial.
Qed.
(** h is irreducible iff h = I(h) *)
Definition is_irreducible (h : hedge) := equal h (irreducible h).
intro.
apply inclusion_impl_le_h.
generalize (analysis_is_analysis h).
intro.
unfold is_analysis in H.
unfold analysis_cond in H.
elim H.
intros.
tauto.
Qed.
unfold irreducible in |- *.
intro.
apply h_equiv_h_red.
Qed.
intro.
apply le_h_trans with (analysis_def h).
apply h_le_h_ana_h.
generalize (ana_h_equiv_irr_h h).
unfold equiv_h in |- *.
tauto.
Qed.
intro.
generalize (analysis_is_analysis (irreducible h)).
unfold is_analysis in |- *.
unfold analysis_cond in |- *.
intros.
elim H.
intros.
apply H1.
split.
unfold irreducible in |- *.
apply red_incl_h.
generalize (analysis_is_analysis h).
unfold is_analysis in |- *.
unfold analysis_cond in |- *.
tauto.
Qed.
unfold irreducible in |- *.
intro.
apply inclusion_le_h_reduce_inclusion.
replace (reduce (analysis_def h)) with (irreducible h).
apply ana_irr_incl_ana.
unfold irreducible in |- *.
trivial.
replace (reduce (analysis_def h)) with (irreducible h).
apply le_h_trans with (irreducible h).
generalize ana_h_equiv_irr_h.
unfold equiv_h in |- *.
intros.
elim (H h); tauto.
apply h_le_h_ana_h.
unfold irreducible in |- *.
trivial.
Qed.
unfold irreducible in |- *.
intros.
apply inclusion_le_h_impl_inclusion_red.
generalize (analysis_is_analysis (reduce (analysis_def h))).
unfold is_analysis in |- *.
unfold analysis_cond in |- *.
tauto.
apply le_h_trans with (analysis_def h).
apply inclusion_impl_le_h.
fold (irreducible h) in |- *.
apply ana_irr_incl_ana.
fold (irreducible h) in |- *.
generalize ana_h_equiv_irr_h.
unfold equiv_h in |- *.
intros.
elim (H h); auto.
Qed.
unfold is_irreducible in |- *.
unfold equal in |- *.
intros.
generalize (irr_incl_irr_irr h).
generalize (irr_irr_incl_irr h).
tauto.
Qed.
unfold is_irreducible in |- *.
unfold irreducible in |- *.
intros.
apply inclusion_trans with (reduce (analysis_def g)).
unfold equal in H0.
tauto.
apply red_equiv_impl_red_incl.
apply equiv_h_trans with g.
apply equal_impl_equiv_h.
apply equal_sym.
trivial.
trivial.
Qed.

(** if g ~ h, g is irreducible and h is irreducible then g = h *)
Theorem equiv_irr_irr_impl_equal :
forall g h : hedge,
equiv_h g h -> is_irreducible g -> is_irreducible h -> equal g h.