(*****************)
(* Prism Theorem *)
(*****************)

(* Auxiliary notion : compat 
   Used to generate the right simultaneous induction on U, V and W *)

(* (compat U V W) iff U,V,W are compatible markings, and (sub V U) *)
Inductive compat : redexes -> redexes -> redexes -> Prop :=
  | Compat_Var : forall n : nat, compat (Var n) (Var n) (Var n)
  | Compat_Fun :
      forall U V W : redexes, compat U V W -> compat (Fun U) (Fun V) (Fun W)
  | Compat_Ap1 :
      forall U1 V1 W1 : redexes,
      compat U1 V1 W1 ->
      forall U2 V2 W2 : redexes,
      compat U2 V2 W2 ->
      forall b : bool, compat (Ap false U1 U2) (Ap false V1 V2) (Ap b W1 W2)
  | Compat_Ap2 :
      forall U1 V1 W1 : redexes,
      compat U1 V1 W1 ->
      forall U2 V2 W2 : redexes,
      compat U2 V2 W2 ->
      forall b b' : bool,
      compat (Ap true (Fun U1) U2) (Ap b (Fun V1) V2) (Ap b' (Fun W1) W2).(*****************)
(* Prism Theorem *)
(*****************)

(* Auxiliary notion : compat 
   Used to generate the right simultaneous induction on U, V and W *)

(* (compat U V W) iff U,V,W are compatible markings, and (sub V U) *)
Inductive compat : redexes -> redexes -> redexes -> Prop :=
  | Compat_Var : forall n : nat, compat (Var n) (Var n) (Var n)
  | Compat_Fun :
      forall U V W : redexes, compat U V W -> compat (Fun U) (Fun V) (Fun W)
  | Compat_Ap1 :
      forall U1 V1 W1 : redexes,
      compat U1 V1 W1 ->
      forall U2 V2 W2 : redexes,
      compat U2 V2 W2 ->
      forall b : bool, compat (Ap false U1 U2) (Ap false V1 V2) (Ap b W1 W2)
  | Compat_Ap2 :
      forall U1 V1 W1 : redexes,
      compat U1 V1 W1 ->
      forall U2 V2 W2 : redexes,
      compat U2 V2 W2 ->
      forall b b' : bool,
      compat (Ap true (Fun U1) U2) (Ap b (Fun V1) V2) (Ap b' (Fun W1) W2).(*****************)
(* Prism Theorem *)
(*****************)

(* Auxiliary notion : compat 
   Used to generate the right simultaneous induction on U, V and W *)

(* (compat U V W) iff U,V,W are compatible markings, and (sub V U) *)
Inductive compat : redexes -> redexes -> redexes -> Prop :=
  | Compat_Var : forall n : nat, compat (Var n) (Var n) (Var n)
  | Compat_Fun :
      forall U V W : redexes, compat U V W -> compat (Fun U) (Fun V) (Fun W)
  | Compat_Ap1 :
      forall U1 V1 W1 : redexes,
      compat U1 V1 W1 ->
      forall U2 V2 W2 : redexes,
      compat U2 V2 W2 ->
      forall b : bool, compat (Ap false U1 U2) (Ap false V1 V2) (Ap b W1 W2)
  | Compat_Ap2 :
      forall U1 V1 W1 : redexes,
      compat U1 V1 W1 ->
      forall U2 V2 W2 : redexes,
      compat U2 V2 W2 ->
      forall b b' : bool,
      compat (Ap true (Fun U1) U2) (Ap b (Fun V1) V2) (Ap b' (Fun W1) W2).(*****************)
(* Prism Theorem *)
(*****************)

(* Auxiliary notion : compat 
   Used to generate the right simultaneous induction on U, V and W *)

(* (compat U V W) iff U,V,W are compatible markings, and (sub V U) *)
Inductive compat : redexes -> redexes -> redexes -> Prop :=
  | Compat_Var : forall n : nat, compat (Var n) (Var n) (Var n)
  | Compat_Fun :
      forall U V W : redexes, compat U V W -> compat (Fun U) (Fun V) (Fun W)
  | Compat_Ap1 :
      forall U1 V1 W1 : redexes,
      compat U1 V1 W1 ->
      forall U2 V2 W2 : redexes,
      compat U2 V2 W2 ->
      forall b : bool, compat (Ap false U1 U2) (Ap false V1 V2) (Ap b W1 W2)
  | Compat_Ap2 :
      forall U1 V1 W1 : redexes,
      compat U1 V1 W1 ->
      forall U2 V2 W2 : redexes,
      compat U2 V2 W2 ->
      forall b b' : bool,
      compat (Ap true (Fun U1) U2) (Ap b (Fun V1) V2) (Ap b' (Fun W1) W2).(*****************)
(* Prism Theorem *)
(*****************)

(* Auxiliary notion : compat 
   Used to generate the right simultaneous induction on U, V and W *)

(* (compat U V W) iff U,V,W are compatible markings, and (sub V U) *)
Inductive compat : redexes -> redexes -> redexes -> Prop :=
  | Compat_Var : forall n : nat, compat (Var n) (Var n) (Var n)
  | Compat_Fun :
      forall U V W : redexes, compat U V W -> compat (Fun U) (Fun V) (Fun W)
  | Compat_Ap1 :
      forall U1 V1 W1 : redexes,
      compat U1 V1 W1 ->
      forall U2 V2 W2 : redexes,
      compat U2 V2 W2 ->
      forall b : bool, compat (Ap false U1 U2) (Ap false V1 V2) (Ap b W1 W2)
  | Compat_Ap2 :
      forall U1 V1 W1 : redexes,
      compat U1 V1 W1 ->
      forall U2 V2 W2 : redexes,
      compat U2 V2 W2 ->
      forall b b' : bool,
      compat (Ap true (Fun U1) U2) (Ap b (Fun V1) V2) (Ap b' (Fun W1) W2).

Lemma prism2 : forall U V W : redexes, sub V U -> regular U -> forall UV : redexes, residuals U V UV -> forall WV : redexes, residuals W V WV -> forall WU : redexes, residuals WV UV WU -> residuals W U WU.