theory flash105Bra  imports flash105Rev

  begin
lemma onInv105:

   assumes  a1:"iInv1 \<le> N" and  a2:"iInv2 \<le> N" and  a3:"iInv1~=iInv2  " and

     b1:"r \<in> rules N" and b2:"invf=inv105  iInv1  iInv2 "
   shows  "invHoldForRule' s invf r (invariants   N)"
   proof -
have c1:"ex1P N (% iRule1 .  r=NI_Local_GetX_PutX1 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_GetX  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Replace  iRule1 )\<or>ex0P N (  r=NI_ShWb N )\<or>ex0P N (  r=PI_Local_GetX_GetX2 )\<or>ex0P N (  r=NI_Local_PutXAcksDone )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX7 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak2  iRule1 )\<or>ex0P N (  r=NI_ReplaceHomeShrVld )\<or>ex1P N (% iRule1 .  r=NI_Remote_Put  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX5 N  iRule1 )\<or>ex0P N (  r=NI_Wb )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Get  iRule1 )\<or>ex0P N (  r=PI_Local_Replace )\<or>ex1P N (% iRule1 .  r=NI_ReplaceShrVld  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX8 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_InvAck_2 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Nak2  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Replace  iRule1 )\<or>ex0P N (  r=NI_Nak_Home )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put2  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_InvAck_1  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX11 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX6 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Put2  iRule1  iRule2 )\<or>ex0P N (  r=PI_Local_Get_Put )\<or>ex0P N (  r=PI_Local_GetX_PutX1 N )\<or>ex1P N (% iRule1 .  r=NI_InvAck_1_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak2  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX10_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Get  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak3  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX10 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX2 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Put1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_PutX  iRule1 )\<or>ex1P N (% iRule1 .  r=Store  iRule1 )\<or>ex0P N (  r=NI_FAck )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX3 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX3 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_PutX  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX8_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put1 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_GetX1 )\<or>ex0P N (  r=StoreHome )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_Nak  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Inv  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_PutX  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX4 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX4 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Nak  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX2 N )\<or>ex0P N (  r=NI_Local_Put )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak1  iRule1 )\<or>ex0P N (  r=NI_Nak_Clear )\<or>ex0P N (  r=PI_Local_PutX )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak3  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_Nak_Home  iRule1 )\<or>ex0P N (  r=PI_Local_Get_Get )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX9 N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_GetX  iRule1 )\<or>ex0P N (  r=NI_ReplaceHome )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_PutX_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put3  iRule1 )"

        apply(cut_tac  b1)
        apply auto
        done      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX1VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_GetXVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_ReplaceVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ShWb N )
"

         from c1 have c2:" r= NI_ShWb N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_ShWb N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ShWbVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX2 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX2 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Local_GetX_GetX2 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_GetX2VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_PutXAcksDone )
"

         from c1 have c2:" r= NI_Local_PutXAcksDone "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_PutXAcksDone ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Local_PutXAcksDoneVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX7 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX7 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX7VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_Get_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak2VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHomeShrVld )
"

         from c1 have c2:" r= NI_ReplaceHomeShrVld "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_ReplaceHomeShrVld ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ReplaceHomeShrVldVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Put  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Put  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Remote_Put  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_PutVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX5 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX5 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX5VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Wb )
"

         from c1 have c2:" r= NI_Wb "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Wb ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_WbVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_Get_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_GetVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Replace )
"

         from c1 have c2:" r= PI_Local_Replace "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Local_Replace ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_ReplaceVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_ReplaceShrVld  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_ReplaceShrVld  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_ReplaceShrVld  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_ReplaceShrVldVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX8VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_InvAck_2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_2VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Nak2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Nak2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Nak2VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Remote_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_ReplaceVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Home )
"

         from c1 have c2:" r= NI_Nak_Home "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Nak_Home ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Nak_HomeVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_Get_Put2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put2VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_InvAck_1  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_InvAck_1  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_1VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX11 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX11 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX11VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX6 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX6 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX6VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Put2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Put2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Put2VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Put )
"

         from c1 have c2:" r= PI_Local_Get_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Local_Get_Put ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_Get_PutVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX1 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX1 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Local_GetX_PutX1 N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX1VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_1_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_1_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_InvAck_1_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_1_HomeVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Nak1VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak1VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak2VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX10_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX10_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX10_homeVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Remote_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_GetVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak3VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX10VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX2VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Put1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Put1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Remote_Get_Put1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Put1VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_PutXVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= Store  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= Store  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (Store  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis StoreVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_FAck )
"

         from c1 have c2:" r= NI_FAck "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_FAck ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_FAckVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX3 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX3 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX3VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX3 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX3 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Local_GetX_PutX3 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX3VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_PutX  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_PutX  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_PutXVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX8_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX8_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX8_homeVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put1VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX1 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX1 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Local_GetX_GetX1 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_GetX1VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= StoreHome )
"

         from c1 have c2:" r= StoreHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (StoreHome ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis StoreHomeVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_Nak  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_Nak  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_NakVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Inv  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Inv  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Inv  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_PutXVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX4 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX4 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Local_GetX_PutX4 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX4VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX4 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX4 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX4VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Nak  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Nak  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Nak  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_NakVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX2 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX2 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Local_GetX_PutX2 N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX2VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_Put )
"

         from c1 have c2:" r= NI_Local_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_Put ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Local_PutVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak1VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Clear )
"

         from c1 have c2:" r= NI_Nak_Clear "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Nak_Clear ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Nak_ClearVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_PutX )
"

         from c1 have c2:" r= PI_Local_PutX "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Local_PutX ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_PutXVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_Get_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak3VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_Nak_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_Nak_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_Nak_HomeVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Get )
"

         from c1 have c2:" r= PI_Local_Get_Get "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Local_Get_Get ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_Get_GetVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX9 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX9 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX9VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (PI_Remote_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_GetXVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHome )
"

         from c1 have c2:" r= NI_ReplaceHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_ReplaceHome ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ReplaceHomeVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_PutX_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_PutX_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_PutX_HomeVsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv105  iInv1  iInv2 ) (NI_Local_Get_Put3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put3VsInv105 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }ultimately show "invHoldForRule' s invf r (invariants N) "
          by blast
     qed
end


theory Combine_Opt
  imports
  "../Combine"
  "Balance_Opt_LR"
begin

context rbt_impl
begin
interpretation rbt_impl_deps .

partial_function (M) combine_opt ::
  "('ki, 'vi) rbti \<Rightarrow> ('ki, 'vi) rbti \<Rightarrow> ('ki, 'vi) rbti llM" where
  "combine_opt l_p r_p = do {
    if l_p = null then return r_p
    else if r_p = null then return l_p
    else do {
      l \<leftarrow> ll_load l_p;
      r \<leftarrow> ll_load r_p;
      if rbt_node.color l = rbt_node.color r
      then do {
        combined_p \<leftarrow> combine_opt (rbt_node.right l) (rbt_node.left r);
        is_red_b \<leftarrow> ll_is_red_br combined_p;
        if is_red_b = ll_True then
        do {
            combined \<leftarrow> ll_load combined_p;
            case combined of (RBT_NODE cc cl ck cv cr) \<Rightarrow>
            do {
              set_right_p cl l_p;
              set_left_p cr r_p;
              ll_store (RBT_NODE cc l_p ck cv r_p) combined_p;
              return combined_p
            }
        }
        else do {
          set_left_p combined_p r_p;
          if rbt_node.color l = 0
          then do {
            set_right_p r_p l_p;
            return l_p
          }
          else do {
            set_right_p r_p l_p;
            balance_left_opt l_p
          }
        }
      }
      else if (rbt_node.color r = 0)
      then do {
        combined_p \<leftarrow> combine_opt l_p (rbt_node.left r);
        set_left_p combined_p r_p;
        return r_p
      }
      else do {
        combined_p \<leftarrow> combine_opt (rbt_node.right l) r_p;
        set_right_p combined_p l_p;
        return l_p
      }
    }
  }"

lemma combine_opt_correct [vcg_rules]:
  "
  llvm_htriple
  (rbt_assn l li ** rbt_assn r ri)
  (combine_opt li ri)
  (\<lambda>x. rbt_assn (rbt_combine l r) x)
"
proof(induction l r arbitrary: li ri rule: RBT_Impl.combine.induct)
  case (1 x)
  then show ?case
    apply (subst combine_opt.simps)
    apply vcg
    done
next
  case (2 v va vb vc vd)
  then show ?case
    apply (subst combine_opt.simps)
    apply vcg
    done
next
  case (3 a k x b c s y d)
  note [vcg_rules] = 3
  show ?case
    apply (subst combine_opt.simps)
    apply vcg
    apply (cases "rbt_combine b c")
     apply (auto split: color.splits)
     apply vcg
    done
next
  case (4 a k x b c s y d)
  note [vcg_rules] = 4
  show ?case
    apply (subst combine_opt.simps)
    apply vcg
    apply (cases "rbt_combine b c")
     apply (auto split: color.splits)
     apply vcg
    done
next
  case (5 va vb vc vd b k x c)
  note [vcg_rules] = 5
  show ?case
    apply (subst combine_opt.simps)
    apply vcg
    done
next
  case (6 a k x b va vb vc vd)
  note [vcg_rules] = 6
  show ?case
    apply (subst combine_opt.simps)
    apply vcg
    done
qed

lemmas [llvm_code] = combine_opt.simps

end

end


theory CoCallImplTTreeSafe
imports CoCallImplTTree CoCallAnalysisSpec TTreeAnalysisSpec
begin

lemma valid_lists_many_calls:
  assumes "\<not> one_call_in_path x p"
  assumes "p \<in> valid_lists S G"
  shows "x--x \<in> G"
using assms(2,1)
proof(induction rule:valid_lists.induct[case_names Nil Cons])
  case Nil thus ?case by simp
