theory flash108Bra  imports flash108Rev

  begin
lemma onInv108:

   assumes

     b1:"r \<in> rules N" and b2:"invf=inv108 "
   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 (inv108 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX1VsInv108 )
          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 (inv108 ) (NI_Local_GetX_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_GetXVsInv108 )
          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 (inv108 ) (NI_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceVsInv108 )
          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 (inv108 ) (NI_ShWb N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ShWbVsInv108 )
          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 (inv108 ) (PI_Local_GetX_GetX2 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX2VsInv108 )
          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 (inv108 ) (NI_Local_PutXAcksDone ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutXAcksDoneVsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX7VsInv108 )
          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 (inv108 ) (NI_Local_Get_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak2VsInv108 )
          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 (inv108 ) (NI_ReplaceHomeShrVld ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeShrVldVsInv108 )
          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 (inv108 ) (NI_Remote_Put  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutVsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX5VsInv108 )
          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 (inv108 ) (NI_Wb ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_WbVsInv108 )
          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 (inv108 ) (NI_Local_Get_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_GetVsInv108 )
          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 (inv108 ) (PI_Local_Replace ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_ReplaceVsInv108 )
          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 (inv108 ) (NI_ReplaceShrVld  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceShrVldVsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8VsInv108 )
          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 (inv108 ) (NI_InvAck_2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_2VsInv108 )
          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 (inv108 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak2VsInv108 )
          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 (inv108 ) (PI_Remote_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_ReplaceVsInv108 )
          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 (inv108 ) (NI_Nak_Home ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_HomeVsInv108 )
          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 (inv108 ) (NI_Local_Get_Put2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put2VsInv108 )
          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 (inv108 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1VsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX11VsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX6VsInv108 )
          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 (inv108 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put2VsInv108 )
          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 (inv108 ) (PI_Local_Get_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_PutVsInv108 )
          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 (inv108 ) (PI_Local_GetX_PutX1 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX1VsInv108 )
          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 (inv108 ) (NI_InvAck_1_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1_HomeVsInv108 )
          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 (inv108 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak1VsInv108 )
          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 (inv108 ) (NI_Local_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak1VsInv108 )
          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 (inv108 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak2VsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10_homeVsInv108 )
          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 (inv108 ) (PI_Remote_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetVsInv108 )
          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 (inv108 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak3VsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10VsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX2VsInv108 )
          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 (inv108 ) (NI_Remote_Get_Put1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put1VsInv108 )
          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 (inv108 ) (NI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutXVsInv108 )
          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 (inv108 ) (Store  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis StoreVsInv108 )
          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 (inv108 ) (NI_FAck ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_FAckVsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX3VsInv108 )
          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 (inv108 ) (PI_Local_GetX_PutX3 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX3VsInv108 )
          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 (inv108 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutXVsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8_homeVsInv108 )
          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 (inv108 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put1VsInv108 )
          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 (inv108 ) (PI_Local_GetX_GetX1 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX1VsInv108 )
          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 (inv108 ) (StoreHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis StoreHomeVsInv108 )
          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 (inv108 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_NakVsInv108 )
          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 (inv108 ) (NI_Inv  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvVsInv108 )
          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 (inv108 ) (PI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_PutXVsInv108 )
          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 (inv108 ) (PI_Local_GetX_PutX4 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX4VsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX4VsInv108 )
          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 (inv108 ) (NI_Nak  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_NakVsInv108 )
          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 (inv108 ) (PI_Local_GetX_PutX2 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX2VsInv108 )
          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 (inv108 ) (NI_Local_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutVsInv108 )
          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 (inv108 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak1VsInv108 )
          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 (inv108 ) (NI_Nak_Clear ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_ClearVsInv108 )
          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 (inv108 ) (PI_Local_PutX ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_PutXVsInv108 )
          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 (inv108 ) (NI_Local_Get_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak3VsInv108 )
          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 (inv108 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_Nak_HomeVsInv108 )
          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 (inv108 ) (PI_Local_Get_Get ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_GetVsInv108 )
          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 (inv108 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX9VsInv108 )
          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 (inv108 ) (PI_Remote_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetXVsInv108 )
          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 (inv108 ) (NI_ReplaceHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeVsInv108 )
          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 (inv108 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutX_HomeVsInv108 )
          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 (inv108 ) (NI_Local_Get_Put3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put3VsInv108 )
          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 Proof_1
  imports trafficLights Requirements VCTheoryLemmas
begin

lemma minimalRed_not_vc3: "toEnvP s1 \<and> substate s1 s \<and> toEnvNum emptyState s1 > MINIMAL_RED_TIME_LIMIT \<and>
getPstate s1 Ctrl = minimalRed \<and>
(\<forall> s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl) \<or>
toEnvNum emptyState s1 \<le> MINIMAL_RED_TIME_LIMIT \<and>
(\<forall> s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green)) \<and>
(\<forall> s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 trafficLight = GREEN) \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> getVarBool s2 trafficLight = GREEN \<and> toEnvNum s2 s1 \<le> ltimeEnv s1 Ctrl)"
  by (metis (no_types, lifting) leD order_le_less substate_trans)

lemma redAfterMinimalRed_not_vc3: "toEnvP s1 \<and> substate s1 s \<and> toEnvNum emptyState s1 > MINIMAL_RED_TIME_LIMIT + 1  \<and>
getPstate s1 Ctrl =redAfterMinimalRed \<and> getVarBool s1 requestButtonPressed \<and>
(\<forall> s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl) \<or>
toEnvNum emptyState s1 \<le> MINIMAL_RED_TIME_LIMIT \<and>
(\<forall> s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green)) \<and>
(\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed \<longrightarrow>
      (\<exists>s2. toEnvP s2 \<and>
            substate s2 s1 \<and>
            toEnvNum s2 s1 = Ctrl \<and>
            getPstate s2 Ctrl = minimalRed \<and>
            ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
            (getVarBool s2 redAfterMinimalRed \<or> getVarBool s1 Ctrl = PRESSED))) \<and>
