Require Import progat_timel_erl_spec.

Definition type_LF_158 :=  nat -> (Prop * (List.list term)).

Definition F_158 : type_LF_158:= (fun    u1 => ((le u1 u1) = false -> False, (Term id_le ((model_nat u1):: (model_nat u1)::nil))::(Term id_false nil)::nil)).
Definition F_169 : type_LF_158:= (fun     _ => (true = false -> False, (Term id_true nil)::(Term id_false nil)::nil)).

Definition LF_158 := [F_158, F_169].

Function f_158 (u1: nat) {struct u1} : bool :=
 match u1 with
| 0 => true
| (S u2) => true
end.

Lemma main_158 : forall F, In F LF_158 -> forall u1, (forall F', In F' LF_158 -> forall e1, less (snd (F' e1)) (snd (F u1)) -> fst (F' e1)) -> fst (F u1).
Proof.
intros F HF u1; case_In HF; intro Hind.

	(* GENERATE on [ 158 ] *)

rename u1 into _u1.
rename _u1 into u1.

revert Hind.

pattern u1, (f_158 u1). apply f_158_ind.

(* case [ 169 ] *)

intros _u1.  intro eq_1.  intro HFabs0.
assert (Hind := HFabs0 F_169). clear HFabs0.
assert (HFabs0 : fst (F_169 0)).
apply Hind. trivial_in 1. unfold snd. unfold F_169. unfold F_158. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_158. unfold F_169.
auto.

(* case [ 175 ] *)

intros _u1. intro u2.  intro eq_1.  intro HFabs0.
assert (Hind := HFabs0 F_158). clear HFabs0.
assert (HFabs0 : fst (F_158 u2)).
apply Hind. trivial_in 0. unfold snd. unfold F_158. unfold F_158. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_158. unfold F_158.
auto.

	(* NEGATIVE CLASH on [ 169 ] *)

unfold fst. unfold F_169. intros. try discriminate.

Qed.

(* the set of all formula instances from the proof *)
Definition S_158 := fun f => exists F, In F LF_158 /\ exists e1, f = F e1.

Theorem all_true_158: forall F, In F LF_158 -> forall u1: nat, fst (F u1).
Proof.
let n := constr:(1) in
let p := constr:(S(S(n))) in
intros;
let G := fresh "G" in
let x := fresh "x" in
apply wf_subset with (R:=@snd_rpo_mul P Prop max_size) (S:=S_158);
[(* 1 *) apply wf_snd_rpo_mul, prec_wf
|(* 2 *) idtac
|(* 3 *) eexists; split; [ eassumption | idtac]; do_nat n ltac:(eexists); reflexivity
];

intros x G;
do_nat p ltac:(elim G; intro; clear G; intro G);
rewrite G in * |- *; clear G; clear x;
intro G;
apply main_158;
 [assumption | idtac];
intros;
apply G;
 [ idtac | assumption ];
eexists; split;
 [idtac | do_nat n ltac:(eexists); reflexivity];
assumption.
Qed.

Theorem true_158: forall (u1: nat), (le u1 u1) = false -> False.
Proof.
do 1 intro.
apply (all_true_158 F_158);
 (trivial_in 0) ||
 (repeat constructor).
Qed.

Definition type_LF_179 :=  PLAN ->  OBJ ->  nat ->  nat ->  nat -> (Prop * (List.list term)).

Definition F_179 : type_LF_179:= (fun  u2 u1  _ _ _ => ((sortedT (Cons u1 u2)) = true -> (sortedT u2) = true, (Term id_sortedT ((Term id_Cons ((model_OBJ u1):: (model_PLAN u2)::nil))::nil))::(Term id_true nil)::(Term id_sortedT ((model_PLAN u2)::nil))::(Term id_true nil)::nil)).
Definition F_199 : type_LF_179:= (fun  u7  _ u3 u4 u6 => ((sortedT (Cons (C u3 u6) u7)) = true -> (le u3 u4) = true -> (sortedT (Cons (C u3 u6) u7)) = true, (Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u6)::nil)):: (model_PLAN u7)::nil))::nil))::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u4)::nil))::(Term id_true nil)::(Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u6)::nil)):: (model_PLAN u7)::nil))::nil))::(Term id_true nil)::nil)).
Definition F_205 : type_LF_179:= (fun  u7  _ u3 u4 u6 => (false = true -> (le u3 u4) = false -> (sortedT (Cons (C u3 u6) u7)) = true, (Term id_false nil)::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u4)::nil))::(Term id_false nil)::(Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u6)::nil)):: (model_PLAN u7)::nil))::nil))::(Term id_true nil)::nil)).
Definition F_193 : type_LF_179:= (fun   _  _  _ _ _ => (true = true -> (sortedT Nil) = true, (Term id_true nil)::(Term id_true nil)::(Term id_sortedT ((Term id_Nil nil)::nil))::(Term id_true nil)::nil)).
Definition F_206 : type_LF_179:= (fun   _  _  _ _ _ => ((sortedT Nil) = true, (Term id_sortedT ((Term id_Nil nil)::nil))::(Term id_true nil)::nil)).
Definition F_209 : type_LF_179:= (fun   _  _  _ _ _ => (true = true, (Term id_true nil)::(Term id_true nil)::nil)).

Definition LF_179 := [F_179, F_199, F_205, F_193, F_206, F_209].

Function f_179 (u2: PLAN) (u1: OBJ) {struct u2} : bool :=
 match u2, u1 with
| Nil, _ => true
| (Cons (C u3 u6) u7), (C u4 u5) => true
end.

Lemma main_179 : forall F, In F LF_179 -> forall u1, forall u2, forall u3, forall u4, forall u5, (forall F', In F' LF_179 -> forall e1, forall e2, forall e3, forall e4, forall e5, less (snd (F' e1 e2 e3 e4 e5)) (snd (F u1 u2 u3 u4 u5)) -> fst (F' e1 e2 e3 e4 e5)) -> fst (F u1 u2 u3 u4 u5).
Proof.
intros F HF u1 u2 u3 u4 u5; case_In HF; intro Hind.

	(* GENERATE on [ 179 ] *)

rename u1 into _u2. rename u2 into _u1. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5.
rename _u2 into u2. rename _u1 into u1.

revert Hind.

pattern u2, u1, (f_179 u2 u1). apply f_179_ind.

(* case [ 193 ] *)

intros _u2 _u1.  intro eq_1. intro. intro Heq1. rewrite <- Heq1.  intro HFabs0.
assert (Hind := HFabs0 F_193). clear HFabs0.
assert (HFabs0 : fst (F_193 Nil (C 0 0 ) 0 0 0)).
apply Hind. trivial_in 3. unfold snd. unfold F_193. unfold F_179. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_179. unfold F_193.
auto.

intros _u2 _u1. intro u3. intro u6. intro u7.  intro eq_1. intro u4. intro u5.  intro eq_2.  intro HFabs0.
case_eq (le u3 u4); [intro H | intro H].

(* case [ 199 ] *)

assert (Hind := HFabs0 F_199). clear HFabs0.
assert (HFabs0 : fst (F_199 u7 (C 0 0 ) u3 u4 u6)).
apply Hind. trivial_in 1. unfold snd. unfold F_199. unfold F_179. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_179. unfold F_199. simpl in H. repeat(simpl; rewrite H). repeat(simpl in HFabs0; rewrite H in HFabs0). try (auto || (intro H0; contradict H0)).
auto.

(* case [ 205 ] *)

assert (Hind := HFabs0 F_205). clear HFabs0.
assert (HFabs0 : fst (F_205 u7 (C 0 0 ) u3 u4 u6)).
apply Hind. trivial_in 2. unfold snd. unfold F_205. unfold F_179. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_179. unfold F_205. simpl in H. repeat(simpl; rewrite H). repeat(simpl in HFabs0; rewrite H in HFabs0). try (auto || (intro H0; contradict H0)).
auto.

	(* TAUTOLOGY on [ 199 ] *)

unfold fst. unfold F_199.
auto.

	(* NEGATIVE CLASH on [ 205 ] *)

unfold fst. unfold F_205. intros. try discriminate.

	(* NEGATIVE DECOMPOSITION on [ 193 ] *)

rename u1 into d_u1. rename u2 into d_u2. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5.

assert (H := Hind F_206).
assert (HFabs0 : fst (F_206 Nil (C 0 0 ) 0 0 0)).
apply H. trivial_in 4. unfold snd. unfold F_206. unfold F_193. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_193. unfold F_206.

unfold fst in HFabs0. unfold F_206 in HFabs0.
auto.

	(* REWRITING on [ 206 ] *)

rename u1 into d_u1. rename u2 into d_u2. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5.

assert (Res := Hind F_209). clear Hind.
assert (HFabs1 : fst (F_209 Nil (C 0 0 ) 0 0 0)).
apply Res. trivial_in 5. unfold snd. unfold F_209. unfold F_206. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_206. unfold fst in HFabs1. unfold F_209 in HFabs1.    simpl. auto.

	(* TAUTOLOGY on [ 209 ] *)

unfold fst. unfold F_209.
auto.

Qed.

(* the set of all formula instances from the proof *)
Definition S_179 := fun f => exists F, In F LF_179 /\ exists e1, exists e2, exists e3, exists e4, exists e5, f = F e1 e2 e3 e4 e5.

Theorem all_true_179: forall F, In F LF_179 -> forall u1: PLAN, forall u2: OBJ, forall u3: nat, forall u4: nat, forall u5: nat, fst (F u1 u2 u3  u4  u5).
Proof.
let n := constr:(5) in
let p := constr:(S(S(n))) in
intros;
let G := fresh "G" in
let x := fresh "x" in
apply wf_subset with (R:=@snd_rpo_mul P Prop max_size) (S:=S_179);
[(* 1 *) apply wf_snd_rpo_mul, prec_wf
|(* 2 *) idtac
|(* 3 *) eexists; split; [ eassumption | idtac]; do_nat n ltac:(eexists); reflexivity
];

intros x G;
do_nat p ltac:(elim G; intro; clear G; intro G);
rewrite G in * |- *; clear G; clear x;
intro G;
apply main_179;
 [assumption | idtac];
intros;
apply G;
 [ idtac | assumption ];
eexists; split;
 [idtac | do_nat n ltac:(eexists); reflexivity];
assumption.
Qed.

Theorem true_179: forall (u2: PLAN) (u1: OBJ), (sortedT (Cons u1 u2)) = true -> (sortedT u2) = true.
Proof.
do 2 intro.
apply (all_true_179 F_179);
 (trivial_in 0) ||
 (repeat constructor).
Qed.

Definition type_LF_210 :=  PLAN ->  OBJ ->  nat ->  nat ->  nat ->  nat -> (Prop * (List.list term)).

Definition F_210 : type_LF_210:= (fun  u2 u1  _ _ _ _ => ((sortedT (Cons u1 u2)) = true -> (le (timel u2) (time u1)) = true, (Term id_sortedT ((Term id_Cons ((model_OBJ u1):: (model_PLAN u2)::nil))::nil))::(Term id_true nil)::(Term id_le ((Term id_timel ((model_PLAN u2)::nil)):: (Term id_time ((model_OBJ u1)::nil))::nil))::(Term id_true nil)::nil)).
Definition F_237 : type_LF_210:= (fun  u7  _ u3 u4 u5 u6 => (false = true -> (le u3 u4) = false -> (le (timel (Cons (C u3 u6) u7)) (time (C u4 u5))) = true, (Term id_false nil)::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u4)::nil))::(Term id_false nil)::(Term id_le ((Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u6)::nil)):: (model_PLAN u7)::nil))::nil)):: (Term id_time ((Term id_C ((model_nat u4):: (model_nat u5)::nil))::nil))::nil))::(Term id_true nil)::nil)).
Definition F_225 : type_LF_210:= (fun   _ u1  _ _ _ _ => (true = true -> (le (timel Nil) (time u1)) = true, (Term id_true nil)::(Term id_true nil)::(Term id_le ((Term id_timel ((Term id_Nil nil)::nil)):: (Term id_time ((model_OBJ u1)::nil))::nil))::(Term id_true nil)::nil)).
Definition F_231 : type_LF_210:= (fun  u7  _ u3 u4 u5 u6 => ((sortedT (Cons (C u3 u6) u7)) = true -> (le u3 u4) = true -> (le (timel (Cons (C u3 u6) u7)) (time (C u4 u5))) = true, (Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u6)::nil)):: (model_PLAN u7)::nil))::nil))::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u4)::nil))::(Term id_true nil)::(Term id_le ((Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u6)::nil)):: (model_PLAN u7)::nil))::nil)):: (Term id_time ((Term id_C ((model_nat u4):: (model_nat u5)::nil))::nil))::nil))::(Term id_true nil)::nil)).
Definition F_238 : type_LF_210:= (fun   _ u1  _ _ _ _ => ((le (timel Nil) (time u1)) = true, (Term id_le ((Term id_timel ((Term id_Nil nil)::nil)):: (Term id_time ((model_OBJ u1)::nil))::nil))::(Term id_true nil)::nil)).
Definition F_241 : type_LF_210:= (fun  u7  _ u3 u4 u6 _ => ((sortedT (Cons (C u3 u6) u7)) = true -> (le u3 u4) = true -> (le (timel (Cons (C u3 u6) u7)) u4) = true, (Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u6)::nil)):: (model_PLAN u7)::nil))::nil))::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u4)::nil))::(Term id_true nil)::(Term id_le ((Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u6)::nil)):: (model_PLAN u7)::nil))::nil)):: (model_nat u4)::nil))::(Term id_true nil)::nil)).
Definition F_244 : type_LF_210:= (fun   _ u1  _ _ _ _ => ((le 0 (time u1)) = true, (Term id_le ((Term id_0 nil):: (Term id_time ((model_OBJ u1)::nil))::nil))::(Term id_true nil)::nil)).
Definition F_250 : type_LF_210:= (fun   _  _  _ _ _ _ => (true = true, (Term id_true nil)::(Term id_true nil)::nil)).
Definition F_247 : type_LF_210:= (fun  u7  _ u3 u4 u6 _ => ((sortedT (Cons (C u3 u6) u7)) = true -> (le u3 u4) = true -> (le (time (C u3 u6)) u4) = true, (Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u6)::nil)):: (model_PLAN u7)::nil))::nil))::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u4)::nil))::(Term id_true nil)::(Term id_le ((Term id_time ((Term id_C ((model_nat u3):: (model_nat u6)::nil))::nil)):: (model_nat u4)::nil))::(Term id_true nil)::nil)).
Definition F_253 : type_LF_210:= (fun  u7  _ u3 u4 u6 _ => ((sortedT (Cons (C u3 u6) u7)) = true -> (le u3 u4) = true -> (le u3 u4) = true, (Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u6)::nil)):: (model_PLAN u7)::nil))::nil))::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u4)::nil))::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u4)::nil))::(Term id_true nil)::nil)).