next
  case (Cons xs x')
  show ?case
  proof(cases "one_call_in_path x xs")
    case False
    from Cons.IH[OF this]
    show ?thesis.
  next
    case True
    with \<open>\<not> one_call_in_path x (x' # xs)\<close>
    have [simp]: "x' = x" by (auto split: if_splits)

    have "x \<in> set xs"
    proof(rule ccontr)
      assume "x \<notin> set xs"
      hence "no_call_in_path x xs" by (metis no_call_in_path_set_conv)
      hence "one_call_in_path x (x # xs)" by simp
      with Cons show False by simp
    qed
    with \<open>set xs \<subseteq> ccNeighbors x' G\<close>
    have "x \<in> ccNeighbors x G" by auto
    thus ?thesis by simp
  qed
qed

context CoCallArityEdom
begin
 lemma carrier_Fexp': "carrier (Texp e\<cdot>a) \<subseteq> fv e"
    unfolding Texp_simp carrier_ccTTree
    by (rule Aexp_edom)

end

context CoCallAritySafe
begin

lemma carrier_AnalBinds_below:
  "carrier ((Texp.AnalBinds  \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) x) \<subseteq> edom ((ABinds \<Delta>)\<cdot>(Aheap \<Delta> e\<cdot>a))"
by (auto simp add: Texp.AnalBinds_lookup Texp_def split: option.splits
         elim!: subsetD[OF edom_mono[OF monofun_cfun_fun[OF ABind_below_ABinds]]])

sublocale TTreeAnalysisCarrier Texp
  apply standard
  unfolding Texp_simp carrier_ccTTree
  apply standard
  done

sublocale TTreeAnalysisSafe Texp
proof
  fix x e a

  from edom_mono[OF Aexp_App]
  have "{x} \<union> edom (Aexp e\<cdot>(inc\<cdot>a)) \<subseteq> edom (Aexp (App e x)\<cdot>a)" by auto
  moreover
  {
  have "ccApprox (many_calls x \<otimes>\<otimes> ccTTree (edom (Aexp e\<cdot>(inc\<cdot>a))) (ccExp e\<cdot>(inc\<cdot>a)))
    = cc_restr (edom (Aexp e\<cdot>(inc\<cdot>a))) (ccExp e\<cdot>(inc\<cdot>a)) \<squnion> ccProd {x} (insert x (edom (Aexp e\<cdot>(inc\<cdot>a))))"
    by (simp add: ccApprox_both ccProd_insert2[where S' = "edom e" for e])
  also
  have "edom (Aexp e\<cdot>(inc\<cdot>a)) \<subseteq> fv e"
    by (rule Aexp_edom)
  also(below_trans[OF eq_imp_below join_mono[OF below_refl ccProd_mono2[OF insert_mono] ]])
  have "cc_restr (edom (Aexp e\<cdot>(inc\<cdot>a))) (ccExp e\<cdot>(inc\<cdot>a)) \<sqsubseteq> ccExp e\<cdot>(inc\<cdot>a)"
    by (rule cc_restr_below_arg)
  also
  have "ccExp e\<cdot>(inc\<cdot>a) \<squnion> ccProd {x} (insert x (fv e)) \<sqsubseteq> ccExp (App e x)\<cdot>a"
    by (rule ccExp_App)
  finally
  have "ccApprox (many_calls x \<otimes>\<otimes> ccTTree (edom (Aexp e\<cdot>(inc\<cdot>a))) (ccExp e\<cdot>(inc\<cdot>a))) \<sqsubseteq> ccExp (App e x)\<cdot>a" by this simp_all
  }
  ultimately
  show "many_calls x \<otimes>\<otimes> Texp e\<cdot>(inc\<cdot>a) \<sqsubseteq> Texp (App e x)\<cdot>a"
    unfolding Texp_simp by (auto intro!: below_ccTTreeI)
next
  fix y e n
  show "without y (Texp e\<cdot>(pred\<cdot>n)) \<sqsubseteq> Texp (Lam [y]. e)\<cdot>n"
    unfolding Texp_simp
    by (auto dest: subsetD[OF Aexp_edom]
             intro!: below_ccTTreeI  below_trans[OF _ ccExp_Lam] cc_restr_mono1 subsetD[OF edom_mono[OF Aexp_Lam]])
next
  fix e y x a

  from edom_mono[OF Aexp_subst]
  have *: "edom (Aexp e[y::=x]\<cdot>a) \<subseteq> insert x (edom (Aexp e\<cdot>a) - {y})" by simp

  have "Texp e[y::=x]\<cdot>a = ccTTree (edom (Aexp e[y::=x]\<cdot>a)) (ccExp e[y::=x]\<cdot>a)"
    unfolding Texp_simp..
  also have "\<dots> \<sqsubseteq> ccTTree (insert x (edom (Aexp e\<cdot>a) - {y})) (ccExp e[y::=x]\<cdot>a)"
    by (rule ccTTree_mono1[OF *])
  also have "\<dots> \<sqsubseteq> many_calls x \<otimes>\<otimes> without x (\<dots>)"
    by (rule paths_many_calls_subset)
  also have "without x (ccTTree (insert x (edom (Aexp e\<cdot>a) - {y})) (ccExp e[y::=x]\<cdot>a))
    = ccTTree (edom (Aexp e\<cdot>a) - {y} - {x}) (ccExp e[y::=x]\<cdot>a)"
    by simp
  also have "\<dots> \<sqsubseteq> ccTTree (edom (Aexp e\<cdot>a) - {y} - {x}) (ccExp e\<cdot>a)"
    by (rule ccTTree_cong_below[OF ccExp_subst]) auto
  also have "\<dots> = without y (ccTTree (edom (Aexp e\<cdot>a) - {x}) (ccExp e\<cdot>a))"
    by simp (metis Diff_insert Diff_insert2)
  also have "ccTTree (edom (Aexp e\<cdot>a) - {x}) (ccExp e\<cdot>a) \<sqsubseteq> ccTTree (edom (Aexp e\<cdot>a)) (ccExp e\<cdot>a)"
    by (rule ccTTree_mono1) auto
  also have "\<dots> = Texp e\<cdot>a"
    unfolding Texp_simp..
  finally
  show "Texp e[y::=x]\<cdot>a \<sqsubseteq> many_calls x \<otimes>\<otimes> without y (Texp e\<cdot>a)"
    by this simp_all
next
  fix v a
  have "up\<cdot>a \<sqsubseteq> (Aexp (Var v)\<cdot>a) v" by (rule Aexp_Var)
  hence "v \<in> edom (Aexp (Var v)\<cdot>a)" by (auto simp add: edom_def)
  thus "single v \<sqsubseteq> Texp (Var v)\<cdot>a"
    unfolding Texp_simp
    by (auto intro: below_ccTTreeI)
next
  fix scrut e1 a e2
  have "ccTTree (edom (Aexp e1\<cdot>a)) (ccExp e1\<cdot>a) \<oplus>\<oplus> ccTTree (edom (Aexp e2\<cdot>a)) (ccExp e2\<cdot>a)
    \<sqsubseteq> ccTTree (edom (Aexp e1\<cdot>a) \<union> edom (Aexp e2\<cdot>a)) (ccExp e1\<cdot>a \<squnion> ccExp e2\<cdot>a)"
      by (rule either_ccTTree)
  note both_mono2'[OF this]
  also
  have "ccTTree (edom (Aexp scrut\<cdot>0)) (ccExp scrut\<cdot>0) \<otimes>\<otimes> ccTTree (edom (Aexp e1\<cdot>a) \<union> edom (Aexp e2\<cdot>a)) (ccExp e1\<cdot>a \<squnion> ccExp e2\<cdot>a)
    \<sqsubseteq> ccTTree (edom (Aexp scrut\<cdot>0) \<union> (edom (Aexp e1\<cdot>a) \<union> edom (Aexp e2\<cdot>a))) (ccExp scrut\<cdot>0 \<squnion> (ccExp e1\<cdot>a \<squnion> ccExp e2\<cdot>a) \<squnion> ccProd (edom (Aexp scrut\<cdot>0)) (edom (Aexp e1\<cdot>a) \<union> edom (Aexp e2\<cdot>a)))"
    by (rule interleave_ccTTree)
  also
  have "edom (Aexp scrut\<cdot>0) \<union> (edom (Aexp e1\<cdot>a) \<union> edom (Aexp e2\<cdot>a)) = edom (Aexp scrut\<cdot>0 \<squnion> Aexp e1\<cdot>a \<squnion> Aexp e2\<cdot>a)" by auto
  also
  have "Aexp scrut\<cdot>0 \<squnion> Aexp e1\<cdot>a \<squnion> Aexp e2\<cdot>a \<sqsubseteq> Aexp (scrut ? e1 : e2)\<cdot>a"
    by (rule Aexp_IfThenElse)
  also
  have "ccExp scrut\<cdot>0 \<squnion> (ccExp e1\<cdot>a \<squnion> ccExp e2\<cdot>a) \<squnion> ccProd (edom (Aexp scrut\<cdot>0)) (edom (Aexp e1\<cdot>a) \<union> edom (Aexp e2\<cdot>a)) \<sqsubseteq>
        ccExp (scrut ? e1 : e2)\<cdot>a"
    by (rule ccExp_IfThenElse)

  show "Texp scrut\<cdot>0 \<otimes>\<otimes> (Texp e1\<cdot>a \<oplus>\<oplus> Texp e2\<cdot>a) \<sqsubseteq> Texp (scrut ? e1 : e2)\<cdot>a"
    unfolding Texp_simp
    by (auto simp add: ccApprox_both join_below_iff  below_trans[OF _ join_above2]
             intro!: below_ccTTreeI below_trans[OF cc_restr_below_arg]
                     below_trans[OF _ ccExp_IfThenElse]  subsetD[OF edom_mono[OF Aexp_IfThenElse]])
next
  fix e
  assume "isVal e"
  hence [simp]: "ccExp e\<cdot>0 = ccSquare (fv e)" by (rule ccExp_pap)
  thus "repeatable (Texp e\<cdot>0)"
    unfolding Texp_simp by (auto intro: repeatable_ccTTree_ccSquare[OF Aexp_edom])
qed

definition Theap :: "heap \<Rightarrow> exp \<Rightarrow> Arity \<rightarrow> var ttree"
  where "Theap \<Gamma> e = (\<Lambda> a. if nonrec \<Gamma> then ccTTree (edom (Aheap \<Gamma> e\<cdot>a)) (ccExp e\<cdot>a) else ttree_restr (edom (Aheap \<Gamma> e\<cdot>a)) anything)"

lemma Theap_simp: "Theap \<Gamma> e\<cdot>a = (if nonrec \<Gamma> then ccTTree (edom (Aheap \<Gamma> e\<cdot>a)) (ccExp e\<cdot>a) else ttree_restr (edom (Aheap \<Gamma> e\<cdot>a)) anything)"
  unfolding Theap_def by simp

lemma carrier_Fheap':"carrier (Theap \<Gamma> e\<cdot>a) = edom (Aheap \<Gamma> e\<cdot>a)"
    unfolding Theap_simp carrier_ccTTree by simp

sublocale TTreeAnalysisCardinalityHeap Texp Aexp Aheap Theap
proof
  fix \<Gamma> e a
  show "carrier (Theap \<Gamma> e\<cdot>a) = edom (Aheap \<Gamma> e\<cdot>a)"
    by (rule carrier_Fheap')
next
  fix x \<Gamma> p e a
  assume "x \<in> thunks \<Gamma>"

  assume "\<not> one_call_in_path x p"
  hence "x \<in> set p" by (rule more_than_one_setD)

  assume "p \<in> paths (Theap \<Gamma> e\<cdot>a)" with \<open>x \<in> set p\<close>
  have "x \<in> carrier (Theap \<Gamma> e\<cdot>a)" by (auto simp add: Union_paths_carrier[symmetric])
  hence "x \<in> edom (Aheap \<Gamma> e\<cdot>a)"
    unfolding Theap_simp by (auto split: if_splits)

  show "(Aheap \<Gamma> e\<cdot>a) x = up\<cdot>0"
  proof(cases "nonrec \<Gamma>")
    case False
    from False \<open>x \<in> thunks \<Gamma>\<close>  \<open>x \<in> edom (Aheap \<Gamma> e\<cdot>a)\<close>
    show ?thesis  by (rule aHeap_thunks_rec)
  next
    case True
    with \<open>p \<in> paths (Theap \<Gamma> e\<cdot>a)\<close>
    have "p \<in> valid_lists (edom (Aheap \<Gamma> e\<cdot>a)) (ccExp e\<cdot>a)" by (simp add: Theap_simp)

    with \<open>\<not> one_call_in_path x p\<close>
    have "x--x\<in> (ccExp e\<cdot>a)" by (rule valid_lists_many_calls)

    from True \<open>x \<in> thunks \<Gamma>\<close> this
    show ?thesis by (rule aHeap_thunks_nonrec)
  qed
next
  fix \<Delta> e a

  have carrier: "carrier (substitute (Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a)) \<subseteq> edom (Aheap \<Delta> e\<cdot>a) \<union> edom (Aexp (Let \<Delta> e)\<cdot>a)"
  proof(rule carrier_substitute_below)
    from edom_mono[OF Aexp_Let[of \<Delta> e a]]
    show "carrier (Texp e\<cdot>a) \<subseteq> edom (Aheap \<Delta> e\<cdot>a) \<union> edom (Aexp (Let \<Delta> e)\<cdot>a)"  by (simp add: Texp_def)
  next
    fix x
    assume "x \<in> edom (Aheap \<Delta> e\<cdot>a) \<union> edom (Aexp (Let \<Delta> e)\<cdot>a)"
    hence "x \<in> edom (Aheap \<Delta> e\<cdot>a) \<or> x : (edom (Aexp (Let \<Delta> e)\<cdot>a))" by simp
    thus "carrier ((Texp.AnalBinds  \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) x) \<subseteq> edom (Aheap \<Delta> e\<cdot>a) \<union> edom (Aexp (Let \<Delta> e)\<cdot>a)"
    proof
      assume "x \<in> edom (Aheap \<Delta> e\<cdot>a)"

      have "carrier ((Texp.AnalBinds  \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) x) \<subseteq> edom (ABinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a))"
        by (rule carrier_AnalBinds_below)
      also have "\<dots> \<subseteq> edom (Aheap \<Delta> e\<cdot>a \<squnion> Aexp (Terms.Let \<Delta> e)\<cdot>a)"
        using edom_mono[OF Aexp_Let[of \<Delta> e a]] by simp
      finally show ?thesis by simp
    next
      assume "x \<in> edom (Aexp (Terms.Let \<Delta> e)\<cdot>a)"
      hence "x \<notin> domA \<Delta>" by (auto  dest: subsetD[OF Aexp_edom])
      hence "(Texp.AnalBinds  \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) x = \<bottom>"
        by (rule Texp.AnalBinds_not_there)
      thus ?thesis by simp
    qed
  qed

  show "ttree_restr (- domA \<Delta>) (substitute (Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a)) \<sqsubseteq> Texp (Let \<Delta> e)\<cdot>a"
  proof (rule below_trans[OF _ eq_imp_below[OF Texp_simp[symmetric]]], rule below_ccTTreeI)
    have "carrier (ttree_restr (- domA \<Delta>) (substitute (Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a)))
       = carrier (substitute (Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a)) - domA \<Delta>" by auto
    also note carrier
    also have "edom (Aheap \<Delta> e\<cdot>a) \<union> edom (Aexp (Terms.Let \<Delta> e)\<cdot>a) - domA \<Delta> = edom (Aexp (Let \<Delta> e)\<cdot>a)"
      by (auto dest: subsetD[OF edom_Aheap] subsetD[OF Aexp_edom])
    finally
    show "carrier (ttree_restr (- domA \<Delta>) (substitute (Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>)(Texp e\<cdot>a)))
          \<subseteq> edom (Aexp (Terms.Let \<Delta> e)\<cdot>a)" by this auto
  next
    let ?x = "ccApprox (ttree_restr (- domA \<Delta>) (substitute (Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a)))"

    have "?x = cc_restr (- domA \<Delta>) ?x"  by simp
    also have "\<dots> \<sqsubseteq> cc_restr (- domA \<Delta>) (ccHeap \<Delta> e\<cdot>a)"
    proof(rule cc_restr_mono2[OF wild_recursion_thunked])
      have "ccExp e\<cdot>a \<sqsubseteq> ccHeap \<Delta> e\<cdot>a" by (rule ccHeap_Exp)
      thus "ccApprox (Texp e\<cdot>a) \<sqsubseteq> ccHeap \<Delta> e\<cdot>a"
        by (auto simp add: Texp_simp intro: below_trans[OF cc_restr_below_arg])
    next
      fix x
      assume "x \<notin> domA \<Delta>"
      thus "(Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) x = empty"
        by (metis Texp.AnalBinds_not_there empty_is_bottom)
    next
      fix x
      assume "x \<in> domA \<Delta>"
      then obtain e' where e': "map_of \<Delta> x = Some e'" by (metis domA_map_of_Some_the)

      show "ccApprox ((Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) x) \<sqsubseteq> ccHeap \<Delta> e\<cdot>a"
      proof(cases "(Aheap \<Delta> e\<cdot>a) x")
        case bottom thus ?thesis using e' by (simp add: Texp.AnalBinds_lookup)
      next
        case (up a')
        with e'
        have "ccExp e'\<cdot>a' \<sqsubseteq> ccHeap \<Delta> e\<cdot>a" by (rule ccHeap_Heap)
        thus ?thesis using up e'
          by (auto simp add: Texp.AnalBinds_lookup Texp_simp  intro: below_trans[OF cc_restr_below_arg])
      qed

      show "ccProd (ccNeighbors x (ccHeap \<Delta> e\<cdot>a)- {x} \<inter> thunks \<Delta>) (carrier ((Texp.AnalBinds  \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) x)) \<sqsubseteq> ccHeap \<Delta> e\<cdot>a"
      proof(cases "(Aheap \<Delta> e\<cdot>a) x")
        case bottom thus ?thesis using e' by (simp add: Texp.AnalBinds_lookup)
      next
        case (up a')
        have subset: "(carrier (fup\<cdot>(Texp e')\<cdot>((Aheap \<Delta> e\<cdot>a) x))) \<subseteq> fv e'"
          using up e' by (auto simp add: Texp.AnalBinds_lookup carrier_Fexp dest!: subsetD[OF Aexp_edom])

        from e' up
        have "ccProd (fv e') (ccNeighbors x (ccHeap \<Delta> e\<cdot>a) - {x} \<inter> thunks \<Delta>) \<sqsubseteq> ccHeap \<Delta> e\<cdot>a"
          by (rule ccHeap_Extra_Edges)
        then
        show ?thesis using e'
          by (simp add: Texp.AnalBinds_lookup  Texp_simp ccProd_comm  below_trans[OF ccProd_mono2[OF subset]])
      qed
    qed
    also have "\<dots> \<sqsubseteq> ccExp (Let \<Delta> e)\<cdot>a"
      by (rule ccExp_Let)
    finally
    show "ccApprox (ttree_restr (- domA \<Delta>) (substitute (Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a)))
        \<sqsubseteq> ccExp (Terms.Let \<Delta> e)\<cdot>a" by this simp_all
  qed

  note carrier
  hence "carrier (substitute (ExpAnalysis.AnalBinds Texp \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a)) \<subseteq> edom (Aheap \<Delta> e\<cdot>a) \<union> - domA \<Delta>"
    by (rule order_trans) (auto dest: subsetD[OF Aexp_edom])
  hence "ttree_restr (domA \<Delta>)            (substitute (Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a))
      = ttree_restr (edom (Aheap \<Delta> e\<cdot>a)) (ttree_restr (domA \<Delta>) (substitute (Texp.AnalBinds  \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a)))"
    by -(rule ttree_restr_noop[symmetric], auto)
  also
  have "\<dots> = ttree_restr (edom (Aheap \<Delta> e\<cdot>a)) (substitute (Texp.AnalBinds  \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a))"
    by (simp add: inf.absorb2[OF edom_Aheap ])
  also
  have "\<dots> \<sqsubseteq> Theap \<Delta> e \<cdot>a"
  proof(cases "nonrec \<Delta>")
    case False
    have "ttree_restr (edom (Aheap \<Delta> e\<cdot>a)) (substitute (Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a))
      \<sqsubseteq> ttree_restr (edom (Aheap \<Delta> e\<cdot>a)) anything"
      by (rule ttree_restr_mono) simp
    also have "\<dots> = Theap \<Delta> e\<cdot>a"
      by (simp add: Theap_simp False)
    finally show ?thesis.
  next
    case [simp]: True

    from True
    have "ttree_restr (edom (Aheap \<Delta> e\<cdot>a)) (substitute (Texp.AnalBinds \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a))
       = ttree_restr (edom (Aheap \<Delta> e\<cdot>a)) (Texp e\<cdot>a)"
      by (rule nonrecE) (rule ttree_rest_substitute, auto simp add: carrier_Fexp fv_def fresh_def dest!: subsetD[OF edom_Aheap] subsetD[OF Aexp_edom])
    also have "\<dots> = ccTTree (edom (Aexp e\<cdot>a) \<inter> edom (Aheap \<Delta> e\<cdot>a)) (ccExp e\<cdot>a)"
      by (simp add: Texp_simp)
    also have "\<dots> \<sqsubseteq> ccTTree (edom (Aexp e\<cdot>a) \<inter> domA \<Delta>) (ccExp e\<cdot>a)"
      by (rule ccTTree_mono1[OF Int_mono[OF order_refl edom_Aheap]])
    also have "\<dots> \<sqsubseteq> ccTTree (edom (Aheap \<Delta> e\<cdot>a)) (ccExp e\<cdot>a)"
      by (rule ccTTree_mono1[OF edom_mono[OF Aheap_nonrec[OF True], simplified]])
    also have "\<dots> \<sqsubseteq> Theap \<Delta> e\<cdot>a"
      by (simp add: Theap_simp)
    finally
    show ?thesis by this simp_all
  qed
  finally
  show "ttree_restr (domA \<Delta>) (substitute (ExpAnalysis.AnalBinds Texp \<Delta>\<cdot>(Aheap \<Delta> e\<cdot>a)) (thunks \<Delta>) (Texp e\<cdot>a)) \<sqsubseteq> Theap \<Delta> e\<cdot>a".

qed
end

(* TODO: Unused stuff from here, mostly about singles. Might be useful later. *)

lemma paths_singles: "xs \<in> paths (singles S) \<longleftrightarrow> (\<forall>x \<in> S. one_call_in_path x xs)"
  by transfer (auto simp add: one_call_in_path_filter_conv)

lemma paths_singles': "xs \<in> paths (singles S) \<longleftrightarrow> (\<forall>x \<in> (set xs \<inter> S). one_call_in_path x xs)"
  apply transfer
  apply (auto simp add: one_call_in_path_filter_conv)
  apply (erule_tac x = x in ballE)
  apply auto
  by (metis (poly_guards_query) filter_empty_conv le0 length_0_conv)

lemma both_below_singles1:
  assumes "t \<sqsubseteq> singles S"
  assumes "carrier t' \<inter> S = {}"
  shows "t \<otimes>\<otimes> t' \<sqsubseteq> singles S"
proof (rule ttree_belowI)
  fix xs
  assume "xs \<in> paths (t \<otimes>\<otimes> t')"
  then obtain ys zs where "ys \<in> paths t" and "zs \<in> paths t'" and "xs \<in> ys \<otimes> zs" by (auto simp add: paths_both)
  with assms
  have "ys \<in> paths (singles S)" and "set zs \<inter> S = {}"
    by (metis below_ttree.rep_eq contra_subsetD paths.rep_eq, auto simp add: Union_paths_carrier[symmetric])
  with \<open>xs \<in> ys \<otimes> zs\<close>
  show "xs \<in> paths (singles S)"
    by (induction) (auto simp add: paths_singles no_call_in_path_set_conv interleave_set dest: more_than_one_setD split: if_splits)
qed

lemma paths_ttree_restr_singles: "xs \<in> paths (ttree_restr S' (singles S)) \<longleftrightarrow> set xs \<subseteq> S' \<and> (\<forall>x \<in> S. one_call_in_path x xs)"
proof
  show "xs \<in> paths (ttree_restr S' (singles S)) \<Longrightarrow>  set xs \<subseteq> S' \<and> (\<forall>x \<in> S. one_call_in_path x xs)"
    by (auto simp add: filter_paths_conv_free_restr[symmetric] paths_singles)
next
  assume *: "set xs \<subseteq> S' \<and> (\<forall>x\<in>S. one_call_in_path x xs)"
  hence "set xs \<subseteq> S'" by auto
  hence [simp]: "filter (\<lambda> x'. x' \<in> S') xs = xs" by (auto simp add: filter_id_conv)

  from *
  have "xs \<in> paths (singles S)"
     by (auto simp add: paths_singles')
  hence "filter (\<lambda> x'. x' \<in> S') xs \<in> filter (\<lambda>x'. x' \<in> S') ` paths (singles S)"
    by (rule imageI)
  thus "xs \<in> paths (ttree_restr S' (singles S))"
    by (auto simp add: filter_paths_conv_free_restr[symmetric] )
qed

(* TODO: unused *)
lemma substitute_not_carrier:
  assumes "x \<notin> carrier t"
  assumes "\<And> x'. x \<notin> carrier (f x')"
  shows "x \<notin>  carrier (substitute f T t)"
proof-
  have "ttree_restr ({x}) (substitute f T t) = ttree_restr ({x}) t"
  proof(rule ttree_rest_substitute)
    fix x'
    from \<open>x \<notin> carrier (f x')\<close>
    show "carrier (f x') \<inter> {x} = {}" by auto
  qed
  hence "x \<notin> carrier (ttree_restr ({x}) (substitute f T t)) \<longleftrightarrow> x \<notin> carrier (ttree_restr ({x}) t)" by metis
  with assms(1)
  show ?thesis by simp
qed

(* TODO: unused *)
lemma substitute_below_singlesI:
  assumes "t \<sqsubseteq> singles S"
  assumes "\<And> x. carrier (f x) \<inter> S = {}"
  shows "substitute f T t \<sqsubseteq> singles S"
proof(rule ttree_belowI)
  fix xs
  assume "xs \<in> paths (substitute f T t)"
  thus "xs \<in> paths (singles S)"
  using assms
  proof(induction f T t xs arbitrary: S rule: substitute_induct)
    case Nil
    thus ?case by simp
  next
    case (Cons f T t x xs)

    from \<open>x#xs \<in> _\<close>
    have xs: "xs \<in> paths (substitute (f_nxt f T x) T (nxt t x \<otimes>\<otimes> f x))" by auto
    moreover

    from \<open>t \<sqsubseteq> singles S\<close>
    have "nxt t x \<sqsubseteq> singles S"
      by (metis "TTree-HOLCF.nxt_mono" below_trans nxt_singles_below_singles)
    from this \<open>carrier (f x) \<inter> S = {}\<close>
    have "nxt t x \<otimes>\<otimes> f x \<sqsubseteq> singles S"
      by (rule both_below_singles1)
    moreover
    { fix x'
      from  \<open>carrier (f x') \<inter> S = {}\<close>
      have "carrier (f_nxt f T x x') \<inter> S = {}"
        by (auto simp add: f_nxt_def)
    }
    ultimately
    have IH: "xs \<in> paths (singles S)"
      by (rule Cons.IH)

  show ?case
    proof(cases "x \<in> S")
      case True
      with \<open>carrier (f x) \<inter> S = {}\<close>
      have "x \<notin> carrier (f x)" by auto
      moreover
      from \<open>t \<sqsubseteq> singles S\<close>
      have "nxt t x \<sqsubseteq> nxt (singles S) x" by (rule nxt_mono)
      hence "carrier (nxt t x) \<subseteq> carrier (nxt (singles S) x)" by (rule carrier_mono)
      from subsetD[OF this] True
      have "x \<notin> carrier (nxt t x)" by auto
      ultimately
      have "x \<notin> carrier (nxt t x \<otimes>\<otimes> f x)" by simp
      hence "x \<notin> carrier (substitute (f_nxt f T x) T (nxt t x \<otimes>\<otimes> f x))"
      proof(rule substitute_not_carrier)
        fix x'
        from \<open>carrier (f x') \<inter> S = {}\<close> \<open>x \<in> S\<close>
        show "x \<notin> carrier (f_nxt f T x x')" by (auto simp add: f_nxt_def)
      qed
      with xs
      have "x \<notin> set xs" by (auto simp add: Union_paths_carrier[symmetric])
      with IH
      have "xs \<in> paths (without x (singles S))" by (rule paths_withoutI)
      thus ?thesis using True by (simp add: Cons_path)
    next
      case False
      with IH
      show ?thesis by (simp add: Cons_path)
    qed
  qed
qed

end


section \<open>Implementation of Relabel-to-Front\<close>
theory Relabel_To_Front_Impl
imports
  Relabel_To_Front
  Prpu_Common_Impl
begin

subsection \<open>Basic Operations\<close>

context Network_Impl
begin

subsubsection \<open>Neighbor Lists\<close>
definition n_init :: "(node \<Rightarrow> node list) \<Rightarrow> (node \<Rightarrow> node list) nres"
  where "n_init am \<equiv> return (am( s := [], t := []) )"

definition n_at_end :: "(node \<Rightarrow> node list) \<Rightarrow> node \<Rightarrow> bool nres"
  where "n_at_end n u \<equiv> do {
    assert (u\<in>V-{s,t});
    return (n u = [])
  }"

definition n_get_hd :: "(node \<Rightarrow> node list) \<Rightarrow> node \<Rightarrow> node nres"
  where "n_get_hd n u \<equiv> do {
    assert (u\<in>V-{s,t} \<and> n u \<noteq> []);
    return (hd (n u))
  }"

definition n_move_next
  :: "(node \<Rightarrow> node list) \<Rightarrow> node \<Rightarrow> (node \<Rightarrow> node list) nres"
  where "n_move_next n u \<equiv> do {
    assert (u\<in>V-{s,t} \<and> n u \<noteq> []);
    return (n (u := tl (n u)))
  }"

definition n_reset
  :: "(node \<Rightarrow> node list) \<Rightarrow> (node \<Rightarrow> node list) \<Rightarrow> node
    \<Rightarrow> (node \<Rightarrow> node list) nres"
  where "n_reset am n u \<equiv> do {
    assert (u\<in>V-{s,t});
    return (n (u := am u))
  }"

lemma n_init_refine[refine2]:
  assumes AM: "is_adj_map am"
  shows "n_init am
    \<le> (spec c. (c, rtf_init_n) \<in> (nat_rel \<rightarrow> \<langle>nat_rel\<rangle>list_set_rel))"
proof -
  have[simp]: "am v = []" if "v\<notin>V" for v
  proof -
    from that have "adjacent_nodes v = {}"
      unfolding adjacent_nodes_def using E_ss_VxV by auto
    thus ?thesis using am_to_adj_nodes_refine[OF AM]
      by (auto simp: list_set_rel_def in_br_conv)
  qed
  show ?thesis
    unfolding n_init_def rtf_init_n_def
    by (auto
        simp: pw_le_iff refine_pw_simps list_set_autoref_empty
        simp: am_to_adj_nodes_refine[OF AM])
qed

subsection \<open>Refinement to Basic Operations\<close>

subsubsection \<open>Discharge\<close>
definition "discharge2 am x cf l n u \<equiv> do {
  assert (u \<in> V);
  monadic_WHILEIT (\<lambda>_. True)
    (\<lambda>((x,cf),l,n). do { xu \<leftarrow> x_get x u; return (xu \<noteq> 0) } )
    (\<lambda>((x,cf),l,n). do {
      at_end \<leftarrow> n_at_end n u;
      if at_end then do {
        l \<leftarrow> relabel2 am cf l u;
        n \<leftarrow> n_reset am n u;
        return ((x,cf),l,n)
      } else do {
        v \<leftarrow> n_get_hd n u;
        cfuv \<leftarrow> cf_get cf (u,v);
        lu \<leftarrow> l_get l u;
        lv \<leftarrow> l_get l v;
        if (cfuv \<noteq> 0 \<and> lu = lv + 1) then do {
          (x,cf) \<leftarrow> push2 x cf (u,v);
          return ((x,cf),l,n)
        } else do {
          n \<leftarrow> n_move_next n u;
          return ((x,cf),l,n)
        }
      }
    }) ((x,cf),l,n)
}"

lemma discharge_structure_refine_aux:
  assumes SR: "(ni,n)\<in>nat_rel \<rightarrow> \<langle>nat_rel\<rangle>list_set_rel"
  assumes SU: "(ui,u)\<in>Id"
  assumes fNR: "fNi \<le> \<Down>R fN"
  assumes UIV: "u\<in>V-{s,t}"
  assumes fSR: "\<And>v vi vs. \<lbrakk>
      (vi,v)\<in>Id; v\<in>n u; ni u = v#vs; (v#vs,n u)\<in>\<langle>nat_rel\<rangle>list_set_rel
    \<rbrakk> \<Longrightarrow> fSi vi \<le> \<Down>R (fS v)"
  shows
  "( do {
    at_end \<leftarrow> n_at_end ni ui;
    if at_end then fNi
    else do {
      v \<leftarrow> n_get_hd ni ui;
      fSi v
    }
  } ) \<le> \<Down>R (

  do {
    v \<leftarrow> select v. v\<in>n u;
    case v of
      None \<Rightarrow> fN
    | Some v \<Rightarrow> fS v
  })" (is "?lhs \<le>\<Down>R ?rhs")
  unfolding n_at_end_def n_get_hd_def
  apply (simp only: nres_monad_laws)
  apply (cases "ni u")
  subgoal
    using fun_relD[OF SR SU] SU UIV fNR
    by (auto simp: list_set_rel_def in_br_conv pw_le_iff refine_pw_simps)

  subgoal for v vs
    using fun_relD[OF SR SU] SU UIV
    using fSR[OF IdI[of v], of vs]
    apply (clarsimp
        simp: list_set_rel_def in_br_conv pw_le_iff refine_pw_simps
        split: option.splits)
    by fastforce
  done

lemma xf_rel_RELATES[refine_dref_RELATES]: "RELATES xf_rel"
  by (auto simp: RELATES_def)

lemma discharge2_refine[refine]:
  assumes A: "((x,cf),f) \<in> xf_rel"
  assumes AM: "(am,adjacent_nodes)\<in>nat_rel\<rightarrow>\<langle>nat_rel\<rangle>list_set_rel"
  assumes [simplified,simp]: "(li,l)\<in>Id" "(ui,u)\<in>Id"
  assumes NR: "(ni,n)\<in>nat_rel \<rightarrow> \<langle>nat_rel\<rangle>list_set_rel"
  shows "discharge2 am x cf li ni ui
    \<le> \<Down>(xf_rel \<times>\<^sub>r Id \<times>\<^sub>r (nat_rel \<rightarrow> \<langle>nat_rel\<rangle>list_set_rel)) (discharge f l n u)"
  unfolding discharge2_def discharge_def
  apply (rewrite in "monadic_WHILEIT _ _ \<hole> _" vcg_intro_frame)
  apply refine_rcg
  apply (vc_solve simp: A NR)
  subgoal by (simp add: xf_rel_def x_get_def)
  subgoal for f l n x cf ni
    apply (subst vcg_rem_frame)
    unfolding n_reset_def cf_get_def l_get_def n_move_next_def
    apply (simp only: nres_monad_laws)
    apply (rule discharge_structure_refine_aux; (refine_vcg AM)?; (assumption)?)
    apply (vc_solve simp: fun_relD fun_relD[OF AM])
    subgoal for v vs unfolding xf_rel_def Graph.E_def by auto
    subgoal for v vs by (auto simp: list_set_rel_def in_br_conv)
    done
  done

subsubsection \<open> Initialization of Queue \<close>

lemma V_is_adj_nodes: "V = { v . adjacent_nodes v \<noteq> {} }"
  unfolding V_def adjacent_nodes_def by auto

definition "init_CQ am \<equiv> do {
  let cardV=0;
  let Q=[];
  nfoldli [0..<N] (\<lambda>_. True) (\<lambda>v (cardV,Q). do {
    assert (v<N);
    inV \<leftarrow> am_is_in_V am v;
    if inV then do {
      let cardV = cardV + 1;
      if v\<noteq>s \<and> v\<noteq>t then
        return (cardV,v#Q)
      else
        return (cardV,Q)
    } else
      return (cardV,Q)
  }) (cardV,Q)
}"

lemma init_CQ_correct[THEN order_trans, refine_vcg]:
  assumes AM: "is_adj_map am"
  shows "init_CQ am \<le> SPEC (\<lambda>(C,Q). C = card V \<and> distinct Q \<and> set Q = V-{s,t})"
  unfolding init_CQ_def
  apply (refine_vcg
      nfoldli_rule[where
        I="\<lambda>l1 _ (C,Q).
             C = card (V\<inter>set l1) \<and> distinct Q \<and> set Q = (V\<inter>set l1)-{s,t} "]
      )
  apply (clarsimp_all simp: am_to_adj_nodes_refine[OF AM])
  using V_ss by (auto simp: upt_eq_lel_conv Int_absorb2)

subsubsection \<open>Main Algorithm\<close>

definition "relabel_to_front2 am \<equiv> do {
  (cardV, L_right) \<leftarrow> init_CQ am;

  xcf \<leftarrow> pp_init_xcf2 am;
  l \<leftarrow> l_init cardV;
  n \<leftarrow> n_init am;

  let L_left=[];

  ((x,cf),l,n,L_left,L_right) \<leftarrow> while\<^sub>T
    (\<lambda>((x,cf),l,n,L_left,L_right). L_right \<noteq> [])
    (\<lambda>((x,cf),l,n,L_left,L_right). do {
      assert (L_right \<noteq> []);
      let u = hd L_right;
      old_lu \<leftarrow> l_get l u;

      ((x,cf),l,n) \<leftarrow> discharge2 am x cf l n u;

      lu \<leftarrow> l_get l u;
      if (lu \<noteq> old_lu) then do {
        \<comment> \<open>Move \<open>u\<close> to front of \<open>l\<close>, and restart scanning \<open>L\<close>. The cost for\<close>
        \<comment> \<open>\<open>rev_append\<close> is amortized by going to next node in \<open>L\<close>\<close>
        let (L_left,L_right) = ([u],rev_append L_left (tl L_right));
        return ((x,cf),l,n,L_left,L_right)
      } else do {
        \<comment> \<open>Goto next node in \<open>L\<close>\<close>
        let (L_left,L_right) = (u#L_left, tl L_right);
        return ((x,cf),l,n,L_left,L_right)
      }

    }) (xcf,l,n,L_left,L_right);

  return cf
}"

lemma relabel_to_front2_refine[refine]:
  assumes AM: "is_adj_map am"
  shows "relabel_to_front2 am
    \<le> \<Down>(br (flow_of_cf) (RPreGraph c s t)) relabel_to_front"
proof -
  define s_rel
    :: "( _ \<times> (
       capacity_impl flow
    \<times> (nat\<Rightarrow>nat)
    \<times> (node\<Rightarrow>node set)
    \<times> node list
    \<times> node list)) set"
    where "s_rel \<equiv>
       xf_rel
    \<times>\<^sub>r Id
    \<times>\<^sub>r (nat_rel \<rightarrow> \<langle>nat_rel\<rangle>list_set_rel)
    \<times>\<^sub>r br rev (\<lambda>_. True)
    \<times>\<^sub>r Id"

  have [refine_dref_RELATES]: "RELATES s_rel" unfolding RELATES_def ..

  {
    fix f l n
    assume "neighbor_invar c s t f l n"
    then interpret neighbor_invar c s t f l n .
    have G1: "flow_of_cf cf = f" by (rule fo_rg_inv)
    have G2: "RPreGraph c s t cf" by (rule is_RPreGraph)
    note G1 G2
  } note AUX1=this

  have AUXR: "do {
      (cardV, L_right) \<leftarrow> init_CQ am;
      xcf \<leftarrow> pp_init_xcf2 am;
      l \<leftarrow> l_init cardV;
      n \<leftarrow> n_init am;
      Fi L_right xcf l n
    }
    \<le> \<Down>R (do {
      L_right \<leftarrow> spec l. distinct l \<and> set l = V - {s, t};
      F L_right
    })
  "
  if "\<And>L_right xcf n.
    \<lbrakk> (xcf,pp_init_f)\<in>xf_rel; (n,rtf_init_n) \<in> nat_rel \<rightarrow> \<langle>nat_rel\<rangle>list_set_rel \<rbrakk>
    \<Longrightarrow> Fi L_right xcf pp_init_l n \<le> \<Down>R (F L_right)"
  for Fi F R
    unfolding l_init_def
    apply (rule refine2specI)
    supply pp_init_xcf2_refine
            [OF AM, unfolded conc_fun_RETURN, THEN order_trans, refine_vcg]
    supply n_init_refine[OF AM,THEN order_trans, refine_vcg]
    apply (refine_vcg AM V_ss)
    apply clarsimp
    subgoal for L_right x cf n
      using that[of "(x,cf)" n L_right]
      unfolding pp_init_l_def
      by (clarsimp simp: pw_le_iff refine_pw_simps; meson)
    done
  show ?thesis
    unfolding relabel_to_front2_def relabel_to_front_def Let_def l_get_def
    apply (simp only: nres_monad_laws)
    apply (rule AUXR)
    apply (refine_rcg)
    apply refine_dref_type
    unfolding s_rel_def
    apply (vc_solve
        simp: in_br_conv rev_append_eq xf_rel_def AUX1 fun_relD
        simp: am_to_adj_nodes_refine[OF AM])
    done
qed

subsection \<open>Refinement to Efficient Data Structures\<close>

context includes Network_Impl_Sepref_Register
begin
  sepref_register n_init
  sepref_register n_at_end
  sepref_register n_get_hd
  sepref_register n_move_next
  sepref_register n_reset
  sepref_register discharge2
  sepref_register "init_CQ"
  sepref_register relabel_to_front2
end

subsubsection \<open>Neighbor Lists by Array of Lists\<close>
definition "n_assn \<equiv> is_nf N ([]::nat list)"

definition (in -) "n_init_impl s t am \<equiv> do {
  n \<leftarrow> array_copy am;
  n \<leftarrow> Array.upd s [] n;
  n \<leftarrow> Array.upd t [] n;
  return n
}"

lemma [sepref_fr_rules]:
  "(n_init_impl s t,PR_CONST n_init) \<in> am_assn\<^sup>k \<rightarrow>\<^sub>a n_assn"
  apply sepref_to_hoare
  unfolding am_assn_def n_assn_def n_init_impl_def n_init_def
  by (sep_auto)

definition (in -) "n_at_end_impl n u \<equiv> do {
  nu \<leftarrow> Array.nth n u;
  return (is_Nil nu)
}"

