Lemma LP11P12 : forall P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 ,
rk(P1 :: P2 :: P3 ::  nil) = 3 -> rk(P4 :: P5 :: P6 ::  nil) = 3 -> rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 ::  nil) = 4 ->
rk(P7 :: P8 :: P9 ::  nil) = 3 -> rk(P1 :: P2 :: P3 :: P7 :: P8 :: P9 ::  nil) = 4 -> rk(P4 :: P5 :: P6 :: P7 :: P8 :: P9 ::  nil) = 4 ->
rk(P1 :: P2 :: P3 :: P10 ::  nil) = 3 -> rk(P4 :: P5 :: P6 :: P10 ::  nil) = 3 -> rk(P7 :: P8 :: P9 :: P10 ::  nil) = 4 ->
rk(P1 :: P2 :: P3 :: P11 ::  nil) = 3 -> rk(P4 :: P5 :: P6 :: P11 ::  nil) = 3 -> rk(P7 :: P8 :: P9 :: P11 ::  nil) = 3 ->
rk(P1 :: P2 :: P3 :: P12 ::  nil) = 3 -> rk(P4 :: P5 :: P6 :: P12 ::  nil) = 3 -> rk(P7 :: P8 :: P9 :: P12 ::  nil) = 3 ->
rk(P11 :: P12 ::  nil) = 1.
Proof.

intros P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12
HP1P2P3eq HP4P5P6eq HP1P2P3P4P5P6eq HP7P8P9eq HP1P2P3P7P8P9eq HP4P5P6P7P8P9eq HP1P2P3P10eq HP4P5P6P10eq HP7P8P9P10eq HP1P2P3P11eq
HP4P5P6P11eq HP7P8P9P11eq HP1P2P3P12eq HP4P5P6P12eq HP7P8P9P12eq .

assert(HP7P8P9P11P12m3 : rk(P7 :: P8 :: P9 :: P11 :: P12 :: nil) >= 3).
{
	try assert(HP7P8P9eq : rk(P7 :: P8 :: P9 :: nil) = 3) by (apply LP7P8P9 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP7P8P9mtmp : rk(P7 :: P8 :: P9 :: nil) >= 3) by (solve_hyps_min HP7P8P9eq HP7P8P9m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P7 :: P8 :: P9 :: nil) (P7 :: P8 :: P9 :: P11 :: P12 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P7 :: P8 :: P9 :: nil) (P7 :: P8 :: P9 :: P11 :: P12 :: nil) 3 3 HP7P8P9mtmp Hcomp Hincl);apply HT.
}

assert(HP7P8P9P11P12M3 : rk(P7 :: P8 :: P9 :: P11 :: P12 :: nil) <= 3).
{
	try assert(HP7P8P9P11eq : rk(P7 :: P8 :: P9 :: P11 :: nil) = 3) by (apply LP7P8P9P11 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP7P8P9P11Mtmp : rk(P7 :: P8 :: P9 :: P11 :: nil) <= 3) by (solve_hyps_max HP7P8P9P11eq HP7P8P9P11M3).
	try assert(HP7P8P9P12eq : rk(P7 :: P8 :: P9 :: P12 :: nil) = 3) by (apply LP7P8P9P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP7P8P9P12Mtmp : rk(P7 :: P8 :: P9 :: P12 :: nil) <= 3) by (solve_hyps_max HP7P8P9P12eq HP7P8P9P12M3).
	try assert(HP7P8P9eq : rk(P7 :: P8 :: P9 :: nil) = 3) by (apply LP7P8P9 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP7P8P9mtmp : rk(P7 :: P8 :: P9 :: nil) >= 3) by (solve_hyps_min HP7P8P9eq HP7P8P9m3).
	assert(Hincl : incl (P7 :: P8 :: P9 :: nil) (list_inter (P7 :: P8 :: P9 :: P11 :: nil) (P7 :: P8 :: P9 :: P12 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P7 :: P8 :: P9 :: P11 :: P12 :: nil) (P7 :: P8 :: P9 :: P11 :: P7 :: P8 :: P9 :: P12 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P7 :: P8 :: P9 :: P11 :: P7 :: P8 :: P9 :: P12 :: nil) ((P7 :: P8 :: P9 :: P11 :: nil) ++ (P7 :: P8 :: P9 :: P12 :: nil))) by (clear_all_rk;my_inO).
	assert(HT := rule_1 (P7 :: P8 :: P9 :: P11 :: nil) (P7 :: P8 :: P9 :: P12 :: nil) (P7 :: P8 :: P9 :: nil) 3 3 3 HP7P8P9P11Mtmp HP7P8P9P12Mtmp HP7P8P9mtmp Hincl);
	rewrite <-HT2 in HT;try rewrite <-HT1 in HT;apply HT.
}
try clear HP7P8P9P12M1. try clear HP7P8P9P12M2. try clear HP7P8P9P12M3. try clear HP7P8P9P12m4. try clear HP7P8P9P12m3. try clear HP7P8P9P12m2. try clear HP7P8P9P12m1.

assert(HP1P2P3P10P12m3 : rk(P1 :: P2 :: P3 :: P10 :: P12 :: nil) >= 3).
{
	try assert(HP1P2P3eq : rk(P1 :: P2 :: P3 :: nil) = 3) by (apply LP1P2P3 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3mtmp : rk(P1 :: P2 :: P3 :: nil) >= 3) by (solve_hyps_min HP1P2P3eq HP1P2P3m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P10 :: P12 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P10 :: P12 :: nil) 3 3 HP1P2P3mtmp Hcomp Hincl);apply HT.
}

assert(HP1P2P3P10P12M3 : rk(P1 :: P2 :: P3 :: P10 :: P12 :: nil) <= 3).
{
	try assert(HP1P2P3P10eq : rk(P1 :: P2 :: P3 :: P10 :: nil) = 3) by (apply LP1P2P3P10 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3P10Mtmp : rk(P1 :: P2 :: P3 :: P10 :: nil) <= 3) by (solve_hyps_max HP1P2P3P10eq HP1P2P3P10M3).
	try assert(HP1P2P3P12eq : rk(P1 :: P2 :: P3 :: P12 :: nil) = 3) by (apply LP1P2P3P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3P12Mtmp : rk(P1 :: P2 :: P3 :: P12 :: nil) <= 3) by (solve_hyps_max HP1P2P3P12eq HP1P2P3P12M3).
	try assert(HP1P2P3eq : rk(P1 :: P2 :: P3 :: nil) = 3) by (apply LP1P2P3 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3mtmp : rk(P1 :: P2 :: P3 :: nil) >= 3) by (solve_hyps_min HP1P2P3eq HP1P2P3m3).
	assert(Hincl : incl (P1 :: P2 :: P3 :: nil) (list_inter (P1 :: P2 :: P3 :: P10 :: nil) (P1 :: P2 :: P3 :: P12 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P1 :: P2 :: P3 :: P10 :: P12 :: nil) (P1 :: P2 :: P3 :: P10 :: P1 :: P2 :: P3 :: P12 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P1 :: P2 :: P3 :: P10 :: P1 :: P2 :: P3 :: P12 :: nil) ((P1 :: P2 :: P3 :: P10 :: nil) ++ (P1 :: P2 :: P3 :: P12 :: nil))) by (clear_all_rk;my_inO).
	assert(HT := rule_1 (P1 :: P2 :: P3 :: P10 :: nil) (P1 :: P2 :: P3 :: P12 :: nil) (P1 :: P2 :: P3 :: nil) 3 3 3 HP1P2P3P10Mtmp HP1P2P3P12Mtmp HP1P2P3mtmp Hincl);
	rewrite <-HT2 in HT;try rewrite <-HT1 in HT;apply HT.
}
try clear HP1P2P3P10M1. try clear HP1P2P3P10M2. try clear HP1P2P3P10M3. try clear HP1P2P3P10m4. try clear HP1P2P3P10m3. try clear HP1P2P3P10m2. try clear HP1P2P3P10m1. try clear HP1P2P3P12M1. try clear HP1P2P3P12M2. try clear HP1P2P3P12M3. try clear HP1P2P3P12m4. try clear HP1P2P3P12m3. try clear HP1P2P3P12m2. try clear HP1P2P3P12m1.

assert(HP1P2P3P10P11P12m3 : rk(P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: nil) >= 3).
{
	try assert(HP1P2P3eq : rk(P1 :: P2 :: P3 :: nil) = 3) by (apply LP1P2P3 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3mtmp : rk(P1 :: P2 :: P3 :: nil) >= 3) by (solve_hyps_min HP1P2P3eq HP1P2P3m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: nil) 3 3 HP1P2P3mtmp Hcomp Hincl);apply HT.
}

assert(HP1P2P3P10P11P12M3 : rk(P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: nil) <= 3).
{
	try assert(HP1P2P3P11eq : rk(P1 :: P2 :: P3 :: P11 :: nil) = 3) by (apply LP1P2P3P11 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3P11Mtmp : rk(P1 :: P2 :: P3 :: P11 :: nil) <= 3) by (solve_hyps_max HP1P2P3P11eq HP1P2P3P11M3).
	try assert(HP1P2P3P10P12eq : rk(P1 :: P2 :: P3 :: P10 :: P12 :: nil) = 3) by (apply LP1P2P3P10P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3P10P12Mtmp : rk(P1 :: P2 :: P3 :: P10 :: P12 :: nil) <= 3) by (solve_hyps_max HP1P2P3P10P12eq HP1P2P3P10P12M3).
	try assert(HP1P2P3eq : rk(P1 :: P2 :: P3 :: nil) = 3) by (apply LP1P2P3 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3mtmp : rk(P1 :: P2 :: P3 :: nil) >= 3) by (solve_hyps_min HP1P2P3eq HP1P2P3m3).
	assert(Hincl : incl (P1 :: P2 :: P3 :: nil) (list_inter (P1 :: P2 :: P3 :: P11 :: nil) (P1 :: P2 :: P3 :: P10 :: P12 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: nil) (P1 :: P2 :: P3 :: P11 :: P1 :: P2 :: P3 :: P10 :: P12 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P1 :: P2 :: P3 :: P11 :: P1 :: P2 :: P3 :: P10 :: P12 :: nil) ((P1 :: P2 :: P3 :: P11 :: nil) ++ (P1 :: P2 :: P3 :: P10 :: P12 :: nil))) by (clear_all_rk;my_inO).
	assert(HT := rule_1 (P1 :: P2 :: P3 :: P11 :: nil) (P1 :: P2 :: P3 :: P10 :: P12 :: nil) (P1 :: P2 :: P3 :: nil) 3 3 3 HP1P2P3P11Mtmp HP1P2P3P10P12Mtmp HP1P2P3mtmp Hincl);
	rewrite <-HT2 in HT;try rewrite <-HT1 in HT;apply HT.
}
try clear HP1P2P3P11M1. try clear HP1P2P3P11M2. try clear HP1P2P3P11M3. try clear HP1P2P3P11m4. try clear HP1P2P3P11m3. try clear HP1P2P3P11m2. try clear HP1P2P3P11m1. try clear HP1P2P3P10P12M1. try clear HP1P2P3P10P12M2. try clear HP1P2P3P10P12M3. try clear HP1P2P3P10P12m4. try clear HP1P2P3P10P12m3. try clear HP1P2P3P10P12m2. try clear HP1P2P3P10P12m1.

assert(HP4P5P6P10P12m3 : rk(P4 :: P5 :: P6 :: P10 :: P12 :: nil) >= 3).
{
	try assert(HP4P5P6eq : rk(P4 :: P5 :: P6 :: nil) = 3) by (apply LP4P5P6 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP4P5P6mtmp : rk(P4 :: P5 :: P6 :: nil) >= 3) by (solve_hyps_min HP4P5P6eq HP4P5P6m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P4 :: P5 :: P6 :: nil) (P4 :: P5 :: P6 :: P10 :: P12 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P4 :: P5 :: P6 :: nil) (P4 :: P5 :: P6 :: P10 :: P12 :: nil) 3 3 HP4P5P6mtmp Hcomp Hincl);apply HT.
}