(\<forall> s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 trafficLight = GREEN) \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> getVarBool s2 trafficLight = GREEN \<and> toEnvNum s2 s1 \<le>MINIMAL_RED_TIME_LIMIT + 1)"
  apply(rule impI)
 apply(rule cut_rl[of "(\<exists>s2. toEnvP s2 \<and>
            substate s2 s1 \<and>
            toEnvNum s2 s1 = Ctrl \<and>
            getPstate s2 Ctrl = minimalRed \<and>
            ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
            (getVarBool s2 redAfterMinimalRed \<or> getVarBool s1 Ctrl = PRESSED))"])
  using minimalRed_not_vc3
   apply (metis (no_types, opaque_lifting) order.order_iff_strict substate_trans toEnvNum3 toEnvP.simps(2))
  by auto

lemma minimalRed_notPressed: "  toEnvP s1 \<and>
          substate s1 s \<and>
          MINIMAL_RED_TIME_LIMIT + Ctrl < toEnvNum emptyState s1 \<and>
          getPstate s1 Ctrl = redAfterMinimalRed \<and>
          \<not> getVarBool s1 redAfterMinimalRed \<and>
          (\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
                (\<exists>s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl) \<or>
                toEnvNum emptyState s1 \<le> MINIMAL_RED_TIME_LIMIT \<and>
                (\<forall>s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green)) \<and>
          (\<forall>s1. toEnvP s1 \<and>
                substate s1 s \<and>
                getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
                (\<exists>s2. toEnvP s2 \<and>
                      substate s2 s1 \<and>
                      getPstate s2 Ctrl = minimalRed \<and>
                      ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
                      getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
                      (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                            getPstate s3 Ctrl = redAfterMinimalRed \<and>
                            getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED))) \<and>
          (\<forall>s1 s2.
              toEnvP s1 \<and>
              toEnvP s2 \<and>
              substate s1 s2 \<and>
              substate s2 s \<and>
              toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and>
              getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
              getVarBool s1 Ctrl = NOT_PRESSED) \<and>
          (\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 minimalRed = PRESSED) \<Longrightarrow>
          \<exists>s2. toEnvP s2 \<and>
               substate s2 s1 \<and>
               getPstate s2 Ctrl = minimalRed \<and>
               ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
               getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
               (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                     getPstate s3 Ctrl = redAfterMinimalRed \<and>
                     getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED) \<Longrightarrow>
          toEnvP x \<and>
          substate x s1 \<and>
          getPstate x Ctrl = minimalRed \<and>
          ltimeEnv x Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
          getVarBool x redAfterMinimalRed = NOT_PRESSED \<and>
          (\<forall>s3. toEnvP s3 \<and> substate x s3 \<and> substate s3 s1 \<and> x \<noteq> s3 \<longrightarrow>
                getPstate s3 Ctrl = redAfterMinimalRed \<and>
                getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED) \<Longrightarrow>
          \<exists>s3. toEnvP s3 \<and> substate s3 s1 \<and> toEnvNum s3 s1 = T1 \<and> getVarBool s3 minimalRed = NOT_PRESSED \<Longrightarrow>
          \<not> (toEnvNum x s1 \<le> T1 - MINIMAL_RED_TIME_LIMIT \<and> MINIMAL_RED_TIME_LIMIT < toEnvNum emptyState x) \<Longrightarrow>
          toEnvNum x s1 \<noteq> T1 - MINIMAL_RED_TIME_LIMIT + Ctrl \<Longrightarrow>
          T1 - MINIMAL_RED_TIME_LIMIT + Ctrl < toEnvNum x s1 \<Longrightarrow>
          toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 < T1 \<longrightarrow> getVarBool s2 Ctrl = NOT_PRESSED"
  apply(cases "substate s2 x")
  using toEnvNum3[of s2 x s1] substate_trans[of x s1 s]
  apply (smt (verit) Nat.add_diff_assoc2 add.commute add_lessD1 less_diff_conv less_diff_conv2 less_or_eq_imp_le linordered_semidom_class.add_diff_inverse trans_le_add2 verit_comp_simplify1(3))
  using  substate_asym
  by (metis substate_total)

lemma toEnvP_gtime_ge_0: "toEnvP s \<Longrightarrow> toEnvNum emptyState s > 0"
  apply(cases s)
  by auto

lemma minimalRed_firstIter: "toEnvP s1 \<and>
    substate s1 s \<and>
    MINIMAL_RED_TIME_LIMIT + Ctrl < toEnvNum emptyState s1 \<and>
    getPstate s1 Ctrl = redAfterMinimalRed \<and>
    \<not> getVarBool s1 redAfterMinimalRed \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl) \<or>
          toEnvNum emptyState s1 \<le> MINIMAL_RED_TIME_LIMIT \<and>
          (\<forall>s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green)) \<and>
    (\<forall>s1. toEnvP s1 \<and>
          substate s1 s \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and>
                substate s2 s1 \<and>
                getPstate s2 Ctrl = minimalRed \<and>
                ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
                getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
                (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                      getPstate s3 Ctrl = redAfterMinimalRed \<and>
                      getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED))) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 s \<and>
        toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and>
        getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
        getVarBool s1 Ctrl = NOT_PRESSED) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 minimalRed = PRESSED) \<Longrightarrow>
    \<exists>s2. toEnvP s2 \<and>
         substate s2 s1 \<and>
         getPstate s2 Ctrl = minimalRed \<and>
         ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
         getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
         (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
               getPstate s3 Ctrl = redAfterMinimalRed \<and>
               getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED) \<Longrightarrow>
    toEnvP x \<and>
    substate x s1 \<and>
    getPstate x Ctrl = minimalRed \<and>
    ltimeEnv x Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
    getVarBool x redAfterMinimalRed = NOT_PRESSED \<and>
    (\<forall>s3. toEnvP s3 \<and> substate x s3 \<and> substate s3 s1 \<and> x \<noteq> s3 \<longrightarrow>
          getPstate s3 Ctrl = redAfterMinimalRed \<and>
          getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED) \<Longrightarrow>
    \<not> (toEnvNum x s1 \<le> T1 - MINIMAL_RED_TIME_LIMIT \<and> MINIMAL_RED_TIME_LIMIT < toEnvNum emptyState x) \<Longrightarrow>
    toEnvNum x s1 \<noteq> T1 - MINIMAL_RED_TIME_LIMIT + Ctrl \<Longrightarrow>
    \<not> T1 - MINIMAL_RED_TIME_LIMIT + Ctrl < toEnvNum x s1 \<Longrightarrow>
(\<exists> s3. toEnvP s3 \<and> substate s3 s1 \<and> toEnvNum s3 s1 = T1 \<and> getVarBool s3 trafficLight = RED) \<Longrightarrow>
     toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 < T1 \<longrightarrow> getVarBool s2 Ctrl = NOT_PRESSED"
  apply(cases "substate s2 x")
   apply(rule cut_rl[of "toEnvNum emptyState s1 \<le> T1"])
    apply(rule cut_rl[of "toEnvNum emptyState s1 > T1"])
     apply arith
  using toEnvP_gtime_ge_0 toEnvNum3[of emptyState _ s1]
    apply (metis diff_add_inverse2 diff_is_0_eq emptyState_substate linorder_not_less minus_nat.diff_0)
   apply(rule cut_rl[of "toEnvNum emptyState x \<le> MINIMAL_RED_TIME_LIMIT \<and> toEnvNum x s1 \<le> T1 - MINIMAL_RED_TIME_LIMIT"])
   apply (metis \<open>\<And>s2. substate emptyState s2 \<and> substate s2 s1 \<Longrightarrow> toEnvNum emptyState s1 = toEnvNum emptyState s2 + toEnvNum s2 s1\<close> diff_add_inverse emptyState_substate le_antisym ltime_le_toEnvNum nat_add_left_cancel_le)
   apply arith
  using substate_total substate_asym
  by metis

lemma minimalRed_notPressed_or_green: "toEnvP s1 \<and>
         substate s1 s \<and>
         MINIMAL_RED_TIME_LIMIT + Ctrl < toEnvNum emptyState s1 \<and>
         getPstate s1 Ctrl = redAfterMinimalRed \<and>
         \<not> getVarBool s1 redAfterMinimalRed \<and>
         (\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
               (\<exists>s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl) \<or>
               toEnvNum emptyState s1 \<le> MINIMAL_RED_TIME_LIMIT \<and>
               (\<forall>s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green)) \<and>
         (\<forall>s1. toEnvP s1 \<and>
               substate s1 s \<and>
               getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
               (\<exists>s2. toEnvP s2 \<and>
                     substate s2 s1 \<and>
                     getPstate s2 Ctrl = minimalRed \<and>
                     ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
                     getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
                     (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                           getPstate s3 Ctrl = redAfterMinimalRed \<and>
                           getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED))) \<and>
         (\<forall>s1 s2.
             toEnvP s1 \<and>
             toEnvP s2 \<and>
             substate s1 s2 \<and>
             substate s2 s \<and>
             toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and>
             getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
             getVarBool s1 Ctrl = NOT_PRESSED) \<and>
         (\<forall>s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 minimalRed = PRESSED) \<Longrightarrow>
         \<exists>s2. toEnvP s2 \<and>
              substate s2 s1 \<and>
              getPstate s2 Ctrl = minimalRed \<and>
              ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
              getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
              (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                    getPstate s3 Ctrl = redAfterMinimalRed \<and>
                    getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED) \<Longrightarrow>
         toEnvP x \<and>
         substate x s1 \<and>
         getPstate x Ctrl = minimalRed \<and>
         ltimeEnv x Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
         getVarBool x redAfterMinimalRed = NOT_PRESSED \<and>
         (\<forall>s3. toEnvP s3 \<and> substate x s3 \<and> substate s3 s1 \<and> x \<noteq> s3 \<longrightarrow>
               getPstate s3 Ctrl = redAfterMinimalRed \<and>
               getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED) \<Longrightarrow>