lemma [sepref_fr_rules]:
  "(uncurry n_at_end_impl, uncurry (PR_CONST n_at_end))
  \<in> n_assn\<^sup>k *\<^sub>a node_assn\<^sup>k \<rightarrow>\<^sub>a bool_assn"
  apply sepref_to_hoare unfolding n_at_end_impl_def n_at_end_def n_assn_def
  by (sep_auto simp: refine_pw_simps split: list.split)

definition (in -) "n_get_hd_impl n u \<equiv> do {
  nu \<leftarrow> Array.nth n u;
  return (hd nu)
}"
lemma [sepref_fr_rules]:
  "(uncurry n_get_hd_impl, uncurry (PR_CONST n_get_hd))
  \<in> n_assn\<^sup>k *\<^sub>a node_assn\<^sup>k \<rightarrow>\<^sub>a node_assn"
  apply sepref_to_hoare unfolding n_get_hd_impl_def n_get_hd_def n_assn_def
  by (sep_auto simp: refine_pw_simps)

definition (in -) "n_move_next_impl n u \<equiv> do {
  nu \<leftarrow> Array.nth n u;
  n \<leftarrow> Array.upd u (tl nu) n;
  return n
}"
lemma [sepref_fr_rules]:
  "(uncurry n_move_next_impl, uncurry (PR_CONST n_move_next))
  \<in> n_assn\<^sup>d *\<^sub>a node_assn\<^sup>k \<rightarrow>\<^sub>a n_assn"
  apply sepref_to_hoare
  unfolding n_move_next_impl_def n_move_next_def n_assn_def
  by (sep_auto simp: refine_pw_simps)