Definition LF_210 := [F_210, F_237, F_225, F_231, F_238, F_241, F_244, F_250, F_247, F_253].

Function f_210 (u2: PLAN) (u1: OBJ) {struct u2} : bool :=
 match u2, u1 with
| Nil, _ => true
| (Cons (C u3 u6) u7), (C u4 u5) => true
end.

Lemma main_210 : forall F, In F LF_210 -> forall u1, forall u2, forall u3, forall u4, forall u5, forall u6, (forall F', In F' LF_210 -> forall e1, forall e2, forall e3, forall e4, forall e5, forall e6, less (snd (F' e1 e2 e3 e4 e5 e6)) (snd (F u1 u2 u3 u4 u5 u6)) -> fst (F' e1 e2 e3 e4 e5 e6)) -> fst (F u1 u2 u3 u4 u5 u6).
Proof.
intros F HF u1 u2 u3 u4 u5 u6; case_In HF; intro Hind.

	(* GENERATE on [ 210 ] *)

rename u1 into _u2. rename u2 into _u1. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5. rename u6 into d_u6.
rename _u2 into u2. rename _u1 into u1.

revert Hind.

pattern u2, u1, (f_210 u2 u1). apply f_210_ind.

(* case [ 225 ] *)

intros _u2 _u1.  intro eq_1. intro. intro Heq1. rewrite <- Heq1.  intro HFabs0.
assert (Hind := HFabs0 F_225). clear HFabs0.
assert (HFabs0 : fst (F_225 Nil _u1 0 0 0 0)).
apply Hind. trivial_in 2. unfold snd. unfold F_225. unfold F_210. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_210. unfold F_225.
auto.

intros _u2 _u1. intro u3. intro u6. intro u7.  intro eq_1. intro u4. intro u5.  intro eq_2.  intro HFabs0.
case_eq (le u3 u4); [intro H | intro H].

(* case [ 231 ] *)

assert (Hind := HFabs0 F_231). clear HFabs0.
assert (HFabs0 : fst (F_231 u7 (C 0 0 ) u3 u4 u5 u6)).
apply Hind. trivial_in 3. unfold snd. unfold F_231. unfold F_210. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_210. unfold F_231. simpl in H. repeat(simpl; rewrite H). repeat(simpl in HFabs0; rewrite H in HFabs0). try (auto || (intro H0; contradict H0)).
auto.

(* case [ 237 ] *)

assert (Hind := HFabs0 F_237). clear HFabs0.
assert (HFabs0 : fst (F_237 u7 (C 0 0 ) u3 u4 u5 u6)).
apply Hind. trivial_in 1. unfold snd. unfold F_237. unfold F_210. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_210. unfold F_237. simpl in H. repeat(simpl; rewrite H). repeat(simpl in HFabs0; rewrite H in HFabs0). try (auto || (intro H0; contradict H0)).
auto.

	(* NEGATIVE CLASH on [ 237 ] *)

unfold fst. unfold F_237. intros. try discriminate.

	(* NEGATIVE DECOMPOSITION on [ 225 ] *)

rename u1 into d_u1. rename u2 into _u1. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5. rename u6 into d_u6.
rename _u1 into u1.
assert (H := Hind F_238).
assert (HFabs0 : fst (F_238 Nil u1 0 0 0 0)).
apply H. trivial_in 4. unfold snd. unfold F_238. unfold F_225. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_225. unfold F_238.

unfold fst in HFabs0. unfold F_238 in HFabs0.
auto.

	(* REWRITING on [ 231 ] *)

rename u1 into _u7. rename u2 into d_u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u5. rename u6 into _u6.
rename _u7 into u7. rename _u3 into u3. rename _u4 into u4. rename _u5 into u5. rename _u6 into u6.
assert (Res := Hind F_241). clear Hind.
assert (HFabs1 : fst (F_241 u7 (C 0 0 ) u3 u4 u6 0)).
apply Res. trivial_in 5. unfold snd. unfold F_241. unfold F_231. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_231. unfold fst in HFabs1. unfold F_241 in HFabs1.
pattern u4, u5. simpl (time _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 238 ] *)

rename u1 into d_u1. rename u2 into _u1. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5. rename u6 into d_u6.
rename _u1 into u1.
assert (Res := Hind F_244). clear Hind.
assert (HFabs1 : fst (F_244 Nil u1 0 0 0 0)).
apply Res. trivial_in 6. unfold snd. unfold F_244. unfold F_238. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_238. unfold fst in HFabs1. unfold F_244 in HFabs1.    simpl. auto.

	(* REWRITING on [ 241 ] *)

rename u1 into _u7. rename u2 into d_u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u6. rename u6 into d_u6.
rename _u7 into u7. rename _u3 into u3. rename _u4 into u4. rename _u6 into u6.
assert (Res := Hind F_247). clear Hind.
assert (HFabs1 : fst (F_247 u7 (C 0 0 ) u3 u4 u6 0)).
apply Res. trivial_in 8. unfold snd. unfold F_247. unfold F_241. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_241. unfold fst in HFabs1. unfold F_247 in HFabs1.
pattern (C u3 u6), u7. simpl (timel _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 244 ] *)

rename u1 into d_u1. rename u2 into _u1. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5. rename u6 into d_u6.
rename _u1 into u1.
assert (Res := Hind F_250). clear Hind.
assert (HFabs1 : fst (F_250 Nil (C 0 0 ) 0 0 0 0)).
apply Res. trivial_in 7. unfold snd. unfold F_250. unfold F_244. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_244. unfold fst in HFabs1. unfold F_250 in HFabs1.
pattern (time u1). simpl (le _ _). cbv beta.
 simpl. auto.

	(* TAUTOLOGY on [ 250 ] *)

unfold fst. unfold F_250.
auto.

	(* REWRITING on [ 247 ] *)

rename u1 into _u7. rename u2 into d_u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u6. rename u6 into d_u6.
rename _u7 into u7. rename _u3 into u3. rename _u4 into u4. rename _u6 into u6.
assert (Res := Hind F_253). clear Hind.
assert (HFabs1 : fst (F_253 u7 (C 0 0 ) u3 u4 u6 0)).
apply Res. trivial_in 9. unfold snd. unfold F_253. unfold F_247. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_247. unfold fst in HFabs1. unfold F_253 in HFabs1.
pattern u3, u6. simpl (time _). cbv beta.
 simpl. auto.

	(* TAUTOLOGY on [ 253 ] *)

unfold fst. unfold F_253.
auto.

Qed.

(* the set of all formula instances from the proof *)
Definition S_210 := fun f => exists F, In F LF_210 /\ exists e1, exists e2, exists e3, exists e4, exists e5, exists e6, f = F e1 e2 e3 e4 e5 e6.

Theorem all_true_210: forall F, In F LF_210 -> forall u1: PLAN, forall u2: OBJ, forall u3: nat, forall u4: nat, forall u5: nat, forall u6: nat, fst (F u1 u2 u3  u4  u5  u6).
Proof.
let n := constr:(6) in
let p := constr:(S(S(n))) in
intros;
let G := fresh "G" in
let x := fresh "x" in
apply wf_subset with (R:=@snd_rpo_mul P Prop max_size) (S:=S_210);
[(* 1 *) apply wf_snd_rpo_mul, prec_wf
|(* 2 *) idtac
|(* 3 *) eexists; split; [ eassumption | idtac]; do_nat n ltac:(eexists); reflexivity
];

intros x G;
do_nat p ltac:(elim G; intro; clear G; intro G);
rewrite G in * |- *; clear G; clear x;
intro G;
apply main_210;
 [assumption | idtac];
intros;
apply G;
 [ idtac | assumption ];
eexists; split;
 [idtac | do_nat n ltac:(eexists); reflexivity];
assumption.
Qed.

Theorem true_210: forall (u2: PLAN) (u1: OBJ), (sortedT (Cons u1 u2)) = true -> (le (timel u2) (time u1)) = true.
Proof.
do 2 intro.
apply (all_true_210 F_210);
 (trivial_in 0) ||
 (repeat constructor).
Qed.

Definition type_LF_254 :=  PLAN ->  nat ->  nat ->  nat ->  nat -> (Prop * (List.list term)).

Definition F_254 : type_LF_254:= (fun   u1  _ _ _ _ => ((sortedT u1) = true -> (progAt u1 (timel u1)) = (erl u1), (Term id_sortedT ((model_PLAN u1)::nil))::(Term id_true nil)::(Term id_progAt ((model_PLAN u1):: (Term id_timel ((model_PLAN u1)::nil))::nil))::(Term id_erl ((model_PLAN u1)::nil))::nil)).
Definition F_301 : type_LF_254:= (fun   u6 u2 u3 u4 u5 => (false = true -> (le u2 u3) = false -> (progAt (Cons (C u3 u4) (Cons (C u2 u5) u6)) (timel (Cons (C u3 u4) (Cons (C u2 u5) u6)))) = (erl (Cons (C u3 u4) (Cons (C u2 u5) u6))), (Term id_false nil)::(Term id_true nil)::(Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_false nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil)):: (Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::nil))::nil))::(Term id_erl ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::nil))::nil)).
Definition F_283 : type_LF_254:= (fun    _  _ _ _ _ => (true = true -> (progAt Nil (timel Nil)) = (erl Nil), (Term id_true nil)::(Term id_true nil)::(Term id_progAt ((Term id_Nil nil):: (Term id_timel ((Term id_Nil nil)::nil))::nil))::(Term id_erl ((Term id_Nil nil)::nil))::nil)).
Definition F_289 : type_LF_254:= (fun    _ u3 u4 _ _ => (true = true -> (progAt (Cons (C u3 u4) Nil) (timel (Cons (C u3 u4) Nil))) = (erl (Cons (C u3 u4) Nil)), (Term id_true nil)::(Term id_true nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil)):: (Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil))::nil))::nil))::(Term id_erl ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil))::nil))::nil)).
Definition F_295 : type_LF_254:= (fun   u6 u2 u3 u4 u5 => ((sortedT (Cons (C u2 u5) u6)) = true -> (le u2 u3) = true -> (progAt (Cons (C u3 u4) (Cons (C u2 u5) u6)) (timel (Cons (C u3 u4) (Cons (C u2 u5) u6)))) = (erl (Cons (C u3 u4) (Cons (C u2 u5) u6))), (Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::(Term id_true nil)::(Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil)):: (Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::nil))::nil))::(Term id_erl ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::nil))::nil)).
Definition F_302 : type_LF_254:= (fun    _  _ _ _ _ => ((progAt Nil (timel Nil)) = (erl Nil), (Term id_progAt ((Term id_Nil nil):: (Term id_timel ((Term id_Nil nil)::nil))::nil))::(Term id_erl ((Term id_Nil nil)::nil))::nil)).
Definition F_303 : type_LF_254:= (fun    _ u3 u4 _ _ => ((progAt (Cons (C u3 u4) Nil) (timel (Cons (C u3 u4) Nil))) = (erl (Cons (C u3 u4) Nil)), (Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil)):: (Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil))::nil))::nil))::(Term id_erl ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil))::nil))::nil)).
Definition F_306 : type_LF_254:= (fun   u6 u2 u3 u4 u5 => ((sortedT (Cons (C u2 u5) u6)) = true -> (le u2 u3) = true -> (progAt (Cons (C u3 u4) (Cons (C u2 u5) u6)) (timel (Cons (C u3 u4) (Cons (C u2 u5) u6)))) = (er (C u3 u4)), (Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::(Term id_true nil)::(Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil)):: (Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::nil))::nil))::(Term id_er ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil))::nil)).
Definition F_309 : type_LF_254:= (fun    _  _ _ _ _ => ((progAt Nil (timel Nil)) = 0, (Term id_progAt ((Term id_Nil nil):: (Term id_timel ((Term id_Nil nil)::nil))::nil))::(Term id_0 nil)::nil)).
Definition F_312 : type_LF_254:= (fun    _ u3 u4 _ _ => ((progAt (Cons (C u3 u4) Nil) (timel (Cons (C u3 u4) Nil))) = (er (C u3 u4)), (Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil)):: (Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil))::nil))::nil))::(Term id_er ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil))::nil)).
Definition F_315 : type_LF_254:= (fun   u6 u2 u3 u4 u5 => ((sortedT (Cons (C u2 u5) u6)) = true -> (le u2 u3) = true -> (progAt (Cons (C u3 u4) (Cons (C u2 u5) u6)) (timel (Cons (C u3 u4) (Cons (C u2 u5) u6)))) = u4, (Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::(Term id_true nil)::(Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil)):: (Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::nil))::nil))::(model_nat u4)::nil)).
Definition F_318 : type_LF_254:= (fun    _  _ _ _ _ => ((progAt Nil 0) = 0, (Term id_progAt ((Term id_Nil nil):: (Term id_0 nil)::nil))::(Term id_0 nil)::nil)).
Definition F_327 : type_LF_254:= (fun    _  _ _ _ _ => (0 = 0, (Term id_0 nil)::(Term id_0 nil)::nil)).
Definition F_321 : type_LF_254:= (fun    _ u3 u4 _ _ => ((progAt (Cons (C u3 u4) Nil) (timel (Cons (C u3 u4) Nil))) = u4, (Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil)):: (Term id_timel ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil))::nil))::nil))::(model_nat u4)::nil)).
Definition F_324 : type_LF_254:= (fun   u6 u2 u3 u4 u5 => ((sortedT (Cons (C u2 u5) u6)) = true -> (le u2 u3) = true -> (progAt (Cons (C u3 u4) (Cons (C u2 u5) u6)) (time (C u3 u4))) = u4, (Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::(Term id_true nil)::(Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil)):: (Term id_time ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil))::nil))::(model_nat u4)::nil)).
Definition F_330 : type_LF_254:= (fun    _ u3 u4 _ _ => ((progAt (Cons (C u3 u4) Nil) (time (C u3 u4))) = u4, (Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil)):: (Term id_time ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil))::nil))::(model_nat u4)::nil)).
Definition F_334 : type_LF_254:= (fun   u6 u2 u3 u4 u5 => ((sortedT (Cons (C u2 u5) u6)) = true -> (le u2 u3) = true -> (progAt (Cons (C u3 u4) (Cons (C u2 u5) u6)) u3) = u4, (Term id_sortedT ((Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil))::(Term id_true nil)::(Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil)):: (model_nat u3)::nil))::(model_nat u4)::nil)).
Definition F_357 : type_LF_254:= (fun   u6 u2 u3 u4 u5 => ((le u2 u3) = true -> (sortedT u6) = true -> (le (timel u6) (time (C u2 u5))) = true -> (progAt (Cons (C u3 u4) (Cons (C u2 u5) u6)) u3) = u4, (Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_sortedT ((model_PLAN u6)::nil))::(Term id_true nil)::(Term id_le ((Term id_timel ((model_PLAN u6)::nil)):: (Term id_time ((Term id_C ((model_nat u2):: (model_nat u5)::nil))::nil))::nil))::(Term id_true nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil)):: (model_nat u3)::nil))::(model_nat u4)::nil)).
Definition F_337 : type_LF_254:= (fun    _ u3 u4 _ _ => ((progAt (Cons (C u3 u4) Nil) u3) = u4, (Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Nil nil)::nil)):: (model_nat u3)::nil))::(model_nat u4)::nil)).
Definition F_403 : type_LF_254:= (fun    _ u3 u4 _ _ => ((le (time (C u3 u4)) u3) = true -> (er (C u3 u4)) = u4, (Term id_le ((Term id_time ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil)):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_er ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil))::(model_nat u4)::nil)).
Definition F_407 : type_LF_254:= (fun    _ u3 u4 _ _ => ((le (time (C u3 u4)) u3) = false -> (progAt Nil u3) = u4, (Term id_le ((Term id_time ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil)):: (model_nat u3)::nil))::(Term id_false nil)::(Term id_progAt ((Term id_Nil nil):: (model_nat u3)::nil))::(model_nat u4)::nil)).
Definition F_410 : type_LF_254:= (fun    _ u3 u4 _ _ => ((le u3 u3) = true -> (er (C u3 u4)) = u4, (Term id_le ((model_nat u3):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_er ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil))::(model_nat u4)::nil)).
Definition F_417 : type_LF_254:= (fun    _ u3 u4 _ _ => ((le u3 u3) = true -> u4 = u4, (Term id_le ((model_nat u3):: (model_nat u3)::nil))::(Term id_true nil)::(model_nat u4)::(model_nat u4)::nil)).
Definition F_413 : type_LF_254:= (fun    _ u3 u4 _ _ => ((le (time (C u3 u4)) u3) = false -> 0 = u4, (Term id_le ((Term id_time ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil)):: (model_nat u3)::nil))::(Term id_false nil)::(Term id_0 nil)::(model_nat u4)::nil)).
Definition F_420 : type_LF_254:= (fun    _ u3 u4 _ _ => ((le u3 u3) = false -> 0 = u4, (Term id_le ((model_nat u3):: (model_nat u3)::nil))::(Term id_false nil)::(Term id_0 nil)::(model_nat u4)::nil)).
Definition F_361 : type_LF_254:= (fun   u6 u2 u3 u4 u5 => ((le u2 u3) = true -> (sortedT u6) = true -> (le (timel u6) u2) = true -> (progAt (Cons (C u3 u4) (Cons (C u2 u5) u6)) u3) = u4, (Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_sortedT ((model_PLAN u6)::nil))::(Term id_true nil)::(Term id_le ((Term id_timel ((model_PLAN u6)::nil)):: (model_nat u2)::nil))::(Term id_true nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u3):: (model_nat u4)::nil)):: (Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil))::nil)):: (model_nat u3)::nil))::(model_nat u4)::nil)).
Definition F_450 : type_LF_254:= (fun   u6 u2 u3 u4 _ => ((le u2 u3) = true -> (sortedT u6) = true -> (le (timel u6) u2) = true -> (le (time (C u3 u4)) u3) = true -> (er (C u3 u4)) = u4, (Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_sortedT ((model_PLAN u6)::nil))::(Term id_true nil)::(Term id_le ((Term id_timel ((model_PLAN u6)::nil)):: (model_nat u2)::nil))::(Term id_true nil)::(Term id_le ((Term id_time ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil)):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_er ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil))::(model_nat u4)::nil)).
Definition F_454 : type_LF_254:= (fun   u6 u2 u3 u4 u5 => ((le u2 u3) = true -> (sortedT u6) = true -> (le (timel u6) u2) = true -> (le (time (C u3 u4)) u3) = false -> (progAt (Cons (C u2 u5) u6) u3) = u4, (Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_sortedT ((model_PLAN u6)::nil))::(Term id_true nil)::(Term id_le ((Term id_timel ((model_PLAN u6)::nil)):: (model_nat u2)::nil))::(Term id_true nil)::(Term id_le ((Term id_time ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil)):: (model_nat u3)::nil))::(Term id_false nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil)):: (model_nat u3)::nil))::(model_nat u4)::nil)).
Definition F_457 : type_LF_254:= (fun   u6 u2 u3 u4 _ => ((le u2 u3) = true -> (sortedT u6) = true -> (le (timel u6) u2) = true -> (le u3 u3) = true -> (er (C u3 u4)) = u4, (Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_sortedT ((model_PLAN u6)::nil))::(Term id_true nil)::(Term id_le ((Term id_timel ((model_PLAN u6)::nil)):: (model_nat u2)::nil))::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_er ((Term id_C ((model_nat u3):: (model_nat u4)::nil))::nil))::(model_nat u4)::nil)).
Definition F_465 : type_LF_254:= (fun   u6 u2 u3 u4 _ => ((le u2 u3) = true -> (sortedT u6) = true -> (le (timel u6) u2) = true -> (le u3 u3) = true -> u4 = u4, (Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_sortedT ((model_PLAN u6)::nil))::(Term id_true nil)::(Term id_le ((Term id_timel ((model_PLAN u6)::nil)):: (model_nat u2)::nil))::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u3)::nil))::(Term id_true nil)::(model_nat u4)::(model_nat u4)::nil)).
Definition F_461 : type_LF_254:= (fun   u6 u2 u3 u4 u5 => ((le u2 u3) = true -> (sortedT u6) = true -> (le (timel u6) u2) = true -> (le u3 u3) = false -> (progAt (Cons (C u2 u5) u6) u3) = u4, (Term id_le ((model_nat u2):: (model_nat u3)::nil))::(Term id_true nil)::(Term id_sortedT ((model_PLAN u6)::nil))::(Term id_true nil)::(Term id_le ((Term id_timel ((model_PLAN u6)::nil)):: (model_nat u2)::nil))::(Term id_true nil)::(Term id_le ((model_nat u3):: (model_nat u3)::nil))::(Term id_false nil)::(Term id_progAt ((Term id_Cons ((Term id_C ((model_nat u2):: (model_nat u5)::nil)):: (model_PLAN u6)::nil)):: (model_nat u3)::nil))::(model_nat u4)::nil)).