assert(HP4P5P6P10P12M3 : rk(P4 :: P5 :: P6 :: P10 :: P12 :: nil) <= 3).
{
	try assert(HP4P5P6P10eq : rk(P4 :: P5 :: P6 :: P10 :: nil) = 3) by (apply LP4P5P6P10 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP4P5P6P10Mtmp : rk(P4 :: P5 :: P6 :: P10 :: nil) <= 3) by (solve_hyps_max HP4P5P6P10eq HP4P5P6P10M3).
	try assert(HP4P5P6P12eq : rk(P4 :: P5 :: P6 :: P12 :: nil) = 3) by (apply LP4P5P6P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP4P5P6P12Mtmp : rk(P4 :: P5 :: P6 :: P12 :: nil) <= 3) by (solve_hyps_max HP4P5P6P12eq HP4P5P6P12M3).
	try assert(HP4P5P6eq : rk(P4 :: P5 :: P6 :: nil) = 3) by (apply LP4P5P6 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP4P5P6mtmp : rk(P4 :: P5 :: P6 :: nil) >= 3) by (solve_hyps_min HP4P5P6eq HP4P5P6m3).
	assert(Hincl : incl (P4 :: P5 :: P6 :: nil) (list_inter (P4 :: P5 :: P6 :: P10 :: nil) (P4 :: P5 :: P6 :: P12 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P4 :: P5 :: P6 :: P10 :: P12 :: nil) (P4 :: P5 :: P6 :: P10 :: P4 :: P5 :: P6 :: P12 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P4 :: P5 :: P6 :: P10 :: P4 :: P5 :: P6 :: P12 :: nil) ((P4 :: P5 :: P6 :: P10 :: nil) ++ (P4 :: P5 :: P6 :: P12 :: nil))) by (clear_all_rk;my_inO).
	assert(HT := rule_1 (P4 :: P5 :: P6 :: P10 :: nil) (P4 :: P5 :: P6 :: P12 :: nil) (P4 :: P5 :: P6 :: nil) 3 3 3 HP4P5P6P10Mtmp HP4P5P6P12Mtmp HP4P5P6mtmp Hincl);
	rewrite <-HT2 in HT;try rewrite <-HT1 in HT;apply HT.
}
try clear HP4P5P6P10M1. try clear HP4P5P6P10M2. try clear HP4P5P6P10M3. try clear HP4P5P6P10m4. try clear HP4P5P6P10m3. try clear HP4P5P6P10m2. try clear HP4P5P6P10m1. try clear HP4P5P6P12M1. try clear HP4P5P6P12M2. try clear HP4P5P6P12M3. try clear HP4P5P6P12m4. try clear HP4P5P6P12m3. try clear HP4P5P6P12m2. try clear HP4P5P6P12m1.

assert(HP4P5P6P10P11P12m3 : rk(P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) >= 3).
{
	try assert(HP4P5P6eq : rk(P4 :: P5 :: P6 :: nil) = 3) by (apply LP4P5P6 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP4P5P6mtmp : rk(P4 :: P5 :: P6 :: nil) >= 3) by (solve_hyps_min HP4P5P6eq HP4P5P6m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P4 :: P5 :: P6 :: nil) (P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P4 :: P5 :: P6 :: nil) (P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) 3 3 HP4P5P6mtmp Hcomp Hincl);apply HT.
}

assert(HP4P5P6P10P11P12M3 : rk(P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) <= 3).
{
	try assert(HP4P5P6P11eq : rk(P4 :: P5 :: P6 :: P11 :: nil) = 3) by (apply LP4P5P6P11 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP4P5P6P11Mtmp : rk(P4 :: P5 :: P6 :: P11 :: nil) <= 3) by (solve_hyps_max HP4P5P6P11eq HP4P5P6P11M3).
	try assert(HP4P5P6P10P12eq : rk(P4 :: P5 :: P6 :: P10 :: P12 :: nil) = 3) by (apply LP4P5P6P10P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP4P5P6P10P12Mtmp : rk(P4 :: P5 :: P6 :: P10 :: P12 :: nil) <= 3) by (solve_hyps_max HP4P5P6P10P12eq HP4P5P6P10P12M3).
	try assert(HP4P5P6eq : rk(P4 :: P5 :: P6 :: nil) = 3) by (apply LP4P5P6 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP4P5P6mtmp : rk(P4 :: P5 :: P6 :: nil) >= 3) by (solve_hyps_min HP4P5P6eq HP4P5P6m3).
	assert(Hincl : incl (P4 :: P5 :: P6 :: nil) (list_inter (P4 :: P5 :: P6 :: P11 :: nil) (P4 :: P5 :: P6 :: P10 :: P12 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) (P4 :: P5 :: P6 :: P11 :: P4 :: P5 :: P6 :: P10 :: P12 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P4 :: P5 :: P6 :: P11 :: P4 :: P5 :: P6 :: P10 :: P12 :: nil) ((P4 :: P5 :: P6 :: P11 :: nil) ++ (P4 :: P5 :: P6 :: P10 :: P12 :: nil))) by (clear_all_rk;my_inO).
	assert(HT := rule_1 (P4 :: P5 :: P6 :: P11 :: nil) (P4 :: P5 :: P6 :: P10 :: P12 :: nil) (P4 :: P5 :: P6 :: nil) 3 3 3 HP4P5P6P11Mtmp HP4P5P6P10P12Mtmp HP4P5P6mtmp Hincl);
	rewrite <-HT2 in HT;try rewrite <-HT1 in HT;apply HT.
}
try clear HP4P5P6P11M1. try clear HP4P5P6P11M2. try clear HP4P5P6P11M3. try clear HP4P5P6P11m4. try clear HP4P5P6P11m3. try clear HP4P5P6P11m2. try clear HP4P5P6P11m1. try clear HP4P5P6P10P12M1. try clear HP4P5P6P10P12M2. try clear HP4P5P6P10P12M3. try clear HP4P5P6P10P12m4. try clear HP4P5P6P10P12m3. try clear HP4P5P6P10P12m2. try clear HP4P5P6P10P12m1. try clear HP4P5P6M1. try clear HP4P5P6M2. try clear HP4P5P6M3. try clear HP4P5P6m4. try clear HP4P5P6m3. try clear HP4P5P6m2. try clear HP4P5P6m1.

assert(HP1P2P3P4P5P6P10P11P12m3 : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) >= 3).
{
	try assert(HP1P2P3eq : rk(P1 :: P2 :: P3 :: nil) = 3) by (apply LP1P2P3 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3mtmp : rk(P1 :: P2 :: P3 :: nil) >= 3) by (solve_hyps_min HP1P2P3eq HP1P2P3m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P1 :: P2 :: P3 :: nil) (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) 3 3 HP1P2P3mtmp Hcomp Hincl);apply HT.
}
try clear HP1P2P3M1. try clear HP1P2P3M2. try clear HP1P2P3M3. try clear HP1P2P3m4. try clear HP1P2P3m3. try clear HP1P2P3m2. try clear HP1P2P3m1.

assert(HP1P2P3P4P5P6P10P11P12m4 : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) >= 4).
{
	try assert(HP1P2P3P4P5P6eq : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: nil) = 4) by (apply LP1P2P3P4P5P6 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3P4P5P6mtmp : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: nil) >= 4) by (solve_hyps_min HP1P2P3P4P5P6eq HP1P2P3P4P5P6m4).
	assert(Hcomp : 4 <= 4) by (repeat constructor).
	assert(Hincl : incl (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: nil) (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: nil) (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) 4 4 HP1P2P3P4P5P6mtmp Hcomp Hincl);apply HT.
}
try clear HP1P2P3P4P5P6M1. try clear HP1P2P3P4P5P6M2. try clear HP1P2P3P4P5P6M3. try clear HP1P2P3P4P5P6m4. try clear HP1P2P3P4P5P6m3. try clear HP1P2P3P4P5P6m2. try clear HP1P2P3P4P5P6m1.

assert(HP7P8P9P10P11P12m3 : rk(P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil) >= 3).
{
	try assert(HP7P8P9eq : rk(P7 :: P8 :: P9 :: nil) = 3) by (apply LP7P8P9 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP7P8P9mtmp : rk(P7 :: P8 :: P9 :: nil) >= 3) by (solve_hyps_min HP7P8P9eq HP7P8P9m3).
	assert(Hcomp : 3 <= 3) by (repeat constructor).
	assert(Hincl : incl (P7 :: P8 :: P9 :: nil) (P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P7 :: P8 :: P9 :: nil) (P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil) 3 3 HP7P8P9mtmp Hcomp Hincl);apply HT.
}
try clear HP7P8P9M1. try clear HP7P8P9M2. try clear HP7P8P9M3. try clear HP7P8P9m4. try clear HP7P8P9m3. try clear HP7P8P9m2. try clear HP7P8P9m1.

assert(HP7P8P9P10P11P12m4 : rk(P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil) >= 4).
{
	try assert(HP7P8P9P10eq : rk(P7 :: P8 :: P9 :: P10 :: nil) = 4) by (apply LP7P8P9P10 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP7P8P9P10mtmp : rk(P7 :: P8 :: P9 :: P10 :: nil) >= 4) by (solve_hyps_min HP7P8P9P10eq HP7P8P9P10m4).
	assert(Hcomp : 4 <= 4) by (repeat constructor).
	assert(Hincl : incl (P7 :: P8 :: P9 :: P10 :: nil) (P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil)) by (repeat clear_all_rk;my_inO).
	assert(HT := rule_5 (P7 :: P8 :: P9 :: P10 :: nil) (P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil) 4 4 HP7P8P9P10mtmp Hcomp Hincl);apply HT.
}
try clear HP7P8P9P10M1. try clear HP7P8P9P10M2. try clear HP7P8P9P10M3. try clear HP7P8P9P10m4. try clear HP7P8P9P10m3. try clear HP7P8P9P10m2. try clear HP7P8P9P10m1.