definition (in -) "n_reset_impl am n u \<equiv> do {
  nu \<leftarrow> Array.nth am u;
  n \<leftarrow> Array.upd u nu n;
  return n
}"
lemma [sepref_fr_rules]:
  "(uncurry2 n_reset_impl, uncurry2 (PR_CONST n_reset))
  \<in> am_assn\<^sup>k *\<^sub>a n_assn\<^sup>d *\<^sub>a node_assn\<^sup>k \<rightarrow>\<^sub>a n_assn"
  apply sepref_to_hoare
  unfolding n_reset_impl_def n_reset_def n_assn_def am_assn_def
  by (sep_auto simp: refine_pw_simps)

subsubsection \<open>Discharge\<close>
sepref_thm discharge_impl is "uncurry5 (PR_CONST discharge2)"
  :: "am_assn\<^sup>k *\<^sub>a x_assn\<^sup>d *\<^sub>a cf_assn\<^sup>d *\<^sub>a l_assn\<^sup>d *\<^sub>a n_assn\<^sup>d *\<^sub>a node_assn\<^sup>k
    \<rightarrow>\<^sub>a (x_assn \<times>\<^sub>a cf_assn) \<times>\<^sub>a l_assn \<times>\<^sub>a n_assn"
  unfolding discharge2_def PR_CONST_def
  by sepref