(\<exists> s3. toEnvP s3 \<and> substate s3 s1 \<and> toEnvNum s3 s1 = T1 \<and> getVarBool s3 trafficLight = RED) \<Longrightarrow>
         (\<exists>s2. toEnvP s2 \<and> substate s2 s1 \<and> getVarBool s2 minimalRed = PRESSED \<and> toEnvNum s2 s1 \<le> T1) \<or>
         (\<forall>s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 < T1 \<longrightarrow> getVarBool s2 requestButton = NOT_PRESSED)"
  apply(cases "toEnvNum x s1 \<le> T1 - MINIMAL_RED_TIME_LIMIT \<and> toEnvNum emptyState x > MINIMAL_RED_TIME_LIMIT")
   apply(rule disjI1)
   apply(rule cut_rl[of "(\<exists>s2. toEnvP s2 \<and> substate s2 x \<and> getVarBool s2 minimalRed = PRESSED \<and>
 toEnvNum s2 x \<le> MINIMAL_RED_TIME_LIMIT)"])
  using toEnvNum3[of _ x s1]
    apply (smt (z3) add_le_mono diff_add_inverse substate_trans)
  using substate_trans minimalRed_not_vc3
   apply (smt (verit) nat_le_linear)
  apply(rule disjI2)
  apply(cases "toEnvNum x s1 = T1 - MINIMAL_RED_TIME_LIMIT + 1")
   apply(rule cut_rl[of "\<forall>s2. toEnvP s2 \<and> (substate x s2 \<and> substate s2 s1 \<and>  x \<noteq> s2 \<or>
 substate s2 x \<and> toEnvNum s2 x <  MINIMAL_RED_TIME_LIMIT - 1)  \<longrightarrow> getVarBool s2 Ctrl = NOT_PRESSED"])
  apply (smt (verit) Nat.add_diff_assoc \<open>\<And>s1a. substate s1a x \<and> substate x s1 \<Longrightarrow> toEnvNum s1a s1 = toEnvNum s1a x + toEnvNum x s1\<close> diff_add_inverse le_add1 less_diff_conv less_diff_conv2 substate_total trans_le_add2)
   apply (smt (z3) substate_trans)
   apply(cases "toEnvNum x s1 > T1 - MINIMAL_RED_TIME_LIMIT + 1")
   apply(rule allI)
   apply ((rule minimalRed_notPressed);blast)
  apply(rule allI)
  by ((rule minimalRed_firstIter);blast)

lemma redAfterMinimalRed_notPressed_not_vc3: "toEnvP s1 \<and> substate s1 s \<and> toEnvNum emptyState s1 > MINIMAL_RED_TIME_LIMIT + 1  \<and>
getPstate s1 Ctrl =redAfterMinimalRed \<and> \<not>getVarBool s1 requestButtonPressed \<and>
(\<forall> s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl) \<or>
toEnvNum emptyState s1 \<le> MINIMAL_RED_TIME_LIMIT \<and>
(\<forall> s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = green)) \<and>
(\<forall>s1. toEnvP s1 \<and>
      substate s1 s \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
      (\<exists>s2. toEnvP s2 \<and>
            substate s2 s1 \<and>
            getPstate s2 Ctrl = minimalRed \<and>
            ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
            getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
            (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                  getPstate s3 Ctrl = redAfterMinimalRed \<and>
                  getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED))) \<and>
(\<forall>s1 s2.
    toEnvP s1 \<and>
    toEnvP s2 \<and>
    substate s1 s2 \<and>
    substate s2 s \<and>
    toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and>
    getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
    getVarBool s1 Ctrl = NOT_PRESSED) \<and>
(\<forall> s1. toEnvP s1 \<and> substate s1 s \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 trafficLight = GREEN) \<Longrightarrow>
(\<exists> s3. toEnvP s3 \<and> substate s3 s1 \<and> toEnvNum s3 s1 = T1 \<and> getVarBool s3 trafficLight = RED)
 \<Longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> getVarBool s2 trafficLight = GREEN \<and> toEnvNum s2 s1 \<le>T1) \<or>
(\<forall> s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 < T1 \<longrightarrow> getVarBool s2 requestButton = NOT_PRESSED)"
  apply(rule cut_rl[of " (\<exists>s2. toEnvP s2 \<and>
            substate s2 s1 \<and>
            getPstate s2 Ctrl = minimalRed \<and>
            ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
            getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
            (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                  getPstate s3 Ctrl = redAfterMinimalRed \<and>
                  getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED))"])
  apply(rule exE[of "(\<lambda> s2. toEnvP s2 \<and>
            substate s2 s1 \<and>
            getPstate s2 Ctrl = minimalRed \<and>
            ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
            getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
            (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                  getPstate s3 Ctrl = redAfterMinimalRed \<and>
                  getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED))"])
    apply fast
   apply((rule minimalRed_notPressed_or_green);blast)
  by blast


theory Exc2
  imports Main

begin
lemma add_ass: "a + b = b + a"
  apply(induction a)

end


theory BaseLogicDeepExperimental
imports CoreStructures Namespace "../HeapLang/PrimitiveLaws" Frac DerivedConstructions
  "../SpanningTree/SpanningTreeCameras" "../HeapLang/State"
begin

text \<open> An experimental approach to a deep embedding of the Iris base/core logic.\<close>

text \<open>Deep embedding of camera objects\<close>
datatype 'a cmra_term = ConstC 'a | Core \<open>'a cmra_term\<close> | Op \<open>'a cmra_term\<close> \<open>'a cmra_term\<close>

text \<open>Deep embedding of step-index predicates about camera objects\<close>
datatype 'a cmra_atom =
  Own \<open>'a cmra_term\<close> \<comment> \<open>Holds for camera objects which include the given partial resource\<close>
| Valid \<open>'a cmra_term\<close>

text \<open>Predicate connectives\<close>
datatype 'a iprop =
  Atom \<open>'a cmra_atom\<close> \<comment> \<open>An atomic predicate about camera resources\<close>
  \<comment> \<open>Standard separation logic connectives\<close>
| Sep "'a iprop" "'a iprop" \<comment> \<open>Separating conjunction\<close>
| Wand "'a iprop" "'a iprop" \<comment> \<open>Wand combinator, i.e. resource specific implication\<close>
| Pure bool \<comment> \<open>Wrapper for pure Isabelle/HOL propositions\<close>
  \<comment> \<open>Iris specific modalities\<close>
| Persistent "'a iprop" \<comment> \<open>Predicate holds for core of the camera argument\<close>
| Plain "'a iprop" \<comment> \<open>Predicate holds for unit camera object\<close>
| Later "'a iprop" \<comment> \<open>Increases step index by one (also holds for n=0)\<close>
| BUpd "'a iprop" \<comment> \<open>Predicate holds after one frame-preserving update\<close>
  \<comment> \<open>Standard logic connectives\<close>
| Impl "'a iprop" "'a iprop"
| Conj "'a iprop" "'a iprop"
| Disj "'a iprop" "'a iprop"

datatype 'a inv = Inv \<open>(name, 'a res iprop later) map_view \<times> name dset \<times> name dfset\<close>
  and 'a res = Res "(gname \<rightharpoonup> 'a inv) \<times> 'a"

definition "invariant_name :: gname \<equiv> 1"
definition "enabled_name :: gname \<equiv> 2"
definition "disabled_name :: gname \<equiv> 3"

fun get_inv :: "gname \<Rightarrow> 'a res \<Rightarrow> 'a inv option" where "get_inv \<gamma> (Res (i,a)) = i \<gamma>"
definition constr_inv :: "gname \<Rightarrow> 'a::ucamera inv \<Rightarrow> 'a res" where
  "constr_inv \<gamma> i = Res ([\<gamma>\<mapsto>i],\<epsilon>)"

instance inv :: (type) ucamera sorry
instance res :: (type) ucamera sorry
instance iprop :: (type) ofe sorry

type_synonym 'a atom = "'a cmra_atom"

primrec cmra_eval :: "'a::ucamera cmra_term \<Rightarrow> 'a" where
  "cmra_eval (ConstC a) = a"
| "cmra_eval (Core a) = core (cmra_eval a)"
| "cmra_eval (Op a b) = (cmra_eval a) \<cdot> (cmra_eval b)"

type_synonym 'a upred = "'a \<Rightarrow> nat \<Rightarrow> bool"

primrec atom_sem :: "'a::ucamera atom \<Rightarrow> 'a upred" where
  "atom_sem (Own a) b n = n_incl n (cmra_eval a) b"
| "atom_sem (Valid a) _ n = n_valid (cmra_eval a) n"

fun pred_sem :: "'a::ucamera iprop \<Rightarrow> 'a upred"
where
  "pred_sem (Atom a) = (\<lambda>b n. atom_sem a b n)"
| "pred_sem (Sep P Q) = (\<lambda>a n. (\<exists>b1 b2. n_equiv n a (b1 \<cdot> b2) \<and> pred_sem P b1 n \<and> pred_sem Q b2 n))"
| "pred_sem (Wand P Q) = (\<lambda>a n.
  (\<forall>m b. m\<le>n \<and> n_valid (a \<cdot> b) m \<longrightarrow> pred_sem P b m \<longrightarrow> pred_sem Q (a \<cdot> b) m))"