assert(HP10P11P12m2 : rk(P10 :: P11 :: P12 :: nil) >= 2).
{
	try assert(HP7P8P9P11eq : rk(P7 :: P8 :: P9 :: P11 :: nil) = 3) by (apply LP7P8P9P11 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP7P8P9P11Mtmp : rk(P7 :: P8 :: P9 :: P11 :: nil) <= 3) by (solve_hyps_max HP7P8P9P11eq HP7P8P9P11M3).
	try assert(HP7P8P9P10P11P12eq : rk(P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil) = 4) by (apply LP7P8P9P10P11P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP7P8P9P10P11P12mtmp : rk(P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil) >= 4) by (solve_hyps_min HP7P8P9P10P11P12eq HP7P8P9P10P11P12m4).
	try assert(HP11eq : rk(P11 :: nil) = 1) by (apply LP11 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP11mtmp : rk(P11 :: nil) >= 1) by (solve_hyps_min HP11eq HP11m1).
	assert(Hincl : incl (P11 :: nil) (list_inter (P7 :: P8 :: P9 :: P11 :: nil) (P10 :: P11 :: P12 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil) (P7 :: P8 :: P9 :: P11 :: P10 :: P11 :: P12 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P7 :: P8 :: P9 :: P11 :: P10 :: P11 :: P12 :: nil) ((P7 :: P8 :: P9 :: P11 :: nil) ++ (P10 :: P11 :: P12 :: nil))) by (clear_all_rk;my_inO).
	try rewrite HT1 in HP7P8P9P10P11P12mtmp;try rewrite HT2 in HP7P8P9P10P11P12mtmp.
	assert(HT := rule_4 (P7 :: P8 :: P9 :: P11 :: nil) (P10 :: P11 :: P12 :: nil) (P11 :: nil) 4 1 3 HP7P8P9P10P11P12mtmp HP11mtmp HP7P8P9P11Mtmp Hincl); apply HT.
}
try clear HP7P8P9P11M1. try clear HP7P8P9P11M2. try clear HP7P8P9P11M3. try clear HP7P8P9P11m4. try clear HP7P8P9P11m3. try clear HP7P8P9P11m2. try clear HP7P8P9P11m1. try clear HP11M1. try clear HP11M2. try clear HP11M3. try clear HP11m4. try clear HP11m3. try clear HP11m2. try clear HP11m1.

assert(HP10P11P12M2 : rk(P10 :: P11 :: P12 :: nil) <= 2).
{
	try assert(HP1P2P3P10P11P12eq : rk(P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: nil) = 3) by (apply LP1P2P3P10P11P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3P10P11P12Mtmp : rk(P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: nil) <= 3) by (solve_hyps_max HP1P2P3P10P11P12eq HP1P2P3P10P11P12M3).
	try assert(HP4P5P6P10P11P12eq : rk(P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) = 3) by (apply LP4P5P6P10P11P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP4P5P6P10P11P12Mtmp : rk(P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) <= 3) by (solve_hyps_max HP4P5P6P10P11P12eq HP4P5P6P10P11P12M3).
	try assert(HP1P2P3P4P5P6P10P11P12eq : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) = 4) by (apply LP1P2P3P4P5P6P10P11P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP1P2P3P4P5P6P10P11P12mtmp : rk(P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) >= 4) by (solve_hyps_min HP1P2P3P4P5P6P10P11P12eq HP1P2P3P4P5P6P10P11P12m4).
	assert(Hincl : incl (P10 :: P11 :: P12 :: nil) (list_inter (P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: nil) (P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P1 :: P2 :: P3 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) (P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) ((P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: nil) ++ (P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil))) by (clear_all_rk;my_inO).
	try rewrite HT1 in HP1P2P3P4P5P6P10P11P12mtmp;try rewrite HT2 in HP1P2P3P4P5P6P10P11P12mtmp.
	assert(HT := rule_3 (P1 :: P2 :: P3 :: P10 :: P11 :: P12 :: nil) (P4 :: P5 :: P6 :: P10 :: P11 :: P12 :: nil) (P10 :: P11 :: P12 :: nil) 3 3 4 HP1P2P3P10P11P12Mtmp HP4P5P6P10P11P12Mtmp HP1P2P3P4P5P6P10P11P12mtmp Hincl);apply HT.
}
try clear HP1P2P3P10P11P12M1. try clear HP1P2P3P10P11P12M2. try clear HP1P2P3P10P11P12M3. try clear HP1P2P3P10P11P12m4. try clear HP1P2P3P10P11P12m3. try clear HP1P2P3P10P11P12m2. try clear HP1P2P3P10P11P12m1. try clear HP4P5P6P10P11P12M1. try clear HP4P5P6P10P11P12M2. try clear HP4P5P6P10P11P12M3. try clear HP4P5P6P10P11P12m4. try clear HP4P5P6P10P11P12m3. try clear HP4P5P6P10P11P12m2. try clear HP4P5P6P10P11P12m1. try clear HP1P2P3P4P5P6P10P11P12M1. try clear HP1P2P3P4P5P6P10P11P12M2. try clear HP1P2P3P4P5P6P10P11P12M3. try clear HP1P2P3P4P5P6P10P11P12m4. try clear HP1P2P3P4P5P6P10P11P12m3. try clear HP1P2P3P4P5P6P10P11P12m2. try clear HP1P2P3P4P5P6P10P11P12m1.

assert(HP11P12M1 : rk(P11 :: P12 :: nil) <= 1).
{
	try assert(HP7P8P9P11P12eq : rk(P7 :: P8 :: P9 :: P11 :: P12 :: nil) = 3) by (apply LP7P8P9P11P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP7P8P9P11P12Mtmp : rk(P7 :: P8 :: P9 :: P11 :: P12 :: nil) <= 3) by (solve_hyps_max HP7P8P9P11P12eq HP7P8P9P11P12M3).
	try assert(HP10P11P12eq : rk(P10 :: P11 :: P12 :: nil) = 2) by (apply LP10P11P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP10P11P12Mtmp : rk(P10 :: P11 :: P12 :: nil) <= 2) by (solve_hyps_max HP10P11P12eq HP10P11P12M2).
	try assert(HP7P8P9P10P11P12eq : rk(P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil) = 4) by (apply LP7P8P9P10P11P12 with (P1 := P1) (P2 := P2) (P3 := P3) (P4 := P4) (P5 := P5) (P6 := P6) (P7 := P7) (P8 := P8) (P9 := P9) (P10 := P10) (P11 := P11) (P12 := P12) ;try assumption).
	assert(HP7P8P9P10P11P12mtmp : rk(P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil) >= 4) by (solve_hyps_min HP7P8P9P10P11P12eq HP7P8P9P10P11P12m4).
	assert(Hincl : incl (P11 :: P12 :: nil) (list_inter (P7 :: P8 :: P9 :: P11 :: P12 :: nil) (P10 :: P11 :: P12 :: nil))) by (repeat clear_all_rk;my_inO).
	assert(HT1 : equivlist (P7 :: P8 :: P9 :: P10 :: P11 :: P12 :: nil) (P7 :: P8 :: P9 :: P11 :: P12 :: P10 :: P11 :: P12 :: nil)) by (clear_all_rk;my_inO).
	assert(HT2 : equivlist (P7 :: P8 :: P9 :: P11 :: P12 :: P10 :: P11 :: P12 :: nil) ((P7 :: P8 :: P9 :: P11 :: P12 :: nil) ++ (P10 :: P11 :: P12 :: nil))) by (clear_all_rk;my_inO).
	try rewrite HT1 in HP7P8P9P10P11P12mtmp;try rewrite HT2 in HP7P8P9P10P11P12mtmp.
	assert(HT := rule_3 (P7 :: P8 :: P9 :: P11 :: P12 :: nil) (P10 :: P11 :: P12 :: nil) (P11 :: P12 :: nil) 3 2 4 HP7P8P9P11P12Mtmp HP10P11P12Mtmp HP7P8P9P10P11P12mtmp Hincl);apply HT.
}
try clear HP7P8P9P11P12M1. try clear HP7P8P9P11P12M2. try clear HP7P8P9P11P12M3. try clear HP7P8P9P11P12m4. try clear HP7P8P9P11P12m3. try clear HP7P8P9P11P12m2. try clear HP7P8P9P11P12m1. try clear HP10P11P12M1. try clear HP10P11P12M2. try clear HP10P11P12M3. try clear HP10P11P12m4. try clear HP10P11P12m3. try clear HP10P11P12m2. try clear HP10P11P12m1. try clear HP7P8P9P10P11P12M1. try clear HP7P8P9P10P11P12M2. try clear HP7P8P9P10P11P12M3. try clear HP7P8P9P10P11P12m4. try clear HP7P8P9P10P11P12m3. try clear HP7P8P9P10P11P12m2. try clear HP7P8P9P10P11P12m1.

assert(HP11P12M : rk(P11 :: P12 ::  nil) <= 2) by (solve_hyps_max HP11P12eq HP11P12M2).
assert(HP11P12m : rk(P11 :: P12 ::  nil) >= 1) by (solve_hyps_min HP11P12eq HP11P12m1).
intuition.
Qed.


Require Import Fiat.ADT Fiat.ADTNotation.

Require Import Coq.Sets.Ensembles.
Require Import Coq.Arith.Arith.
Require Import Coq.Lists.List.

Require Import
  ByteString.ByteString
  ByteString.ByteStringLib
  ByteString.Refined
  ByteString.Same_set.

Import LeastFixedPointFun.

Require Import
  Fiat.ADTRefinement
  Fiat.ADTRefinement.BuildADTRefinements.

Section ByteStringLib.

Variable Word8 : Type.

Definition ByteStringSpec := ByteStringSpec Word8.
Definition ByteString     := ByteString Word8.

(** Refine [singleton] into something optimized in terms of the internal set
    representation. *)
Lemma singleton_Impl_Ensemble :
  { Impl : _ & forall w : Word8, refine (@singleton_Spec Word8 w) (Impl w) }.
Proof.
  exists (fun w : Word8 => ret (Singleton _ (0, w))).
  intro w.
  simplify with monad laws; simpl.
  apply Same_set_ret.
  unfold Ensembles.Add.
  rewrite Ensemble_map_Empty_set, Empty_set_zero.
  reflexivity.
Defined.

Lemma singleton_Impl_List :
  { Impl : _
  & forall w : Word8,
      refine (o <- @singleton_Spec Word8 w;
              { n : list Word8 | ByteString_list_AbsR o n })
             (ret (Impl w)) }.
Proof.
  exists (fun w : Word8 => [w]).
  intro w.
  simplify with monad laws; simpl.
  refine pick val [w].
    reflexivity.
  unfold ByteString_list_AbsR; intros.
  unfold Ensembles.Add.
  split; intros;
  rewrite Ensemble_map_Empty_set, Empty_set_zero in *.
    inv H.
    exists eq_refl.
    reflexivity.
  destruct H.
  simpl in x0.
  destruct i.
    simpl in e; subst.
    constructor.
  discriminate.
Defined.

Definition singleton := Eval simpl in projT1 singleton_Impl_List.
(* Print singleton. *)

Definition partially_refine
           {oldRep newRep fDom fCod}
           (AbsR : oldRep -> newRep -> Prop)
           (fDef : funType (oldRep :: fDom) (oldRep * fCod)) :=
  { Impl : _ & refineFun_AbsR AbsR fDef Impl }.

Definition fully_refine
           {oldRep newRep fDom fCod}
           (AbsR : oldRep -> newRep -> Prop)
           (fDef : funType (oldRep :: fDom) (oldRep * fCod)) :=
  { Impl : _ & refineFun_AbsR AbsR fDef (Lift_cfunType _ _ Impl) }.

Definition fully_refine_List
           {fDom fCod}
           (fDef : funType (ByteString :: fDom) (ByteString * fCod)) :=
  fully_refine (@ByteString_list_AbsR Word8) fDef.

Lemma match_list_fst : forall A (xs : list A) B C (x : B) (y : C) f g,
  fst match xs with
      | [] => (x, y)
      | x :: xs => (f x xs, g x xs)
      end = match xs with
            | [] => x
            | x :: xs => f x xs
            end.
Proof. destruct xs; trivial. Qed.

Lemma match_list_snd : forall A (xs : list A) B C (x : B) (y : C) f g,
  snd match xs with
      | [] => (x, y)
      | x :: xs => (f x xs, g x xs)
      end = match xs with
            | [] => y
            | x :: xs => g x xs
            end.
Proof. destruct xs; trivial. Qed.

Lemma If_Opt_Then_Else_fst :
  forall A b B (x : B) C (y : C) f g,
    fst (If_Opt_Then_Else b (fun p : A => (f p, g p)) (x, y))
      = If_Opt_Then_Else b f x.
Proof. intros; destruct b; reflexivity. Qed.

Lemma If_Opt_Then_Else_snd :
  forall A b B (x : B) C (y : C) f g,
    snd (If_Opt_Then_Else b (fun p : A => (f p, g p)) (x, y))
      = If_Opt_Then_Else b g y.
Proof. intros; destruct b; reflexivity. Qed.

Lemma If_Opt_match_list : forall A (xs : list A) B (y : B) f (g : A -> B),
  (Ifopt match xs with
         | [] => None
         | x :: xs => Some (f x xs)
         end as p Then g p Else y) = match xs with
                                   | [] => y
                                   | x :: xs => g (f x xs)
                                   end.
Proof. destruct xs; trivial. Qed.

Lemma match_list_pair : forall A (xs : list A) B (z : B) C (w : C) f g,
  (match xs with
   | [] => z
   | x :: xs => f x xs
   end, match xs with
        | [] => w
        | x :: xs => g x xs
        end) = match xs with
               | [] => (z, w)
               | x :: xs => (f x xs, g x xs)
               end.
Proof. destruct xs; trivial. Qed.

(*
Definition tail_Impl_Ensemble :
  partially_refine eq (fDom:=[]) (@tail_Spec Word8).
Proof.
  eexists.
  unfold refineFun_AbsR; simpl; intros; subst.
  simplify with monad laws; unfold uncons; simpl.
    setoid_rewrite If_Opt_Then_Else_fst.
    setoid_rewrite If_Opt_Then_Else_snd.
*)

Definition tail_Impl_List : fully_refine_List (fDom:=[]) (@tail_Spec Word8).
Proof.
  exists (fun bs => match bs with
                    | nil => (nil, false)
                    | List.cons x xs => (xs, true)
                    end).
  unfold refineFun_AbsR, ByteString_list_AbsR.
  simpl; intros.
  simplify with monad laws.
  unfold uncons.
  refine pick val match r_n with
                  | nil => (r_o, None)
                  | List.cons x xs =>
                    (Ensemble_map (first Init.Nat.pred)
                                  (Subtract (nat * Word8) r_o (0, x)), Some x)
                  end.
    simplify with monad laws; simpl.
    rewrite match_list_fst, match_list_snd.
    rewrite If_Opt_Then_Else_fst, If_Opt_Then_Else_snd.
    refine pick val match r_n with
                    | nil => nil
                    | List.cons x xs => xs
                    end.
      simplify with monad laws; simpl.
      rewrite If_Opt_match_list.
      rewrite match_list_pair.
      finish honing.
    {
    split; intros;
    destruct r_n; simpl in *.
    - apply H in H0.
      destruct H0.
      inv x0.
    - simplify_ensembles.
      apply H in H1.
      destruct n; simpl in *.
        contradiction H2.
        destruct H1; subst.
        constructor.
      apply H1.
    - apply H; assumption.
    - apply H in H0.
      unfold Ensemble_map, first.
      exists (S i, x).
      split.
        constructor.
          exact H0.
        unfold not; intros.
        inv H1.
      simpl.
      constructor.
    }
  destruct r_n; simpl in *.
    reflexivity.
  split.
    apply H.
    exists eq_refl.
    reflexivity.
  reflexivity.
Defined.

Definition tail := Eval simpl in projT1 tail_Impl_List.
(* Print tail. *)

End ByteStringLib.


Require Import VST.floyd.proofauto.
Require Import sll_free.
From SSL_VST Require Import core.
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.

Definition free_spec :=
  DECLARE _free
          WITH ty: type, x: val
                              PRE  [ (tptr tvoid) ]
                              PROP()
                              PARAMS(x)
                              SEP (data_at_ Tsh ty x)
                              POST [ Tvoid ]
                              PROP()
                              LOCAL()
                              SEP (emp).

Inductive sll_card : Set :=
    | sll_card_0 : sll_card
    | sll_card_1 : sll_card -> sll_card.

Fixpoint sll (x: val) (s: (list Z)) (self_card: sll_card) {struct self_card} : mpred := match self_card with
    | sll_card_0  =>  !!((x : val) = nullval) && !!((s : list Z) = ([] : list Z)) && emp
    | sll_card_1 _alpha_513 =>
      EX v : Z,
      EX s1 : (list Z),
      EX nxt : val,
 !!(Int.min_signed <= v <= Int.max_signed) && !!(is_pointer_or_null nxt) && !!(~ ((x : val) = nullval)) && !!((s : list Z) = (([(v : Z)] : list Z) ++ (s1 : list Z))) && (data_at Tsh (tarray (Tunion _sslval noattr) 2) [(inl ((Vint (Int.repr v)) : val)); (inr (nxt : val))] (x : val)) * (sll (nxt : val) (s1 : list Z) (_alpha_513 : sll_card))
end.

Definition sll_free_spec :=
  DECLARE _sll_free
   WITH x: val, s: (list Z), _alpha_514: sll_card
   PRE [ (tptr (Tunion _sslval noattr)) ]
   PROP( is_pointer_or_null((x : val)) )
   PARAMS(x)
   SEP ((sll (x : val) (s : list Z) (_alpha_514 : sll_card)))
   POST[ tvoid ]
   PROP(  )
   LOCAL()
   SEP ().

Lemma sll_x_valid_pointerP x s self_card: sll x s self_card |-- valid_pointer x. Proof. destruct self_card; simpl; entailer;  entailer!; eauto. Qed.
Hint Resolve sll_x_valid_pointerP : valid_pointer.
Lemma sll_local_factsP x s self_card :
  sll x s self_card|-- !!(((((x : val) = nullval)) -> (self_card = sll_card_0))/\(((~ ((x : val) = nullval))) -> (exists _alpha_513, self_card = sll_card_1 _alpha_513))/\is_pointer_or_null((x : val))).
 Proof.  destruct self_card;  simpl; entailer; saturate_local; apply prop_right; eauto. Qed.
Hint Resolve sll_local_factsP : saturate_local.
Lemma unfold_sll_card_0  (x: val) (s: (list Z)) : sll x s (sll_card_0 ) =  !!((x : val) = nullval) && !!((s : list Z) = ([] : list Z)) && emp. Proof. auto. Qed.
Lemma unfold_sll_card_1 (_alpha_513 : sll_card) (x: val) (s: (list Z)) : sll x s (sll_card_1 _alpha_513) =
      EX v : Z,
      EX s1 : (list Z),
      EX nxt : val,
 !!(Int.min_signed <= v <= Int.max_signed) && !!(is_pointer_or_null nxt) && !!(~ ((x : val) = nullval)) && !!((s : list Z) = (([(v : Z)] : list Z) ++ (s1 : list Z))) && (data_at Tsh (tarray (Tunion _sslval noattr) 2) [(inl ((Vint (Int.repr v)) : val)); (inr (nxt : val))] (x : val)) * (sll (nxt : val) (s1 : list Z) (_alpha_513 : sll_card)). Proof. auto. Qed.
Definition Gprog : funspecs :=
  ltac:(with_library prog [sll_free_spec; free_spec]).

Lemma body_sll_free : semax_body Vprog Gprog f_sll_free sll_free_spec.
Proof.
start_function.
ssl_open_context.
forward_if.

 - {
assert_PROP (_alpha_514 = sll_card_0) as ssl_card_assert. { entailer!; ssl_dispatch_card. }
ssl_card sll ssl_card_assert .
assert_PROP (((x : val) = nullval)). { entailer!. }
let ssl_var := fresh in assert_PROP(s = ([] : list Z)) as ssl_var; try rewrite ssl_var in *. { entailer!. }
forward; entailer!.

}
 - {
assert_PROP (exists _alpha_513, _alpha_514 = sll_card_1 _alpha_513) as ssl_card_assert. { entailer!; ssl_dispatch_card. }
ssl_card sll ssl_card_assert _alpha_513x.
assert_PROP ((~ ((x : val) = nullval))). { entailer!. }
Intros vx s1x nxtx.
let ssl_var := fresh in assert_PROP(s = (([(vx : Z)] : list Z) ++ (s1x : list Z))) as ssl_var; try rewrite ssl_var in *. { entailer!. }
try rename vx into vx2.
forward.
try rename nxtx into nxtx2.
forward.
assert_PROP(is_pointer_or_null((nxtx2 : val))). { entailer!. }
forward_call ((nxtx2 : val), (s1x : list Z), (_alpha_513x : sll_card)).
forward_call (tarray (Tunion _sslval noattr) 2, x).
forward; entailer!.

}
Qed.


(* Copyright (c) 2014, Robert Dockins *)

Require Import String.
Require Import List.
Require Import Setoid.

Require Import Domains.basics.
Require Import Domains.preord.
Require Import Domains.categories.
Require Import Domains.sets.
Require Import Domains.finsets.
Require Import Domains.esets.
Require Import Domains.effective.
Require Import Domains.directed.
Require Import Domains.plotkin.
Require Import Domains.joinable.
Require Import Domains.approx_rels.
Require Import Domains.cpo.
Require Import Domains.profinite.
Require Import Domains.profinite_adj.

(** * A fixpoint operator for nonstrict functions in PLT.
  *)

Program Definition precompose hf (A B C:PLT.PLT hf) (f:A → B) :
  (Preord.hom (PLT.hom_ord hf B C) (PLT.hom_ord hf A C)) :=
  Preord.Hom (PLT.hom_ord hf B C) (PLT.hom_ord hf A C)
     (fun g => g ∘ f) _.
Next Obligation.
  intros. apply PLT.compose_mono; auto.
Qed.
Arguments precompose [hf A B] C f.

Program Definition postcompose hf (A B C:PLT.PLT hf) (g:B → C) :
  (Preord.hom (PLT.hom_ord hf A B) (PLT.hom_ord hf A C)) :=
  Preord.Hom (PLT.hom_ord hf A B) (PLT.hom_ord hf A C)
      (fun f => g ∘ f) _.
Next Obligation.
  intros. apply PLT.compose_mono; auto.
Qed.
Arguments postcompose [hf] A [B C] g.

Lemma precompose_continuous hf (A B C:PLT.PLT hf) (f:A → B) :
  continuous (directed_hf_cl hf) (precompose C f).
Proof.
  apply CPO.continuous_sup.
  repeat intro. destruct a as [a c].
  unfold precompose in H.
  apply PLT.compose_hom_rel in H.
  destruct H as [y [??]].
  simpl in H0.
  apply union_axiom in H0. destruct H0 as [q [??]].
  apply image_axiom2 in H0. destruct H0 as [q' [??]].
  simpl in H2.
  apply union_axiom.
  exists (PLT.hom_rel (precompose C f q')).
  split. apply image_axiom1'.
  exists (precompose C f q').
  split; auto.
  apply image_axiom1'.
  exists q'. split; auto.
  unfold precompose.
  apply PLT.compose_hom_rel.
  exists y. split; auto.
  rewrite <- H2; auto.
Qed.

Lemma postcompose_continuous hf (A B C:PLT.PLT hf) (g:B → C) :
  continuous (directed_hf_cl hf) (postcompose A g).
Proof.
  apply CPO.continuous_sup.
  repeat intro. destruct a as [a c].
  unfold postcompose in H.
  apply PLT.compose_hom_rel in H.
  destruct H as [y [??]].
  simpl in H.
  apply union_axiom in H. destruct H as [q [??]].
  apply image_axiom2 in H. destruct H as [q' [??]].
  simpl in H2.
  apply union_axiom.
  exists (PLT.hom_rel (postcompose A g q')).
  split. apply image_axiom1'.
  exists (postcompose A g q').
  split; auto.
  apply image_axiom1'.
  exists q'. split; auto.
  unfold postcompose.
  apply PLT.compose_hom_rel.
  exists y. split; auto.
  rewrite <- H2; auto.
Qed.

Program Definition pair_right hf (A B C:PLT.PLT hf) (f:C → A) :
  (Preord.hom (PLT.hom_ord hf C B) (PLT.hom_ord hf C (PLT.prod A B))) :=
  Preord.Hom (PLT.hom_ord hf C B) (PLT.hom_ord hf C (PLT.prod A B))
  (fun g => PLT.pair f g) _.
Next Obligation.
  intros. apply PLT.pair_mono; auto.
Qed.
Arguments pair_right [hf A] B [C] f.

Program Definition pair_left hf (A B C:PLT.PLT hf) (g:C → B) :
  (Preord.hom (PLT.hom_ord hf C A) (PLT.hom_ord hf C (PLT.prod A B))) :=
  Preord.Hom (PLT.hom_ord hf C A) (PLT.hom_ord hf C (PLT.prod A B))
  (fun f => PLT.pair f g) _.
Next Obligation.
  intros. apply PLT.pair_mono; auto.
Qed.
Arguments pair_left [hf] A [B C] g.

Lemma pair_right_continuous hf (A B C:PLT.PLT hf) (f:C → A) :
  continuous (directed_hf_cl hf) (pair_right B f).
Proof.
  apply CPO.continuous_sup.
  repeat intro. destruct a as [c [a b]].
  unfold pair_right in H.
  simpl in H.
  rewrite (PLT.pair_hom_rel _ _ _ _ _ _ c a b) in H.
  destruct H.
  simpl in H0.
  apply union_axiom in H0. destruct H0 as [q [??]].
  apply image_axiom2 in H0. destruct H0 as [q' [??]].
  simpl in H2.
  apply union_axiom.
  exists (PLT.hom_rel (pair_right B f q')).
  split.
  apply image_axiom1'.
  exists (pair_right B f q'). split; auto.
  apply image_axiom1'.  exists q'. split; auto.
  simpl.
  apply PLT.pair_hom_rel. split; auto.
  rewrite <- H2; auto.
Qed.

Lemma pair_left_continuous hf (A B C:PLT.PLT hf) (g:C → B) :
  continuous (directed_hf_cl hf) (pair_left A g).
Proof.
  apply CPO.continuous_sup.
  repeat intro. destruct a as [c [a b]].
  unfold pair_right in H.
  simpl in H.
  rewrite (PLT.pair_hom_rel _ _ _ _ _ _ c a b) in H.
  destruct H.
  simpl in H.
  apply union_axiom in H. destruct H as [q [??]].
  apply image_axiom2 in H. destruct H as [q' [??]].
  simpl in H2.
  apply union_axiom.
  exists (PLT.hom_rel (pair_left A g q')).
  split.
  apply image_axiom1'.
  exists (pair_left A g q'). split; auto.
  apply image_axiom1'.  exists q'. split; auto.
  simpl.
  apply PLT.pair_hom_rel. split; auto.
  rewrite <- H2; auto.
Qed.

Section fixes.
  Variable Γ:PLT.
  Variable A:∂PLT.
  Variable f:Γ → U A ⇒ U A.

  Definition fixes_step
    (x:Γ → U A) : Γ → U A :=

    apply ∘ 〈f, x〉.

  Program Definition fixes_step' :
    PLT.homset_cpo _ Γ (U A) → PLT.homset_cpo _ Γ (U A) :=

    CPO.Hom _ (PLT.homset_cpo _ Γ (U A)) (PLT.homset_cpo _ Γ (U A))
    fixes_step _ _.
  Next Obligation.
    intros. unfold fixes_step.
    apply PLT.compose_mono; auto.
    apply PLT.pair_mono; auto.
  Qed.
  Next Obligation.
    red; intros.
    unfold fixes_step.
    apply continuous_equiv with
      (postcompose Γ PLT.app ∘ pair_right (U A) f); auto.
    hnf; simpl; intros. split; auto.
    apply continuous_sequence.
    apply postcompose_continuous.
    apply pair_right_continuous.
  Qed.

  Definition fixes : Γ → U A := lfp fixes_step'.

  Lemma fixes_unroll :
    fixes ≈ apply ∘ 〈f, fixes〉.
  Proof.
    unfold fixes at 1.
    rewrite <- lfp_fixpoint. simpl. unfold fixes_step.
    auto.
  Qed.

End fixes.
Arguments fixes [Γ A] f.

Lemma fixes_mono Γ A (f g:Γ → U A ⇒ U A) :
  f ≤ g -> fixes f ≤ fixes g.
Proof.
  intro. unfold fixes at 1.
  apply scott_induction.
  red. split. apply bottom_least.
  intros.
  apply CPO.sup_is_least.
  red; intros. apply H1; auto.
  intros. rewrite <- H0; auto.
  simpl; intros. unfold fixes_step.
  rewrite fixes_unroll.
  apply PLT.compose_mono; auto.
  apply PLT.pair_mono; auto.
Qed.

Lemma fixes_eq Γ A (f g:Γ → U A ⇒ U A) :
  f ≈ g -> fixes f ≈ fixes g.
Proof.
  intros [??]; split; apply fixes_mono; auto.
Qed.

Add Parametric Morphism Γ A :
  (@fixes Γ A)
  with signature (Preord.ord_op _ ==> Preord.ord_op _)
  as fixes_le_morphism.
Proof.
  intros. apply fixes_mono. auto.
Qed.

Add Parametric Morphism Γ A :
  (@fixes Γ A)
  with signature (eq_op _ ==> eq_op _)
  as fixes_morphism.
Proof.
  intros. apply fixes_eq. auto.
Qed.

Lemma plt_bot_None A B x y :
  (x,y) ∈ PLT.hom_rel (⊥ : A → U B) <-> y = None.
Proof.
  split; intros.
  simpl in H.
  unfold plt_hom_adj' in H.
  apply PLT.compose_hom_rel in H.
  destruct H as [?[??]].
  simpl in H.
  apply adj_unit_rel_elem in H.
  apply U_hom_rel in H0.
  destruct H0; auto.
  destruct H0 as [?[?[??]]].
  simpl in H0.
  apply union_axiom in H0.
  destruct H0 as [?[??]].
  apply image_axiom2 in H0.
  destruct H0 as [?[??]].
  apply empty_elem in H0. elim H0.

  subst y.
  simpl.
  unfold plt_hom_adj'.
  apply PLT.compose_hom_rel.
  exists None.
  split. simpl.
  apply adj_unit_rel_elem.
  hnf; auto.
  apply U_hom_rel. auto.
Qed.

Lemma plt_bot_chomp A B C (g:A → B) :
  (⊥ : B → U C) ∘ g ≈ ⊥.
Proof.
  split. 2: apply bottom_least.
  hnf. intros.
  destruct a.
  apply PLT.compose_hom_rel in H.
  destruct H as [?[??]].
  apply plt_bot_None in H0.
  apply plt_bot_None. auto.
Qed.

Lemma fixes_compose_commute Γ Γ' A (f:Γ → U A ⇒ U A) (g:Γ' → Γ) :
  fixes f ∘ g ≈ fixes (f ∘ g).
Proof.
  split; unfold fixes at 1; apply scott_induction.
  red; split.
  rewrite plt_bot_chomp.
  apply bottom_least.
  intros.
  transitivity (∐(image (precompose (U A) g) XS)).
  destruct (CPO.continuous_sup _ _ _ (precompose (U A) g)).
  apply H1.
  apply (precompose_continuous false _ _ (U A) g).
  apply CPO.sup_is_least.
  red; intros.
  apply image_axiom2 in H1.
  destruct H1 as [q [??]].
  rewrite H2. simpl.
  apply H0. auto.
  intros. rewrite <- H. auto.
  simpl; intros.
  unfold fixes_step.
  rewrite fixes_unroll.
  rewrite <- (cat_assoc PLT).
  apply PLT.compose_mono; auto.
  rewrite (PLT.pair_compose_commute false).
  apply PLT.pair_mono; auto.

  red; split.
  apply bottom_least.
  intros.
  apply CPO.sup_is_least.
  red; intros.
  apply H0; auto.
  intros.
  rewrite <- H; auto.
  simpl; intros.
  unfold fixes_step.
  rewrite fixes_unroll.
  rewrite <- (cat_assoc PLT).
  apply PLT.compose_mono; auto.
  rewrite (PLT.pair_compose_commute false).
  apply PLT.pair_mono; auto.
Qed.


Require Import String.

From mathcomp
Require Import all_ssreflect.

From chip
Require Import connect acyclic string kosaraju topos close_dfs check change check_seq check_seq_hierarchical.

Section Finn.

Local Notation A := [eqType of string].

Variable n : nat.
Variable m' : nat.

Local Notation m := m'.+1.

Hypothesis H_mn : m <= n.

Local Notation V' := 'I_n.

Definition lt_m_pred : pred V' := fun v => val v < m.

Local Notation V := (sig_finType lt_m_pred).

Variable successors : V -> seq V.

Variable f' : V' -> A.
Variable f : V -> A.
Variable checkable' : pred V'.

Definition succs_closure := @rclosure' V.
Definition succs_closureP := rclosure'Pg.
Definition succs_closure_uniq := rclosure'_uniq.

(* TODO: use custom efficient succs_freshV' *)

Definition succs_modified := seq_modifiedV f' f.
Definition succs_checkable_impacted :=
 seq_checkable_impacted f' f successors checkable' succs_closure.
Definition succs_impacted_fresh :=
 seq_impacted_fresh f' f successors succs_closure.
Definition succs_checkable_impacted_fresh :=
 seq_checkable_impacted_fresh f' f successors checkable' succs_closure.

Variable successors' : V' -> seq V'.

Definition succs_ts :=
 ts_g'rev_imf_checkable_val f' f successors checkable' succs_closure tseq successors'.

Variable (g : rel V).

Hypothesis g_grev : [rel x y | g y x] =2 grel successors.

Variable (g' : rel V').

Hypothesis g'_g'rev : [rel x y | g' y x] =2 grel successors'.

Lemma succs_impacted_fresh_eq :
  impactedV' f' f g =i succs_impacted_fresh.
Proof.
apply: seq_impacted_fresh_eq; eauto.
exact: succs_closureP.
Qed.

Lemma succs_checkable_impacted_fresh_eq :
 checkable_impactedV' f' f g checkable' =i succs_checkable_impacted_fresh.
Proof.
apply: seq_checkable_impacted_fresh_eq; eauto.
exact: succs_closureP.
Qed.

Lemma succs_impacted_fresh_uniq : uniq succs_impacted_fresh.
Proof.
apply: seq_impacted_fresh_uniq => //.
- exact: succs_closureP.
- move => s Hs.
  exact: succs_closure_uniq.
Qed.

Lemma succs_checkable_impacted_fresh_uniq :
  uniq succs_checkable_impacted_fresh.
Proof.
apply: seq_checkable_impacted_fresh_uniq => //.
- exact: succs_closureP.
- move => s Hs.
  exact: succs_closure_uniq.
Qed.

Lemma succs_ts_uniq :
  uniq succs_ts.
Proof.
apply: ts_g'rev_imf_checkable_val_uniq.
exact: tseq_uniq.
Qed.

Lemma in_succs_ts :
  forall x, x \in succs_ts ->
  checkable' x /\ x \in impactedV' f' f g.
Proof.
apply: in_ts_g'rev_imf_checkable_val; eauto.
exact: succs_closureP.
Qed.

Lemma succs_ts_in :
  forall x, checkable' x -> x \in impactedV' f' f g ->
  x \in succs_ts.
Proof.
apply: ts_g'rev_imf_checkable_val_in; eauto.
- exact: succs_closureP.
- exact: tseq_all.
Qed.

Hypothesis g'_acyclic : acyclic g'.

Local Notation gV' := [rel x y : V' | insub_g g x y].

Hypothesis f_equal_g :
  forall v, f v = f' (val v) -> forall v', gV' (val v) v' = g' (val v) v'.

Lemma succs_tseq_before : forall x y,
  x \in impactedV' f' f g -> checkable' x ->
  y \in impactedV' f' f g -> checkable' y ->
  connect g' x y ->
  before succs_ts y x.
Proof.
apply: ts_g'rev_imf_checkable_val_before; eauto.
- exact: succs_closureP.
- exact: tseq_sorted.
- exact: tseq_all.
Qed.

End Finn.

Section FinnHierarchical.

Local Notation A_top := [eqType of string].
Local Notation A_bot := [eqType of string].

Variable n_top : nat.
Variable m'_top : nat.

Local Notation m_top := m'_top.+1.

Hypothesis H_mn_top : m_top <= n_top.

Local Notation U' := 'I_n_top.

Definition lt_m_top_pred : pred U' := fun v => val v < m_top.

Local Notation U := (sig_finType lt_m_top_pred).

Variable successors_top : U -> seq U.

Variable f'_top : U' -> A_top.
Variable f_top : U -> A_top.

Variable n_bot : nat.
Variable m'_bot : nat.

Local Notation m_bot := m'_bot.+1.

Hypothesis H_mn_bot : m_bot <= n_bot.

Local Notation V' := 'I_n_bot.

Definition lt_m_bot_pred : pred V' := fun v => val v < m_bot.

Local Notation V := (sig_finType lt_m_bot_pred).

Variable successors_bot : V -> seq V.

Variable f'_bot : V' -> A_bot.
Variable f_bot : V -> A_bot.
Variable checkable'_bot : pred V'.

Variable p : U -> seq V.
Variable p' : U' -> seq V'.

Definition succs_modified_sub : seq _ :=
  seq_modifiedV_sub f'_top f'_bot f_top f_bot p.

Definition succs_impacted_fresh_sub :=
  seq_impacted_fresh_sub f'_top f'_bot f_top f_bot successors_top successors_bot p (@rclosure' _) (@rclosure' _).

Definition succs_checkable_impacted_fresh_sub :=
  seq_checkable_impacted_fresh_sub f'_top f'_bot f_top f_bot successors_top successors_bot p checkable'_bot (@rclosure' _) (@rclosure' _).

Definition succs_impacted_fresh_sub_pt :=
  seq_impacted_fresh_sub_pt f'_top f'_bot f_top f_bot successors_top successors_bot p p' (@rclosure' _) (@rclosure' _).

Definition succs_checkable_impacted_fresh_sub_pt :=
  seq_checkable_impacted_fresh_sub_pt f'_top f'_bot f_top f_bot successors_top successors_bot p p' checkable'_bot (@rclosure' _) (@rclosure' _).

Variable (g_top : rel U).

Hypothesis g_top_grev : [rel x y | g_top y x] =2 grel successors_top.

Variable (g_bot : rel V).

Hypothesis g_bot_grev : [rel x y | g_bot y x] =2 grel successors_bot.

Variable (ps : U -> {set V}).

Hypothesis p_ps_eq : forall u : U, p u =i ps u.

Hypothesis ps_partition : partition (\bigcup_( u | u \in U ) [set ps u]) [set: V].

Variable (ps' : U' -> {set V'}).

Hypothesis p'_ps'_eq : forall u : U', p' u =i ps' u.

Hypothesis ps'_partition : partition (\bigcup_( u | u \in U' ) [set ps' u]) [set: V'].

Hypothesis f_top_bot_ps : forall (u : U),
 f_top u = f'_top (val u) -> forall (v : V), v \in ps u -> f_bot v = f'_bot (val v).

Hypothesis f_top_partition : forall (u : U),
 f_top u = f'_top (val u) -> [set val v | v in ps u] = ps' (val u).

Hypothesis g_bot_top_ps : forall (v v' : V) (u u' : U),
 u <> u' -> g_bot v v' -> v \in ps u -> v' \in ps u' -> g_top u u'.

Hypothesis ps_neq : forall (u u' : U), u <> u' -> ps u <> ps u'.

Hypothesis ps'_neq : forall (u u' : U'), u <> u' -> ps' u <> ps' u'.

Hypothesis p_uniq : forall u, uniq (p u).

Hypothesis p'_uniq : forall u, uniq (p' u).

Lemma succs_impacted_fresh_sub_eq :
  impactedV' f'_bot f_bot g_bot =i succs_impacted_fresh_sub.
Proof.
move => x.
by rewrite (seq_impacted_fresh_sub_correct (@rclosure'Pg _) (@rclosure'Pg _) g_top_grev p_ps_eq ps_partition g_bot_grev).
Qed.

Lemma succs_checkable_impacted_fresh_sub_eq :
  checkable_impactedV' f'_bot f_bot g_bot checkable'_bot =i succs_checkable_impacted_fresh_sub.
Proof.
move => x.
by rewrite (seq_checkable_impacted_fresh_sub_correct _ (@rclosure'Pg _) (@rclosure'Pg _) g_top_grev p_ps_eq ps_partition g_bot_grev).
Qed.

Lemma succs_impacted_fresh_sub_pt_eq :
  impactedV' f'_bot f_bot g_bot =i succs_impacted_fresh_sub_pt.
Proof.
move => x.
by rewrite (seq_impacted_fresh_sub_pt_correct (@rclosure'Pg _) (@rclosure'Pg _) g_top_grev p_ps_eq ps_partition p'_ps'_eq ps'_partition g_bot_grev).
Qed.

Lemma succs_checkable_impacted_fresh_sub_pt_eq :
  checkable_impactedV' f'_bot f_bot g_bot checkable'_bot =i succs_checkable_impacted_fresh_sub_pt.
Proof.
move => x.
by rewrite (seq_checkable_impacted_fresh_sub_pt_correct _ (@rclosure'Pg _) (@rclosure'Pg _) g_top_grev p_ps_eq ps_partition p'_ps'_eq ps'_partition g_bot_grev).
Qed.

Lemma succs_impacted_fresh_sub_uniq :
  uniq succs_impacted_fresh_sub.
Proof.
apply: seq_impacted_fresh_sub_uniq => //.
- exact: succs_closureP.
- exact: succs_closureP.
- move => s Hs.
  exact: succs_closure_uniq.
Qed.

Lemma succs_checkable_impacted_fresh_sub_uniq :
  uniq succs_checkable_impacted_fresh_sub.
Proof.
apply: seq_checkable_impacted_fresh_sub_uniq => //.
- exact: succs_closureP.
- exact: succs_closureP.
- move => s Hs.
  exact: succs_closure_uniq.
Qed.

Lemma succs_impacted_fresh_sub_pt_uniq :
  uniq succs_impacted_fresh_sub_pt.
Proof.
apply: seq_impacted_fresh_sub_pt_uniq => //.
- exact: succs_closureP.
- exact: succs_closureP.
- move => s Hs.
  exact: succs_closure_uniq.
Qed.

Lemma succs_checkable_impacted_fresh_sub_pt_uniq :
  uniq succs_checkable_impacted_fresh_sub_pt.
Proof.
apply: seq_checkable_impacted_fresh_sub_pt_uniq => //.
- exact: succs_closureP.
- exact: succs_closureP.
- move => s Hs.
  exact: succs_closure_uniq.
Qed.

End FinnHierarchical.


From RecordUpdate Require Import RecordSet.

From stdpp Require Import gmap.
From iris.algebra Require Import ofe.

From Perennial.Helpers Require Import Tactics Integers.
From Perennial.program_proof Require Import disk_lib.
From Perennial.goose_lang Require Import ffi.disk.

Module update.
  Record t :=
    mk { addr: u64;
         b: Block; }.
  Global Instance _eta: Settable _ := settable! mk <addr; b>.
  Global Instance _witness: Inhabited t := populate!.
End update.

Definition LogSz: Z := 511.
#[global]
Hint Unfold LogSz : word.

Definition disk := gmap Z Block.
Canonical Structure diskO := leibnizO disk.

Definition txn_upds (txns: list (u64 * list update.t)) : list update.t :=
  concat (snd <$> txns).

Definition is_txn (txns: list (u64 * list update.t)) (txn_id: nat) (pos: u64): Prop :=
  fst <$> txns !! txn_id = Some pos.

Theorem is_txn_bound txns txn_id pos :
  is_txn txns txn_id pos ->
  (txn_id < length txns)%nat.
Proof.
  rewrite /is_txn -list_lookup_fmap.
  intros H%lookup_lt_Some.
  autorewrite with len in H; lia.
Qed.

Module log_state.
  Record t :=
    mk {
        d: disk;
        txns: list (u64 * list update.t);
        (* installed_lb promises what will be read after a cache miss *)
        installed_lb: nat;
        (* durable_lb promises what will be on-disk after a crash *)
        durable_lb: nat;
      }.
  Global Instance _eta: Settable _ := settable! mk <d; txns; installed_lb; durable_lb>.
  Global Instance _witness: Inhabited t := populate!.

  Definition updates σ : list update.t := txn_upds σ.(txns).
End log_state.

Definition addr_wf (a: u64) (d: disk) :=
  2 + LogSz ≤ int.Z a ∧
  ∃ (b: Block), d !! (int.Z a) = Some b.

Definition addrs_wf (updates: list update.t) (d: disk) :=
  Forall (λ u, addr_wf u.(update.addr) d) updates.

(** * Monotonic lists *)
Section list_mono.
  Context {A} (ltR: A → A → Prop) {Htrans: Transitive ltR}.
  Implicit Types (l: list A).
  Definition list_mono l :=
    ∀ (i1 i2: nat) (x1 x2: A)
      (Hlt: (i1 < i2)%nat)
      (Hx1: l !! i1 = Some x1)
      (Hx2: l !! i2 = Some x2),
      ltR x1 x2.

  Theorem list_mono_app l1 l2 :
    list_mono (l1 ++ l2) <->
    list_mono l1 ∧ list_mono l2 ∧
    (∀ i1 i2 x1 x2
       (Hx1: l1 !! i1 = Some x1)
       (Hx2: l2 !! i2 = Some x2),
        ltR x1 x2).
  Proof.
    split; intros.
    - split_and!.
      + rewrite /list_mono; intros **.
        apply (H i1 i2 x1 x2); auto.
        { rewrite lookup_app_l; auto.
          eapply lookup_lt_Some; eauto. }
        { rewrite lookup_app_l; auto.
          eapply lookup_lt_Some; eauto. }
      + rewrite /list_mono; intros.
        apply (H (length l1 + i1)%nat (length l1 + i2)%nat x1 x2).
        { lia. }
        { rewrite lookup_app_r; auto; try lia.
          replace (length l1 + i1 - length l1)%nat with i1 by lia; auto. }
        { rewrite lookup_app_r; auto; try lia.
          replace (length l1 + i2 - length l1)%nat with i2 by lia; auto. }
      + intros.
        apply (H i1 (length l1 + i2)%nat x1 x2).
        { apply lookup_lt_Some in Hx1.
          lia. }
        { rewrite lookup_app_l; auto.
          eapply lookup_lt_Some; eauto. }
        { rewrite lookup_app_r; auto; try lia.
          replace (length l1 + i2 - length l1)%nat with i2 by lia; auto. }
    - destruct_and! H.
      hnf; intros **.
      apply lookup_app_Some in Hx1.
      apply lookup_app_Some in Hx2.
      intuition idtac.
      + eapply H0; eauto.
      + eapply H2; eauto.
      + apply lookup_lt_Some in H4.
        apply lookup_lt_Some in H1.
        lia.
      + eapply H; [ | eauto | eauto ].
        lia.
  Qed.

  Theorem list_mono_singleton (x:A) :
    list_mono [x].
  Proof.
    hnf; intros.
    apply lookup_lt_Some in Hx1.
    apply lookup_lt_Some in Hx2.
    simpl in *.
    lia.
  Qed.

End list_mono.

Definition wal_wf (s : log_state.t) :=
  addrs_wf (log_state.updates s) s.(log_state.d) ∧
  (* monotonicity of txnids  *)
  list_mono (λ pos1 pos2, int.Z pos1 ≤ int.Z pos2) (fst <$> s.(log_state.txns)) ∧
  s.(log_state.installed_lb) ≤ s.(log_state.durable_lb) < length s.(log_state.txns).

(** * apply_upds: interpret txns on top of disk *)
Definition apply_upds (upds: list update.t) (d: disk): disk :=
  fold_left (fun d '(update.mk a b) => <[int.Z a := b]> d) upds d.

Definition has_updates (log: list update.t) (txns: list (u64 * list update.t)) :=
  forall d, apply_upds log d =
            apply_upds (txn_upds txns) d.

(** * Properties of above definitions *)

Theorem txn_upds_app txn1 txn2:
  txn_upds (txn1 ++ txn2) =
  txn_upds txn1 ++ txn_upds txn2.
Proof.
  rewrite /txn_upds.
  rewrite -concat_app -fmap_app //=.
Qed.

Theorem txn_upds_cons txn txnl:
  txn_upds (txn :: txnl) =
  txn_upds [txn] ++ txn_upds txnl.
Proof.
  rewrite -txn_upds_app //=.
Qed.

Theorem txn_upds_single pos upds :
  txn_upds [(pos, upds)] = upds.
Proof.
  rewrite /txn_upds /=.
  rewrite app_nil_r //.
Qed.

Theorem apply_upds_cons disk u ul :
  apply_upds (u :: ul) disk =
  apply_upds ul (apply_upds [u] disk).
Proof. reflexivity. Qed.

Theorem apply_upds_app upds1 upds2 d :
  apply_upds (upds1 ++ upds2) d =
  apply_upds upds2 (apply_upds upds1 d).
Proof.
  rewrite /apply_upds fold_left_app //.
Qed.

Lemma txn_upds_nils nils :
  Forall (λ x, snd x = nil) nils ->
  txn_upds nils = nil.
Proof.
  rewrite /txn_upds.
  induction nils; simpl in *; intros.
  - done.
  - inversion H; clear H; simpl in *; subst.
    rewrite H2. simpl. eauto.
Qed.

Theorem has_updates_nil :
  has_updates [] [].
Proof. rewrite /has_updates //. Qed.

Theorem has_updates_eq_nil log txns :
  log = [] →
  txns = [] →
  has_updates log txns.
Proof. intros -> ->. rewrite /has_updates //. Qed.

Theorem has_updates_app log1 txns1 log2 txns2 :
  has_updates log1 txns1 ->
  has_updates log2 txns2 ->
  has_updates (log1 ++ log2) (txns1 ++ txns2).
Proof.
  rewrite /has_updates; intros.
  rewrite txn_upds_app !apply_upds_app.
  rewrite H H0 //.
Qed.

Lemma has_updates_app_nils log txns nils :
  Forall (λ x, snd x = nil) nils ->
  has_updates log txns ->
  has_updates log (txns ++ nils).
Proof.
  rewrite /has_updates; intros.
  rewrite txn_upds_app.
  rewrite apply_upds_app.
  rewrite txn_upds_nils; eauto.
Qed.

Lemma has_updates_app_nils_2 log txns nils :
  Forall (λ x, snd x = nil) nils ->
  has_updates log (txns ++ nils) ->
  has_updates log txns.
Proof.
  rewrite /has_updates; intros.
  specialize (H0 d).
  rewrite txn_upds_app in H0.
  rewrite apply_upds_app in H0.
  rewrite (txn_upds_nils nils) /= in H0; eauto.
Qed.

Lemma has_updates_prepend_nils log txns nils :
  Forall (λ x, snd x = nil) nils ->
  has_updates log (nils ++ txns) ->
  has_updates log txns.
Proof.
  rewrite /has_updates; intros.
  specialize (H0 d).
  rewrite txn_upds_app in H0.
  rewrite apply_upds_app in H0.
  rewrite (txn_upds_nils nils) /= in H0; eauto.
Qed.

Lemma has_updates_prepend_nils_2 log txns nils :
  Forall (λ x, snd x = nil) nils ->
  has_updates log txns ->
  has_updates log (nils ++ txns).
Proof.
  rewrite /has_updates; intros.
  specialize (H0 d).
  rewrite txn_upds_app.
  rewrite apply_upds_app.
  rewrite (txn_upds_nils nils) /=; eauto.
Qed.

Lemma apply_upds_equiv_implies_has_updates_equiv upds1 upds2 txns :
  (∀ d : disk, apply_upds upds1 d = apply_upds upds2 d) →
  has_updates upds1 txns →
  has_updates upds2 txns.
Proof.
  intros Hequiv Hupds1 d.
  rewrite -(Hequiv d) //.
Qed.

(** installer-related properties *)

Lemma apply_upds_notin d upds (a: u64) :
  a ∉ (update.addr <$> upds) →
  apply_upds upds d !! int.Z a = d !! int.Z a.
Proof.
  rewrite -(reverse_involutive upds).
  remember (reverse upds) as upds_r.
  clear Hequpds_r upds.
  induction upds_r.
  1: eauto.
  intros Hnotin.
  rewrite fmap_reverse fmap_cons reverse_cons -fmap_reverse in Hnotin.
  apply not_elem_of_app in Hnotin.
  destruct Hnotin as (Hnotin&Hneq).
  apply IHupds_r in Hnotin.
  rewrite reverse_cons apply_upds_app.
  destruct a0.
  simpl.
  rewrite lookup_insert_ne.
  2: {
    simpl in Hneq.
    apply not_elem_of_cons in Hneq.
    destruct (decide (int.Z addr = int.Z a)).
    2: intuition.
    assert (addr = a) by word.
    intuition.
  }
  intuition.
Qed.

(* this looks very similar to the previous one, but it doesn't seem like one implies the other
  since there may not exist an addr such that a = int.Z addr *)
Lemma apply_upds_notin' d upds (a: Z) :
  a ∉ ((λ u, int.Z u.(update.addr)) <$> upds) →
  apply_upds upds d !! a = d !! a.
Proof.
  rewrite -(reverse_involutive upds).
  remember (reverse upds) as upds_r.
  clear Hequpds_r upds.
  induction upds_r.
  1: eauto.
  intros Hnotin.
  rewrite fmap_reverse fmap_cons reverse_cons -fmap_reverse in Hnotin.
  apply not_elem_of_app in Hnotin.
  destruct Hnotin as (Hnotin&Hneq).
  apply IHupds_r in Hnotin.
  rewrite reverse_cons apply_upds_app.
  destruct a0.
  simpl.
  rewrite lookup_insert_ne.
  2: {
    simpl in Hneq.
    apply not_elem_of_cons in Hneq.
    intuition.
  }
  intuition.
Qed.

Lemma apply_upds_NoDup_lookup d upds i a b :
  NoDup (update.addr <$> upds) →
  upds !! i = Some {| update.addr := a; update.b := b |} →
  (apply_upds upds d) !! int.Z a = Some b.
Proof.
  intros Hnodup Hlookup.
  rewrite -(take_drop (S i) upds).
  rewrite -(take_drop (S i) upds) fmap_app in Hnodup.
  apply NoDup_app in Hnodup.
  destruct Hnodup as (Hnodup&Heither&_).
  rewrite apply_upds_app apply_upds_notin.
  2: {
    apply Heither.
    rewrite -(lookup_take _ (S i)) in Hlookup.
    2: lia.
    apply (elem_of_list_lookup_2 _ i).
    rewrite list_lookup_fmap Hlookup //.
  }
  rewrite (take_S_r _ _ _ Hlookup) apply_upds_app /=.
  apply lookup_insert.
Qed.

Lemma apply_upds_dom upds d :
  ∀ (a: Z), a ∈ dom (apply_upds upds d) ↔
            a ∈ ((λ u, int.Z u.(update.addr)) <$> upds) ∨ a ∈ (dom d).
Proof.
  induction upds as [|[a b] upds] using rev_ind.
  - simpl.
    set_solver+.
  - intros.
    rewrite fmap_app apply_upds_app /=.
    set_solver.
Qed.

Lemma apply_upds_empty_dom upds :
  ∀ a, a ∈ dom (apply_upds upds ∅) ↔
       a ∈ ((λ u, int.Z u.(update.addr)) <$> upds).
Proof.
  intros.
  rewrite apply_upds_dom.
  set_solver.
Qed.

Lemma equiv_upds_addrs_subseteq upds1 upds2 :
  (apply_upds upds1 ∅ = apply_upds upds2 ∅) →
  (λ u : update.t, int.Z u.(update.addr)) <$> upds2 ⊆
  (λ u : update.t, int.Z u.(update.addr)) <$> upds1.
Proof.
  intros.
  intros a.
  rewrite -!apply_upds_empty_dom.
  rewrite H //.
Qed.

Lemma has_updates_addrs upds txns :
  has_updates upds txns →
  (λ u, int.Z u.(update.addr)) <$> upds ⊆ (λ u, int.Z u.(update.addr)) <$> txn_upds txns.
Proof.
  rewrite /has_updates /txn_upds; intros ?.
  specialize (H ∅).
  intros a.
  rewrite -apply_upds_empty_dom H apply_upds_empty_dom //.
Qed.

Lemma list_to_set_subseteq `{Countable A} (l1 l2: list A) :
  l1 ⊆ l2 ↔
  list_to_set (C:=gset _) l1 ⊆ list_to_set (C:=gset _) l2.
Proof. set_solver. Qed.

Lemma list_to_set_subseteq_Z (l1 l2: list Z) :
  l1 ⊆ l2 →
  list_to_set (C:=gset Z) l1 ⊆ list_to_set (C:=gset Z) l2.
Proof. apply list_to_set_subseteq. Qed.

Lemma equiv_upds_addrs_eq (upds1 upds2: list update.t) :
  (∀ d, apply_upds upds1 d = apply_upds upds2 d) →
  list_to_set (C:=gset Z) ((λ u : update.t, int.Z u.(update.addr)) <$> upds2) =
  list_to_set (C:=gset Z) ((λ u : update.t, int.Z u.(update.addr)) <$> upds1).
Proof.
  intros Hequiv.
  apply (iffRL (set_eq_subseteq _ _)).
  split.
  - apply list_to_set_subseteq.
    apply equiv_upds_addrs_subseteq.
    apply Hequiv.
  - apply list_to_set_subseteq.
    apply equiv_upds_addrs_subseteq.
    auto.
Qed.


Require Import Lia.
Require Import RelationClasses.

From sflib Require Import sflib.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Loc.

Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.

Set Implicit Arguments.

Module AMemory.
  Inductive promise
            (promises1 mem1:Memory.t)
            (loc:Loc.t) (from to:Time.t) (msg:Message.t)
            (promises2 mem2:Memory.t): forall (kind:Memory.op_kind), Prop :=
  | promise_add
      (PROMISES: Memory.add promises1 loc from to msg promises2)
      (MEM: Memory.add mem1 loc from to msg mem2)
      (TS: Memory.message_to msg loc to)
      (RESERVE: msg = Message.reserve ->
             exists from' val' released',
               Memory.get loc from mem1 = Some (from', Message.full val' released')):
      promise promises1 mem1 loc from to msg promises2 mem2 Memory.op_kind_add
  | promise_split
      ts3 msg3
      (PROMISES: Memory.split promises1 loc from to ts3 msg msg3 promises2)
      (MEM: Memory.split mem1 loc from to ts3 msg msg3 mem2)
      (TS: Memory.message_to msg loc to)
      (RESERVE: exists val' released', msg = Message.full val' released'):
      promise promises1 mem1 loc from to msg promises2 mem2 (Memory.op_kind_split ts3 msg3)
  | promise_lower
      msg0
      (PROMISES: Memory.lower promises1 loc from to msg0 msg promises2)
      (MEM: Memory.lower mem1 loc from to msg0 msg mem2)
      (TS: Memory.message_to msg loc to)
      (RESERVE: exists val released, msg0 = Message.full val released):
      promise promises1 mem1 loc from to msg promises2 mem2 (Memory.op_kind_lower msg0)
  | promise_cancel
      (PROMISES: Memory.remove promises1 loc from to msg promises2)
      (MEM: Memory.remove mem1 loc from to msg mem2)
      (RESERVE: msg = Message.reserve):
      promise promises1 mem1 loc from to msg promises2 mem2 Memory.op_kind_cancel
  .
  #[global]
  Hint Constructors promise: core.

  Inductive write
            (promises1 mem1:Memory.t)
            (loc:Loc.t) (from1 to1:Time.t) (val:Const.t) (released: option View.t)
            (promises3 mem2:Memory.t) (kind:Memory.op_kind): Prop :=
  | write_intro
      promises2
      (PROMISE: promise promises1 mem1 loc from1 to1 (Message.full val released) promises2 mem2 kind)
      (REMOVE: Memory.remove promises2 loc from1 to1 (Message.full val released) promises3)
  .
  #[global]
  Hint Constructors write: core.

  (* Lemmas on op *)

  Lemma promise_op
        promises1 mem1 loc from to msg promises2 mem2 kind
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind):
    Memory.op mem1 loc from to msg mem2 kind.
  Proof.
    inv PROMISE.
    - econs 1. ss.
    - econs 2. ss.
    - econs 3. ss.
    - econs 4; ss.
  Qed.

  Lemma promise_op_promise
        promises1 mem1 loc from to msg promises2 mem2 kind
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind):
    Memory.op promises1 loc from to msg promises2 kind.
  Proof.
    inv PROMISE.
    - econs 1. ss.
    - econs 2. ss.
    - econs 3. ss.
    - econs 4; ss.
  Qed.

  (* Lemmas on closedness *)

  Lemma promise_closed_timemap
        times
        promises1 mem1 loc from to msg promises2 mem2 kind
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind)
        (CLOSED: Memory.closed_timemap times mem1):
    Memory.closed_timemap times mem2.
  Proof.
    eapply Memory.op_closed_timemap; eauto.
    eapply promise_op. eauto.
  Qed.

  Lemma promise_closed_view
        view
        promises1 mem1 loc from to msg promises2 mem2 kind
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind)
        (CLOSED: Memory.closed_view view mem1):
    Memory.closed_view view mem2.
  Proof.
    eapply Memory.op_closed_view; eauto.
    eapply promise_op. eauto.
  Qed.

  Lemma promise_closed_opt_view
        view
        promises1 mem1 loc from to msg promises2 mem2 kind
        (CLOSED: Memory.closed_opt_view view mem1)
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind):
    Memory.closed_opt_view view mem2.
  Proof.
    inv CLOSED; econs. eapply promise_closed_view; eauto.
  Qed.

  (* reserve_wf *)

  Lemma promise_reserve_wf
        promises1 mem1 loc from to msg promises2 mem2 kind
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind)
        (RESERVE1: Memory.reserve_wf promises1 mem1):
    <<RESERVE2: Memory.reserve_wf promises2 mem2>>.
  Proof.
    inv PROMISE; ii; revert GET.
    - erewrite Memory.add_o; eauto. condtac; ss; i.
      + des. subst. inv GET.
        exploit RESERVE; eauto. i. des.
        exploit Memory.add_get1; try exact x; eauto.
      + guardH o.
        exploit RESERVE1; eauto. i. des.
        exploit Memory.add_get1; try exact x; eauto.
    - erewrite Memory.split_o; eauto. repeat condtac; ss; i.
      + des. subst. inv GET.
      + guardH o. des. subst. inv GET.
        exploit Memory.split_get0; try exact MEM. i. des. eauto.
      + guardH o. guardH o0.
        exploit RESERVE1; eauto. i. des.
        exploit Memory.split_get1; try exact x; eauto. i. des. eauto.
    - erewrite Memory.lower_o; eauto. condtac; ss; i.
      + des. subst. inv GET.
        exploit Memory.lower_get0; try exact PROMISES. i. des. inv MSG_LE.
      + guardH o.
        exploit RESERVE1; eauto. i. des.
        exploit Memory.lower_get1; try exact x; eauto. i. des.
        inv MSG_LE. eauto.
    - erewrite Memory.remove_o; eauto. condtac; ss. i.
      guardH o.
      exploit RESERVE1; eauto. i. des.
      erewrite Memory.remove_o; eauto. condtac; ss; eauto.
      des. subst.
      exploit Memory.remove_get0; try exact MEM. i. des. congr.
  Qed.

  (* Lemmas on promise & remove *)

  Lemma promise_get0
        promises1 promises2 mem1 mem2
        loc from to msg kind
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind)
        (KIND: Memory.op_kind_is_cancel kind = false):
    <<GET_PROMISES: Memory.get loc to promises2 = Some (from, msg)>> /\
    <<GET_MEM: Memory.get loc to mem2 = Some (from, msg)>>.
  Proof.
    inv PROMISE; ss.
    - erewrite (Memory.add_o _ _ PROMISES).
      erewrite (Memory.add_o _ _ MEM).
      condtac; ss. des; congr.
    - erewrite (Memory.split_o _ _ PROMISES).
      erewrite (Memory.split_o _ _ MEM).
      repeat condtac; ss; des; intuition.
    - erewrite (Memory.lower_o _ _ PROMISES).
      erewrite (Memory.lower_o _ _ MEM).
      condtac; ss. des; congr.
  Qed.

  Lemma promise_get1
        promises1 mem1 loc from to msg promises2 mem2 kind
        l t f m
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind)
        (KIND: Memory.op_kind_is_cancel kind = false)
        (GET: Memory.get l t mem1 = Some (f, m)):
    exists f' m',
      <<GET: Memory.get l t mem2 = Some (f', m')>> /\
      <<FROM: Time.le f f'>> /\
      <<MSG_LE: Message.le m' m>>.
  Proof.
    inv PROMISE; ss.
    - eapply Memory.op_get1; eauto.
    - eapply Memory.op_get1; eauto.
    - eapply Memory.op_get1; eauto.
  Qed.

  Lemma promise_get1_promise
        promises1 mem1 loc from to msg promises2 mem2 kind
        l t f m
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind)
        (KIND: Memory.op_kind_is_cancel kind = false)
        (GET: Memory.get l t promises1 = Some (f, m)):
    exists f' m',
      <<GET: Memory.get l t promises2 = Some (f', m')>> /\
      <<FROM: Time.le f f'>> /\
      <<MSG_LE: Message.le m' m>>.
  Proof.
    inv PROMISE; eapply Memory.op_get1; eauto.
  Qed.

  Lemma promise_get2
        promises1 mem1 loc from to msg promises2 mem2 kind
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind)
        (KIND: Memory.op_kind_is_cancel kind = false):
    <<GET_PROMISE: Memory.get loc to promises2 = Some (from, msg)>> /\
    <<GET_MEM: Memory.get loc to mem2 = Some (from, msg)>>.
  Proof.
    inv PROMISE; splits; eauto using Memory.op_get2.
  Qed.

  Lemma promise_le
        promises1 mem1 loc from to msg promises2 mem2 kind
        (LE_PROMISES1: Memory.le promises1 mem1)
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind):
    <<LE_PROMISES2: Memory.le promises2 mem2>>.
  Proof.
    inv PROMISE.
    - ii. revert LHS.
      erewrite Memory.add_o; eauto.
      erewrite (@Memory.add_o mem2); try exact MEM; eauto.
      condtac; ss. auto.
    - ii. revert LHS.
      erewrite Memory.split_o; eauto.
      erewrite (@Memory.split_o mem2); try exact MEM; eauto.
      repeat condtac; ss. auto.
    - ii. revert LHS.
      erewrite Memory.lower_o; eauto.
      erewrite (@Memory.lower_o mem2); try exact MEM; eauto.
      condtac; ss. auto.
    - ii. revert LHS.
      erewrite Memory.remove_o; eauto.
      erewrite (@Memory.remove_o mem2); try exact MEM; eauto.
      condtac; ss. auto.
  Qed.

  Lemma promise_future
        promises1 mem1 loc from to msg promises2 mem2 kind
        (LE_PROMISES1: Memory.le promises1 mem1)
        (FINITE1: Memory.finite promises1)
        (BOT1: Memory.bot_none promises1)
        (RESERVE1: Memory.reserve_wf promises1 mem1)
        (CLOSED1: Memory.closed mem1)
        (MSG_CLOSED: Memory.closed_message msg mem2)
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind):
    <<LE_PROMISES2: Memory.le promises2 mem2>> /\
    <<FINITE2: Memory.finite promises2>> /\
    <<BOT2: Memory.bot_none promises2>> /\
    <<RESERVE2: Memory.reserve_wf promises2 mem2>> /\
    <<CLOSED2: Memory.closed mem2>> /\
    <<FUTURE: Memory.future mem1 mem2>>.
  Proof.
    hexploit promise_le; eauto. i. des.
    hexploit Memory.op_inhabited; try apply CLOSED1.
    { eapply promise_op. eauto. }
    hexploit Memory.op_finite; eauto.
    { eapply promise_op_promise. eauto. }
    hexploit Memory.op_future; eauto.
    { eapply promise_op. eauto. }
    { by inv PROMISE. }
    i. des.
    hexploit promise_reserve_wf; eauto. i. des.
    splits; auto.
    inv PROMISE.
    - eapply Memory.add_bot_none; eauto.
    - eapply Memory.split_bot_none; eauto.
    - eapply Memory.lower_bot_none; eauto.
    - eapply Memory.cancel_bot_none; eauto.
  Qed.

  Lemma promise_disjoint
        promises1 mem1 loc from to msg promises2 mem2 ctx kind
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind)
        (LE_CTX: Memory.le ctx mem1)
        (RESERVE_CTX: Memory.reserve_wf ctx mem1)
        (DISJOINT: Memory.disjoint promises1 ctx):
    <<DISJOINT: Memory.disjoint promises2 ctx>> /\
    <<LE_CTX: Memory.le ctx mem2>> /\
    <<RESERVE_CTX: Memory.reserve_wf ctx mem2>>.
  Proof.
    inv PROMISE.
    - splits.
      + inv DISJOINT. econs. i. revert GET1. erewrite Memory.add_o; eauto. condtac; ss.
        * des. subst. i. inv GET1. splits.
          { inv MEM. inv ADD. eauto. }
          { ii. inv H. inv MEM. inv ADD. inv TO. }
        * i. eapply DISJOINT0; eauto.
      + ii. erewrite Memory.add_o; eauto. condtac; ss; eauto.
        des. subst. exfalso. inv MEM. inv ADD. eapply DISJOINT0; eauto.
        * apply Interval.mem_ub. auto.
        * apply Interval.mem_ub.
          destruct (Cell.WF (mem1 loc)). exploit VOLUME; eauto. intro x. des; auto.
          inv x. inv TO.
      + ii. exploit RESERVE_CTX; eauto. i. des.
        exploit Memory.add_get1; try exact x; eauto.
    - splits.
      + inv DISJOINT. econs. i. revert GET1. erewrite Memory.split_o; eauto. repeat condtac; ss.
        * des. subst. i. inv GET1.
          exploit Memory.split_get0; try exact PROMISES; eauto. i. des.
          exploit DISJOINT0; try exact GET0; eauto. i. des.
          splits.
          { eapply Interval.le_disjoint; eauto. econs; [refl|].
            left. inv MEM. inv SPLIT. auto.
          }
          { ii. inv H. inv MEM. inv SPLIT. inv TS12. }
        * guardH o. des. subst. i. inv GET1.
          exploit Memory.split_get0; try exact PROMISES; eauto. i. des.
          exploit DISJOINT0; try exact GET0; eauto. i. des.
          splits.
          { eapply Interval.le_disjoint; eauto. econs; [|refl].
            left. inv MEM. inv SPLIT. auto.
          }
          { ii. inv H. inv MEM. inv SPLIT. inv TS23. }
        * i. eapply DISJOINT0; eauto.
      + ii. erewrite Memory.split_o; eauto. repeat condtac; ss; eauto.
        * des. subst. exfalso. inv DISJOINT. exploit DISJOINT0; eauto.
          { hexploit Memory.split_get0; try exact PROMISES; eauto. i. des. eauto. }
          intro x. des. eapply x.
          { inv MEM. inv SPLIT. econs. eauto. left. auto. }
          { apply Interval.mem_ub.
            destruct (Cell.WF (mem1 loc)). exploit VOLUME; eauto. intro x1. des; auto.
            inv x1. inv MEM. inv SPLIT. inv TS12.
          }
        * guardH o. des. subst. exfalso. inv DISJOINT. exploit DISJOINT0; eauto.
          { hexploit Memory.split_get0; try exact PROMISES; eauto. i. des. eauto. }
          intro x. des. eapply x.
          { apply Interval.mem_ub. inv MEM. inv SPLIT. etrans; eauto. }
          { apply Interval.mem_ub.
            destruct (Cell.WF (ctx loc)). exploit VOLUME; eauto. intro x1. des; auto.
            inv x1. inv MEM. inv SPLIT. inv TS23.
          }
      + ii. exploit RESERVE_CTX; eauto. i. des.
        exploit Memory.split_get1; try exact x; eauto. i. des. eauto.
    - splits.
      + inv DISJOINT. econs. i. revert GET1. erewrite Memory.lower_o; eauto. condtac; ss.
        * des. subst. i. inv GET1. eapply DISJOINT0; eauto.
          hexploit Memory.lower_get0; try eapply PROMISES; eauto. i. des. eauto.
        * i. eapply DISJOINT0; eauto.
      + ii. erewrite Memory.lower_o; eauto. condtac; ss; eauto.
        des. subst. exfalso. eapply Memory.disjoint_get; eauto.
        hexploit Memory.lower_get0; try exact PROMISES; eauto. i. des. eauto.
      + ii. exploit RESERVE_CTX; eauto. i. des.
        exploit Memory.lower_get1; try exact x; eauto. i. des.
        inv MSG_LE. eauto.
    - splits.
      + inv DISJOINT. econs. i. revert GET1. erewrite Memory.remove_o; eauto. condtac; ss.
        des. subst. i. inv GET1. eapply DISJOINT0; eauto.
        hexploit Memory.remove_get0; try eapply PROMISES; eauto.
      + ii. erewrite Memory.remove_o; eauto. condtac; ss; eauto.
        des. subst. exfalso. eapply Memory.disjoint_get; eauto.
        hexploit Memory.remove_get0; try exact PROMISES; eauto. i. des. eauto.
      + ii. exploit RESERVE_CTX; eauto. intro x. des.
        destruct (Memory.get loc0 from0 mem2) as [[]|] eqn:GET2.
        * revert GET2. erewrite Memory.remove_o; eauto. condtac; ss. i.
          rewrite GET2 in *. inv x. eauto.
        * exploit Memory.remove_get0; try exact MEM. i. des.
          revert GET2. erewrite Memory.remove_o; eauto. condtac; ss; try congr.
          des. subst. congr.
  Qed.

  Lemma write_get2
        promises1 mem1 loc from to val released promises2 mem2 kind
        (WRITE: write promises1 mem1 loc from to val released promises2 mem2 kind):
    <<GET_PROMISE: Memory.get loc to promises2 = None>> /\
    <<GET_MEM: Memory.get loc to mem2 = Some (from, Message.full val released)>>.
  Proof.
    inv WRITE. splits.
    - erewrite Memory.remove_o; eauto. condtac; ss. des; ss.
    - eapply promise_get2; eauto. inv PROMISE; ss.
  Qed.

  Lemma write_future
        promises1 mem1 loc from to val released promises2 mem2 kind
        (WRITE: write promises1 mem1 loc from to val released promises2 mem2 kind)
        (CLOSED: Memory.closed mem1)
        (MSG_CLOSED: Memory.closed_message (Message.full val released) mem2)
        (LE: Memory.le promises1 mem1)
        (FINITE: Memory.finite promises1)
        (BOT: Memory.bot_none promises1)
        (RESERVE: Memory.reserve_wf promises1 mem1):
    <<CLOSED: Memory.closed mem2>> /\
    <<LE: Memory.le promises2 mem2>> /\
    <<FINITE: Memory.finite promises2>> /\
    <<BOT: Memory.bot_none promises2>> /\
    <<RESERVE: Memory.reserve_wf promises2 mem2>> /\
    <<FUTURE: Memory.future mem1 mem2>>.
  Proof.
    inv WRITE.
    hexploit promise_future; eauto. i. des.
    hexploit Memory.remove_future; eauto. i. des.
    splits; auto.
    - ii. erewrite Memory.remove_o; eauto. condtac; ss.
    - ii. revert GET.
      erewrite Memory.remove_o; eauto. condtac; ss.
      i. exploit RESERVE2; eauto.
  Qed.

  Lemma write_disjoint
        promises1 mem1 loc from to val released promises2 mem2 ctx kind
        (WRITE: write promises1 mem1 loc from to val released promises2 mem2 kind)
        (DISJOINT: Memory.disjoint promises1 ctx)
        (LE_CTX: Memory.le ctx mem1)
        (RESERVE_CTX: Memory.reserve_wf ctx mem1):
    <<DISJOINT: Memory.disjoint promises2 ctx>> /\
    <<LE_CTX: Memory.le ctx mem2>> /\
    <<RESERVE_CTX: Memory.reserve_wf ctx mem2>>.
  Proof.
    inv WRITE.
    hexploit promise_disjoint; try apply PROMISE; eauto. i. des.
    hexploit Memory.remove_disjoint; try apply REMOVE; eauto.
  Qed.

  Lemma bot_write_bot
        promises1 mem1 loc from to val released promises2 mem2 kind
        (WRITE: write promises1 mem1 loc from to val released promises2 mem2 kind)
        (PROMISES: promises1 = Memory.bot):
    promises2 = Memory.bot.
  Proof.
    subst. inv WRITE. inv PROMISE.
    - apply Memory.ext. i.
      exploit Memory.add_get0; try exact PROMISES. i. des.
      exploit Memory.remove_get0; eauto. i. des.
      erewrite Memory.remove_o; eauto. condtac; ss.
      + des. subst. ss.
      + erewrite Memory.add_o; eauto. condtac; ss.
    - exploit Memory.split_get0; try exact PROMISES. i. des.
      rewrite Memory.bot_get in *. ss.
    - exploit Memory.lower_get0; try exact PROMISES. i. des.
      rewrite Memory.bot_get in *. ss.
    - exploit Memory.remove_get0; try exact PROMISES. i. des.
      rewrite Memory.bot_get in *. ss.
  Qed.

  (* no_reserve *)

  Lemma promise_no_reserve_except
        promises1 promises2 mem1 mem2
        loc from to msg kind
        (PROMISE: promise promises1 mem1 loc from to msg promises2 mem2 kind)
        (RESERVE1: Memory.reserve_wf promises1 mem1)
        (NORESERVE1: Memory.no_reserve_except promises1 mem1):
    Memory.no_reserve_except promises2 mem2.
  Proof.
    ii. inv PROMISE.
    - erewrite Memory.add_o; try exact PROMISES.
      erewrite Memory.add_o in GET; try exact MEM.
      condtac; eauto.
      guardH o.
      exploit Memory.max_ts_spec; try exact GET. i. des.
      exploit Memory.add_get1; try exact GET0; eauto. i.
      exploit Memory.max_ts_spec; try exact x0. i. des.
      exploit TimeFacts.antisym; eauto. i.
      rewrite <- x1 in *. eauto.
    - erewrite Memory.split_o; try exact PROMISES.
      erewrite Memory.split_o in GET; try exact MEM.
      repeat condtac; eauto.
      guardH o. guardH o0.
      exploit Memory.max_ts_spec; try exact GET. i. des.
      exploit Memory.split_get1; try exact GET0; eauto. i. des.
      exploit Memory.max_ts_spec; try exact GET2. i. des.
      exploit TimeFacts.antisym; eauto. i.
      rewrite <- x0 in *. eauto.
    - erewrite Memory.lower_o; try exact PROMISES.
      erewrite Memory.lower_o in GET; try exact MEM.
      condtac; eauto.
      guardH o.
      exploit Memory.max_ts_spec; try exact GET. i. des.
      exploit Memory.lower_get1; try exact GET0; eauto. i. des.
      exploit Memory.max_ts_spec; try exact GET2. i. des.
      exploit TimeFacts.antisym; eauto. i.
      rewrite <- x0 in *. eauto.
    - erewrite Memory.remove_o; eauto.
      erewrite Memory.remove_o in GET; try exact MEM.
      condtac; ss.
      guardH o.
      destruct (Loc.eq_dec loc0 loc); cycle 1.
      { cut (Memory.max_ts loc0 mem2 = Memory.max_ts loc0 mem1).
        { i. rewrite H in *. eapply NORESERVE1; eauto. }
        exploit Memory.max_ts_spec; try exact GET. i. des.
        destruct (Memory.get loc0 (Memory.max_ts loc0 mem1) mem2) as [[]|] eqn:GET2.
        - exploit Memory.max_ts_spec; try exact GET2. i. des.
          apply TimeFacts.antisym; auto.
        - revert GET2. erewrite Memory.remove_o; eauto. condtac; ss; i.
          + des. subst. ss.
          + congr.
      }
      subst. unguard. des; ss. clear COND.
      exploit Memory.max_ts_spec; eauto. i. des. inv MAX; cycle 1.
      { inv H. rewrite H1 in *. eapply NORESERVE1; eauto. }
      destruct (Memory.get loc (Memory.max_ts loc mem1) mem2) as [[]|] eqn:GET2.
      { exploit Memory.max_ts_spec; try exact GET2. i. des. timetac. }
      revert GET2. erewrite Memory.remove_o; eauto.
      condtac; ss; try congr. des. subst.
      i. clear COND GET2 a.
      exploit Memory.remove_get0; try exact MEM. i. des.
      rewrite GET0 in *. inv GET1.
      exploit RESERVE1; eauto. i. des.
      cut (from = Memory.max_ts loc mem2); try congr.
      exploit Memory.get_ts; try exact GET0. i. des.
      { subst. rewrite x2 in *. congr. }
      destruct (Memory.get loc from mem2) as [[]|] eqn:GETF; cycle 1.
      { revert GETF. erewrite Memory.remove_o; eauto. condtac; ss.
        - des. subst. rewrite GET0 in *. clarify.
        - congr. }
      exploit Memory.max_ts_spec; try exact GETF. i. des.
      inv MAX; eauto.
      revert GET1. erewrite Memory.remove_o; eauto. condtac; ss. i.
      clear o0 COND.
      exploit Memory.get_ts; try exact GET1. i. des.
      { subst. rewrite x3 in *. inv H0. }
      exploit Memory.get_disjoint; [exact GET0|exact GET1|..]. i. des; try congr.
      exfalso.
      apply (x3 (Memory.max_ts loc mem2)); econs; ss; try refl.
      econs. ss.
  Qed.
End AMemory.


From iris.bi Require Import bi.
From iris.proofmode Require Export classes.
Set Default Proof Using "Type".
Import bi.

Section bi_modalities.
  Context {PROP : bi}.

  Lemma modality_persistently_mixin :
    modality_mixin (@bi_persistently PROP) MIEnvId MIEnvClear.
  Proof.
    split; simpl; eauto using equiv_entails_sym, persistently_intro,
      persistently_mono, persistently_sep_2 with typeclass_instances.
  Qed.
  Definition modality_persistently :=
    Modality _ modality_persistently_mixin.

  Lemma modality_affinely_mixin :
    modality_mixin (@bi_affinely PROP) MIEnvId (MIEnvForall Affine).
  Proof.
    split; simpl; eauto using equiv_entails_sym, affinely_intro, affinely_mono,
      affinely_sep_2 with typeclass_instances.
  Qed.
  Definition modality_affinely :=
    Modality _ modality_affinely_mixin.

  Lemma modality_intuitionistically_mixin :
    modality_mixin (@bi_intuitionistically PROP) MIEnvId MIEnvIsEmpty.
  Proof.
    split; simpl; eauto using equiv_entails_sym, intuitionistically_emp,
      affinely_mono, persistently_mono, intuitionistically_idemp,
      intuitionistically_sep_2 with typeclass_instances.
  Qed.
  Definition modality_intuitionistically :=
    Modality _ modality_intuitionistically_mixin.

  Lemma modality_embed_mixin `{BiEmbed PROP PROP'} :
    modality_mixin (@embed PROP PROP' _)
      (MIEnvTransform IntoEmbed) (MIEnvTransform IntoEmbed).
  Proof.
    split; simpl; split_and?;
      eauto using equiv_entails_sym, embed_emp_2, embed_sep, embed_and.
    - intros P Q. rewrite /IntoEmbed=> ->. by rewrite embed_intuitionistically_2.
    - by intros P Q ->.
  Qed.
  Definition modality_embed `{BiEmbed PROP PROP'} :=
    Modality _ modality_embed_mixin.
End bi_modalities.

Section sbi_modalities.
  Context {PROP : sbi}.

  Lemma modality_plainly_mixin `{BiPlainly PROP} :
    modality_mixin (@plainly PROP _) (MIEnvForall Plain) MIEnvClear.
  Proof.
    split; simpl; split_and?; eauto using equiv_entails_sym, plainly_intro,
      plainly_mono, plainly_and, plainly_sep_2 with typeclass_instances.
  Qed.
  Definition modality_plainly `{BiPlainly PROP} :=
    Modality _ modality_plainly_mixin.

  Lemma modality_laterN_mixin n :
    modality_mixin (@sbi_laterN PROP n)
      (MIEnvTransform (MaybeIntoLaterN false n)) (MIEnvTransform (MaybeIntoLaterN false n)).
  Proof.
    split; simpl; split_and?; eauto using equiv_entails_sym, laterN_intro,
      laterN_mono, laterN_and, laterN_sep with typeclass_instances.
    rewrite /MaybeIntoLaterN=> P Q ->. by rewrite laterN_intuitionistically_2.
  Qed.
  Definition modality_laterN n :=
    Modality _ (modality_laterN_mixin n).
End sbi_modalities.


(* (c) Copyright 2006-2018 Microsoft Corporation and Inria.                  *)
(* Distributed under the terms of CeCILL-B.                                  *)
From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat seq.
From fourcolor Require Import cfmap cfreducible configurations.

(******************************************************************************)
(* Reducibility of configurations number 254 to 270, whose indices in         *)
(* the_configs range over segment [253, 270).                                 *)
(******************************************************************************)

Lemma red253to270 : reducible_in_range 253 270 the_configs.
Proof. CheckReducible. Qed.