concrete_definition (in -) discharge_impl
  uses Network_Impl.discharge_impl.refine_raw is "(uncurry5 ?f,_)\<in>_"
lemmas [sepref_fr_rules] = discharge_impl.refine[OF Network_Impl_axioms]

subsubsection \<open>Initialization of Queue\<close>

sepref_thm init_CQ_impl is "(PR_CONST init_CQ)"
  :: "am_assn\<^sup>k \<rightarrow>\<^sub>a nat_assn \<times>\<^sub>a list_assn nat_assn"
  unfolding init_CQ_def PR_CONST_def
  apply (rewrite HOL_list.fold_custom_empty)
  by sepref
concrete_definition (in -) init_CQ_impl
  uses Network_Impl.init_CQ_impl.refine_raw is "(?f,_)\<in>_"
lemmas [sepref_fr_rules] = init_CQ_impl.refine[OF Network_Impl_axioms]

subsubsection \<open>Main Algorithm\<close>
sepref_thm relabel_to_front_impl is
  "(PR_CONST relabel_to_front2)" :: "am_assn\<^sup>k \<rightarrow>\<^sub>a cf_assn"
  unfolding relabel_to_front2_def PR_CONST_def
  supply [[goals_limit = 1]]
  apply (rewrite in "Let [] _" HOL_list.fold_custom_empty)
  apply (rewrite in "[_]" HOL_list.fold_custom_empty)
  by sepref