| "pred_sem (Pure b) = (\<lambda>_ _.  b)"
| "pred_sem (Persistent P) = (\<lambda>a n. pred_sem P (core a) n)"
| "pred_sem (Plain P) = (\<lambda>_ n. pred_sem P \<epsilon> n)"
| "pred_sem (Later P) = (\<lambda>a n. (n=0 \<or> pred_sem P a (n-1)))"
| "pred_sem (BUpd P) = (\<lambda>a n.
  (\<forall>m a'. m\<le>n \<and> n_valid (a \<cdot> a') m \<longrightarrow> (\<exists>b. n_valid (b \<cdot> a') m \<and> pred_sem P b m)))"
| "pred_sem (Impl P Q) = (\<lambda>a n.
  (\<forall>m b. m\<le>n \<and> incl a b \<and> n_valid b m \<longrightarrow> pred_sem P b m \<longrightarrow> pred_sem Q b m))"
| "pred_sem (Conj P Q) = (\<lambda>a n. (pred_sem P a n \<and> pred_sem Q a n))"
| "pred_sem (Disj P Q) = (\<lambda>a n. (pred_sem P a n \<or> pred_sem Q a n))"

definition uniform :: "'a::ucamera upred \<Rightarrow> bool" where
  "uniform f \<longleftrightarrow> (\<forall>n m x y. f x n \<longrightarrow> n_incl m x y \<longrightarrow> m\<le>n \<longrightarrow> f y m)"

lemma upred_weaken: "\<lbrakk>n_equiv n x y; m\<le>n;uniform f; f x n\<rbrakk> \<Longrightarrow> f y m"
  using total_n_inclI uniform_def by fast

lemma upred_weaken_simple: "\<lbrakk>uniform f; f x n; m\<le>n\<rbrakk> \<Longrightarrow> f x m"
  using ofe_refl upred_weaken by blast

lemma atom_sem_uniform: "uniform (atom_sem a)"
proof (induct a)
  case (Own x)
  then show ?case unfolding uniform_def n_incl_def atom_sem.simps
  using camera_assoc op_equiv_subst by (metis (no_types, lifting))
next
  case (Valid x)
  then show ?case by (simp add: uniform_def)
qed

lemma pred_sem_uniform: "uniform (pred_sem P)"
proof (induct P rule: iprop.induct)
  case (Atom x)
  then show ?case by (simp) (rule atom_sem_uniform)
next
  case (Sep P Q)
  then have Q: "\<And>n m x y. \<lbrakk>(pred_sem Q) x n; n_incl m x y; m\<le>n\<rbrakk> \<Longrightarrow> (pred_sem Q) y m"
    by (auto simp: uniform_def)
  {
    fix n m x y
    assume assms: "pred_sem (Sep P Q) x n" "n_incl m x y" "m\<le>n"
    then obtain b1 b2 where bs: "n_equiv n x (b1 \<cdot> b2)" "(pred_sem P) b1 n" "(pred_sem Q) b2 n"
      by auto
    from assms(2) obtain z where z: "n_equiv m y (x \<cdot> z)" by (auto simp: n_incl_def)
    from op_equiv_subst[OF this bs(1) assms(3)] camera_assoc have "n_equiv m y (b1 \<cdot> (b2 \<cdot> z))"
      by (metis (no_types, lifting))
    with upred_weaken_simple[OF Sep(1) bs(2) assms(3)] Q[OF bs(3) n_incl_op_extend assms(3), of z]
    have "pred_sem (Sep P Q) y m" unfolding pred_sem.simps by blast
  }
  then show ?case by (simp add: uniform_def)
next
  case (Wand P Q)
  then have Q: "\<And>n m x y. \<lbrakk>(pred_sem Q) x n; n_incl m x y; m\<le>n\<rbrakk> \<Longrightarrow> (pred_sem Q) y m"
    by (auto simp: uniform_def)
  {
    fix n m x y
    assume assms: "pred_sem (Wand P Q) x n" "n_incl m x y" "m\<le>n"
    then have I: "\<And>m b. \<lbrakk>m\<le>n; n_valid (x \<cdot> b) m; (pred_sem P) b m\<rbrakk> \<Longrightarrow> (pred_sem Q) (x \<cdot> b) m"
      by auto
    {
      fix m' z
      assume assms2: "m'\<le>m" "n_valid (y \<cdot> z) m'" "(pred_sem P) z m'"
      from assms(3) assms2(1) have "m'\<le>n" by linarith
      from Q[OF I[OF this n_valid_incl_subst[OF assms(2) assms2(2,1)] assms2(3)]
        n_incl_extend[OF assms(2) assms2(1), of z] order.refl]
      have "(pred_sem Q) (y \<cdot> z) m'" .
    }
    then have "pred_sem (Wand P Q) y m" by simp
  }
  then show ?case by (simp add: uniform_def)
next
  case (Pure b)
  then show ?case by (simp add: uniform_def)
next
  case (Persistent P)
  {
    fix n m x y
    assume assms: "pred_sem (Persistent P) x n" "n_incl m x y" "m\<le>n"
    then have I: "pred_sem P (core x) n" by simp
    from assms(2) have "n_incl m (core x) (core y)" by (rule camera_core_mono_n)
    with Persistent I assms(3) have "pred_sem (Persistent P) y m"
      unfolding pred_sem.simps uniform_def by blast
  }
  then show ?case by (simp add: uniform_def)
next
  case (Plain P)
  then show ?case by (simp add: uniform_def)
next
  case (Later P)
  then show ?case by (auto simp: uniform_def camera_n_incl_le diff_le_mono)
next
  case (BUpd P)
  then show ?case by (simp add: uniform_def n_valid_incl_subst order.trans)
next
  case (Impl P Q)
  then have P: "\<And>n m x y. \<lbrakk>(pred_sem P) x n; n_incl m x y; m\<le>n\<rbrakk> \<Longrightarrow> (pred_sem P) y m"
    by (auto simp: uniform_def)
  from Impl(2) have Q: "\<And>n m x y. \<lbrakk>(pred_sem Q) x n; n_incl m x y; m\<le>n\<rbrakk> \<Longrightarrow> (pred_sem Q) y m"
    by (auto simp: uniform_def)
  {
    fix n m x y
    assume assms: "pred_sem (Impl P Q) x n" "n_incl m x y" "m\<le>n"
    then have I: "\<And>m' z. \<lbrakk>m'\<le>n;incl x z; n_valid z m'; pred_sem P z m'\<rbrakk> \<Longrightarrow> pred_sem Q z m'"
      by auto
    {
      fix m' z
      assume assms2: "m'\<le>m" "incl y z" "n_valid z m'" "pred_sem P z m'"
      with assms(3) have "m'\<le>n" by linarith
      from assms(2) obtain y' where y': "n_equiv m y (x\<cdot>y')" using n_incl_def by blast
      with ofe_sym ofe_mono[OF assms2(1)] have y'_sym: "n_equiv m' (x\<cdot>y') y" by fast
      from assms2(2) obtain z' where z': "z=y\<cdot>z'" using incl_def by blast
      from valid_op_op_weaken[OF ofe_mono[OF assms2(1) y'] assms2(3)[simplified this]]
        have "n_valid ((x\<cdot>y')\<cdot>z') m'" .
      moreover have "incl x ((x\<cdot>y')\<cdot>z')" using incl_op_extend incl_def by blast
      moreover from P[OF assms2(4) _ order.refl, simplified z', OF total_n_incl_extend[OF y' assms2(1)]]
        have "pred_sem P ((x\<cdot>y')\<cdot>z') m'".
      ultimately have "pred_sem Q ((x\<cdot>y')\<cdot>z') m'" using I[OF \<open>m'\<le>n\<close>] by simp
      from Q[OF this, of m' z, simplified z', OF total_n_incl_extend[OF y'_sym order.refl] order.refl]
      have "pred_sem Q z m'" unfolding z' .
    }
    then have "pred_sem (Impl P Q) y m" by (simp add: uniform_def)
  }
  then show ?case using uniform_def by blast
next
  case (Conj P Q)
  then show ?case by (auto simp: uniform_def)
next
  case (Disj P Q)
  then show ?case by (auto simp: uniform_def)
qed

context assumes "SORT_CONSTRAINT('a::ucamera)" begin

definition upred_entails :: "'a upred \<Rightarrow> 'a upred \<Rightarrow> bool" where
  "upred_entails P Q \<equiv> \<forall>a n. n_valid a n \<longrightarrow> P a n \<longrightarrow> Q a n"
definition pred_entails :: "'a iprop \<Rightarrow> 'a iprop \<Rightarrow> bool" where
  "pred_entails P Q = upred_entails (pred_sem P) (pred_sem Q)"

definition upred_holds :: "'a upred \<Rightarrow> bool" where
  "upred_holds P \<equiv> \<forall>a n. n_valid a n \<longrightarrow>  P a n"
definition pred_holds :: "'a iprop \<Rightarrow> bool" where
  "pred_holds P = upred_holds (pred_sem P)"
end

context assumes "SORT_CONSTRAINT('a::ucamera)" begin
definition own_inv :: "gname \<Rightarrow> 'a inv \<Rightarrow> 'a res iprop" where
  "own_inv \<gamma> i = Atom (Own(ConstC (constr_inv \<gamma> i)))"

definition sep_map_set :: "('b\<Rightarrow>'a res iprop) \<Rightarrow> 'b set \<Rightarrow> 'a res iprop" where
  "sep_map_set f s = folding_on.F (\<lambda>x a. Sep a (f x)) (Pure True) s"

definition ownI :: "name \<Rightarrow> 'a res iprop \<Rightarrow> 'a res iprop" where
  "ownI \<iota> P = own_inv invariant_name (Inv (view_frag [\<iota>\<mapsto>(DfracDiscarded,to_ag (Next P))],\<epsilon>,\<epsilon>))"

definition inv :: "namespace \<Rightarrow> 'a res iprop \<Rightarrow> 'a res iprop" where
  "inv N P = Pure (\<exists> \<iota>. pred_holds (Conj (Pure (\<iota>\<in>names N)) ((ownI \<iota> P))))"

definition ownE :: "name set \<Rightarrow> 'a res iprop" where
  "ownE E = own_inv enabled_name (Inv (\<epsilon>,DSet E,\<epsilon>))"

definition ownD :: "name fset \<Rightarrow> 'a res iprop" where
  "ownD D = own_inv disabled_name (Inv (\<epsilon>,\<epsilon>,DFSet D))"

definition lift_inv_fmap :: "(name,'a res iprop) fmap \<Rightarrow> (name,'a res iprop later) fmap" where
  "lift_inv_fmap m = Abs_fmap (map_option Next \<circ> (fmlookup m))"

definition wsat :: "'a res iprop" where
  "wsat \<equiv> Pure (\<exists>(I::(name,'a res iprop) fmap). pred_holds
    (Sep (own_inv invariant_name (Inv(view_auth_full(lift_inv_fmap I),\<epsilon>,\<epsilon>)))
     (sep_map_set (\<lambda>\<iota>. Disj (Sep (Later((the \<circ> (fmlookup I)) \<iota>)) (ownD {|\<iota>|}))
      (ownE {\<iota>})) (fmdom' I))))"
end

context
fixes get_heap :: "gname \<Rightarrow> 'a::ucamera res \<Rightarrow> heap_lang_heap option"
  and constr_heap :: "gname \<Rightarrow> heap_lang_heap \<Rightarrow> 'a res"
assumes inG_heap: "inG get_heap constr_heap"
begin

definition heap_name :: gname where "heap_name = 42"

abbreviation own_heap :: "heap_lang_heap \<Rightarrow> 'a res iprop" where
  "own_heap h \<equiv> Atom (Own (ConstC (constr_heap heap_name h)))"

definition points_to :: "loc \<Rightarrow> dfrac \<Rightarrow> val \<Rightarrow> 'a res iprop" where
  "points_to l dq v = own_heap(view_frag [l\<mapsto>(dq, to_ag (Some v))])"
abbreviation points_to_disc :: "loc \<Rightarrow> val \<Rightarrow> 'a res iprop" where
  "points_to_disc \<equiv> \<lambda>l v. points_to l DfracDiscarded v"
abbreviation points_to_own :: "loc \<Rightarrow> frac \<Rightarrow> val \<Rightarrow> 'a res iprop" where
  "points_to_own \<equiv> \<lambda>l p v. points_to l (DfracOwn p) v"
abbreviation points_to_full :: "loc \<Rightarrow> val \<Rightarrow> 'a res iprop" where
  "points_to_full \<equiv> \<lambda>l v. points_to_own l 1 v"

definition own_state_heap :: "state \<Rightarrow> 'a res iprop" where
  "own_state_heap s = own_heap (view_auth_full (heap s))"
end

type_synonym res1 = "(gname \<rightharpoonup> heap_lang_heap) res"

fun get_heap :: "gname \<Rightarrow> res1 \<Rightarrow> heap_lang_heap option" where
  "get_heap \<gamma> (Res (_,h)) = h \<gamma>"
definition constr_heap :: "gname \<Rightarrow> heap_lang_heap \<Rightarrow> res1" where
  "constr_heap \<gamma> h = Res (\<epsilon>, [\<gamma>\<mapsto>h])"

lemma res_n_equiv: "n_equiv n (Res r1) (Res r2) \<longleftrightarrow> n_equiv n r1 r2" sorry
lemma res_valid: "n_valid (Res r) n \<longleftrightarrow> n_valid r n" sorry
lemma res_pcore: "pcore (Res r) = map_option Res (pcore r)" sorry
lemma res_\<epsilon>: "\<epsilon> = Res \<epsilon>" sorry
lemma res_op: "Res r1 \<cdot> Res r2 = Res (r1\<cdot>r2)" sorry

interpretation inG_heap: inG get_heap constr_heap
apply (auto simp: inG_def constr_heap_def non_expansive_def res_n_equiv res_valid prod_n_valid_def \<epsilon>_n_valid res_pcore
  pcore_prod_def \<epsilon>_pcore pcore_fun_alt ofe_refl  res_\<epsilon> res_op op_prod_def \<epsilon>_left_id
  split: option.splits)
by (auto simp: \<epsilon>_fun_def \<epsilon>_option_def)

lemma ownE_singleton_twice: "pred_entails (Sep (ownE {i}) (ownE {i})) (Pure False)"
apply (auto simp: pred_entails_def upred_entails_def ownE_def own_inv_def constr_inv_def n_incl_def)
subgoal for a n b1 b2 c d
apply (cases c; cases d; cases b1; cases b2)
apply (auto simp: res_n_equiv res_op op_prod_def \<epsilon>_left_id op_fun_def op_option_def n_equiv_fun_def
  n_equiv_option_def split: option.splits)
sorry
done
end


(*
 * Copyright 2019, NTU
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 *  Author: Albert Rizaldi, NTU Singapore
 *)

theory Subtraction_Hoare_Typed
  imports VHDL_Hoare_Typed Bits_Int_Aux
begin

datatype sig = A | B | C

definition sub :: "sig conc_stmt" where
  "sub \<equiv> process {A, B} : Bassign_trans C (Bsub (Bsig A) (Bsig B)) 1"

lemma potential_tyenv:
  assumes "seq_wt \<Gamma> (Bassign_trans C (Bsub (Bsig A) (Bsig B)) 1)"
  shows "\<exists>len1>0. \<exists>len2>0. \<Gamma> A = Lty Uns len1 \<and> \<Gamma> B = Lty Uns len2 \<and> \<Gamma> C = Lty Uns (max len1 len2)
                   \<or> \<Gamma> A = Lty Sig len1 \<and> \<Gamma> B = Lty Sig len2 \<and> \<Gamma> C = Lty Sig (max len1 len2)"
proof (rule seq_wt_cases(4)[OF assms])
  assume "bexp_wt \<Gamma> (Bsub (Bsig A) (Bsig B)) (\<Gamma> C)"
  obtain len1 len2 where " \<Gamma> A = Lty Uns len1 \<and> \<Gamma> B = Lty Uns len2 \<and> \<Gamma> C = Lty Uns (max len1 len2)
                              \<or> \<Gamma> A = Lty Sig len1 \<and> \<Gamma> B = Lty Sig len2 \<and> \<Gamma> C = Lty Sig (max len1 len2)"
      and "0 < len1" and "0 < len2"
    apply (rule bexp_wt_cases_slice(6)[OF \<open>bexp_wt \<Gamma> (Bsub (Bsig A) (Bsig B)) (\<Gamma> C)\<close>])
    by (metis bexp_wt_cases_slice(2))+
 thus ?thesis
    by auto
qed

locale unsigned_subtraction =
  fixes \<Gamma> :: "sig tyenv"
  fixes len len1 len2 :: nat
  assumes len_def: "len = max len1 len2"
  assumes atype: "\<Gamma> A = Lty Uns len1" and btype: "\<Gamma> B = Lty Uns len2" and ctype: "\<Gamma> C = Lty Uns len"
  assumes len1: "0 < len1" and len2: "0 < len2"
begin

lemma well_typed:
  "seq_wt \<Gamma> (Bassign_trans C (Bsub (Bsig A) (Bsig B)) 1)"
  apply (rule seq_wt.intros(4))
  unfolding ctype len_def apply (rule bexp_wt.intros(19))
      apply (rule bexp_wt.intros(3))
      apply (rule atype[THEN sym] )
      apply (rule bexp_wt.intros(3))
      apply (rule btype[THEN sym] )
  using len1 len2 by auto

abbreviation "lof_wline tw sig n \<equiv> lval_of (wline_of tw sig n)"

definition inv :: "sig assn2" where
  "inv tw \<equiv> lof_wline tw C (fst tw) = bin_to_bl len (bl_to_bin (lof_wline tw A (fst tw - 1)) - bl_to_bin (lof_wline tw B (fst tw - 1)))"

definition inv2 :: "sig assn2" where
  "inv2 tw \<equiv> (disjnt {A, B} (event_of tw) \<longrightarrow> (\<forall>i > fst tw. lof_wline tw C i = lof_wline tw C (fst tw)))"

lemma inv_next_time:
  fixes tw
  defines "v \<equiv> eval_world_raw2 tw (Bsub (Bsig A) (Bsig B))"
  defines "tw' \<equiv> tw[C, 1 :=\<^sub>2 v]"
  assumes "wityping \<Gamma> (snd tw)"
  shows   "inv (fst tw' + 1, snd tw')"
proof -
  have bexpA: "bexp_wt \<Gamma> (Bsig A) (Lty Uns len1)" and bexpB: "bexp_wt \<Gamma> (Bsig B) (Lty Uns len2)"
    using unsigned_subtraction_axioms unfolding unsigned_subtraction_def by (metis bexp_wt.intros(3))+
  obtain bsA bsB where evalA: "eval_world_raw (fst tw) (snd tw) (Bsig A) = Lv Uns bsA" and" length bsA = len1 " and
                       evalB: "eval_world_raw (fst tw) (snd tw) (Bsig B) = Lv Uns bsB" and" length bsB = len2 "
      using eval_world_raw_lv[OF bexpA `wityping \<Gamma> (snd tw)`] eval_world_raw_lv[OF bexpB `wityping \<Gamma> (snd tw)`] by blast
  have "lof_wline tw' C (fst tw + 1) = lval_of v"
    unfolding tw'_def worldline_upd2_def worldline_upd_def by auto
  also have "... = bin_to_bl len (bl_to_bin (lof_wline tw A (fst tw)) - bl_to_bin (lof_wline tw B (fst tw)))"
    using evalA evalB `length bsA = len1` `length bsB = len2`
    unfolding v_def eval_world_raw.simps eval_arith.simps len_def Let_def by auto
  finally show ?thesis
    unfolding inv_def tw'_def worldline_upd2_def worldline_upd_def  by auto
qed

lemma inv2_next_time:
  fixes tw v
  defines "tw' \<equiv> tw[C, 1 :=\<^sub>2 v]"
  shows   "inv2 (fst tw' + 1, snd tw')"
  unfolding inv2_def tw'_def worldline_upd2_def worldline_upd_def by auto

lemma sub_conc_hoare:
  "\<And>tw. inv tw \<and> inv2 tw \<and> disjnt {A, B} (event_of tw) \<Longrightarrow> inv (fst tw + 1, snd tw)"
proof -
  fix tw
  assume "inv tw \<and> inv2 tw \<and> disjnt {A, B} (event_of tw)"
  hence "inv tw" and "inv2 tw" and "disjnt {A, B} (event_of tw)"
    by auto
  have "lof_wline tw C (fst tw + 1) = lof_wline tw C (fst tw)"
    using `inv2 tw` `disjnt {A, B} (event_of tw)` unfolding inv2_def by auto
  also have "... = bin_to_bl len (bl_to_bin (lval_of (wline_of tw A (get_time tw - 1))) - bl_to_bin (lval_of (wline_of tw B (get_time tw - 1))))"
    using `inv tw` unfolding inv_def by auto
  also have "... = bin_to_bl len (bl_to_bin (lval_of (wline_of tw A (fst tw))) - bl_to_bin (lval_of (wline_of tw B (fst tw))))"
    using `disjnt {A, B} (event_of tw)`  unfolding event_of_alt_def
    by (smt diff_0_eq_0 disjnt_insert1 mem_Collect_eq)
  finally show "inv (fst tw + 1, snd tw)"
    unfolding inv_def by auto
qed

lemma sub_conc_hoare2:
  "\<And>tw. inv2 tw \<and> disjnt {A, B} (event_of tw) \<Longrightarrow> inv2 (fst tw + 1, snd tw)"
  unfolding inv2_def by auto

lemma conc_stmt_wf_sub:
  "conc_stmt_wf sub"
  unfolding sub_def conc_stmt_wf_def by auto

lemma nonneg_delay_conc_sub:
  "nonneg_delay_conc sub"
  unfolding sub_def by auto

lemma nonneg_delay_conc_sub':
  "nonneg_delay_conc ( process {A, B} : Bassign_trans C (Bsub (Bsig A) (Bsig B)) 1)"
  using nonneg_delay_conc_sub unfolding sub_def by auto

lemma conc_wt_sub:
  "conc_wt \<Gamma> sub"
  unfolding sub_def  by (meson conc_wt.intros(1) well_typed)

lemma conc_wt_sub':
  "conc_wt \<Gamma> ( process {A, B} : Bassign_trans C (Bsub (Bsig A) (Bsig B)) 1)"
  using conc_wt_sub unfolding sub_def by auto

lemma sub_conc_sim2':
  "\<Gamma> \<turnstile>\<^sub>s \<lbrace>\<lambda>tw. inv tw \<and> inv2 tw\<rbrace> sub \<lbrace>\<lambda>tw. inv tw \<and> inv2 tw\<rbrace>"
  apply (rule While_Suc)
  apply (rule Conseq'[where P="wp3_conc \<Gamma> sub (\<lambda>tw. inv  (fst tw + 1, snd tw) \<and>
                                                      inv2 (fst tw + 1, snd tw))", rotated])
  apply (rule wp3_conc_is_pre, rule conc_stmt_wf_sub, rule nonneg_delay_conc_sub, rule conc_wt_sub, simp)
  unfolding sub_def  wp3_conc_single'[OF conc_wt_sub' nonneg_delay_conc_sub'] wp3_fun.simps
  using inv_next_time inv2_next_time sub_conc_hoare sub_conc_hoare2 by presburger

text \<open>Initialisation preserves the invariant\<close>

lemma nonneg_delay_sub:
  " nonneg_delay (Bassign_trans C (Bsub (Bsig A) (Bsig B)) 1)"
  using nonneg_delay_conc_sub' by auto

lemma init_sat_nand_inv_comb:
  "init_sim2_hoare_wt \<Gamma> (\<lambda>tw. fst tw = 0) sub (\<lambda>tw. inv tw \<and> inv2 tw)"
  unfolding sub_def
  apply (rule AssignI_suc, rule SingleI)
  apply (rule Conseq3[where Q="\<lambda>tw. inv (fst tw + 1, snd tw) \<and> inv2 (fst tw + 1, snd tw)", rotated])
  apply (rule wp3_fun_is_pre[OF well_typed nonneg_delay_sub], simp)
  unfolding wp3_fun.simps using inv_next_time inv2_next_time by blast

lemma correctness:
  assumes "sim_fin2 w (i + 1) sub tw'" and "wityping \<Gamma> w"
  shows "lof_wline tw' C (i + 1) = bin_to_bl len (bl_to_bin (lof_wline tw' A i) - bl_to_bin (lof_wline tw' B i))"
  using grand_correctness[OF assms conc_stmt_wf_sub conc_wt_sub nonneg_delay_conc_sub sub_conc_sim2' init_sat_nand_inv_comb]
  unfolding sub_def inv_def by (metis (no_types, lifting) add_diff_cancel_right' assms(1)
  sim_fin2.cases world_maxtime_lt_fst_tres)

end


theory sugar
imports Main
begin

subsection {* Syntactic sugar *}

text {* Here we define some helper functions, to shorten the notation in this document. *}

definition orElse (infixr "orElse" 25) where
"x orElse y \<equiv> (case x of Some a \<Rightarrow> a | None \<Rightarrow> y)"

lemma orElse_some[simp]: "(Some x orElse y) = x"
  by (simp add: orElse_def)

lemma orElse_none[simp]: "(None orElse x) = x"
  by (simp add: orElse_def)

definition compose_forward (infixl "|>" 25) where
"x |> f \<equiv> f x"

lemma "(1 |> op+ 1 |> op* 2) = (4 :: int)"
  by eval

end


theory Rustv
  imports Defs BorrowStack
begin

abbreviation "collect_tags_stack == BorrowStack.collect_tags"
abbreviation "pop_tags_stack == BorrowStack.pop_tags"
abbreviation "permission_is_stack == BorrowStack.permission_is"
abbreviation "readable_stack == BorrowStack.readable"
abbreviation "writable_stack == BorrowStack.writable"
abbreviation "reborrow_comp_stack == BorrowStack.reborrow_comp"
abbreviation "reborrow_stack == BorrowStack.reborrow"

record globals_ram =
  memory :: "val list"
  tags :: "(ref_kind * tag set) stack list"
  issued_tags :: "tag list"

fun wf_tags :: "(ref_kind * tag set) stack list \<Rightarrow> bool" where
  "wf_tags [] = True" |
  "wf_tags (stack # ts) = (wf_reborrow stack \<and> stack_finite stack \<and> wf_tags ts)"

lemma wf_tags_spec:
  "wf_tags ts \<longleftrightarrow> (\<forall>stack \<in> set ts. wf_reborrow stack \<and> stack_finite stack)"
proof (induction ts)
qed auto

lemma wf_tags_snoc:
  "wf_tags (ts @ [stack]) \<longleftrightarrow> wf_tags ts \<and> wf_reborrow stack \<and> stack_finite stack"
  using wf_tags_spec by auto

lemma list_update_forall:
  "\<lbrakk>\<forall>x \<in> set xs. P x; P x'\<rbrakk> \<Longrightarrow> \<forall>x \<in> set (xs[p := x']). P x"
  using set_update_subset_insert by fastforce

lemma wf_tags_update:
  assumes
    "wf_tags ts"
    "wf_reborrow stack"
    "stack_finite stack"
  shows "wf_tags (ts[p := stack])"
  using assms set_update_subset_insert wf_tags_spec by fastforce

fun collect_tags :: "(ref_kind * tag set) stack list \<Rightarrow> tag set" where
  "collect_tags [] = {}" |
  "collect_tags (stack # ts) = collect_tags_stack stack \<union> collect_tags ts"
lemma collect_tags_spec:
  "t \<in> collect_tags ts \<longleftrightarrow> (\<exists>stack \<in> set ts. \<exists>entry \<in> set (map snd stack). t \<in> entry)"
proof (induction ts)
  case Nil
  then show ?case by simp
next
  case (Cons stack ts)
  show ?case
  proof
    assume "t \<in> collect_tags (stack # ts)"
    then have "t \<in> \<Union>(set (map snd stack)) \<or> t \<in> collect_tags ts" by simp
    then show "\<exists>s \<in> set (stack # ts). \<exists>entry \<in> set (map snd s). t \<in> entry"
    proof (rule disjE)
      assume "t \<in> \<Union>(set (map snd stack))"
      then show ?thesis by simp
    next
      assume "t \<in> collect_tags ts"
      then show ?thesis by (simp add: Cons.IH)
    qed
  next
    assume "\<exists>stack \<in> set (stack # ts). \<exists>entry \<in> set (map snd stack). t \<in> entry"
    then obtain s entry where
      1: "s \<in> set (stack # ts)" and
      2: "entry \<in> set (map snd s)" and
      3: "t \<in> entry"
      by auto

    have "s = stack \<or> s \<in> set ts" using 1 by auto
    then show "t \<in> collect_tags (stack # ts)"
    proof (rule disjE)
      assume "s = stack"
      then have "\<exists>entry \<in> set (map snd stack). t \<in> entry" using 2 3 by auto
      then show ?thesis by simp
    next
      assume "s \<in> set ts"
      then have "\<exists>s \<in> set ts. \<exists>entry \<in> set (map snd s). t \<in> entry"
        using 2 3 by auto
      then show ?thesis by (simp add: Cons.IH)
    qed
  qed
qed

lemma collect_tags_spec':
  "t \<in> collect_tags ts \<longleftrightarrow> (\<exists>stack \<in> set ts. t \<in> collect_tags_stack stack)"
  using collect_tags_spec by fastforce

lemma collect_tags_update[simp, intro]:
  "t \<in> collect_tags (ts[p := stack]) \<Longrightarrow> t \<in> collect_tags ts \<or> t \<in> collect_tags_stack stack"
  using collect_tags_spec set_update_subset_insert subset_code(1) by fastforce

lemma collect_tags_update_subset:
  "collect_tags (ts[p := stack]) \<subseteq> collect_tags_stack stack \<union> collect_tags ts"
  using collect_tags_update by blast

lemma collect_tags_last[simp, intro]:
  "collect_tags (ts @ [stack]) = collect_tags_stack stack \<union> (collect_tags ts)"
proof (induction ts)
qed auto

lemma collect_tags_finite[simp, intro]: "wf_tags ts \<Longrightarrow> finite (collect_tags ts)"
proof (induction ts)
  case (Cons stack ts)
  then have "stack_finite stack \<and> finite (collect_tags ts)" by auto
  then show ?case using collect_tags_stack_finite by auto
qed auto

fun wf_heap :: "'a globals_ram_scheme \<Rightarrow> bool" where
  "wf_heap s \<longleftrightarrow>
    length (memory s) = length (tags s)
    \<and> wf_tags (tags s)
    \<and> collect_tags (tags s) \<subseteq> set (issued_tags s)"

fun pop_tags :: "tagged_ref \<Rightarrow> 'a globals_ram_scheme \<Rightarrow> 'a globals_ram_scheme" where
  "pop_tags r s =
    (let p = the_ptr (pointer r);
         stack = tags s ! p;
         stack' = pop_tags_stack (tag r) stack in
    s\<lparr> tags := (tags s)[p := stack'] \<rparr>)"

fun_cases pop_tags_elims: "pop_tags r s = s'"

lemma pop_tags_wf_tags:
  assumes
    "pop_tags r s = s'"
    "the_ptr (pointer r) < length (tags s)"
    "(tags s') ! the_ptr (pointer r) \<noteq> []"
    "wf_tags (tags s)"
  shows "wf_tags (tags s')"
  using assms(1) apply (rule pop_tags_elims, simp add: Let_def)
  apply (rule wf_tags_update)
  using assms(4) apply simp
  using assms dropWhile_stack_reborrow wf_tags_spec apply simp
  using assms dropWhile_stack_finite wf_tags_spec by simp

lemma hd_pop_tags:
  assumes
    "pop_tags r s = s'"
    "the_ptr (pointer r) < length (tags s)"
    "tag r \<in> collect_tags_stack ((tags s) ! the_ptr (pointer r))"
  shows "tag r \<in> snd (hd ((tags s') ! the_ptr (pointer r)))"
  using assms(1) apply (rule pop_tags_elims)
  using assms hd_dropWhile_stack Let_def  by (auto simp add: Let_def)

lemma pop_tags_memory[intro]:
  "pop_tags r s = s' \<Longrightarrow> memory s' = memory s"
  apply (erule pop_tags.elims)
  by (simp add: Let_def)

lemma pop_tags_tags_length:
  assumes "pop_tags r s = s'"
  shows "length (tags s) = length (tags s')"
using assms proof (rule pop_tags_elims, auto simp add: Let_def)
qed

lemma pop_tags_result:
  assumes
    "pop_tags r s = s'"
    "the_ptr (pointer r) < length (tags s)"
    "p < length (tags s)"
  shows "\<exists>start. (tags s) ! p =
    (if p = the_ptr (pointer r) then
      start @ (tags s') ! p
    else
       (tags s') ! p)"
proof -
  have "p \<noteq> the_ptr (pointer r) \<Longrightarrow> (tags s) ! p = (tags s') ! p"
    using assms(1) apply (rule pop_tags_elims)
    by (auto simp add: Let_def)
  moreover have "p = the_ptr (pointer r) \<Longrightarrow> \<exists>start. (tags s) ! p = start @ (tags s') ! p"
    using assms(1) apply (rule pop_tags_elims)
    apply (auto simp add: Let_def)
    by (metis assms(2) takeWhile_dropWhile_id nth_list_update_eq)
  ultimately show ?thesis by simp
qed

fun memread :: "tagged_ref \<Rightarrow> 'a globals_ram_scheme \<Rightarrow> val" where
  "memread p s =
    (let memory = memory s in
    memory ! (the_ptr (pointer p)))"

fun memwrite :: "tagged_ref \<Rightarrow> val \<Rightarrow> 'a globals_ram_scheme \<Rightarrow> 'a globals_ram_scheme"
  where
  "memwrite p v s =
    (let memory = memory s in
    let memory' = memory[the_ptr (pointer p) := v] in
    s\<lparr> memory := memory' \<rparr>)"

lemma memwrite_written[simp]:
  fixes p v s s'
  assumes "s' = memwrite p v s"
          "the_ptr (pointer p) < length (memory s)"
  shows "(memory s') ! the_ptr (pointer p) = v"
  by (simp add: assms(1) assms(2))
lemma memwrite_not_written[simp]:
  fixes p p' v s s'
  assumes "s' = memwrite p v s"
          "pointer p \<noteq> pointer p'"
        shows "(memory s') ! the_ptr (pointer p') = (memory s) ! the_ptr (pointer p')"
  apply (simp add: assms(1))
  by (metis assms(2) nth_list_update_neq the_ptr.elims)
lemma memwrite_tags:
  fixes p v s s'
  assumes "s' = memwrite p v s"
  shows "tags s' = tags s"
  by (simp add: assms)

fun max_list :: "nat list \<Rightarrow> nat" where
  "max_list [] = 0" |
  "max_list (x # xs) = max x (max_list xs)"

lemma max_list_ge: "\<forall>x \<in> set xs. max_list xs \<ge> x"
proof (induction xs)
  case Nil
  then show ?case by simp
next
  case (Cons x' xs)
  then show ?case by auto
qed

lemma suc_max_list_gt: "\<forall>x \<in> set xs. Suc (max_list xs) > x"
  using max_list_ge by fastforce

lemma max_simp[simp]: "max (Suc n) n = Suc n"
  by simp

fun new_tag :: "'a globals_ram_scheme \<Rightarrow> tag" where
  "new_tag s = tag_val (Suc (max_list (map the_tag (issued_tags s))))"

fun_cases new_tag_elims: "new_tag s = t"

lemma new_tag_gt: "\<forall>t \<in> set (issued_tags s). the_tag (new_tag s) > the_tag t"
  using suc_max_list_gt by simp

lemma new_tag_notin[simp, intro]: "new_tag s = t \<Longrightarrow> t \<notin> set (issued_tags s)"
  using new_tag_gt by blast

lemma new_tag_notin_at:
  assumes
    "wf_heap s"
    "new_tag s = t"
    "r < length (tags s)"
  shows "t \<notin> collect_tags_stack (tags s ! r)"
proof -
  have "t \<notin> set (issued_tags s)" using assms by auto
  then have "t \<notin> collect_tags (tags s)" using assms by auto
  thus ?thesis using assms using collect_tags_spec' nth_mem by blast
qed

fun permission_is :: "ref_kind \<Rightarrow> tagged_ref \<Rightarrow> 'a globals_ram_scheme \<Rightarrow> bool" where
  "permission_is k r s =
    (let p = the_ptr (pointer r) in
    let t = tag r in
    p < length (memory s) \<and> permission_is_stack k t (tags s ! p))"

fun readable :: "tagged_ref \<Rightarrow> 'a globals_ram_scheme \<Rightarrow> bool" where
  "readable r s =
    (let p = the_ptr (pointer r) in
    let t = tag r in
    p < length (memory s) \<and> readable_stack t (tags s ! p))"

fun writable :: "tagged_ref \<Rightarrow> 'a globals_ram_scheme \<Rightarrow> bool" where
  "writable r s =
    (let p = the_ptr (pointer r) in
    let t = tag r in
    p < length (memory s) \<and> writable_stack t (tags s ! p))"

lemma writable_update[simp]: "writable r (memwrite r' v s) = writable r s"
  by simp

lemma pop_tags_writable[intro]: "\<lbrakk>writable r s; wf_heap s\<rbrakk> \<Longrightarrow> writable r (pop_tags r s)"
  apply (auto simp del: BorrowStack.pop_tags.simps)
  by (metis nth_list_update_eq writable_pop_tags)

fun new_pointer :: "'a globals_ram_scheme \<Rightarrow> pointer" where
  "new_pointer s = ptr_val (length (memory s))"

fun heap_new :: "val \<Rightarrow> 'a globals_ram_scheme \<Rightarrow> tagged_ref * 'a globals_ram_scheme" where
  "heap_new v s =
    (let p = new_pointer s;
         t = new_tag s in
    (\<lparr> pointer = p, tag = t \<rparr>,
     s\<lparr> memory := memory s @ [v],
        tags := tags s @ [[(Unique, {t})]],
        issued_tags := t # issued_tags s \<rparr>))"

fun_cases heap_new_elims: "heap_new v s = (r, s')"

lemma heap_new_writable: "\<lbrakk>wf_heap s; heap_new v s = (r', s')\<rbrakk> \<Longrightarrow> writable r' s'"
  apply (erule heap_new_elims)
  by (simp add: Let_def)

lemma heap_new_wf_heap_update: "\<lbrakk>wf_heap s; heap_new v s = (r', s')\<rbrakk> \<Longrightarrow> wf_heap s'"
  apply (erule heap_new_elims)
  by (auto simp add: Let_def wf_tags_snoc BorrowRoot)

fun reborrow :: "ref_kind \<Rightarrow> tagged_ref \<Rightarrow> 'a globals_ram_scheme \<Rightarrow> tagged_ref * 'a globals_ram_scheme" where
  "reborrow k r s =
    (let p = the_ptr (pointer r) in
    let t = new_tag s in
    let tags = (tags s)[p := reborrow_comp_stack k t (tag r) ((tags s) ! p)] in
    (\<lparr> pointer = pointer r, tag = t \<rparr>,  s\<lparr> tags := tags, issued_tags := t # issued_tags s \<rparr>))"

declare BorrowStack.reborrow_comp.simps [simp del]
fun_cases reborrow_elims: "reborrow k r s = (r', s')"
declare BorrowStack.reborrow_comp.simps [simp]

lemma collect_tags_stack_reborrow_subset:
  assumes
    "pop_tags_stack parent stack = popped"
    "reborrow_stack k child popped = stack'"
  shows "collect_tags_stack stack' \<subseteq> {child} \<union> collect_tags_stack stack"
proof -
  have "collect_tags_stack stack' \<subseteq> {child} \<union> collect_tags_stack popped"
    using collect_tags_reborrow_subset assms by simp
  moreover have "collect_tags_stack popped \<subseteq> collect_tags_stack stack"
    using notin_pop_tags assms by simp
  ultimately show ?thesis by auto
qed

lemma collect_tags_reborrow_subset:
  "\<lbrakk>the_ptr (pointer r) < length (tags s); reborrow k r s = (r', s')\<rbrakk> \<Longrightarrow> collect_tags (tags s') \<subseteq> {new_tag s} \<union> collect_tags (tags s)"
  apply (erule reborrow_elims)
  apply (simp add: Let_def del: reborrow_comp.simps)
  using collect_tags_update_subset reborrow_comp_subset collect_tags_spec' nth_mem by blast

lemma collect_tags_reborrow_subset':
  "\<lbrakk>the_ptr (pointer r) < length (tags s)\<rbrakk>
  \<Longrightarrow> collect_tags (tags (snd (reborrow k r s))) \<subseteq> {new_tag s} \<union> collect_tags (tags s)"
  apply (simp add: Let_def del: reborrow_comp.simps)
  using collect_tags_update_subset reborrow_comp_subset collect_tags_spec' nth_mem by blast

lemma reborrow_pointer: "reborrow k r s = (r', s') \<Longrightarrow> pointer r' = pointer r"
  apply (erule reborrow_elims)
  by (auto simp add: Let_def)

lemma new_tag_collect:
  assumes
    "p < length ts"
    "x \<in> collect_tags (ts[p := reborrow_comp_stack k t' t (ts ! p)])"
      (is "x \<in> collect_tags (ts[p := ?stack])")
    "collect_tags ts \<subseteq> issued"
    "x \<notin> issued"
  shows "x = t'"
proof -
  have "x \<in> collect_tags_stack ?stack \<union> collect_tags ts"
    using assms collect_tags_update by blast
  then have "x \<in> {t'} \<union> collect_tags_stack (ts ! p) \<union> collect_tags ts"
    using reborrow_comp_subset by blast
  moreover have "collect_tags_stack (ts ! p) \<subseteq> collect_tags ts"
    using assms collect_tags_spec' nth_mem by blast
  ultimately have "x \<in> {t'} \<union> collect_tags ts" by auto
  then show ?thesis using assms by auto
qed

lemma reborrow_update_heap': "\<lbrakk>wf_heap s; writable r s\<rbrakk> \<Longrightarrow> wf_heap (snd (reborrow k r s))"
  apply (auto simp add: Let_def)
   apply (rule wf_tags_update, auto)
    apply (rule wf_reborrow_reborrow_comp, auto)
     apply (simp add: wf_tags_spec)
  using new_tag_notin_at apply fastforce
   apply (rule stack_finite_reborrow, auto)
   apply (rule dropWhile_stack_finite)
   apply (simp add: wf_tags_spec)
  using new_tag_collect by auto

lemma reborrow_update_heap: "\<lbrakk>wf_heap s; writable r s; reborrow k r s = (r', s')\<rbrakk> \<Longrightarrow> wf_heap s'"
  using reborrow_update_heap' by (metis snd_conv)

lemma reborrow_writable: "\<lbrakk>wf_heap s; writable r s; reborrow k r s = (r', s')\<rbrakk> \<Longrightarrow> writable r s'"
  apply (erule reborrow_elims)
  apply (simp add: Let_def del: BorrowStack.reborrow_comp.simps)
  apply (rule writable_reborrow_comp)
     apply blast
    apply blast
  using wf_tags_spec nth_mem apply blast
  using new_tag_notin_at by auto

lemma reborrow_writable_derived:
  assumes
    "wf_heap s"
    "writable r s"
    "reborrow k r s = (r', s')"
    "k = Unique \<or> k = SharedReadWrite"
  shows "writable r' s'"
  using assms(3) apply (rule reborrow_elims)
  using assms apply (simp add: Let_def del: BorrowStack.reborrow_comp.simps)
  apply (rule writable_reborrow_comp_derived[of "tag r" "tags s ! the_ptr (pointer r)" k])
  using wf_tags_spec apply auto[3]
  using new_tag_notin_at by auto

lemma lemma_for_write_ex1:
  assumes
    "the_ptr (pointer p) < length ts"
    "\<exists>x \<in> set (ts ! the_ptr (pointer p)). t \<in> snd x"
  shows "t \<in> collect_tags ts"
  using assms collect_tags_spec nth_mem by auto

lemma lemma_for_write_ex:
  assumes
    "the_ptr (pointer p) < length ts"
    "collect_tags ts \<subseteq> set issued"
  shows "\<forall>x \<in> set (ts ! the_ptr (pointer p)). tag_val (Suc (max_list (map the_tag issued))) \<notin> snd x"
  using assms lemma_for_write_ex1
  by (metis Suc_n_not_le_n in_set_conv_nth length_map max_list_ge nth_map subsetD the_tag.simps)

lemma wf_tags_in_same_layer_dropWhile:
  fixes x y tags
  assumes
    "wf_tags tags"
    "ptr_eq x y"
    "the_ptr (pointer y) < length tags"
    "in_same_layer (tag x) (tag y) (tags ! the_ptr (pointer y))"
  shows "dropWhile (\<lambda>entry. tag x \<notin> snd entry) (tags ! the_ptr (pointer y))
        = dropWhile (\<lambda>entry. tag y \<notin> snd entry) (tags ! the_ptr (pointer y))"
  using assms in_same_layer_pop_tags wf_tags_spec by fastforce

end