Definition e_diag1 (b : wsort) (x y : TS b) :=
  forall z : TS b,
  e_beta_par _ x z ->
  exists u : TS b, e_slstar_bp_slstar _ y u /\ e_relSLstar _ z u.Notation diag1 := (e_diag1 _) (only parsing).(* <Warning> : Syntax is discontinued *)


(* les regles du systeme sigma-lift (SL) verifient le diagramme *)

Goal forall x y : terms, reg_app x y -> e_diag1 _ x y.Save commut_app.Goal forall x y : terms, reg_lambda x y -> e_diag1 _ x y.(* L(a[||s]) SL*B||*SL L(a'[||s']) *)
(* (L a0')[s'] SL* L(a0'[||s']) *)
Save commut_lambda.Goal forall x y : terms, reg_clos x y -> e_diag1 _ x y.(*  a[sot] SL*B||SL* a'[s'ot'] *)
(* (a'[s'])[t'] SL* a'[s'ot'] *)
Save commut_clos.Goal forall x y : terms, reg_varshift1 x y -> e_diag1 _ x y.(* n+1 SL*B||SL* n+1 *)
(* n[|] SL* n+1 *)
Save commut_varshift1.Goal forall x y : terms, reg_varshift2 x y -> e_diag1 _ x y.(* n+1[s] SL*B||SL* n+1[s'] *)
(* n[|os'] SL* n+1[s'] *)
Save commut_varshift2.Goal forall x y : terms, reg_fvarcons x y -> e_diag1 _ x y.(* a SL*B||SL* a' *)
(* 0[a'.s'] SL* a' *)
Save commut_fvarcons.Goal forall x y : terms, reg_fvarlift1 x y -> e_diag1 _ x y.(* 0 SL*B||SL* 0 *)
(* 0[||s'] SL* 0 *)
Save commut_fvarlift1.Goal forall x y : terms, reg_fvarlift2 x y -> e_diag1 _ x y.(* 0[t] SL*B||SL* 0[t'] *)
(* 0[||s'ot'] SL* 0[t'] *)
Save commut_fvarlift2.Goal forall x y : terms, reg_rvarcons x y -> e_diag1 _ x y.(* n[s] SL*B||SL* n[s'] *)
(* n+1[a'.s'] SL* n[s'] *)
Save commut_rvarcons.Goal forall x y : terms, reg_rvarlift1 x y -> e_diag1 _ x y.(* n[so|] SL*B||SL* n[s'o|] *)
(* n+1[||s'] SL* n[s'o|] *)
Save commut_rvarlift1.Goal forall x y : terms, reg_rvarlift2 x y -> e_diag1 _ x y.(* n[so(|ot)] SL*B||SL* n[s'o(|ot')] *)
(* n+1[||s'ot'] SL* n[s'o(|ot')] *)
Save commut_rvarlift2.Goal forall x y : sub_explicits, reg_assenv x y -> e_diag1 _ x y.(* so(tou) SL*B||SL* s'o(t'ou') *)
(*  (s'ot')ou' SL* s'o(t'ou') *)
Save commut_assenv.Goal forall x y : sub_explicits, reg_mapenv x y -> e_diag1 _ x y.(* a[t].(sot) SL*B||SL a'[t'].(s'ot') *)
(* (a'.s')ot' SL* a'[t'].(s'ot') *)
Save commut_mapenv.Goal forall x y : sub_explicits, reg_shiftcons x y -> e_diag1 _ x y.(* s SL*B||SL* s' *)
(* shift o(a'.s') SL* s' *)
Save commut_shiftcons.Goal forall x y : sub_explicits, reg_shiftlift1 x y -> e_diag1 _ x y.(* so| SL*B||SL* s'o| *)
(* |o(|| s') SL* s'o| *)
Save commut_shiftlift1.Goal forall x y : sub_explicits, reg_shiftlift2 x y -> e_diag1 _ x y.(* so(|ot) SL*B||SL* s'o(|ot') *)
(* (|| s')ot' SL* s'o(|ot') *)
Save commut_shiftlift2.Goal forall x y : sub_explicits, reg_lift1 x y -> e_diag1 _ x y.(* ||(sot) SL*B||SL* ||(s'ot') *)
(* ||s' o ||t' SL* ||(s'ot') *)
Save commut_lift1.Goal forall x y : sub_explicits, reg_lift2 x y -> e_diag1 _ x y.(* ||(sot)ou SL*B||SL* ||(s'ot')ou' *) 
(* ||s'o(||t'ou') SL* ||(s'ot')ou' *) 
Save commut_lift2.Goal forall x y : sub_explicits, reg_liftenv x y -> e_diag1 _ x y.(* a.(sot) SL*B||SL* a'.(s'ot') *)
(* ||s'o(a'.t') SL* a'.(s'ot') *)
Save commut_liftenv.Goal forall x y : sub_explicits, reg_idl x y -> e_diag1 _ x y.(* s SL*B||SL* s' *)
(* idos' SL* s' *)
Save commut_idl.Goal forall x y : sub_explicits, reg_idr x y -> e_diag1 _ x y.(* s SL*B||SL* s' *)
(* s'oid SL* s' *)
Save commut_idr.Goal forall x y : sub_explicits, reg_liftid x y -> e_diag1 _ x y.(* id SL*B||SL* id *)
(* ||id SL* id *)
Save commut_liftid.Goal forall x y : terms, reg_id x y -> e_diag1 _ x y.(* a SLB||SL* a' *)
(* a'[id] SL* a' *)
Save commut_id.Goal forall (b : wsort) (x y : TS b), e_systemSL _ x y -> e_diag1 _ x y.Save commut_systemSL.(* lemmes techniques *)

Goal
forall (P : terms -> Prop) (a : terms),
(forall a' : terms, e_relSLstar _ a a' -> P (lambda a')) ->
forall M N : terms, e_relSLstar _ N M -> N = lambda a -> P M.Save case_SLstar_lambda'.Goal
forall (P : terms -> Prop) (a : terms),
(forall a' : terms, e_relSLstar _ a a' -> P (lambda a')) ->
forall M : terms, e_relSLstar _ (lambda a) M -> P M.Save case_SLstar_lambda.Goal
forall (P : terms -> Prop) (a : terms),
(forall a' : terms, e_slstar_bp_slstar _ a a' -> P (lambda a')) ->
forall M : terms, e_slstar_bp_slstar _ (lambda a) M -> P M.Save case_slbpsl_lambda.Goal forall a a' : terms, e_diag1 _ (lambda a) (lambda a') -> e_diag1 _ a a'.Save diag1_lambda.

Theorem commutation : forall (b : wsort) (x y z : TS b), e_relSL _ x y -> e_beta_par _ x z -> exists u : TS b, e_relSLstar _ z u /\ e_slstar_bp_slstar _ y u.