concrete_definition (in -) relabel_to_front_impl
  uses Network_Impl.relabel_to_front_impl.refine_raw is "(?f,_)\<in>_"
lemmas [sepref_fr_rules] = relabel_to_front_impl.refine[OF Network_Impl_axioms]

end \<comment> \<open>Network Implementation Locale\<close>

export_code relabel_to_front_impl checking SML_imp

subsection \<open>Combination with Network Checker and Correctness\<close>
context Network_Impl begin

  theorem relabel_to_front_impl_correct[sep_heap_rules]:
    assumes AM: "is_adj_map am"
    shows "
      <am_assn am ami>
        relabel_to_front_impl c s t N ami
      <\<lambda>cfi. \<exists>\<^sub>Acf. cf_assn cf cfi
                * \<up>(isMaxFlow (flow_of_cf cf) \<and> RGraph_Impl c s t N cf)>\<^sub>t"
  proof -
    note relabel_to_front2_refine[OF AM]
    also note relabel_to_front_correct
    finally have R1:
      "relabel_to_front2 am
      \<le> \<Down> (br flow_of_cf (RPreGraph c s t)) (SPEC isMaxFlow)" .

    have [simp]: "nofail (\<Down>R (RES X))" for R X by (auto simp: refine_pw_simps)

    note R2 = relabel_to_front_impl.refine[
      OF Network_Impl_axioms, to_hnr, unfolded autoref_tag_defs]
    note R3 = hn_refine_ref[OF R1 R2, of ami]
    note R4 = R3[unfolded hn_ctxt_def pure_def, THEN hn_refineD, simplified]

    note RGII = rgraph_and_network_impl_imp_rgraph_impl[OF
      RPreGraph.maxflow_imp_rgraph
      Network_Impl_axioms
        ]

    show ?thesis
      by (sep_auto heap: R4 simp: pw_le_iff refine_pw_simps in_br_conv RGII)
  qed
end

definition "relabel_to_front_impl_tab_am c s t N am \<equiv> do {
  ami \<leftarrow> Array.make N am;  \<comment> \<open>TODO/DUP: Called \<open>init_ps\<close> in Edmonds-Karp impl\<close>
  relabel_to_front_impl c s t N ami
}"

theorem relabel_to_front_impl_tab_am_correct[sep_heap_rules]:
  assumes NW: "Network c s t"
  assumes VN: "Graph.V c \<subseteq> {0..<N}"
  assumes ABS_PS: "Graph.is_adj_map c am"
  shows "
    <emp>
      relabel_to_front_impl_tab_am c s t N am
    <\<lambda>cfi. \<exists>\<^sub>Acf.
        asmtx_assn N id_assn cf cfi
      * \<up>(Network.isMaxFlow c s t (Network.flow_of_cf c cf)
        \<and> RGraph_Impl c s t N cf
        )>\<^sub>t"