Definition LF_254 := [F_254, F_301, F_283, F_289, F_295, F_302, F_303, F_306, F_309, F_312, F_315, F_318, F_327, F_321, F_324, F_330, F_334, F_357, F_337, F_403, F_407, F_410, F_417, F_413, F_420, F_361, F_450, F_454, F_457, F_465, F_461].

Function f_254 (u1: PLAN) {struct u1} : bool :=
 match u1 with
| Nil => true
| (Cons (C u3 u4) Nil) => true
| (Cons (C u3 u4) (Cons (C u2 u5) u6)) => true
end.

Lemma main_254 : forall F, In F LF_254 -> forall u1, forall u2, forall u3, forall u4, forall u5, (forall F', In F' LF_254 -> forall e1, forall e2, forall e3, forall e4, forall e5, less (snd (F' e1 e2 e3 e4 e5)) (snd (F u1 u2 u3 u4 u5)) -> fst (F' e1 e2 e3 e4 e5)) -> fst (F u1 u2 u3 u4 u5).
Proof.
intros F HF u1 u2 u3 u4 u5; case_In HF; intro Hind.

	(* GENERATE on [ 254 ] *)

rename u1 into _u1. rename u2 into d_u2. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5.
rename _u1 into u1.

revert Hind.

pattern u1, (f_254 u1). apply f_254_ind.

(* case [ 283 ] *)

intros _u1.  intro eq_1.  intro HFabs0.
assert (Hind := HFabs0 F_283). clear HFabs0.
assert (HFabs0 : fst (F_283 Nil 0 0 0 0)).
apply Hind. trivial_in 2. unfold snd. unfold F_283. unfold F_254. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_254. unfold F_283.
auto.

(* case [ 289 ] *)

intros _u1. intro u3. intro u4.  intro eq_1.  intro HFabs0.
assert (Hind := HFabs0 F_289). clear HFabs0.
assert (HFabs0 : fst (F_289 Nil u3 u4 0 0)).
apply Hind. trivial_in 3. unfold snd. unfold F_289. unfold F_254. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_254. unfold F_289.
auto.

intros _u1. intro u3. intro u4. intro u2. intro u5. intro u6.  intro eq_1.  intro HFabs0.
case_eq (le u2 u3); [intro H | intro H].

(* case [ 295 ] *)

assert (Hind := HFabs0 F_295). clear HFabs0.
assert (HFabs0 : fst (F_295 u6 u2 u3 u4 u5)).
apply Hind. trivial_in 4. unfold snd. unfold F_295. unfold F_254. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_254. unfold F_295. simpl in H. repeat(simpl; rewrite H). repeat(simpl in HFabs0; rewrite H in HFabs0). try (auto || (intro H0; contradict H0)).
auto.

(* case [ 301 ] *)

assert (Hind := HFabs0 F_301). clear HFabs0.
assert (HFabs0 : fst (F_301 u6 u2 u3 u4 u5)).
apply Hind. trivial_in 1. unfold snd. unfold F_301. unfold F_254. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_254. unfold F_301. simpl in H. repeat(simpl; rewrite H). repeat(simpl in HFabs0; rewrite H in HFabs0). try (auto || (intro H0; contradict H0)).
auto.

	(* NEGATIVE CLASH on [ 301 ] *)

unfold fst. unfold F_301. intros. try discriminate.

	(* NEGATIVE DECOMPOSITION on [ 283 ] *)

rename u1 into d_u1. rename u2 into d_u2. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5.

assert (H := Hind F_302).
assert (HFabs0 : fst (F_302 Nil 0 0 0 0)).
apply H. trivial_in 5. unfold snd. unfold F_302. unfold F_283. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_283. unfold F_302.

unfold fst in HFabs0. unfold F_302 in HFabs0.
auto.

	(* NEGATIVE DECOMPOSITION on [ 289 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
assert (H := Hind F_303).
assert (HFabs0 : fst (F_303 Nil u3 u4 0 0)).
apply H. trivial_in 6. unfold snd. unfold F_303. unfold F_289. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_289. unfold F_303.

unfold fst in HFabs0. unfold F_303 in HFabs0.
auto.

	(* REWRITING on [ 295 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4. rename _u5 into u5.
assert (Res := Hind F_306). clear Hind.
assert (HFabs1 : fst (F_306 u6 u2 u3 u4 u5)).
apply Res. trivial_in 7. unfold snd. unfold F_306. unfold F_295. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_295. unfold fst in HFabs1. unfold F_306 in HFabs1.
pattern (C u3 u4), (Cons (C u2 u5) u6). simpl (erl _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 302 ] *)

rename u1 into d_u1. rename u2 into d_u2. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5.

assert (Res := Hind F_309). clear Hind.
assert (HFabs1 : fst (F_309 Nil 0 0 0 0)).
apply Res. trivial_in 8. unfold snd. unfold F_309. unfold F_302. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_302. unfold fst in HFabs1. unfold F_309 in HFabs1.    simpl. auto.

	(* REWRITING on [ 303 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
assert (Res := Hind F_312). clear Hind.
assert (HFabs1 : fst (F_312 Nil u3 u4 0 0)).
apply Res. trivial_in 9. unfold snd. unfold F_312. unfold F_303. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_303. unfold fst in HFabs1. unfold F_312 in HFabs1.
pattern (C u3 u4), Nil. simpl (erl _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 306 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4. rename _u5 into u5.
assert (Res := Hind F_315). clear Hind.
assert (HFabs1 : fst (F_315 u6 u2 u3 u4 u5)).
apply Res. trivial_in 10. unfold snd. unfold F_315. unfold F_306. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_306. unfold fst in HFabs1. unfold F_315 in HFabs1.
pattern u3, u4. simpl (er _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 309 ] *)

rename u1 into d_u1. rename u2 into d_u2. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5.

assert (Res := Hind F_318). clear Hind.
assert (HFabs1 : fst (F_318 Nil 0 0 0 0)).
apply Res. trivial_in 11. unfold snd. unfold F_318. unfold F_309. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_309. unfold fst in HFabs1. unfold F_318 in HFabs1.    simpl. auto.

	(* REWRITING on [ 312 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
assert (Res := Hind F_321). clear Hind.
assert (HFabs1 : fst (F_321 Nil u3 u4 0 0)).
apply Res. trivial_in 13. unfold snd. unfold F_321. unfold F_312. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_312. unfold fst in HFabs1. unfold F_321 in HFabs1.
pattern u3, u4. simpl (er _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 315 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4. rename _u5 into u5.
assert (Res := Hind F_324). clear Hind.
assert (HFabs1 : fst (F_324 u6 u2 u3 u4 u5)).
apply Res. trivial_in 14. unfold snd. unfold F_324. unfold F_315. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_315. unfold fst in HFabs1. unfold F_324 in HFabs1.
pattern (C u3 u4), (Cons (C u2 u5) u6). simpl (timel _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 318 ] *)

rename u1 into d_u1. rename u2 into d_u2. rename u3 into d_u3. rename u4 into d_u4. rename u5 into d_u5.

assert (Res := Hind F_327). clear Hind.
assert (HFabs1 : fst (F_327 Nil 0 0 0 0)).
apply Res. trivial_in 12. unfold snd. unfold F_327. unfold F_318. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_318. unfold fst in HFabs1. unfold F_327 in HFabs1.
pattern 0. simpl (progAt _ _). cbv beta.
 simpl. auto.

	(* TAUTOLOGY on [ 327 ] *)

unfold fst. unfold F_327.
auto.

	(* REWRITING on [ 321 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
assert (Res := Hind F_330). clear Hind.
assert (HFabs1 : fst (F_330 Nil u3 u4 0 0)).
apply Res. trivial_in 15. unfold snd. unfold F_330. unfold F_321. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_321. unfold fst in HFabs1. unfold F_330 in HFabs1.
pattern (C u3 u4), Nil. simpl (timel _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 324 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4. rename _u5 into u5.
assert (Res := Hind F_334). clear Hind.
assert (HFabs1 : fst (F_334 u6 u2 u3 u4 u5)).
apply Res. trivial_in 16. unfold snd. unfold F_334. unfold F_324. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_324. unfold fst in HFabs1. unfold F_334 in HFabs1.
pattern u3, u4. simpl (time _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 330 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
assert (Res := Hind F_337). clear Hind.
assert (HFabs1 : fst (F_337 Nil u3 u4 0 0)).
apply Res. trivial_in 18. unfold snd. unfold F_337. unfold F_330. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_330. unfold fst in HFabs1. unfold F_337 in HFabs1.
pattern u3, u4. simpl (time _). cbv beta.
 simpl. auto.

	(* AUGMENTATION on [ 334 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4. rename _u5 into u5.
assert (H := Hind F_357). clear Hind.
assert (HFabs0: fst (F_357 u6 u2 u3 u4 u5)).
apply H. trivial_in 17. unfold snd. unfold F_334. unfold F_357. rewrite_model. abstract solve_rpo_mul.

unfold fst. unfold F_334.

specialize true_210 with (u1 := (C u2 u5)) (u2 := u6).
specialize true_179 with (u1 := (C u2 u5)) (u2 := u6). auto.

	(* REWRITING on [ 357 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4. rename _u5 into u5.
assert (Res := Hind F_361). clear Hind.
assert (HFabs1 : fst (F_361 u6 u2 u3 u4 u5)).
apply Res. trivial_in 25. unfold snd. unfold F_361. unfold F_357. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_357. unfold fst in HFabs1. unfold F_361 in HFabs1.
pattern u2, u5. simpl (time _). cbv beta.
 simpl. auto.

	(* TOTAL CASE REWRITING on [ 337 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
assert (H: ((le (time (C u3 u4)) u3) = true) \/ ((le (time (C u3 u4)) u3) = false)).

destruct ((le (time (C u3 u4)) u3)); auto.

destruct H as [H|H].

(* rewriting with the axiom [ 137 ] *)

assert (H1 := Hind F_403). clear Hind.
assert (HFabs0 : fst (F_403 Nil u3 u4 0 0)).
apply H1. trivial_in 19. unfold snd. unfold F_403. unfold F_337. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_337. unfold F_403. unfold fst in HFabs0. unfold F_403 in HFabs0. simpl in HFabs0.
pattern (C u3 u4).
pattern u3.
pattern Nil.
simpl (progAt _ _). cbv beta. try unfold progAt. try rewrite H. try rewrite H0. try unfold progAt in HFabs0. try rewrite H in HFabs0. try rewrite H0 in HFabs0. auto.

(* rewriting with the axiom [ 138 ] *)

assert (H1 := Hind F_407). clear Hind.
assert (HFabs0 : fst (F_407 Nil u3 u4 0 0)).
apply H1. trivial_in 20. unfold snd. unfold F_407. unfold F_337. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_337. unfold F_407. unfold fst in HFabs0. unfold F_407 in HFabs0. simpl in HFabs0.
pattern (C u3 u4).
pattern u3.
pattern Nil.
simpl (progAt _ _). cbv beta. try unfold progAt. try rewrite H. try rewrite H0. try unfold progAt in HFabs0. try rewrite H in HFabs0. try rewrite H0 in HFabs0. auto.

	(* REWRITING on [ 403 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
assert (Res := Hind F_410). clear Hind.
assert (HFabs1 : fst (F_410 Nil u3 u4 0 0)).
apply Res. trivial_in 21. unfold snd. unfold F_410. unfold F_403. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_403. unfold fst in HFabs1. unfold F_410 in HFabs1.
pattern u3, u4. simpl (time _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 407 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
assert (Res := Hind F_413). clear Hind.
assert (HFabs1 : fst (F_413 Nil u3 u4 0 0)).
apply Res. trivial_in 23. unfold snd. unfold F_413. unfold F_407. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_407. unfold fst in HFabs1. unfold F_413 in HFabs1.
pattern u3. simpl (progAt _ _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 410 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
assert (Res := Hind F_417). clear Hind.
assert (HFabs1 : fst (F_417 Nil u3 u4 0 0)).
apply Res. trivial_in 22. unfold snd. unfold F_417. unfold F_410. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_410. unfold fst in HFabs1. unfold F_417 in HFabs1.
pattern u3, u4. simpl (er _). cbv beta.
 simpl. auto.

	(* TAUTOLOGY on [ 417 ] *)

unfold fst. unfold F_417.
auto.

	(* REWRITING on [ 413 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
assert (Res := Hind F_420). clear Hind.
assert (HFabs1 : fst (F_420 Nil u3 u4 0 0)).
apply Res. trivial_in 24. unfold snd. unfold F_420. unfold F_413. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_413. unfold fst in HFabs1. unfold F_420 in HFabs1.
pattern u3, u4. simpl (time _). cbv beta.
 simpl. auto.

	(* SUBSUMPTION on [ 420 ] *)

rename u1 into d_u1. rename u2 into _u3. rename u3 into _u4. rename u4 into d_u4. rename u5 into d_u5.
rename _u3 into u3. rename _u4 into u4.
unfold fst. unfold F_420. specialize true_158 with (u1 := u3). intro L. intros. contradict L. (auto || symmetry; auto).

	(* TOTAL CASE REWRITING on [ 361 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4. rename _u5 into u5.
assert (H: ((le (time (C u3 u4)) u3) = true) \/ ((le (time (C u3 u4)) u3) = false)).

destruct ((le (time (C u3 u4)) u3)); auto.

destruct H as [H|H].

(* rewriting with the axiom [ 137 ] *)

assert (H1 := Hind F_450). clear Hind.
assert (HFabs0 : fst (F_450 u6 u2 u3 u4 0)).
apply H1. trivial_in 26. unfold snd. unfold F_450. unfold F_361. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_361. unfold F_450. unfold fst in HFabs0. unfold F_450 in HFabs0. simpl in HFabs0.
pattern (C u3 u4).
pattern u3.
pattern (Cons (C u2 u5) u6).
simpl (progAt _ _). cbv beta. try unfold progAt. try rewrite H. try rewrite H0. try unfold progAt in HFabs0. try rewrite H in HFabs0. try rewrite H0 in HFabs0. auto.

(* rewriting with the axiom [ 138 ] *)

assert (H1 := Hind F_454). clear Hind.
assert (HFabs0 : fst (F_454 u6 u2 u3 u4 u5)).
apply H1. trivial_in 27. unfold snd. unfold F_454. unfold F_361. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_361. unfold F_454. unfold fst in HFabs0. unfold F_454 in HFabs0. simpl in HFabs0.
pattern (C u3 u4).
pattern u3.
pattern (Cons (C u2 u5) u6).
simpl (progAt _ _). cbv beta. try unfold progAt. try rewrite H. try rewrite H0. try unfold progAt in HFabs0. try rewrite H in HFabs0. try rewrite H0 in HFabs0. auto.

	(* REWRITING on [ 450 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into d_u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4.
assert (Res := Hind F_457). clear Hind.
assert (HFabs1 : fst (F_457 u6 u2 u3 u4 0)).
apply Res. trivial_in 28. unfold snd. unfold F_457. unfold F_450. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_450. unfold fst in HFabs1. unfold F_457 in HFabs1.
pattern u3, u4. simpl (time _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 454 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4. rename _u5 into u5.
assert (Res := Hind F_461). clear Hind.
assert (HFabs1 : fst (F_461 u6 u2 u3 u4 u5)).
apply Res. trivial_in 30. unfold snd. unfold F_461. unfold F_454. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_454. unfold fst in HFabs1. unfold F_461 in HFabs1.
pattern u3, u4. simpl (time _). cbv beta.
 simpl. auto.

	(* REWRITING on [ 457 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into d_u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4.
assert (Res := Hind F_465). clear Hind.
assert (HFabs1 : fst (F_465 u6 u2 u3 u4 0)).
apply Res. trivial_in 29. unfold snd. unfold F_465. unfold F_457. rewrite_model. abstract solve_rpo_mul.
unfold fst. unfold F_457. unfold fst in HFabs1. unfold F_465 in HFabs1.
pattern u3, u4. simpl (er _). cbv beta.
 simpl. auto.

	(* TAUTOLOGY on [ 465 ] *)

unfold fst. unfold F_465.
auto.

	(* SUBSUMPTION on [ 461 ] *)

rename u1 into _u6. rename u2 into _u2. rename u3 into _u3. rename u4 into _u4. rename u5 into _u5.
rename _u6 into u6. rename _u2 into u2. rename _u3 into u3. rename _u4 into u4. rename _u5 into u5.
unfold fst. unfold F_461. specialize true_158 with (u1 := u3). intro L. intros. contradict L. (auto || symmetry; auto).

Qed.

(* the set of all formula instances from the proof *)
Definition S_254 := fun f => exists F, In F LF_254 /\ exists e1, exists e2, exists e3, exists e4, exists e5, f = F e1 e2 e3 e4 e5.

Theorem all_true_254: forall F, In F LF_254 -> forall u1: PLAN, forall u2: nat, forall u3: nat, forall u4: nat, forall u5: nat, fst (F u1 u2  u3  u4  u5).
Proof.
let n := constr:(5) in
let p := constr:(S(S(n))) in
intros;
let G := fresh "G" in
let x := fresh "x" in
apply wf_subset with (R:=@snd_rpo_mul P Prop max_size) (S:=S_254);
[(* 1 *) apply wf_snd_rpo_mul, prec_wf
|(* 2 *) idtac
|(* 3 *) eexists; split; [ eassumption | idtac]; do_nat n ltac:(eexists); reflexivity
];

intros x G;
do_nat p ltac:(elim G; intro; clear G; intro G);
rewrite G in * |- *; clear G; clear x;
intro G;
apply main_254;
 [assumption | idtac];
intros;
apply G;
 [ idtac | assumption ];
eexists; split;
 [idtac | do_nat n ltac:(eexists); reflexivity];
assumption.
Qed.

Theorem true_254: forall (u1: PLAN), (sortedT u1) = true -> (progAt u1 (timel u1)) = (erl u1).
Proof.
do 1 intro.
apply (all_true_254 F_254);
 (trivial_in 0) ||
 (repeat constructor).
Qed.


From Domains Require Import Preamble Preorder Poset Dcpo Sierpinski DcpoExponential.

Section Path.
  Context (D : Dcpo.type).

  Definition Path := map (HB.pack Σ) D.

  Lemma lub_intro (A : Family Σ): ∀ u ϕ, is_lub A ϕ → A u → ϕ.
  Proof. by move=> u ϕ ϕlub; apply: (lub_is_ub A). Qed.

  Section PathFromLt.
    Context (x y : D) (xy : x ≤ y).

    Section Family.
      Context (ϕ : Σ).

      Definition path_fam : Family D.
      Proof.
        exists (sum ϕ True).
        by case=> _; [exact: y| exact: x].
      Defined.

      Lemma path_fam_directed : is_directed path_fam.
      Proof.
        split.
        - by exists (inr I).
        - by case=>a1; case=>a2 /=; (unshelve esplit; [left + right; assumption | eauto]).
      Qed.
    End Family.

    Lemma dlub_continuous : is_continuous (λ ϕ : Σ, dlub (path_fam ϕ) (path_fam_directed ϕ)).
    Proof.
      move=> A dirA p plub; split.
      - move=> //= u; apply: (above_lub _)=>//=; case.
        + move=>s; apply: ltT'.
          * by apply: dlub_is_ub; left; apply: (Σ_lub_intro A _ _ _ s).
          * by [].
        + move=> []; apply: ltT'.
          * by apply: dlub_is_ub; right.
          * by [].
      - move=> z zub; apply: (lub_univ _)=>//; case=>/=.
        + move=> h.
          suff: ∃ i, A i.
          * move=> [i u].
            apply: ltT; last by apply: zub.
            apply: ltT'.
            -- by apply: lub_is_ub; [apply: dlub_is_lub | left].
            -- by [].
          * apply: (lub_univ A); auto.
            -- by apply/lub_is_ub/Σ_exists_is_lub.
            -- suff: dlub A dirA = p by move=>->.
               by apply: lub_unique.
        + move=> _.
          case: dirA => [[i _] h].
          apply/ltT/zub; last by [].
          apply: ltT'.
          * by apply: dlub_is_ub; right.
          * by [].
    Qed.

    Definition make_path : Path.
    Proof.
      unshelve esplit.
      - move=> ϕ.
        by apply/dlub/path_fam_directed/ϕ.
      - by apply: dlub_continuous.
    Defined.
  End PathFromLt.

  Definition HasPath x y := ∃ p : Path, ap p ⊥ = x /\ ap p ⊤ = y.
  Infix "⟿" := HasPath (at level 10).

  Lemma fwd : ∀ x y : D, x ≤ y → x ⟿ y.
  Proof.
    move=> x y xy.
    exists (make_path x y xy); split=>/=.
    - apply: (lub_unique (path_fam _ _ _))=>//; split.
      + by case=>//; rewrite Σ_bot_rw.
      + move=> z h; apply: ltT'.
        * by apply: h; right.
        * by [].
    - apply:  (lub_unique (path_fam _ _ _))=>//; split; first by case.
      move=> z h; apply: ltT'.
      * by apply: h; left; rewrite Σ_top_rw.
      * by [].
  Qed.

  Lemma bwd : ∀ x y : D, x ⟿ y → x ≤ y.
  Proof.
    move=> ? ? [? [<- <-]].
    by apply/cont_mono/bottom_is_bottom/ap_cont.
  Qed.

  Lemma characterization : ∀ x y, (x ≤ y) = (x ⟿ y).
  Proof.
    move=> x y.
    by apply: propext; split; [apply: fwd | apply: bwd].
  Qed.

End Path.

Definition Σ_fun :=
  map (HB.pack Σ) (HB.pack Σ).

Definition Σ_line :=
  {ϕ : Σ & {ψ : Σ | ϕ ≤ ψ}}.

Notation "Σ^Σ" := Σ_fun.
Notation "Σ/=>" := Σ_line.

Definition phoa_fwd : Σ^Σ → Σ/=>.
Proof.
  move=> F.
  exists (ap F ⊥).
  exists (ap F ⊤).
  abstract by apply: cont_mono; first by apply: svalP.
Defined.

Definition phoa_bwd : Σ/=> → Σ^Σ.
Proof.
  move=> [ϕ [ψ h]].
  apply: make_path h.
Defined.

Ltac replace_goal H :=
  match goal with
  | [|- ?G] => rewrite (_ : G = H)
  end.

Definition phoa_bwd_fwd : ∀ F, phoa_bwd (phoa_fwd F) = F.
Proof.
  move=> F.
  apply: eq_sig=>//=.
  apply: funext=> ϕ.
  apply: propext; split.
  - apply: Σ_lub_elim=>//=.
    by case=>//= ?; apply: (cont_mono (ap F))=>//=; by apply: svalP.
  - move=> x.
    set fam := path_fam (HB.pack Σ) ⊥ ⊤ ϕ.
    set Ffam := path_fam (HB.pack Σ) (ap F ⊥) (ap F ⊤) ϕ.
    set dfam := path_fam_directed (HB.pack Σ) ⊥ ⊤ (top_is_top ⊥) ϕ.

    replace_goal (ap F (∃ i, fam i)).
    + apply: lub_unique; first by [].
      rewrite (_ : Ffam = push_fam (sval F) fam).
      * by congr Build_Family; apply: funext; case.
      * apply: (svalP F fam dfam).
        by apply: Σ_exists_is_lub.
    + rewrite /fam /dfam /Ffam.
      move: x.
      apply: (cont_mono (ap F)); first by apply: svalP.
      move=> u.
      exists (inl u).
      by rewrite //= Σ_top_rw.
Qed.

Definition phoa_fwd_bwd : ∀ x, phoa_fwd (phoa_bwd x) = x.
Proof.
  move=> [ϕ [ψ h]].
  rewrite /phoa_fwd //=.
  apply: eq_sigT=>//=.
  - set fam := path_fam (HB.pack Σ) ϕ ψ ⊥.
    set dfam := path_fam_directed (HB.pack Σ ) ϕ ψ h ⊥.
    apply: lub_unique=>//=.
    split.
    + case=>//=.
      by rewrite Σ_bot_rw.
    + move=>//= χ h'.
      apply: h' (inr _).
      done.
  - move=> H.
    apply: eq_sig=>//=.
    simplify_eqs.
    apply: lub_unique=>//=.
    split.
    + by case=>//=.
    + move=> //= χ h'.
      apply: h' (inl _).
      by rewrite Σ_top_rw.
Qed.


From Coq Require Import ssreflect ssrfun ssrbool.
From Coq Require FunctionalExtensionality.
From Mon Require Export Base.
From Coq Require Import Relation_Definitions Morphisms.
From Mon Require Import SPropBase.
From Relational Require Import Category RelativeMonads EnrichedSetting.

Set Primitive Projections.
Set Universe Polymorphism.

(* This file defines most components of the relational dependent type theory as embedded in coq *)

Section Rel.
  Notation πl := (fun x => nfst (dfst x)).
  Notation πr := (fun x => nsnd (dfst x)).
  Notation πw := (fun x => dsnd x).
  Notation "⦑ x , y ⦒" := (dpair _ (npair x y) _).
  Notation "⦑ x , y | w ⦒" := (dpair _ (npair x y) w).
  Notation "⦑ x , y | w | Y ⦒" := (dpair (fun p => πw Y (nfst p) (nsnd p)) (npair x y) w).

  (* CwF of relations *)

  (* Objects *)
  Definition Rel : Type := { AB : Type × Type ⫳ nfst AB -> nsnd AB -> Type }.
  Definition mkRel (A B : Type) (R : A -> B -> Type) : Rel :=
    dpair (fun p => nfst p -> nsnd p -> Type) ⟨A , B⟩ R.

  Definition Relw : forall R:Rel, ( _ -> _ -> _) := πw.
  Coercion Relw : Rel >-> Funclass.

  Definition points (X:Rel) : Type := { p : πl X × πr X ⫳ X (nfst p) (nsnd p)}.
  Notation "⟬ X ⟭" := (points X).

  (* Universes *)
  Definition TyRel : Rel := @mkRel Type Type (fun A B => A -> B -> Type).

  (* Up to size issues, we have ⟬TyRel⟭ = Rel *)

  Definition ArrRel (X Y : Rel) : Rel :=
    ⦑ πl X -> πl Y, πr X -> πr Y
    | fun fl fr => forall xl xr, X xl xr -> Y (fl xl) (fr xr) | TyRel ⦒.

  Notation "X R=> Y" := (ArrRel X Y) (at level 60).

  Definition arrRel X Y := ⟬X R=> Y⟭.
  Notation "X R==> Y" := (arrRel X Y) (at level 60).

  Program Definition idRel X : X R==> X := ⦑id, id⦒.

  Program Definition compRel {X Y Z : Rel}
          (f : X R==> Y) (g : Y R==> Z) : X R==> Z :=
    ⦑fun x => πl g (πl f x), fun x => πr g (πr f x)
    | fun xl xr xw => πw g _ _ (πw f xl xr xw)⦒.

  (* Defining relational morphisms : *)
  (*      We use a syntactic trick to define relational morphisms *)
  (*      X R==> Y out of plain functions (1 R==> X) -> (1 R==> Y) *)
  (*      such that the value of the function on the left (resp. right) *)
  (*      projection is determined by the value of the argument on its *)
  (*      left (resp. right) projection. *)
  (*    *)
  Notation "[< t | Y >]" :=
    (ltac:(let tl :=
               let t := (eval cbn in (fun x y w => πl (t ⦑x, y| w⦒))) in
               match t with | fun x y w => @?P x =>  P end
           in
           let tr :=
               let t := (eval cbn in (fun x y w => πr (t ⦑x, y| w⦒))) in
               match t with | fun x y w => @?P y =>  P end
           in
           let tw := eval cbn in (fun x y w => πw (t ⦑x, y| w⦒)) in
           exact (dpair (fun p => forall xl xr xw, πw Y (nfst p xl) (nsnd p xr)) ⟨tl, tr⟩ tw)))
    (only parsing).

  Definition Hi A : Rel := ⦑ A, A | fun a a' => True | TyRel ⦒.
  Definition Lo A : Rel := ⦑ A, A | fun a a' => a = a' | TyRel ⦒.

  (* Families *)
  Definition dRel (r:Rel) := r R=> TyRel.

  Program Definition applyRel (X Y:Rel) (f :X R==> Y) : ⟬X⟭ -> ⟬Y⟭ :=
    fun x => ⦑πl f (πl x), πr f (πr x) | πw f (πl x) (πr x) (πw x) | Y⦒.

  Notation "f @R x" := (applyRel f x) (at level 85).

  Definition f : Hi nat R==> (Lo nat R=> Lo nat) :=
    [< fun (hi : ⟬Hi nat⟭)  => [< fun lo : ⟬Lo nat⟭ => lo | Lo nat >] | Lo nat R=> Lo nat >].

  (* Notation "[| x | t |]" := (ltac:(let t' := constr:(fun x => t) in idtac t' ; exact 0)) (x ident). *)

  (* Notation "λ² x ∈ X | Y → t" := ([< constr:(fun x : ⟬ X ⟭ => t) | Y >]) (at level 50, x ident). *)

  (* Definition g := λ² x ∈ Hi nat | Lo nat R=> Lo nat → λ² y ∈ Lo nat | Lo nat → y. *)

  Definition EmptyCtx : Rel := mkRel unit unit (fun _ _ => unit).
  Definition ConsCtx (Γ : Rel) (X : Rel) :=
    mkRel (πl Γ × πl X) (πr Γ × πr X) (fun γx1 γx2 => Γ (nfst γx1) (nfst γx2) × X (nsnd γx1) (nsnd γx2)).

  Definition extends (Γ : Rel) (A1 A2 : Type) : Rel :=
    mkRel (πl Γ × A1) (πr Γ × A2) (fun γa1 γa2 => Γ (nfst γa1) (nfst γa2)).

  Definition extend_point {Γ A1 A2} (γ : ⟬Γ⟭) (a1:A1) (a2:A2)
    : ⟬extends Γ A1 A2⟭.
  Proof. exists ⟨⟨πl γ, a1⟩, ⟨πr γ, a2⟩⟩. exact: πw γ. Defined.

  Definition mk_point (R : Rel) (xl : πl R) (xr : πr R) (xw : R xl xr) : ⟬R⟭ :=
    dpair _ ⟨xl, xr⟩ xw.
End Rel.

Module RelNotations.
  Notation πl := (fun x => nfst (dfst x)).
  Notation πr := (fun x => nsnd (dfst x)).
  Notation πw := (fun x => dsnd x).
  Notation "⦑ x , y ⦒" := (dpair _ (npair x y) _).
  Notation "⦑ x , y | w ⦒" := (dpair _ (npair x y) w).
  Notation "⦑ x , y | w | Y ⦒" := (dpair (fun p => πw Y (nfst p) (nsnd p)) (npair x y) w).
  Notation "⟬ X ⟭" := (points X).
  Notation "X R=> Y" := (ArrRel X Y) (at level 60).
  Notation "X R==> Y" := (arrRel X Y) (at level 60).

  Notation "[< t | Y >]" :=
    (ltac:(let tl :=
               let t := (eval cbn in (fun x y w => πl (t ⦑x, y| w⦒))) in
               match t with | fun x y w => @?P x =>  P end
           in
           let tr :=
               let t := (eval cbn in (fun x y w => πr (t ⦑x, y| w⦒))) in
               match t with | fun x y w => @?P y =>  P end
           in
           let tw := eval cbn in (fun x y w => πw (t ⦑x, y| w⦒)) in
           exact (dpair (fun p => forall xl xr xw, πw Y (nfst p xl) (nsnd p xr)) ⟨tl, tr⟩ tw)))
    (only parsing).

  Notation "f @R x" := (applyRel _ _ f x) (at level 85).

  Notation " Γ ,∘ X " := (ConsCtx Γ (Hi X)) (at level 100).
  Notation " Γ ,∙ X " := (ConsCtx Γ (Lo X)) (at level 100).
End RelNotations.

Section RelCat.
  Import RelNotations.

  Program Definition RelCat :=
    mkCategory Rel arrRel (fun _ _ f1 f2 => f1 = f2) _ idRel
               (fun _ _ _ f g => compRel g f) _ _ _ _.
  Next Obligation. cbv ; intuition. induction H. induction H0=> //. Qed.

  Definition rel_one : Rel := ⦑unit, unit| fun _ _ => unit⦒.
  Definition to_rel_one X : RelCat⦅X;rel_one⦆ :=
    dpair _ ⟨fun=> tt, fun=> tt⟩ (fun _ _ _=> tt).

  Definition rel_prod (X Y : Rel) : Rel :=
    ⦑πl X × πl Y, πr X × πr Y |
     fun p1 p2 => X (nfst p1) (nfst p2) × Y (nsnd p1) (nsnd p2)|TyRel⦒.

  Definition rel_prod_fmap {X1 X2 Y1 Y2} (f1:RelCat⦅X1;Y1⦆) (f2:RelCat⦅X2;Y2⦆)
    : RelCat⦅rel_prod X1 X2; rel_prod Y1 Y2⦆.
  Proof.
    cbv.
    unshelve eexists.
    split ; move=> [p1 p2] ; constructor.
    exact (πl f1 p1).
    exact (πl f2 p2).
    exact (πr f1 p1).
    exact (πr f2 p2).
    move=> [xl1 xl2] [yl1 yl2] [w1 w2] ; constructor.
    exact (πw f1 xl1 yl1 w1).
    exact (πw f2 xl2 yl2 w2).
  Defined.

End RelCat.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^383 - 31
Base: 47.875
***)

Definition curve : CurveParameters :=
  {|
    sz := 8%nat;
    base := 47 + 7/8;
    bitwidth := 64;
    s := 2^383;
    c := [(1, 31)];
    carry_chains := Some [seq 0 (pred 8); [0; 1]]%nat;

    a24 := None;
    coef_div_modulus := Some 2%nat;

    goldilocks := None;
    karatsuba := None;
    montgomery := false;
    freeze := Some true;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.


Load loadpath.
Require Import ZArith Coq.Lists.List Permutation.
Require Import msl.Axioms veric.Coqlib2.
Require Import msl.predicates_sa.
Require Import veristar.variables veristar.datatypes veristar.list_denote
               veristar.heapresolve veristar.model_type veristar.model
               veristar.superpose veristar.clauses.

Import HeapResolve.

Module Type NORM_SOUND.
Declare Module VSM: VERISTAR_MODEL.
Import VSM VeriStarLogic Superposition.

Axiom norm_sound : forall sigma sc s,
  clause_denote sc s -> setd clause_denote (@andp _) TT sigma s ->
  clause_denote (HeapResolve.norm sigma sc) s.

End NORM_SOUND.

Module Norm_Sound (VSM: VERISTAR_MODEL) : NORM_SOUND with Module VSM := VSM.
Module VSM := VSM.
Import VSM VeriStarLogic Superposition.

Import sepalg.

Lemma subst_expr_sound v e e' s :
  (Var v === e) s -> (expr_denote e' s = expr_denote (subst_expr v e e') s).
Proof with simpl in *; auto.
unfold var_eq. intro A. destruct e'... if_tac... rewrite <- H...
Qed.

Lemma join_var_eq : forall (s0 s1 s : state) x y,
  join s0 s1 s -> (x === y) s0 -> (x === y) s.
Proof.
intros.
destruct s; destruct s0; destruct s1. destruct H. simpl in *. destruct H.
unfold var_eq in *; subst; auto.
Qed.

Lemma join_var_eq' : forall (s0 s1 s : state) x y,
  join s0 s1 s -> (x === y) s -> (x === y) s0.
Proof.
intros.
destruct s; destruct s0; destruct s1. destruct H. simpl in *. destruct H.
unfold var_eq in *; subst; auto.
Qed.

Lemma subst_space_atom_sound:
   forall (v : datatypes.var) (e : expr) (s : state) (Heq : (Var v === e) s) sa,
  space_atom_denote sa s = space_atom_denote (subst_space v e sa) s.
Proof with simpl in *; auto.
destruct sa... rewrite <- subst_expr_sound...
destruct (val2loc (expr_denote e0 s))... rewrite <- subst_expr_sound...
rewrite <- subst_expr_sound... rewrite <- subst_expr_sound...
Qed.

Lemma subst_space_atoms_sound v e sigma s :
  (Var v === e) s ->
  space_denote sigma s = space_denote (map (subst_space v e) sigma) s.
Proof with simpl; auto.
intro A; revert s A; induction sigma... simpl; intros s A.
apply prop_ext. split; intro B. destruct B as [x [y [B [C D]]]].
exists x; exists y. rewrite (subst_space_atom_sound v e) in C.
split; auto. split; auto. rewrite <- IHsigma; auto.
eapply join_var_eq'; eauto. eapply join_var_eq'; eauto.
destruct B as [x [y [B [C D]]]]. exists x; exists y. split; auto.
rewrite <- subst_space_atom_sound in C; auto. split; auto.
rewrite IHsigma; auto. eapply join_var_eq'; eauto. eapply join_var_eq'; eauto.
Qed.

Lemma normalize1_3_sound pc sc s :
  clause_denote pc s -> clause_denote sc s ->
  clause_denote (normalize1_3 pc sc) s.
Proof with destruct delta; try destruct p; try destruct e; simpl; auto.
intros A B; unfold normalize1_3; destruct pc...
simpl in A. destruct sc; auto; intro C; rewrite (@listd_sort_uniq_un _ state);
try solve [apply pure_atom_cmp_eq]. rewrite listd_app, listd_unfold_un.
rewrite (@listd_sort_uniq_inter _ state) in C. 2: apply pure_atom_cmp_eq.
rewrite listd_app, listd_unfold_inter in C; destruct C as [C D].
specialize (A C). specialize (B D). rewrite (@listd_unfold_un _ state) in B.
destruct A as [A | A]; [ destruct B as [B | B]; right | left; auto].
rewrite listd_unfold_un; left... rewrite listd_unfold_un. right.
unfold space_denote in B; unfold subst_spaces.
solve[rewrite <- subst_space_atoms_sound; auto].
rewrite listd_app, listd_unfold_un.
rewrite (@listd_sort_uniq_inter _ state) in C. 2: apply pure_atom_cmp_eq.
rewrite listd_app, listd_unfold_inter in C; destruct C as [C D].
specialize (A C). destruct A as [A | A]; [ | left; auto].
rewrite listd_unfold_inter in D. destruct D as [D E].
unfold subst_spaces in E. rewrite <- subst_space_atoms_sound in E; auto.
simpl in B. rewrite (@listd_unfold_inter _ state) in B. right; apply B.
split; auto.
Qed.

Require Import Bool.

Lemma empty_state (s : state) : exists s0, emp s0 /\ join s0 s s.
Proof with auto.
generalize (join_ex_identities s); intros [s0 [A [s' B]]].
exists s0; split... assert (s = s'). apply (A _ _ B). subst s...
Qed.

Lemma lseg_nilnil sigma s :
  space_denote sigma s =
  (space_atom_denote (Lseg Nil Nil) * space_denote sigma)%pred s.
Proof with simpl; auto; try congruence.
apply prop_ext; split; intro A. destruct (empty_state s) as [s0 [B C]].
exists s0; exists s. split... split... simpl. rewrite empstate_empheap in B.
constructor... constructor...
destruct A as [x [y [A [B C]]]]. simpl in B. inversion B; subst...
cut (y = s); [ intro X; rewrite <- X; auto | ].
inversion A; subst. destruct y as [y1 y2], s as [s1 s2]; f_equal...
apply A.
Qed.

Lemma lseg_vv sigma v s :
  space_denote sigma s =
  (space_atom_denote (Lseg (Var v) (Var v)) * space_denote sigma)%pred s.
Proof with simpl; auto; try congruence.
apply prop_ext; split; intro A. destruct (empty_state s) as [s0 [B C]].
exists s0; exists s. split... split... simpl.
constructor... apply empstate_empheap...
apply var_nil_or_loc.
destruct A as [x [y [A [B C]]]]. simpl in B. inversion B; subst...
cut (y = s); [ intro X; rewrite <- X; auto | ].
inversion A; subst. destruct y as [y1 y2], s as [s1 s2]; f_equal...
apply A.
Qed.

Lemma drop_reflex_lseg_sound sigma s :
  space_denote sigma s = space_denote (drop_reflex_lseg sigma) s.
Proof with simpl; auto; try congruence.
apply prop_ext; split; intro A.
revert s A; induction sigma... intros s [x [y [A [B C]]]].
generalize A; intros [[A0 A1] A2].
destruct a; [exists x; exists y; split; auto | ].
destruct e; destruct e0. inversion B; simpl; auto; try congruence; subst. apply IHsigma.
cut (y = s); [ intro X; rewrite <- X; auto | ].
destruct y as [y1 y2], s as [s1 s2]; f_equal...
exists x; exists y; split...
exists x; exists y; split...
rewrite if_negb; remember (eq_var v v0) as b; destruct b.
2: exists x; exists y; split...
unfold eq_var in Heqb. apply eq_pos_var_eqZ in Heqb. inversion Heqb; subst.
inversion B; subst.
cut (y = s); [ intro X; rewrite <- X; auto | ].
destruct y as [y1 y2], s as [s1 s2]; f_equal... apply IHsigma...
(* <-- *)
revert s A; induction sigma... intros s A. destruct a in A |- *.
destruct A as [x [y [A [B C]]]]. exists x; exists y; split...
remember e as b1; remember  e0 as b2. destruct b1, b2 in A |- *.
rewrite <- lseg_nilnil...
destruct A as [x [y [A [B C]]]]; exists x; exists y; split...
destruct A as [x [y [A [B C]]]]; exists x; exists y; split...
rewrite if_negb in A; remember (eq_var v v0) as b; destruct b.
apply eq_pos_var_eqZ in Heqb; inversion Heqb; subst. rewrite <- lseg_vv...
destruct A as [x [y [A [B C]]]]; exists x; exists y; split...
Qed.

Lemma normalize2_4_sound sc s :
  clause_denote sc s -> clause_denote (normalize2_4 sc) s.
Proof with try solve [simpl; auto; congruence].
intro A; destruct sc... intro B. specialize (A B). clear B.
rewrite (@listd_unfold_un _ state) in A |- *. destruct A; [ left; auto | ].
right; rewrite <- drop_reflex_lseg_sound...
intro B. rewrite (@listd_unfold_inter _ state) in B. destruct B as [B C].
rewrite <- drop_reflex_lseg_sound in C. apply A.
rewrite (@listd_unfold_inter _ state); split...
Qed.

Lemma norm_sound sigma sc s :
  clause_denote sc s -> setd clause_denote (@andp _) TT sigma s ->
  clause_denote (norm sigma sc) s.
Proof with simpl; auto; try congruence.
unfold norm. intros A B. apply normalize2_4_sound. apply listd_foldr_pred...
intros x a C. apply normalize1_3_sound...
rewrite (@listd_sort_inter _ state) with (cmp := (rev_cmp compare_clause2)); auto.
Qed.

End Norm_Sound.


From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq.
Require Import common.types.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Inductive syscall := Malloc | Free | Size | Base | Eq.

Scheme Equality for syscall.

Lemma syscall_eqP : Equality.axiom syscall_beq.
Proof.
move=> sc1 sc2; apply/(iffP idP).
exact: internal_syscall_dec_bl.
exact: internal_syscall_dec_lb.
Qed.

Definition syscall_eqMixin := EqMixin syscall_eqP.

Canonical syscall_eqType := Eval hnf in EqType syscall syscall_eqMixin.

Definition syscalls :=
  [:: Malloc; Free; Size; Base; Eq].

Class memory_syscall_addrs mt := {
  addr : syscall -> mword mt;
  uniq_addr : injective addr
}.

Section Syscalls.

Context mt {sc : memory_syscall_addrs mt}.

Definition syscall_of_addr (a : mword mt) :=
  nth None (map some syscalls)
      (find (pred1 a) [seq addr sc | sc <- syscalls]).

Lemma addrK : pcancel addr syscall_of_addr.
Proof.
by case; rewrite /syscall_of_addr /= !(inj_eq (@uniq_addr _ sc)).
Qed.

End Syscalls.


Require Import Specification.
Require Import Restrictions.

Ltac crushRewriteH :=
  autorewrite with infra in *.

Ltac crushMatchH :=
  match goal with
    | [ H: ?x = ?x |- _ ] => clear H
    | [ H: ?x ≠ ?x |- _ ] => destruct H
    | [ H: _ ∧ _   |- _ ] => destruct H

    (* Domains *)
    | [ H: S _ = S _     |- _ ] => apply eq_add_S in H
    | [ |- S _ = S _ ] => f_equal

    (* Environments *)
    | [ H : _ ▻ _ = _ ▻ _ |- _ ] =>
      inversion H; clear H
    | [ H : [_] = _ ▻ _ |- _ ] =>
      unfold singleton in H; inversion H; clear H
    | [ H : _ ▻ _ = [_] |- _ ] =>
      unfold singleton in H; inversion H; clear H
    | [ |- _ ▻ _ = _ ▻ _ ] => f_equal

    (* Partitioning *)
    | [ H: match ?i with _ => _ end = inl _ |- _ ] =>
      destruct i eqn: ?
    | [ H: match ?i with _ => _ end = inr _ |- _ ] =>
      destruct i eqn: ?
    | [ |- pleft _ = pleft _ ] => f_equal
    | [ |- pright _ = pright _ ] => f_equal

    (* Env partitioning *)
    | [ pe: ⟪ _        ⊢ _       = ε ∘ _ ⟫ |- _ ] =>
      apply partEnv_leftEmpty in pe; destruct pe
    (* | [ pe: ⟪ _        ⊢ _       = _ ∘ ε ⟫ |- _ ] => *)
    (*   apply partEnv_rightEmpty in pe; destruct pe *)
    | [ pe: ⟪ _        ⊢ ε       = _ ∘ _ ⟫ |- _ ] => inversion pe; clear pe
    | [ pe: ⟪ _        ⊢ _       = ε ∘ ε ⟫ |- _ ] => inversion pe; clear pe
    | [ pe: ⟪ pnil     ⊢ _       = _ ∘ _ ⟫ |- _ ] => inversion pe; clear pe
    | [ pe: ⟪ _        ⊢ (_ ▻ _) = _ ∘ _ ⟫ |- _ ] => inversion pe; clear pe
    | [ pe: ⟪ pleft _  ⊢ _       = _ ∘ _ ⟫ |- _ ] => inversion pe; clear pe
    | [ pe: ⟪ pright _ ⊢ _       = _ ∘ _ ⟫ |- _ ] => inversion pe; clear pe

    | [ |- ⟪ pleft _   ⊢ _ = _ ∘ _ ⟫ ] => econstructor
    | [ |- ⟪ pright _  ⊢ _ = _ ∘ _ ⟫ ] => econstructor
    | [ |- ⟪ plefts _  ⊢ _ = _ ∘ _ ⟫ ] => eapply partEnv_plefts
    (* | [ |- ⟪ prights _ ⊢ _ = _ ∘ _ ⟫ ] => eapply partEnv_prights *)

    | [ H: ⟪ ?pΓΔ ⊢ ?ΓΔ = ?Γ ∘ _ ⟫ |- context[leftEnv ?pΓΔ ?ΓΔ] ] =>
      replace (leftEnv pΓΔ ΓΔ) with Γ by apply eq_sym, (leftEnv_sound H)
    (* | [ H: ⟪ ?pΓΔ ⊢ ?ΓΔ = _ ∘ ?Δ ⟫ |- context[rightEnv ?pΓΔ ?ΓΔ] ] => *)
    (*   replace (rightEnv pΓΔ ΓΔ) with Δ by apply eq_sym, (rightEnv_sound H) *)
    | [ H: ⟪ ?pΓΔ ⊢ ?ΓΔ = _ ∘ _ ⟫ |- context[domPart ?pΓΔ] ] =>
      replace (domPart pΓΔ) with (dom ΓΔ) by apply eq_sym, (domPart_sound H)
    | [ H: ⟪ ?pΓΔ ⊢ _ = ?Γ ∘ _ ⟫ |- context[domPartLeft ?pΓΔ] ] =>
      replace (domPartLeft pΓΔ) with (dom Γ) by apply eq_sym, (domPartLeft_sound H)
    (* | [ H: ⟪ ?pΓΔ ⊢ _ = _ ∘ ?Δ ⟫ |- context[domPartRight ?pΓΔ] ] => *)
    (*   replace (domPartRight pΓΔ) with (dom Δ) by apply eq_sym, (domPartRight_sound H) *)

    (* Substitution *)
    | [ w: ⟪ _ : ε     => _ ⟫ |- _ ] => inversion w; clear w
    | [ w: ⟪ _ : [_]   => _ ⟫ |- _ ] => inversion w; clear w
    | [ w: ⟪ _ : _ ▻ _ => _ ⟫ |- _ ] => inversion w; clear w
    | [ w: ⟪ ?ζ : _ => ?Δ ⟫ |- context[codSub ?ζ] ] =>
      replace (codSub ζ) with (dom Δ) by apply eq_sym, (codSub_sound w)
    | [ |- ⟪ _ : ε     => _ ⟫ ] => econstructor
    | [ |- ⟪ _ : [_]   => _ ⟫ ] => econstructor
    | [ |- ⟪ _ : _ ▻ _ => _ ⟫ ] => econstructor
    | [ |- snoc _ _ _ = snoc _ _ _ ] => f_equal

    (* Typing *)
    | [ |- ⟪ _ ⊢ var : _ ⟫ ] => econstructor
    | [ |- ⟪ _ ⊢ abs _ _ : _ ⟫ ] => econstructor
    | [ |- ⟪ _ ⊢ app _ _ _ : _ ⟫ ] => econstructor
  end.

Ltac crush :=
  intros;
  repeat
    (simpl in *;
     try crushRewriteH;
     try crushMatchH;
     crushRestrictH;
     try subst;
     try discriminate;
     eauto with infra
    ).

(******************************************************************************)

Fixpoint subCat (pΓ pΔ: Part) (ζ₁ ζ₂: Sub) : Sub :=
  match pΓ with
    | pnil  => snil
    | pleft pΓ =>
      match ζ₁ with
        | snil => snil (* IMPOSSIBLE *)
        | snoc pΣ ζ₁ t =>
          snoc
            (restrictLeftLeftPart pΔ pΣ)
            (subCat pΓ (restrictLeftLeftPart' pΔ pΣ) ζ₁ ζ₂)
            t
      end
    | pright pΓ =>
      match ζ₂ with
        | snil => snil (* IMPOSSIBLE *)
        | snoc pΣ ζ₂ t =>
          snoc
            (restrictRightLeftPart pΔ pΣ)
            (subCat pΓ (restrictRightLeftPart' pΔ pΣ) ζ₁ ζ₂)
            t
      end
  end.

Lemma wtSubCat {pΓ Γ Γ₁ Γ₂} (peΓ : ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫) :
  ∀ {pΔ Δ Δ₁ Δ₂ ζ₁ ζ₂},
  ⟪ pΔ ⊢ Δ = Δ₁ ∘ Δ₂ ⟫ →
  ⟪ ζ₁ : Γ₁ => Δ₁⟫ →
  ⟪ ζ₂ : Γ₂ => Δ₂⟫ →
  ⟪ subCat pΓ pΔ ζ₁ ζ₂ : Γ => Δ ⟫.
Proof. induction peΓ; crush. Qed.
Hint Resolve wtSubCat : infra.

Fixpoint splitSubPart (pΓ: Part) (ζ: Sub) : Part :=
  match pΓ , ζ with
    | pnil        , _           => pnil
    | pleft pΓ    , snil        => pnil (* IMPOSSIBLE *)
    | pleft pΓ    , snoc pΔ ζ t => restrictLeftLeftPart pΔ (splitSubPart pΓ ζ)
    | pright pΓ   , snil        => pnil (* IMPOSSIBLE *)
    | pright pΓ   , snoc pΔ ζ t => restrictLeftRightPart pΔ (splitSubPart pΓ ζ)
  end.

Fixpoint splitSubEnvLeft (pΓ: Part) (Δ: Env) (ζ: Sub) : Env :=
  match pΓ , ζ with
    | pnil        , _           => ε
    | pleft pΓ    , snil        => ε (* IMPOSSIBLE *)
    | pleft pΓ    , snoc pΔ ζ t => restrictLeftLeftEnv pΔ (splitSubPart pΓ ζ) Δ
    | pright pΓ   , snil        => ε (* IMPOSSIBLE *)
    | pright pΓ   , snoc pΔ ζ t => splitSubEnvLeft pΓ (leftEnv pΔ Δ) ζ
  end.

Fixpoint splitSubEnvRight (pΓ: Part) (Δ: Env) (ζ: Sub) : Env :=
  match pΓ , ζ with
    | pnil        , _           => ε
    | pleft pΓ    , snil        => ε (* IMPOSSIBLE *)
    | pleft pΓ    , snoc pΔ ζ t => splitSubEnvRight pΓ (leftEnv pΔ Δ) ζ
    | pright pΓ   , snil        => ε (* IMPOSSIBLE *)
    | pright pΓ   , snoc pΔ ζ t => restrictLeftRightEnv pΔ (splitSubPart pΓ ζ) Δ
  end.

Lemma splitSubPart_sound {Γ Δ ζ} (wζ : ⟪ ζ : Γ => Δ ⟫) :
  ∀ pΓ Γ₁ Γ₂, ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ →
  ⟪ splitSubPart pΓ ζ ⊢ Δ = splitSubEnvLeft pΓ Δ ζ ∘ splitSubEnvRight pΓ Δ ζ ⟫.
Proof. induction wζ; crush. Qed.
Hint Resolve splitSubPart_sound : infra.

Fixpoint splitSubLeft (pΓ: Part) (ζ: Sub) : Sub :=
  match pΓ , ζ with
    | pnil        , _           => snil
    | pleft pΓ    , snil        => snil (* IMPOSSIBLE *)
    | pleft pΓ    , snoc pΔ ζ t =>
      snoc
        (restrictLeftLeftPart' pΔ (splitSubPart pΓ ζ))
        (splitSubLeft pΓ ζ) t
    | pright pΓ   , snil        => snil (* IMPOSSIBLE *)
    | pright pΓ   , snoc pΔ ζ t => splitSubLeft pΓ ζ
  end.

Fixpoint splitSubRight (pΓ: Part) (ζ: Sub) : Sub :=
  match pΓ , ζ with
    | pnil        , _           => snil
    | pleft pΓ    , snil        => snil (* IMPOSSIBLE *)
    | pleft pΓ    , snoc pΔ ζ t => splitSubRight pΓ ζ
    | pright pΓ   , snil        => snil (* IMPOSSIBLE *)
    | pright pΓ   , snoc pΔ ζ t =>
      snoc
        (restrictLeftRightPart' pΔ (splitSubPart pΓ ζ))
        (splitSubRight pΓ ζ) t
  end.

Lemma splitSubLeft_sound {ζ Γ Δ} (wζ : ⟪ ζ : Γ => Δ ⟫) :
  ∀ pΓ Γ₁ Γ₂, ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ →
   ⟪ splitSubLeft pΓ ζ : Γ₁ => splitSubEnvLeft pΓ Δ ζ ⟫.
Proof. induction wζ; crush. Qed.
Hint Resolve splitSubLeft_sound : infra.

Lemma splitSubRight_sound {ζ Γ Δ} (wζ : ⟪ ζ : Γ => Δ ⟫) :
  ∀ pΓ Γ₁ Γ₂, ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ →
   ⟪ splitSubRight pΓ ζ : Γ₂ => splitSubEnvRight pΓ Δ ζ ⟫.
Proof. induction wζ; crush. Qed.
Hint Resolve splitSubRight_sound : infra.

Lemma splitSubPart_subCat {pΓ Γ Γ₁ Γ₂} (peΓ: ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫) :
  ∀ {pΔ Δ Δ₁ Δ₂ ζ₁ ζ₂},
    ⟪ pΔ ⊢ Δ = Δ₁ ∘ Δ₂ ⟫ → ⟪ ζ₁ : Γ₁ => Δ₁ ⟫ → ⟪ ζ₂ : Γ₂ => Δ₂ ⟫ →
    splitSubPart pΓ (subCat pΓ pΔ ζ₁ ζ₂) = pΔ.
Proof.
  induction peΓ; crush.
  - erewrite IHpeΓ; crush.
  - erewrite IHpeΓ; crush.
Qed.

Lemma splitSubLeft_subCat_beta {pΓ Γ Γ₁ Γ₂} (peΓ: ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫) :
  ∀ {pΔ Δ Δ₁ Δ₂ ζ₁ ζ₂},
    ⟪ pΔ ⊢ Δ = Δ₁ ∘ Δ₂ ⟫ → ⟪ ζ₁ : Γ₁ => Δ₁ ⟫ → ⟪ ζ₂ : Γ₂ => Δ₂ ⟫ →
    splitSubLeft pΓ (subCat pΓ pΔ ζ₁ ζ₂) = ζ₁.
Proof.
  induction peΓ; crush.
  erewrite splitSubPart_subCat; crush.
Qed.

Lemma splitSubRight_subCat_beta {pΓ Γ Γ₁ Γ₂} (peΓ: ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫) :
  ∀ {pΔ Δ Δ₁ Δ₂ ζ₁ ζ₂},
    ⟪ pΔ ⊢ Δ = Δ₁ ∘ Δ₂ ⟫ → ⟪ ζ₁ : Γ₁ => Δ₁ ⟫ → ⟪ ζ₂ : Γ₂ => Δ₂ ⟫ →
    splitSubRight pΓ (subCat pΓ pΔ ζ₁ ζ₂) = ζ₂.
Proof.
  induction peΓ; crush.
  erewrite splitSubPart_subCat; crush.
Qed.

Lemma subCat_splitSub_eta {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ ζ Σ, ⟪ ζ : ΓΔ => Σ ⟫ →
    subCat pΓΔ (splitSubPart pΓΔ ζ)
      (splitSubLeft pΓΔ ζ) (splitSubRight pΓΔ ζ) = ζ.
Proof. induction peΓΔ; crush. Qed.

Lemma splitSubPart_plefts {ζ Γ Δ} (wζ: ⟪ ζ : Γ => Δ ⟫) :
  splitSubPart (plefts (dom Γ)) ζ = plefts (dom Δ).
Proof.
  induction wζ; crush.
  - rewrite IHwζ.
    erewrite restrictLeftLeftPart_part_plefts; eauto.
Qed.

Lemma splitSubPart_prights {ζ Γ Δ} (wζ: ⟪ ζ : Γ => Δ ⟫) :
  splitSubPart (prights (dom Γ)) ζ = prights (dom Δ).
Proof.
  induction wζ; crush.
  - rewrite IHwζ.
    erewrite restrictLeftRightPart_part_prights; eauto.
Qed.

Lemma splitSubLeft_plefts {ζ Γ Δ} (wζ: ⟪ ζ : Γ => Δ ⟫) :
  splitSubLeft (plefts (dom Γ)) ζ = ζ.
Proof.
  induction wζ; crush.
  - erewrite splitSubPart_plefts; eauto.
    erewrite restrictLeftLeftPart'_part_plefts; eauto.
Qed.

Lemma splitSubLeft_prights {ζ Γ Δ} (wζ: ⟪ ζ : Γ => Δ ⟫) :
  splitSubLeft (prights (dom Γ)) ζ = snil.
Proof. induction wζ; crush. Qed.

Lemma splitSubRight_prights {ζ Γ Δ} (wζ: ⟪ ζ : Γ => Δ ⟫) :
  splitSubRight (prights (dom Γ)) ζ = ζ.
Proof.
  induction wζ; crush.
  - erewrite splitSubPart_prights; eauto.
    erewrite restrictLeftRightPart'_part_prights; eauto.
Qed.

Lemma splitSubPart_subId {pΓ Γ Γ₁ Γ₂} (peΓ: ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫) :
  splitSubPart pΓ (subId (dom Γ)) = pΓ.
Proof. induction peΓ; crush. Qed.

Lemma splitSubLeft_subId {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  splitSubLeft pΓΔ (subId (dom ΓΔ)) = subId (dom Γ).
Proof.
  induction peΓΔ; crush.
  - unfold subUp; crush.
    erewrite splitSubPart_subId; eauto.
    erewrite restrictLeftLeftPart'_plefts_part; eauto.
Qed.

Lemma splitSubRight_subId {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  splitSubRight pΓΔ (subId (dom ΓΔ)) = subId (dom Δ).
Proof.
  induction peΓΔ; crush.
  - unfold subUp; crush.
    erewrite splitSubPart_subId; eauto.
    erewrite restrictLeftRightPart'_plefts_part; eauto.
Qed.

Fixpoint subTm (ζ: Sub) (t: Tm) : Tm :=
  match t with
    | var => match ζ with
               | snil => var (* IMPOSSIBLE *)
               | snoc _ _ t => t
             end
    | abs a t =>
      abs a (subTm (subUp ζ) t)
    | app pΓ t₁ t₂ =>
      app
        (splitSubPart pΓ  ζ)
        (subTm (splitSubLeft pΓ ζ) t₁)
        (subTm (splitSubRight pΓ ζ) t₂)
  end.

(* The substitution lemma. *)
Lemma wtSubTm {Γ t a} (wt: ⟪ Γ ⊢ t : a ⟫) :
  ∀ ζ Δ, ⟪ ζ : Γ => Δ ⟫ → ⟪ Δ ⊢ subTm ζ t : a ⟫.
Proof. induction wt; crush. Qed.
Hint Resolve wtSubTm : infra.

Reserved Notation "σ₁ >=> σ₂" (at level 42, left associativity).
Fixpoint subComp (ξ ζ: Sub) : Sub :=
  match ξ with
    | snil        => ζ
    | snoc pΔ ξ t =>
      snoc
        (splitSubPart pΔ ζ)
        (ξ >=> splitSubLeft pΔ ζ)
        (subTm (splitSubRight pΔ ζ) t)
  end
where "ξ >=> ζ" := (subComp ξ ζ).

Lemma wtSubComp {ξ Γ Δ} (wξ: ⟪ ξ : Γ => Δ ⟫) :
  ∀ {ζ Σ}, ⟪ ζ : Δ => Σ ⟫ → ⟪ (ξ >=> ζ) : Γ => Σ ⟫.
Proof. induction wξ; crush. Qed.
Hint Resolve wtSubComp : infra.

Lemma subTmId {Γ t a} (wt: ⟪ Γ ⊢ t : a ⟫) :
  subTm (subId (dom Γ)) t = t.
Proof.
  induction wt; crush.
  - f_equal.
    eapply IHwt.
  - erewrite splitSubPart_subId; eauto.
    erewrite splitSubLeft_subId; eauto.
    erewrite splitSubRight_subId; eauto.
    f_equal; auto.
Qed.

Lemma subCompIdRight {ζ Γ Δ} (wζ: ⟪ ζ : Γ => Δ ⟫) :
  ζ >=> subId (dom Δ) = ζ.
Proof.
  induction wζ; crush; simpl.
  eapply splitSubPart_subId; eauto.
  erewrite splitSubLeft_subId; eauto.
  erewrite splitSubRight_subId; eauto.
  erewrite subTmId; eauto.
Qed.

Lemma subCompIdLeft {ζ Γ Δ} (wζ: ⟪ ζ : Γ => Δ ⟫) :
  subId (dom Γ) >=> ζ = ζ.
Proof.
  induction wζ; crush.
  - erewrite splitSubPart_plefts; eauto.
    erewrite restrictLeftRightPart_part_plefts; eauto.
  - erewrite splitSubLeft_plefts; eauto.
Qed.

Lemma domPart_restrictLeftLeftPart {pΓΔ ΓΔ Γ Δ} (peΓΔ : ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ pΓ Γ₁ Γ₂, ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ →
    domPart (restrictLeftLeftPart pΓΔ pΓ) = dom ΓΔ.
Proof. induction peΓΔ; crush. Qed.

Lemma domPart_restrictLeftRightPart {pΓΔ ΓΔ Γ Δ} (peΓΔ : ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ pΓ Γ₁ Γ₂, ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ →
    domPart (restrictLeftRightPart pΓΔ pΓ) = dom ΓΔ.
Proof. induction peΓΔ; crush. Qed.

Lemma domPart_splitSubPart {ζ Γ Δ} (wζ: ⟪ ζ : Γ => Δ ⟫) :
  ∀ {pΓ Γ₁ Γ₂}, ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ →
    domPart (splitSubPart pΓ ζ) = dom Δ.
Proof.
  induction wζ; crush.
  - erewrite domPart_restrictLeftLeftPart; crush.
  - erewrite domPart_restrictLeftRightPart; crush.
Qed.

Lemma codSub_subComp {Γ Δ ξ} (wξ: ⟪ ξ : Γ => Δ⟫) :
  ∀ ζ Σ, ⟪ ζ : Δ => Σ⟫ → codSub (ξ >=> ζ) = codSub ζ.
Proof.
  induction wξ; crush.
  eapply domPart_splitSubPart; eauto.
Qed.

Lemma subUpComp {Γ Δ Σ ζ₁ ζ₂} (wζ₁: ⟪ ζ₁ : Γ => Δ⟫) (wζ₂: ⟪ ζ₂ : Δ => Σ⟫) :
  subUp (ζ₁ >=> ζ₂) = subUp ζ₁ >=> subUp ζ₂.
Proof.
  unfold subUp; crush.
  - erewrite splitSubPart_plefts; crush.
    erewrite codSub_subComp; crush.
  - erewrite splitSubLeft_plefts; eauto.
Qed.

Lemma restrictLeftLeftPart_restrictLeftLeftPart
  {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ {pΓ Γ₁ Γ₂ pΓ₁ Γ₁₁ Γ₁₂},
    ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ pΓ₁ ⊢ Γ₁ = Γ₁₁ ∘ Γ₁₂ ⟫ →
  restrictLeftLeftPart pΓΔ (restrictLeftLeftPart pΓ pΓ₁) =
  restrictLeftLeftPart (restrictLeftRightPart pΓΔ pΓ) pΓ₁.
Proof. induction peΓΔ; crushRestrict. Qed.

Lemma restrictLeftLeftPart_restrictLeftRightPart
  {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ {pΓ Γ₁ Γ₂ pΓ₁ Γ₁₁ Γ₁₂},
    ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ pΓ₁ ⊢ Γ₁ = Γ₁₁ ∘ Γ₁₂ ⟫ →
    restrictLeftLeftPart pΓΔ (restrictLeftRightPart pΓ pΓ₁) =
    restrictLeftRightPart (restrictLeftLeftPart pΓΔ pΓ)
      (restrictLeftLeftPart (restrictLeftLeftPart' pΓΔ pΓ) pΓ₁).
Proof. induction peΓΔ; crushRestrict. Qed.

(* Lemma restrictLeftLeftPart'_restrictLeftRightPart *)
(*   {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) : *)
(*   ∀ {pΓ Γ₁ Γ₂ pΓ₁ Γ₁₁ Γ₁₂}, *)
(*     ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ pΓ₁ ⊢ Γ₁ = Γ₁₁ ∘ Γ₁₂ ⟫ → *)
(*     restrictLeftLeftPart' pΓΔ (restrictLeftRightPart pΓ pΓ₁) = *)
(*     restrictLeftLeftPart' (restrictLeftLeftPart' pΓΔ pΓ) pΓ₁. *)
(* Proof. induction peΓΔ; crushRestrict. Qed. *)

Lemma restrictLeftRightPart_restrictLeftLeftPart
  {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ {pΓ Γ₁ Γ₂ pΓ₁ Γ₁₁ Γ₁₂},
    ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ pΓ₁ ⊢ Γ₁ = Γ₁₁ ∘ Γ₁₂ ⟫ →
  restrictLeftRightPart pΓΔ (restrictLeftLeftPart pΓ pΓ₁) =
  restrictLeftLeftPart (restrictLeftLeftPart pΓΔ pΓ)
    (restrictLeftRightPart (restrictLeftLeftPart' pΓΔ pΓ) pΓ₁).
Proof. induction peΓΔ; crushRestrict. Qed.

Lemma restrictLeftRightPart_restrictLeftRightPart
  {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ {pΓ Γ₁ Γ₂ pΓ₁ Γ₁₁ Γ₁₂},
    ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ pΓ₁ ⊢ Γ₁ = Γ₁₁ ∘ Γ₁₂ ⟫ →
    restrictLeftRightPart pΓΔ (restrictLeftRightPart pΓ pΓ₁) =
    restrictLeftRightPart (restrictLeftRightPart pΓΔ pΓ) pΓ₁.
Proof. induction peΓΔ; crushRestrict. Qed.

(* Lemma restrictLeftLeftPart_restrictLeftLeftPart' *)
(*   {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) : *)
(*   ∀ {pΓ Γ₁ Γ₂ pΓ₁ Γ₁₁ Γ₁₂}, *)
(*     ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → *)
(*     ⟪ pΓ₁ ⊢ Γ₁ = Γ₁₁ ∘ Γ₁₂ ⟫ → *)
(*     restrictLeftLeftPart *)
(*       (restrictLeftLeftPart' pΓΔ (restrictLeftLeftPart pΓ pΓ₁)) *)
(*       (restrictLeftLeftPart' pΓ pΓ₁) = *)
(*     restrictLeftLeftPart' (restrictLeftLeftPart pΓΔ pΓ) *)
(*       (restrictLeftLeftPart (restrictLeftLeftPart' pΓΔ pΓ) pΓ₁). *)
(* Proof. induction peΓΔ; crushRestrict. Qed. *)

Lemma splitSubPart_restrictLeftLeftPart
  {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ {pΓ Γ₁ Γ₂ ξ Σ},
    ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ ξ : ΓΔ => Σ ⟫ →
    splitSubPart (restrictLeftLeftPart pΓΔ pΓ) ξ =
    restrictLeftLeftPart (splitSubPart pΓΔ ξ)
      (splitSubPart pΓ (splitSubLeft pΓΔ ξ)).
Proof.
  induction peΓΔ; crush.
  - erewrite IHpeΓΔ; crush.
    erewrite restrictLeftLeftPart_restrictLeftLeftPart; crush.
    erewrite restrictLeftLeftPart_restrictLeftLeftPart; crush.
  - erewrite IHpeΓΔ; crush.
    erewrite restrictLeftRightPart_restrictLeftLeftPart; crush.
  - erewrite IHpeΓΔ; crush.
    erewrite restrictLeftLeftPart_restrictLeftLeftPart; crush.
Qed.

Lemma splitSubPart_restrictLeftRightPart
  {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ {pΓ Γ₁ Γ₂ ξ Σ},
    ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ ξ : ΓΔ => Σ ⟫ →
    splitSubPart (restrictLeftRightPart pΓΔ pΓ) ξ =
    restrictLeftRightPart (splitSubPart pΓΔ ξ)
      (splitSubPart pΓ (splitSubLeft pΓΔ ξ)).
Proof.
  induction peΓΔ; crush.
  - erewrite IHpeΓΔ; crush.
    erewrite restrictLeftLeftPart_restrictLeftRightPart; crush.
  - erewrite IHpeΓΔ; crush.
    erewrite restrictLeftRightPart_restrictLeftRightPart; crush.
    erewrite restrictLeftRightPart_restrictLeftRightPart; crush.
  - erewrite IHpeΓΔ; crush.
    erewrite restrictLeftRightPart_restrictLeftRightPart; crush.
Qed.

(* Lemma splitSubLeft_restrictLeftRightPart *)
(*   {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) : *)
(*   ∀ {pΓ Γ₁ Γ₂ ζ Σ}, *)
(*     ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ ζ : ΓΔ => Σ ⟫ → *)
(*   splitSubLeft (restrictLeftRightPart pΓΔ pΓ) ζ = *)
(*   splitSubLeft pΓ (splitSubLeft pΓΔ ζ). *)
(* Proof. *)
(*   induction peΓΔ; crush. *)
(*   erewrite splitSubPart_restrictLeftRightPart; crush. *)
(* Qed. *)

Lemma splitSubPartComp {ζ Γ Δ} (wζ: ⟪ ζ : Γ => Δ⟫) :
  ∀ {pΓ Γ₁ Γ₂ ξ Σ},
    ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ ξ : Δ => Σ ⟫ →
    splitSubPart (splitSubPart pΓ ζ) ξ  =
    splitSubPart pΓ (ζ >=> ξ).
Proof.
  induction wζ; crush.
  - erewrite splitSubPart_restrictLeftLeftPart; crush.
    erewrite IHwζ; crush.
  - erewrite splitSubPart_restrictLeftRightPart; crush.
    erewrite IHwζ; crush.
Qed.

(* Lemma restrictLeftLeftPart'_restrictLeftLeftPart *)
(*   {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) : *)
(*   ∀ {pΓ Γ₁ Γ₂ pΓ₁ Γ₁₁ Γ₁₂}, *)
(*     ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → *)
(*     ⟪ pΓ₁ ⊢ Γ₁ = Γ₁₁ ∘ Γ₁₂ ⟫ → *)
(*     restrictLeftLeftPart' (restrictLeftLeftPart pΓΔ pΓ) *)
(*       (restrictLeftRightPart (restrictLeftLeftPart' pΓΔ pΓ) pΓ₁) = *)
(*     restrictLeftLeftPart' pΓ pΓ₁. *)
(* Proof. *)
(*   intros. *)
(*   erewrite restrictLeftLeftPart'_restrictLeftRightPart; eauto with infra. *)
(*   crush. *)
(* Qed. *)

(* Lemma splitSubPart_restrictLeftLeftPart' *)
(*   {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) : *)
(*   ∀ {pΓ Γ₁ Γ₂ ζ Σ}, *)
(*     ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ ζ : ΓΔ => Σ ⟫ → *)
(*     splitSubPart (restrictLeftLeftPart' pΓΔ pΓ) *)
(*       (splitSubLeft (restrictLeftLeftPart pΓΔ pΓ) ζ) = *)
(*     restrictLeftLeftPart' (splitSubPart pΓΔ ζ) *)
(*       (splitSubPart pΓ (splitSubLeft pΓΔ ζ)). *)
(* Proof. *)
(*   induction peΓΔ; crush. *)
(*   - erewrite IHpeΓΔ; crush. *)
(*     erewrite splitSubPart_restrictLeftLeftPart; crush. *)
(*     erewrite restrictLeftLeftPart_restrictLeftLeftPart'; crush. *)
(*   - erewrite IHpeΓΔ; crush. *)
(*     erewrite restrictLeftLeftPart'_restrictLeftRightPart; crush. *)
(*   - erewrite IHpeΓΔ; crush. *)
(*     erewrite splitSubPart_restrictLeftLeftPart; crush. *)
(* Admitted. *)

Lemma splitSubLeftComp {Γ Δ ξ} (wξ: ⟪ ξ : Γ => Δ⟫) :
  ∀ {pΓ Γ₁ Γ₂ ζ Σ},
    ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ ζ : Δ => Σ⟫ →
    splitSubLeft pΓ ξ >=> splitSubLeft (splitSubPart pΓ ξ) ζ =
    splitSubLeft pΓ (ξ >=> ζ).
Proof.
Admitted.

Lemma splitSubRightComp {Γ Δ ξ} (wξ: ⟪ ξ : Γ => Δ⟫) :
  ∀ {pΓ Γ₁ Γ₂ ζ Σ},
    ⟪ pΓ ⊢ Γ = Γ₁ ∘ Γ₂ ⟫ → ⟪ ζ : Δ => Σ⟫ →
    splitSubRight pΓ ξ >=> splitSubRight (splitSubPart pΓ ξ) ζ =
    splitSubRight pΓ (ξ >=> ζ).
Proof.
  induction wξ; crush.
Admitted.

Lemma subTmComp {Γ t a} (wt : ⟪ Γ ⊢ t : a ⟫) :
  ∀ {Δ Σ ζ₁ ζ₂} (wζ₁: ⟪ ζ₁ : Γ => Δ ⟫) (wζ₂: ⟪ ζ₂ : Δ => Σ ⟫),
    subTm ζ₂ (subTm ζ₁ t) = subTm (ζ₁ >=> ζ₂) t.
Proof.
  induction wt; crush.
  - erewrite splitSubRight_prights; eauto.
  - erewrite subUpComp; crush.
    erewrite IHwt; crush.
  - f_equal.
    + eapply splitSubPartComp; eauto.
    + erewrite IHwt1; crush. f_equal.
      eapply splitSubLeftComp; eauto.
    + erewrite IHwt2; crush. f_equal.
      eapply splitSubRightComp; eauto.
Qed.

Definition subBeta (t: Tm) (pΓΔ: Part) : Sub :=
  snoc pΓΔ (subId (domPartLeft pΓΔ)) t.

Lemma wtSubBeta {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ t a, ⟪ Δ ⊢ t : a ⟫ →
    ⟪ subBeta t pΓΔ : (Γ ▻ a) => ΓΔ ⟫.
Proof. crush. Qed.
Hint Resolve wtSubBeta : infra.

Lemma subBetaComm {pΓΔ ΓΔ Γ Δ} (peΓΔ: ⟪ pΓΔ ⊢ ΓΔ = Γ ∘ Δ ⟫) :
  ∀ {t a ζ Σ},
    ⟪ Δ ⊢ t : a ⟫ → ⟪ ζ : ΓΔ => Σ ⟫ →
    subBeta t pΓΔ >=> ζ =
    subUp (splitSubLeft pΓΔ ζ) >=>
    subBeta (subTm (splitSubRight pΓΔ ζ) t) (splitSubPart pΓΔ ζ).
Proof.
  unfold subBeta; crush.
  - erewrite domPartLeft_sound; crush.
    erewrite codSub_sound; crush.
    erewrite splitSubPart_subId; crush.
    erewrite restrictLeftRightPart_part_plefts; crush.
  - erewrite domPartLeft_sound; crush.
    erewrite codSub_sound; crush.
    erewrite splitSubLeft_subId; crush.
    erewrite subCompIdLeft; crush.
    erewrite subCompIdRight; crush.
Qed.

Lemma subBetaComm' {pΓΣ ΓΣ pΔΣ ΔΣ Γ Δ Σ ζ t a} (wζ: ⟪ ζ : Γ => Δ ⟫)
  (wt : ⟪ Σ ⊢ t : a ⟫) (peΓΣ : ⟪ pΓΣ ⊢ ΓΣ = Γ ∘ Σ ⟫) (peΔΣ : ⟪ pΔΣ ⊢ ΔΣ = Δ ∘ Σ ⟫) :
  subUp ζ >=> subBeta t pΔΣ =
  subBeta t pΓΣ >=> subCat pΓΣ pΔΣ ζ (subId (dom Σ)).
Proof.
  unfold subBeta; crush.
  - erewrite splitSubPart_subId; crush.
    erewrite restrictLeftRightPart_part_plefts; crush.
    erewrite splitSubPart_subCat; crush.
  - erewrite splitSubLeft_subCat_beta; crush.
    erewrite splitSubLeft_subId; crush.
    erewrite subCompIdLeft; crush.
    erewrite subCompIdRight; crush.
  - erewrite splitSubRight_subCat_beta; crush.
    erewrite subTmId; crush.
Qed.


(* 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                                                     *)

Set Implicit Arguments.
Unset Strict Implicit.
Require Export Parts.
(** Title "Singletons." *)
Section Single1.
Variable E : Setoid.

Definition single : E -> part_set E.
intros x.
apply (Build_Predicate (Pred_fun:=fun y : E => Equal y x)).
red in |- *.
intros x0 y H' H'0; try assumption.
apply Trans with x0; auto with algebra.
Defined.

Lemma in_single : forall x : E, in_part x (single x).
simpl in |- *; auto with algebra.
Qed.
Hint Resolve in_single: algebra.

Lemma single_law : forall x y : E, Equal x y -> Equal (single x) (single y).
unfold single in |- *; simpl in |- *.
unfold eq_part in |- *; simpl in |- *.
intros x y H' x0; split; [ intros H'0; try assumption | idtac ].
apply Trans with x; auto with algebra.
intros H'0; try assumption.
apply Trans with y; auto with algebra.
Qed.
Hint Resolve single_law: algebra.

Lemma single_prop : forall x y : E, Equal y x -> in_part y (single x).
simpl in |- *; auto with algebra.
Qed.
Hint Immediate single_prop: algebra.

Lemma single_prop_rev : forall x y : E, in_part y (single x) -> Equal y x.
simpl in |- *; auto with algebra.
Qed.
Hint Immediate single_prop_rev: algebra.

Lemma single_simpl : forall x y : E, Equal (single x) (single y) -> Equal x y.
simpl in |- *.
unfold eq_part, single in |- *; simpl in |- *.
intros x y H'; try assumption.
elim (H' x); auto with algebra.
Qed.
End Single1.
Hint Resolve single_law in_single: algebra.
Hint Immediate single_prop: algebra.
Hint Immediate single_prop_rev: algebra.