proof -
  interpret Network c s t by fact
  interpret Network_Impl c s t N using VN by unfold_locales

  from ABS_PS have [simp]: "am u = []" if "u\<ge>N" for u
    unfolding is_adj_map_def
    using E_ss_VxV VN that
    apply (subgoal_tac "u\<notin>V")
    by (auto simp del: inV_less_N)

  show ?thesis
    unfolding relabel_to_front_impl_tab_am_def
    apply vcg
    apply (rule
        Hoare_Triple.cons_rule[OF _ _ relabel_to_front_impl_correct[OF ABS_PS]])
    subgoal unfolding am_assn_def is_nf_def by sep_auto
    subgoal unfolding cf_assn_def by sep_auto
    done
qed

definition "relabel_to_front el s t \<equiv> do {
  case prepareNet el s t of
    None \<Rightarrow> return None
  | Some (c,am,N) \<Rightarrow> do {
      cf \<leftarrow> relabel_to_front_impl_tab_am c s t N am;
      return (Some (c,am,N,cf))
  }
}"
export_code relabel_to_front checking SML_imp

text \<open>
  Main correctness statement:
  \<^item> If \<open>relabel_to_front\<close> returns \<open>None\<close>, the edge list was invalid or described
    an invalid network.
  \<^item> If it returns \<open>Some (c,am,N,cfi)\<close>, then the edge list is valid and describes
    a valid network. Moreover, \<open>cfi\<close> is an integer square matrix of
    dimension \<open>N\<close>, which describes a valid residual graph in the network, whose
    corresponding flow is maximal. Finally, \<open>am\<close> is a valid adjacency map of the
    graph, and the nodes of the graph are integers less than \<open>N\<close>.
\<close>
theorem relabel_to_front_correct:
  "<emp>
  relabel_to_front el s t
  <\<lambda>
    None \<Rightarrow> \<up>(\<not>ln_invar el \<or> \<not>Network (ln_\<alpha> el) s t)
  | Some (c,am,N,cfi) \<Rightarrow>
      \<up>(c = ln_\<alpha> el \<and> ln_invar el)
    * (\<exists>\<^sub>Acf. asmtx_assn N int_assn cf cfi
          * \<up>(RGraph_Impl c s t N cf
            \<and> Network.isMaxFlow c s t (Network.flow_of_cf c cf)))
    * \<up>(Graph.is_adj_map c am)
  >\<^sub>t
  "
  unfolding relabel_to_front_def
  using prepareNet_correct[of el s t]
  by (sep_auto simp: ln_rel_def in_br_conv)

end


(*  Title:      HOL/Auth/n_mutualEx.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

theory n_mutualEx imports n_mutualEx_lemma_invs_on_rules n_mutualEx_on_inis
begin
lemma main:
assumes a1: "s \<in> reachableSet {andList (allInitSpecs N)} (rules N)"
and a2: "0 < N"
shows "\<forall> f. f \<in> (invariants N) --> formEval f s"
proof (rule consistentLemma)
show "consistent (invariants N) {andList (allInitSpecs N)} (rules N)"
proof (cut_tac a1, unfold consistent_def, rule conjI)
show "\<forall> f ini s. f \<in> (invariants N) --> ini \<in> {andList (allInitSpecs N)} --> formEval ini s --> formEval f s"
proof ((rule allI)+, (rule impI)+)
  fix f ini s
  assume b1: "f \<in> (invariants N)" and b2: "ini \<in> {andList (allInitSpecs N)}" and b3: "formEval ini s"
  have b4: "formEval (andList (allInitSpecs N)) s"
  apply (cut_tac b2 b3, simp) done
  show "formEval f s"
  apply (rule on_inis, cut_tac b1, assumption, cut_tac b2, assumption, cut_tac b3, assumption) done
qed
next show "\<forall> f r s. f \<in> invariants N --> r \<in> rules N --> invHoldForRule s f r (invariants N)"
proof ((rule allI)+, (rule impI)+)
  fix f r s
  assume b1: "f \<in> invariants N" and b2: "r \<in> rules N"
  show "invHoldForRule s f r (invariants N)"
  apply (rule invs_on_rules, cut_tac b1, assumption, cut_tac b2, assumption) done
qed
qed
next show "s \<in> reachableSet {andList (allInitSpecs N)} (rules N)"
  apply (metis a1) done
qed
end


\<^marker>\<open>creator Bernhard Pöttinger\<close>

chapter \<open>Footprints of Modifications to Flow Graphs\<close>
theory Flow_Footprint
imports Flow_Base Flow_Extensions
begin

paragraph \<open>Summary\<close>
text \<open>A theoretical result on the footprint of flow interfaces.\<close>
text \<open>@{cite \<open>def. 7\<close> krishna19b}\<close>

paragraph \<open>Major Definitions\<close>
text \<open>\<^item>  @{text flow_footprint}
\<^item> @{text the_flow_footprint}\<close>

paragraph \<open>Major Theorems\<close>
text \<open>\<^item> @{cite \<open>lem. 4\<close> krishna19b}
\<^item> flow footprints are unique\<close>

section \<open>Flow Footprints\<close>

definition flow_footprint where
  "flow_footprint \<equiv> \<lambda>h h' h1'.
             (\<exists>h1 h2. h = h1 + h2 \<and> h' = h1'  + h2 \<and> int_fg h1 = int_fg h1' \<and>
     (\<forall>h1''. (\<exists>h1 h2. h = h1 + h2 \<and> h' = h1'' + h2 \<and> int_fg h1 = int_fg h1'')
              \<longrightarrow> (dom_fg h1' \<subseteq> dom_fg h1'')))"

definition "the_flow_footprint \<equiv> \<lambda>h h'. (THE h1'. flow_footprint h h' h1')"

text \<open>
The proof structure of @{text in_footprint_iff_changed}@{cite \<open>lem. 4\<close> krishna19b} is:
@{text in_footprint_iff_changed}
- ==> @{text in_footprint_iff_changed1}
- <== @{text in_footprint_iff_changed2}
\<close>

lemma in_footprint_iff_changed1:
  assumes "int_fg h = int_fg h'" "h \<noteq> bot" "h' \<noteq> bot" "n \<in> dom_fg h" "flow_footprint h h' h1'"
    "fg {n} (edge_fg h) (flow_fg h) \<noteq> fg {n} (edge_fg h') (flow_fg h')"
  shows "n \<in> dom_fg h1'"
proof -
  have *: "flow_fg h n \<noteq> flow_fg h' n \<or> edge_fg h n \<noteq> edge_fg h' n"
  proof (rule ccontr, goal_cases)
    case 1
    then have *: "flow_fg h n = flow_fg h' n" "edge_fg h n = edge_fg h' n" by auto
    have "fg {n} (edge_fg h) (flow_fg h) = fg {n} (edge_fg h') (flow_fg h')"
      apply (rule fg_cong) using assms * by auto
    then show ?case using assms by simp
  qed

  obtain h1 h2 where **: "h = h1 + h2" "h' = h1' + h2" "int_fg h1 = int_fg h1'"
    "\<forall>h1''. (\<exists>h1 h2. h = h1 + h2 \<and> h' = h1'' + h2 \<and> int_fg h1 = int_fg h1'')
            \<longrightarrow> (dom_fg h1' \<subseteq> dom_fg h1'')"
    using assms unfolding flow_footprint_def by blast

  have "n \<notin> dom_fg h2"
  proof
    assume AA: "n \<in> dom_fg h2"
    consider (a) "flow_fg h n \<noteq> flow_fg h' n" | (b) "edge_fg h n \<noteq> edge_fg h' n"
      using * by blast
    then show False
    proof cases
      case a
      moreover have "flow_fg h n = flow_fg h' n"
        using ** AA assms flow_fg_plus_fg_on2[of h1 h2] flow_fg_plus_fg_on2[of h1' h2]
        by simp
      ultimately show ?thesis
        by simp
    next
      case b
      moreover have "edge_fg h n = edge_fg h' n"
        using ** AA assms edge_fg_plus_fg_on2[of h1 h2] edge_fg_plus_fg_on2[of h1' h2]
        by simp
      ultimately show ?thesis
        by simp
    qed
  qed
  moreover have "dom_fg h = dom_fg h1 \<union> dom_fg h2" "dom_fg h1 \<inter> dom_fg h2 = {}"
    using assms ** by auto
  ultimately have "n \<in> dom_fg h1"
    using assms by simp
  then show ?thesis
    using assms **
    by (metis dom_fi_int_fg)
qed

lemma in_footprint_iff_changed2:
  assumes "int_fg h = int_fg h'" "h \<noteq> bot" "h' \<noteq> bot" "n \<in> dom_fg h" "flow_footprint h h' h1'"
    "n \<in> dom_fg h1'"
  shows "fg {n} (edge_fg h) (flow_fg h) \<noteq> fg {n} (edge_fg h') (flow_fg h')"
proof
  (* proof by contradiction: we construct a "smaller" h1' which can not exist due to minimality
     of h1'. The false assumption fg {n} ... = fg {n} ... implies that we can move n
     from h1' to h2. *)

  let ?h = "fg {n} (edge_fg h) (flow_fg h)"
  let ?h' = "fg {n} (edge_fg h') (flow_fg h')"

  (* first show that ?h is valid in order to access its components*)
  obtain g1 g2 where J: "h = g1 + g2 \<and> dom_fg g1 = {n} \<and> dom_fg g2 = dom_fg h - {n} \<and>
    edge_fg h = edge_fg g1 on {n} \<and> edge_fg h = edge_fg g2 on dom_fg h - {n} \<and>
    flow_fg h = flow_fg g1 on {n} \<and> flow_fg h = flow_fg g2 on dom_fg h - {n}"
    "g1 \<noteq> bot" "g2 \<noteq> bot"
    using split_fg[of h "{n}" "dom_fg h - {n}"] assms by blast

  have "g1 = fg (dom_fg g1) (edge_fg g1) (flow_fg g1)" by (simp add: J(2))
  have "?h = fg (dom_fg g1) (edge_fg g1) (flow_fg g1)"
    apply (rule fg_cong) using J \<open>g1 \<noteq> bot\<close> by auto
  then have "?h \<noteq> bot" using \<open>g1 \<noteq> bot\<close> by simp
  (* then we can show that the assumption that we obtain from our proof by contradiction
     implies equality of edge and flow on n *)
  moreover assume AA: "?h = ?h'"
  ultimately have EE: "edge_fg h n = edge_fg h' n" "flow_fg h n = flow_fg h' n"
    using fg_eqD[of ?h ?h']
     apply (metis edge_fg_fg singletonI)
    using fg_eqD[of ?h ?h']
    by (metis AA \<open>fg {n} (edge_fg h) (flow_fg h) \<noteq> bot\<close> flow_fg_fg singletonI)

  (* unfold the flow footprint assumption *)
  obtain h1 h2 where **: "h = h1 + h2" "h' = h1' + h2" "int_fg h1 = int_fg h1'"
    "\<forall>h1''. (\<exists>h1 h2. h = h1 + h2 \<and> h' = h1'' + h2 \<and> int_fg h1 = int_fg h1'')
            \<longrightarrow> (dom_fg h1' \<subseteq> dom_fg h1'')"
    using assms unfolding flow_footprint_def by blast

  (* some observations *)
  have X: "dom_fg h1 = dom_fg h1'"
    using ** dom_fi_int_fg[of h1] dom_fi_int_fg[of h1']
    by simp

  have "dom_fg h = (dom_fg h1 - {n}) \<union> (dom_fg h2 \<union> {n})"
    "(dom_fg h1 - {n}) \<inter> (dom_fg h2 \<union> {n}) = {}"
    using ** plus_fg_dom_un assms plus_fg_dom_disj by blast+

  (* fact 1: split h into hh1 and hh2 such that n is now part of hh2 instead of hh1 *)
  then obtain hh1 hh2 where C: "h = hh1 + hh2" "dom_fg hh1 = dom_fg h1 - {n}"
      "dom_fg hh2 = dom_fg h2 \<union> {n}"
      "edge_fg h = edge_fg hh2 on dom_fg h2 \<union> {n}" "flow_fg h = flow_fg hh2 on dom_fg h2 \<union> {n}"
      "edge_fg h = edge_fg hh1 on dom_fg h1 - {n}" "flow_fg h = flow_fg hh1 on dom_fg h1 - {n}"
    using split_fg[of h "dom_fg h1 - {n}" "dom_fg h2 \<union> {n}"] assms
    by auto

  have "dom_fg h' = (dom_fg h1 - {n}) \<union> (dom_fg h2 \<union> {n})"
    "(dom_fg h1 - {n}) \<inter> (dom_fg h2 \<union> {n}) = {}"
    using X ** plus_fg_dom_un assms plus_fg_dom_disj by blast+

  (* fact 2: split h' into hh1' and hh2' such that n is now part of hh2 instead of hh1' *)
  then obtain hh1' hh2' where D: "h' = hh1' + hh2'" "dom_fg hh1' = dom_fg h1 - {n}"
      "dom_fg hh2' = dom_fg h2 \<union> {n}"
      "edge_fg h' = edge_fg hh2' on dom_fg h2 \<union> {n}" "flow_fg h' = flow_fg hh2' on dom_fg h2 \<union> {n}"
      "edge_fg h' = edge_fg hh1' on dom_fg h1 - {n}" "flow_fg h' = flow_fg hh1' on dom_fg h1 - {n}"
    using split_fg[of h' "dom_fg h1 - {n}" "dom_fg h2 \<union> {n}"] assms
    by auto

  have E0: "edge_fg h' = edge_fg h2 on (dom_fg h2)" "edge_fg h = edge_fg h2 on (dom_fg h2)"
    "flow_fg h' = flow_fg h2 on (dom_fg h2)" "flow_fg h = flow_fg h2 on (dom_fg h2)"
    using ** assms edge_fg_plus_fg_on2 flow_fg_plus_fg_on2 by blast+

  (* notice that h = h1 + h2 and h' = h1' + h2 imply hh2 = hh2' *)
  have E1: "hh2 = hh2'"
    apply (rule fg_eqI)
    using C D EE apply auto[1]
    using D(1) assms(3) plus_fg_ops_exist apply blast
    using C D EE E0 by auto
  then have E2: "int_fg hh2 = int_fg hh2'"
    by simp

  have "int_fg hh1 + int_fg hh2 = int_fg h"
    by (simp add: C(1) int_fg_fi_hom)
  also have "... = int_fg h'"
    using assms by simp
  also have "... = int_fg hh1' + int_fg hh2'"
    by (simp add: D(1) int_fg_fi_hom)
  (* fact 3: interface have to be equal *)
  finally have E2: "int_fg hh1 = int_fg hh1'"
    using E2 plus_fi_cancel_left[of "int_fg hh1" "int_fg hh2"] int_fg_fi_hom[of hh1 hh2] assms C
    by simp

  (* we collected all facts 1-3 that are required to contradict minimality of h1' *)
  have "h = hh1 + hh2" "h' = hh1' + hh2" "int_fg hh1 = int_fg hh1'" "dom_fg hh1' \<subset> dom_fg h1'"
    using E1 E2 C D ** X assms by auto
  then show False
    using ** by blast
qed

text \<open>@{cite \<open>lem. 4\<close> krishna19b}\<close>

lemma in_footprint_iff_changed:
  assumes "int_fg h = int_fg h'" "h \<noteq> bot" "h' \<noteq> bot"
    "n \<in> dom_fg h" "flow_footprint h h' h1'"
  shows "n \<in> dom_fg h1' \<longleftrightarrow>
    fg {n} (edge_fg h) (flow_fg h) \<noteq> fg {n} (edge_fg h') (flow_fg h')"
  using assms in_footprint_iff_changed1 in_footprint_iff_changed2 by metis

text \<open>Additionally show that flow footprints are unique:\<close>

lemma flow_footprint_unique:
  assumes "flow_footprint h h' h1'" "flow_footprint h h' h1''" "h \<noteq> bot" "h' \<noteq> bot"
  shows "h1' = h1''"
proof -
  obtain h11 h12 where *: "h = h11 + h12" "h' = h1' + h12" "int_fg h11 = int_fg h1'"
    using assms unfolding flow_footprint_def by blast

  obtain h21 h22 where **: "h = h21 + h22" "h' = h1'' + h22" "int_fg h21 = int_fg h1''"
    using assms unfolding flow_footprint_def by blast

  have nbot2: "h12 \<noteq> bot" "h22 \<noteq> bot" using * ** plus_fg_ops_exist assms by auto

  let ?h12 = "fg (dom_fg h12) (edge_fg h12) (flow_fg h12)"
  let ?h22 = "fg (dom_fg h22) (edge_fg h22) (flow_fg h22)"

  have "int_fg (h11 + h12) = int_fg h11 + int_fg h12" using int_fg_fi_hom by metis
  also have "... = int_fg h1' + int_fg h12" using * by simp
  also have "... = int_fg (h1' + h12)" using int_fg_fi_hom by metis
  finally have inbot: "int_fg (h1' + h12) \<noteq> bot" "int_fg h = int_fg h'" using assms * by auto

  let ?X = "{n . n \<in> dom_fg h \<and> fg {n} (edge_fg h) (flow_fg h) \<noteq> fg {n} (edge_fg h') (flow_fg h')}"

  have BLA: "\<And>x. x \<in> dom_fg h1' \<Longrightarrow> x \<in> dom_fg h"
    using assms * plus_fg_dom_un[of h1' h12]
    by (metis Diff_insert_absorb dom_fg_plus_fg_subs1 dom_fi_int_fg subset_Diff_insert)

  have dom1: "dom_fg h1' = ?X"
    using BLA apply auto
    using in_footprint_iff_changed2[OF inbot(2)] assms inbot BLA apply blast
    using * inbot in_footprint_iff_changed1[OF inbot(2) \<open>h \<noteq> bot\<close> \<open>h' \<noteq> bot\<close>] assms by blast

  have BLA: "\<And>x. x \<in> dom_fg h1'' \<Longrightarrow> x \<in> dom_fg h"
    using assms * ** plus_fg_dom_un[of h1'' h22]
    by (metis Diff_insert_absorb dom_fg_plus_fg_subs1 dom_fi_int_fg subset_Diff_insert)

  have dom2: "dom_fg h1'' = ?X"
    using BLA apply auto
    using in_footprint_iff_changed2[OF inbot(2)] assms inbot BLA apply blast
    using * inbot in_footprint_iff_changed1[OF inbot(2) \<open>h \<noteq> bot\<close> \<open>h' \<noteq> bot\<close>] assms by blast

  have dom: "dom_fg h1' = dom_fg h1''" using dom1 dom2 by simp
  then have "dom_fg h12 = dom_fg h' - dom_fg h1'" using assms plus_fg_dom_un[of h1' h12]
      plus_fg_dom_disj[of h1' h12] assms * by blast
  moreover have "dom_fg h22 = dom_fg h' - dom_fg h1''" using assms plus_fg_dom_un[of h1'' h22]
      plus_fg_dom_disj[of h1'' h22] assms ** \<open>dom_fg h1' = dom_fg h1''\<close> ** by blast
  ultimately have dom: "dom_fg h12 = dom_fg h22" using dom by simp

  have X1: "edge_fg h = edge_fg h12 on dom_fg h12" using edge_fg_plus_fg_on2 * assms by auto
  have X2: "edge_fg h = edge_fg h22 on dom_fg h22" using edge_fg_plus_fg_on2 ** assms by auto
  have X3: "flow_fg h = flow_fg h12 on dom_fg h12" using flow_fg_plus_fg_on2 * assms by auto
  have X4: "flow_fg h = flow_fg h22 on dom_fg h22" using flow_fg_plus_fg_on2 ** assms by auto

  have "?h12 = ?h22"
    apply (rule fg_cong)
    using dom X1 X2 X3 X4 by auto
  then have "h12 = h22"
    using nbot2 by auto
  then have "h1' + h12 = h1'' + h12" using * ** by simp
  then show "h1' = h1''" using plus_fg_cancel_right assms * by blast
qed

end