(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_weird_nat_op_assoc2
  imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun op1 :: "Nat => Nat => Nat => Nat => Nat" where
  "op1 x y z x2 =
   (let fail :: Nat =
     (case z of
        Z => (case x of S x4 => op1 x4 y y x2)
        | S x3 => op1 x y x3 (S x2))
   in (case x of
         Z =>
           (case z of
              Z => x2
              | S x6 => fail)
         | S x5 => fail))"

theorem property0 :
  "((op1 (op1 x a a a) b c d) = (op1 a (op1 b x b b) c d))"
  oops

end


(* Author: Andrew Boyton, 2012
   Maintainers: Gerwin Klein <kleing at cse.unsw.edu.au>
                Rafal Kolanski <rafal.kolanski at nicta.com.au>
*)

section "A simplified version of the actual capDL specification."

theory Types_D
imports "HOL-Word.Word"
begin

(*
 * Objects are named by 32 bit words.
 * This name may correspond to the memory address of the object.
 *)
type_synonym cdl_object_id = "32 word"

type_synonym cdl_object_set = "cdl_object_id set"

(* The type we use to represent object sizes. *)
type_synonym cdl_size_bits = nat

(* An index into a CNode, TCB, or other kernel object that contains caps. *)
type_synonym cdl_cnode_index = nat

(* A reference to a capability slot. *)
type_synonym cdl_cap_ref = "cdl_object_id \<times> cdl_cnode_index"

(* The possible access-control rights that exist in the system. *)
datatype cdl_right = AllowRead | AllowWrite | AllowGrant

(*
 * Kernel capabilities.
 *
 * Such capabilities (or "caps") give the holder particular rights to
 * a kernel object or system hardware.
 *
 * Caps have attributes such as the object they point to, the rights
 * they give the holder, or how the holder is allowed to interact with
 * the target object.
 *
 * This is a simplified, cut-down version of this datatype for
 * demonstration purposes.
 *)
datatype cdl_cap =
    NullCap
  | EndpointCap cdl_object_id "cdl_right set"
  | CNodeCap cdl_object_id
  | TcbCap cdl_object_id

(* A mapping from capability identifiers to capabilities. *)
type_synonym cdl_cap_map = "cdl_cnode_index \<Rightarrow> cdl_cap option"

translations
  (type) "cdl_cap_map" <= (type) "nat \<Rightarrow> cdl_cap option"
  (type) "cdl_cap_ref" <= (type) "cdl_object_id \<times> nat"

(* A user cap pointer. *)
type_synonym cdl_cptr = "32 word"

(* Kernel objects *)
record cdl_tcb =
  cdl_tcb_caps :: cdl_cap_map
  cdl_tcb_fault_endpoint :: cdl_cptr

record cdl_cnode =
  cdl_cnode_caps :: cdl_cap_map
  cdl_cnode_size_bits :: cdl_size_bits

(*
 * Kernel objects.
 *
 * These are in-memory objects that may, over the course of the system
 * execution, be created or deleted by users.
 *
 * Again, a simplified version of the real datatype.
 *)
datatype cdl_object =
    Endpoint
  | Tcb cdl_tcb
  | CNode cdl_cnode

(*
 * The current state of the system.
 *
 * The state record contains the following primary pieces of information:
 *
 * objects:
 *   The objects that currently exist in the system.
 *
 * current_thread:
 *   The currently running thread. Operations will always be performed
 *   on behalf of this thread.
 *
 * ghost_state: (Used for separation logic)
 *   Which fields are owned by an object.
 *   In capDL this is all of the fields (or none of them).
 *   In any concrete state, this will be all of the fields.
 *)

(* The ghost state tracks which components (fields and slots) are owned by an object.
 * Fields + slots are encoded as None + Some nat.
 *)
type_synonym cdl_heap = "cdl_object_id \<Rightarrow> cdl_object option"
type_synonym cdl_component  = "nat option"
type_synonym cdl_components = "cdl_component set"
type_synonym cdl_ghost_state = "cdl_object_id \<Rightarrow> cdl_components"

translations
  (type) "cdl_heap" <= (type) "cdl_object_id \<Rightarrow> cdl_object option"
  (type) "cdl_ghost_state" <= (type) "cdl_object_id \<Rightarrow> nat option set"

record cdl_state =
  cdl_objects :: "cdl_heap"
  cdl_current_thread :: "cdl_object_id option"
  cdl_ghost_state :: "cdl_ghost_state"

(* Kernel objects types. *)
datatype cdl_object_type =
    EndpointType
  | TcbType
  | CNodeType

(* Return the type of an object. *)
definition
  object_type :: "cdl_object \<Rightarrow> cdl_object_type"
where
  "object_type x \<equiv>
    case x of
        Endpoint \<Rightarrow> EndpointType
      | Tcb _ \<Rightarrow> TcbType
      | CNode _ \<Rightarrow> CNodeType"

(*
 * Getters and setters for various data types.
 *)

(* Capability getters / setters *)

definition cap_objects :: "cdl_cap \<Rightarrow> cdl_object_id set"
where
    "cap_objects cap \<equiv>
       case cap of
           TcbCap x \<Rightarrow> {x}
         | CNodeCap x \<Rightarrow> {x}
         | EndpointCap x _ \<Rightarrow> {x}"

definition cap_has_object :: "cdl_cap \<Rightarrow> bool"
where
    "cap_has_object cap \<equiv>
       case cap of
           NullCap          \<Rightarrow> False
         | _                \<Rightarrow> True"

definition cap_object :: "cdl_cap \<Rightarrow> cdl_object_id"
where
    "cap_object cap \<equiv>
       if cap_has_object cap
         then THE obj_id. cap_objects cap = {obj_id}
         else undefined "

lemma cap_object_simps:
  "cap_object (TcbCap x) = x"
  "cap_object (CNodeCap x) = x"
  "cap_object (EndpointCap x j) = x"
  by (simp_all add:cap_object_def cap_objects_def cap_has_object_def)

definition
  cap_rights :: "cdl_cap \<Rightarrow> cdl_right set"
where
  "cap_rights c \<equiv> case c of
      EndpointCap _ x \<Rightarrow> x
    | _ \<Rightarrow> UNIV"

definition
  update_cap_rights :: "cdl_right set \<Rightarrow> cdl_cap \<Rightarrow> cdl_cap"
where
  "update_cap_rights r c \<equiv> case c of
      EndpointCap f1 _ \<Rightarrow> EndpointCap f1 r
    | _ \<Rightarrow> c"

(* Kernel object getters / setters *)
definition
  object_slots :: "cdl_object \<Rightarrow> cdl_cap_map"
where
  "object_slots obj \<equiv> case obj of
    CNode x \<Rightarrow> cdl_cnode_caps x
  | Tcb x \<Rightarrow> cdl_tcb_caps x
  | _ \<Rightarrow> Map.empty"

definition
  update_slots :: "cdl_cap_map \<Rightarrow> cdl_object \<Rightarrow> cdl_object"
where
  "update_slots new_val obj \<equiv> case obj of
    CNode x \<Rightarrow> CNode (x\<lparr>cdl_cnode_caps := new_val\<rparr>)
  | Tcb x \<Rightarrow> Tcb (x\<lparr>cdl_tcb_caps := new_val\<rparr>)
  | _ \<Rightarrow> obj"

(* Adds new caps to an object. It won't overwrite on a collision. *)
definition
  add_to_slots :: "cdl_cap_map \<Rightarrow> cdl_object \<Rightarrow> cdl_object"
where
  "add_to_slots new_val obj \<equiv> update_slots (new_val ++ (object_slots obj)) obj"

definition
  slots_of :: "cdl_heap \<Rightarrow> cdl_object_id \<Rightarrow> cdl_cap_map"
where
  "slots_of h \<equiv> \<lambda>obj_id.
  case h obj_id of
    None \<Rightarrow> Map.empty
  | Some obj \<Rightarrow> object_slots obj"

definition
  has_slots :: "cdl_object \<Rightarrow> bool"
where
  "has_slots obj \<equiv> case obj of
    CNode _ \<Rightarrow> True
  | Tcb _ \<Rightarrow> True
  | _ \<Rightarrow> False"

definition
  object_at :: "(cdl_object \<Rightarrow> bool) \<Rightarrow> cdl_object_id \<Rightarrow> cdl_heap \<Rightarrow> bool"
where
  "object_at P p s \<equiv> \<exists>object. s p = Some object \<and> P object"

abbreviation
  "ko_at k \<equiv> object_at ((=) k)"

end


theory flash96Bra  imports flash96Rev

  begin
lemma onInv96:

   assumes

     b1:"r \<in> rules N" and b2:"invf=inv96 "
   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 (inv96 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX1VsInv96 )
          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 (inv96 ) (NI_Local_GetX_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_GetXVsInv96 )
          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 (inv96 ) (NI_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceVsInv96 )
          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 (inv96 ) (NI_ShWb N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ShWbVsInv96 )
          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 (inv96 ) (PI_Local_GetX_GetX2 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX2VsInv96 )
          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 (inv96 ) (NI_Local_PutXAcksDone ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutXAcksDoneVsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX7VsInv96 )
          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 (inv96 ) (NI_Local_Get_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak2VsInv96 )
          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 (inv96 ) (NI_ReplaceHomeShrVld ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeShrVldVsInv96 )
          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 (inv96 ) (NI_Remote_Put  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutVsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX5VsInv96 )
          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 (inv96 ) (NI_Wb ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_WbVsInv96 )
          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 (inv96 ) (NI_Local_Get_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_GetVsInv96 )
          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 (inv96 ) (PI_Local_Replace ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_ReplaceVsInv96 )
          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 (inv96 ) (NI_ReplaceShrVld  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceShrVldVsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8VsInv96 )
          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 (inv96 ) (NI_InvAck_2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_2VsInv96 )
          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 (inv96 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak2VsInv96 )
          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 (inv96 ) (PI_Remote_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_ReplaceVsInv96 )
          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 (inv96 ) (NI_Nak_Home ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_HomeVsInv96 )
          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 (inv96 ) (NI_Local_Get_Put2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put2VsInv96 )
          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 (inv96 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1VsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX11VsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX6VsInv96 )
          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 (inv96 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put2VsInv96 )
          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 (inv96 ) (PI_Local_Get_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_PutVsInv96 )
          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 (inv96 ) (PI_Local_GetX_PutX1 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX1VsInv96 )
          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 (inv96 ) (NI_InvAck_1_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1_HomeVsInv96 )
          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 (inv96 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak1VsInv96 )
          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 (inv96 ) (NI_Local_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak1VsInv96 )
          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 (inv96 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak2VsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10_homeVsInv96 )
          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 (inv96 ) (PI_Remote_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetVsInv96 )
          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 (inv96 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak3VsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10VsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX2VsInv96 )
          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 (inv96 ) (NI_Remote_Get_Put1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put1VsInv96 )
          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 (inv96 ) (NI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutXVsInv96 )
          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 (inv96 ) (Store  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis StoreVsInv96 )
          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 (inv96 ) (NI_FAck ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_FAckVsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX3VsInv96 )
          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 (inv96 ) (PI_Local_GetX_PutX3 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX3VsInv96 )
          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 (inv96 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutXVsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8_homeVsInv96 )
          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 (inv96 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put1VsInv96 )
          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 (inv96 ) (PI_Local_GetX_GetX1 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX1VsInv96 )
          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 (inv96 ) (StoreHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis StoreHomeVsInv96 )
          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 (inv96 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_NakVsInv96 )
          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 (inv96 ) (NI_Inv  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvVsInv96 )
          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 (inv96 ) (PI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_PutXVsInv96 )
          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 (inv96 ) (PI_Local_GetX_PutX4 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX4VsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX4VsInv96 )
          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 (inv96 ) (NI_Nak  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_NakVsInv96 )
          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 (inv96 ) (PI_Local_GetX_PutX2 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX2VsInv96 )
          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 (inv96 ) (NI_Local_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutVsInv96 )
          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 (inv96 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak1VsInv96 )
          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 (inv96 ) (NI_Nak_Clear ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_ClearVsInv96 )
          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 (inv96 ) (PI_Local_PutX ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_PutXVsInv96 )
          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 (inv96 ) (NI_Local_Get_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak3VsInv96 )
          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 (inv96 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_Nak_HomeVsInv96 )
          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 (inv96 ) (PI_Local_Get_Get ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_GetVsInv96 )
          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 (inv96 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX9VsInv96 )
          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 (inv96 ) (PI_Remote_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetXVsInv96 )
          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 (inv96 ) (NI_ReplaceHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeVsInv96 )
          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 (inv96 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutX_HomeVsInv96 )
          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 (inv96 ) (NI_Local_Get_Put3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put3VsInv96 )
          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 "ConstantMemory"

imports
   "InstructionAux" "../../ProgramInAvl"

begin

declare stack_1_1_op_def [simp del]
declare jump_def [simp del]
(* declare cut_memory.simps [simp del] *)

theorem lemma_stack_2_1_op :
"stack_2_1_op v c f = InstructionContinue nv \<Longrightarrow>
 vctx_memory v = vctx_memory nv"
apply(auto simp:stack_2_1_op_def)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto split:option.split)
done

theorem lemma_stack_3_1_op :
"stack_3_1_op v c f = InstructionContinue nv \<Longrightarrow>
 vctx_memory v = vctx_memory nv"
apply(auto simp:stack_3_1_op_def)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply auto
apply(cases "tl (tl (vctx_stack v))")
apply auto
done

theorem lemma_stack_1_1_op :
"stack_1_1_op v c f = InstructionContinue nv \<Longrightarrow>
 vctx_memory v = vctx_memory nv"
apply(auto simp:stack_1_1_op_def)
apply(cases "vctx_stack v")
apply(auto split:option.split)
done

theorem lemma_jump [simp] :
"jump v c = InstructionContinue nv \<Longrightarrow>
 vctx_memory v = vctx_memory nv"
apply(auto simp:jump_def)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "vctx_next_instruction
   (v\<lparr>vctx_stack := tl (vctx_stack v), vctx_pc := unat (hd (vctx_stack v))\<rparr>) c")
apply(auto)
apply(cases "get_some (vctx_next_instruction
   (v\<lparr>vctx_stack := tl (vctx_stack v), vctx_pc := unat (hd (vctx_stack v))\<rparr>) c)")
apply(auto)
apply(cases "get_pc (vctx_next_instruction
   (v\<lparr>vctx_stack := tl (vctx_stack v), vctx_pc := unat (hd (vctx_stack v))\<rparr>) c)")
apply(auto)
done

theorem lemma_jump_foo [simp] :
"jump (v\<lparr>vctx_stack:=x\<rparr>) c = InstructionContinue nv \<Longrightarrow>
 vctx_memory v = vctx_memory nv"
apply(auto simp:jump_def)
apply(cases "x")
apply(auto)
apply(cases "vctx_next_instruction
   (v\<lparr>vctx_stack := tl x, vctx_pc := unat (hd x)\<rparr>) c")
apply(auto)
apply(cases "get_some (vctx_next_instruction
   (v\<lparr>vctx_stack := tl x, vctx_pc := unat (hd x)\<rparr>) c)")
apply(auto)
apply(cases "get_pc (vctx_next_instruction
   (v\<lparr>vctx_stack := tl x, vctx_pc := unat (hd x)\<rparr>) c)")
apply(auto)
done

theorem lemma_pop_stack [simp] :
"vctx_memory v = vctx_memory (vctx_pop_stack n v)"
apply(auto)
done

theorem lemma_update_storage [simp] :
"vctx_memory v = vctx_memory (vctx_update_storage a aa v)"
apply(auto)
done

lemma lemma_subtract :
  "subtract_gas x (InstructionContinue v) = InstructionContinue nv \<Longrightarrow>
   vctx_memory v = vctx_memory nv"
apply auto
done

declare instruction_aux_def [simp]

theorem no_modify_memory_aux :
  "inst \<noteq> Memory MSTORE \<Longrightarrow>
   inst \<noteq> Memory MSTORE8 \<Longrightarrow>
   inst \<noteq> Memory CALLDATACOPY \<Longrightarrow>
   inst \<noteq> Memory CODECOPY \<Longrightarrow>
   inst \<noteq> Memory EXTCODECOPY \<Longrightarrow>
   instruction_aux v c inst = InstructionContinue nv \<Longrightarrow>
   vctx_memory v = vctx_memory nv"
apply(cases inst)

apply(auto)
(* apply(auto simp:lemma_subtract) *)

apply(cases "get_bits (Some inst)",
   auto simp:lemma_stack_2_1_op lemma_stack_3_1_op lemma_stack_1_1_op)
apply(cases "get_sarith (Some inst)",
   auto simp:lemma_stack_2_1_op lemma_stack_3_1_op lemma_stack_1_1_op)
apply(cases "get_arith (Some inst)",
   auto simp:lemma_stack_2_1_op lemma_stack_3_1_op lemma_stack_1_1_op)

apply(auto simp:sha3_def)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "get_info (Some inst)")
apply(auto simp:lemma_stack_2_1_op lemma_stack_3_1_op lemma_stack_1_1_op
  split:option.split)
apply(cases "index (vctx_stack v)
              (nat (uint (get_dup (Some inst))))")
apply(auto split:option.split)
apply(cases "get_memory (Some inst)")
apply(auto)
apply(cases "vctx_stack v")
apply(auto split:option.split)
apply(cases "get_storage (Some inst)")
apply(auto simp:lemma_stack_1_1_op)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto simp:strict_if_def split:option.split)
apply(cases "get_pc (Some inst)")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto simp:strict_if_def split:option.split)
apply(cases "hd (tl (vctx_stack v)) = 0")
apply(auto)
apply(cases "get_stack inst")
apply(auto simp:lemma_stack_1_1_op)
apply(cases "vctx_stack v")
apply(auto split:option.split)
apply(cases "index (vctx_stack v)
              (nat (uint (get_swap (Some inst))))")
apply(auto split:option.split)
apply(cases "index (vctx_stack v) (Suc (nat (uint (get_swap (Some inst)))))")
apply(auto split:option.split)
apply(cases "index (vctx_stack v) 0")
apply(auto split:option.split)

apply(cases "get_log (Some inst)")
apply(auto simp:log_def split:option.split)
apply(cases "get_misc (Some inst)")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "tl (tl (vctx_stack v))")
apply(simp)
apply(cases "vctx_balance v (cctx_this c) < hd (vctx_stack v)")
apply(auto)
apply(cases "vctx_stack v")
apply(simp)
apply(cases "tl (vctx_stack v)")
apply(simp)
apply(cases "tl (tl (vctx_stack v))")
apply(simp)
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(simp)
apply(cases "tl (tl (tl (tl (vctx_stack v))))")
apply(simp)
apply(cases "tl (tl (tl (tl (tl (vctx_stack v)))))")
apply(simp)
apply(cases "tl (tl (tl (tl (tl (tl (vctx_stack v))))))")
apply(auto)
apply(cases "vctx_balance v (cctx_this c) <
    hd (tl (tl (vctx_stack v)))")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "tl (tl (vctx_stack v))")
apply(auto)
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(auto)
apply(cases "tl (tl (tl (tl (vctx_stack v))))")
apply(auto)
apply(cases "tl (tl (tl (tl (tl (vctx_stack v)))))")
apply(auto)
apply(cases "tl (tl (tl (tl (tl (tl (vctx_stack v))))))")
apply(auto)
apply(cases "vctx_balance v (cctx_this c) <
    hd (tl (tl (vctx_stack v)))")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "tl (tl (vctx_stack v))")
apply(auto)
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(auto)
apply(cases "tl (tl (tl (tl (vctx_stack v))))")
apply(auto)
apply(cases "tl (tl (tl (tl (tl (vctx_stack v)))))")
apply(auto)
apply(cases "vctx_balance v (cctx_this c) <
    vctx_value_sent v")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
done

lemma no_modify_memory :
  "inst \<noteq> Memory MSTORE \<Longrightarrow>
   inst \<noteq> Memory MSTORE8 \<Longrightarrow>
   inst \<noteq> Memory CALLDATACOPY \<Longrightarrow>
   inst \<noteq> Memory CODECOPY \<Longrightarrow>
   inst \<noteq> Memory EXTCODECOPY \<Longrightarrow>
   instruction_sem v c inst = InstructionContinue nv \<Longrightarrow>
   vctx_memory v = vctx_memory nv"
apply(subst (asm) inst_gas)
apply(cases "instruction_aux v c inst")
defer
apply(simp)
apply(simp)
  by (metis lemma_subtract no_modify_memory_aux)

end


chapter \<open>Congruence Closure Algorithm with Explain Operation\<close>
theory CC_Definition2
  imports CC_Explain_Helper_Lemmata
begin

text \<open>We extend the congruence closure data structure with timestamps for the edges,
which tell us in which order the edges were added. \<close>

record congruence_closure_t =
  congruence_closure +
  time :: "nat"
  timestamps :: "nat list"

text \<open>Implementation of the timestamps\<close>

function (domintros) add_timestamp :: "nat list \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat list"
  where
"add_timestamp pf ti e e' k =
(if pf ! e = e then (ti[e := k]) else add_timestamp (pf[e := e']) (ti[e := k]) (pf ! e) e (ti ! e))"
  by pat_completeness auto

lemma add_timestamp_dom_if_add_edge_dom:
   "add_edge_dom (pf, e, e') \<longleftrightarrow> add_timestamp_dom (pf, ti, e, e', k)"
proof
  show "add_edge_dom (pf, e, e') \<Longrightarrow> add_timestamp_dom (pf, ti, e, e', k)"
    apply(induction arbitrary: ti k rule: add_edge.pinduct)
    using add_timestamp.domintros by blast
  show "add_timestamp_dom (pf, ti, e, e', k) \<Longrightarrow> add_edge_dom (pf, e, e')"
    apply(induction arbitrary: ti k rule: add_timestamp.pinduct)
    using add_edge.domintros by blast
qed

lemma add_timestamp_domain:
  assumes "ufa_invar l" "y < length l" "y' < length l" "rep_of l y \<noteq> rep_of l y'"
  shows "add_timestamp_dom (l, ti, y, y', k)"
  using add_edge_domain add_timestamp_dom_if_add_edge_dom assms by auto

abbreviation propagate_step_t
  where
    "propagate_step_t l u t pe pf pfl ip a b eq k ti \<equiv>
 congruence_closure.extend (propagate_step l u t pe pf pfl ip a b eq)
    \<lparr>time = k + 1,
    timestamps = add_timestamp pf ti a b k\<rparr>"

function (domintros) propagate_t :: "congruence_closure_t \<Rightarrow> congruence_closure_t"
  where
    "propagate_t cc =
(let l = cc_list cc;
u = use_list cc;
t = lookup cc;
pe = pending cc;
pf = proof_forest cc;
pfl = pf_labels cc;
ip = input cc;
k = time cc;
ti = timestamps cc
 in (case pe of
[] \<Rightarrow> cc |
eq # pe \<Rightarrow>
(let a = left eq; b = right eq in
  (if rep_of l a = rep_of l b
    then propagate_t \<lparr>cc_list = l, use_list = u, lookup = t, pending = pe, proof_forest = pf,
f_labels = pfl, input = ip, time = k, timestamps = ti\<rparr>
    else
      propagate_t (propagate_step_t l u t pe pf pfl ip a b eq k ti)
))))"
  by pat_completeness auto

lemma propagate_t_simps1[simp]:
  assumes "propagate_t_dom cc"
    "pending cc = []"
  shows "propagate_t cc = cc"
  using assms propagate_t.psimps by fastforce

lemma propagate_t_simps2[simp]:
  assumes "propagate_t_dom \<lparr>cc_list = l, use_list = u, lookup = t, pending = (eq # pe),
proof_forest = pf, pf_labels = pfl, input = ip, time = k, timestamps = ti\<rparr>"
    "rep_of l (left eq) = rep_of l (right eq)"
  shows "propagate_t
\<lparr>cc_list = l, use_list = u, lookup = t, pending = (eq # pe), proof_forest = pf, pf_labels = pfl,
input = ip, time = k, timestamps = ti\<rparr>
 = propagate_t \<lparr>cc_list = l, use_list = u, lookup = t, pending = pe, proof_forest = pf,
pf_labels = pfl, input = ip, time = k, timestamps = ti\<rparr>"
  using assms propagate_t.psimps unfolding Let_def Case_def by auto

lemma propagate_simps3[simp]:
  assumes "propagate_t_dom \<lparr>cc_list = l, use_list = u, lookup = t, pending = (eq # pe),
proof_forest = pf, pf_labels = pfl, input = ip, time = k, timestamps = ti\<rparr>"
    "rep_of l (left eq) \<noteq> rep_of l (right eq)"
  shows "propagate_t
\<lparr>cc_list = l, use_list = u, lookup = t, pending = (eq # pe), proof_forest = pf, pf_labels = pfl,
input = ip, time = k, timestamps = ti\<rparr>
 = propagate_t (propagate_step_t l u t pe pf pfl ip (left eq) (right eq) eq k ti)"
  using assms propagate_t.psimps unfolding Let_def Case_def by auto

fun merge_t :: "congruence_closure_t \<Rightarrow> equation \<Rightarrow> congruence_closure_t"
  where
    "merge_t cc
(a \<approx> b) =
(let l = cc_list cc;
u = use_list cc;
t = lookup cc;
pe = pending cc;
pf = proof_forest cc;
pfl = pf_labels cc;
ip = input cc;
k = time cc;
ti = timestamps cc
 in
  propagate_t
    \<lparr>cc_list = l, use_list = u, lookup = t, pending = One (a \<approx> b)#pe,
proof_forest = pf, pf_labels = pfl, input = insert (a \<approx> b) ip, time = k, timestamps = ti\<rparr>)"

| "merge_t cc
(F a\<^sub>1 a\<^sub>2 \<approx> a) =
(let l = cc_list cc;
u = use_list cc;
t = lookup cc;
pe = pending cc;
pf = proof_forest cc;
pfl = pf_labels cc;
ip = input cc;
k = time cc;
ti = timestamps cc
 in
(if (lookup_Some t l (F a\<^sub>1 a\<^sub>2 \<approx> a))
  then propagate_t \<lparr>cc_list = l, use_list = u, lookup = t,
            pending = link_to_lookup t l (F a\<^sub>1 a\<^sub>2 \<approx> a)#pe, proof_forest = pf, pf_labels = pfl,
input = insert (F a\<^sub>1 a\<^sub>2 \<approx> a) ip, time = k, timestamps = ti\<rparr>
  else \<lparr>cc_list = l,
          use_list = (u[rep_of l a\<^sub>1 := (F a\<^sub>1 a\<^sub>2 \<approx> a)#(u ! rep_of l a\<^sub>1)])[rep_of l a\<^sub>2 := (F a\<^sub>1 a\<^sub>2 \<approx> a)#(u ! rep_of l a\<^sub>2)],
          lookup = update_lookup t l (F a\<^sub>1 a\<^sub>2 \<approx> a),
          pending = pe, proof_forest = pf, pf_labels = pfl, input = insert (F a\<^sub>1 a\<^sub>2 \<approx> a) ip,
          time = k, timestamps = ti\<rparr>)
)"

text \<open>For the initialisation of the congruence closure algorithm.\<close>
abbreviation
  "initial_cc_t n \<equiv> congruence_closure.extend
(initial_cc n) \<lparr>time = 0, timestamps = replicate n 0\<rparr>"

lemma propagate_step_propagate_step_t_equivalence:
  "propagate_step l u t pe pf pfl ip a b eq =
congruence_closure.truncate (propagate_step_t l u t pe pf pfl ip a b eq k ti)"
  unfolding congruence_closure.truncate_def congruence_closure.extend_def
  by simp

thm propagate_step_propagate_step_t_equivalence[of l b u a t pe pf pfl eq ip]
lemma propagate_propagate_t_domain:
  shows "propagate_dom cc =
propagate_t_dom (congruence_closure.extend cc
\<lparr>time = k, timestamps = ti\<rparr>)"
proof
  show "propagate_dom cc
\<Longrightarrow> propagate_t_dom (congruence_closure.extend cc \<lparr>time = k, timestamps = ti\<rparr>)"
  proof(induction cc arbitrary: k ti rule: propagate.pinduct)
    case (1 l u t pf pfl ip)
    then show ?case using propagate_t.domintros unfolding congruence_closure.extend_def
        congruence_closure.select_convs
      by (metis congruence_closure.select_convs(4) list.discI)
  next
    case (2 l u t eq pe pf pfl ip)
    then show ?case
    proof(cases "rep_of l (left eq) = rep_of l (right eq)")
      case True
      then have "propagate_t_dom
     (congruence_closure.extend
       \<lparr>cc_list = l, use_list = u, lookup = t, pending = pe, proof_forest = pf, pf_labels = pfl, input = ip\<rparr>
       \<lparr>time = k, timestamps = ti\<rparr>)"
        using "2.IH"(1) by blast
      then show ?thesis using propagate_t.domintros True unfolding congruence_closure.extend_def
          congruence_closure.select_convs congruence_closure_t.select_convs
        by (smt (verit) congruence_closure.select_convs(1) congruence_closure.select_convs(2) congruence_closure.select_convs(3) congruence_closure.select_convs(4) congruence_closure.select_convs(5) congruence_closure.select_convs(6) congruence_closure.select_convs(7) congruence_closure_t.select_convs(1) congruence_closure_t.select_convs(2) list_tail_coinc)
    next
      case False
      then have "propagate_t_dom
     (congruence_closure.extend (propagate_step l u t pe pf pfl ip (left eq) (right eq) eq)
\<lparr>time = k, timestamps = ti\<rparr>)"
        using "2.IH"(2) by blast
      then show ?thesis using propagate_t.domintros False unfolding congruence_closure.extend_def
          congruence_closure.select_convs congruence_closure_t.select_convs
        by (smt (verit) "2.IH"(2) congruence_closure.select_convs(1) congruence_closure.select_convs(2) congruence_closure.select_convs(3) congruence_closure.select_convs(4) congruence_closure.select_convs(5) congruence_closure.select_convs(6) congruence_closure.select_convs(7) list_tail_coinc propagate_t.domintros)
    qed
  qed
next
  obtain cc_l u t pe pf pfl ip where cc: "cc =
\<lparr>cc_list = cc_l, use_list = u, lookup = t, pending = pe, proof_forest = pf, pf_labels = pfl,
         input = ip\<rparr>" using congruence_closure.cases by blast
  assume "propagate_t_dom (congruence_closure.extend cc \<lparr>time = k, timestamps = ti\<rparr>) "
  then show "propagate_dom cc"
    using cc proof(induction "(congruence_closure.extend cc \<lparr>time = k, timestamps = ti\<rparr>)"
      arbitrary: cc k ti cc_l u t pe pf pfl ip rule: propagate_t.pinduct)
    case 1
    then show ?case proof(cases pe)
      case Nil
      then show ?thesis using 1(4) propagate.domintros
        by auto
    next
      case (Cons eq list)
      then show ?thesis proof(cases "rep_of cc_l (left eq) = rep_of cc_l (right eq)")
        case True
        have "propagate_dom
      \<lparr>cc_list = cc_l, use_list = u, lookup = t, pending = list, proof_forest = pf, pf_labels = pfl,
         input = ip\<rparr>" using 1(2) Cons True
          unfolding 1(4) congruence_closure.extend_def congruence_closure.select_convs
            congruence_closure_t.select_convs by simp
        then show ?thesis
          using 1(4) propagate.domintros True Cons by blast
      next
        case False
        have "propagate_dom
      (propagate_step cc_l u t list pf pfl ip (left eq) (right eq) eq)"
          using 1(3)[of cc_l u t pe pf pfl ip k ti eq list "left eq" "right eq"] Cons False
          unfolding 1(4) congruence_closure.extend_def congruence_closure.select_convs
            congruence_closure_t.select_convs
          by (smt (verit) congruence_closure.surjective old.unit.exhaust)
        then show ?thesis
          using 1(4) propagate.domintros False Cons by blast
      qed
    qed
  qed
qed

lemma propagate_propagate_t_equivalence:
  assumes "cc_invar cc"
    "nr_vars cc > 0"
  shows "propagate cc =
congruence_closure.truncate (propagate_t (congruence_closure.extend cc
\<lparr>time = k, timestamps = ti\<rparr>))"
proof-
  have "propagate_dom cc" using propagate_domain assms by auto
  then show ?thesis
  proof(induction arbitrary: k ti rule: propagate.pinduct)
    case (1 l u t pf pfl ip)
    then have t_dom: "propagate_t_dom
        \<lparr>cc_list = l, use_list = u, lookup = t, pending = [], proof_forest = pf,
               pf_labels = pfl, input = ip, time = k, timestamps = ti\<rparr>"
      using propagate_propagate_t_domain[of " \<lparr>cc_list = l, use_list = u, lookup = t, pending = [], proof_forest = pf,
               pf_labels = pfl, input = ip\<rparr>"] unfolding congruence_closure.extend_def
      by simp
    show ?case
      unfolding propagate.psimps(1)[OF 1] propagate_t.psimps(1)[OF t_dom]
        Let_def congruence_closure.select_convs
        congruence_closure.extend_def congruence_closure.truncate_def
        congruence_closure_t.select_convs
      by force
  next
    case (2 l u t eq pe pf pfl ip)
    then have t_dom: "propagate_t_dom
      \<lparr>cc_list = l, use_list = u, lookup = t, pending = eq # pe, proof_forest = pf,
            pf_labels = pfl, input = ip, time = k, timestamps = ti\<rparr>"
      using propagate_propagate_t_domain[of "\<lparr>cc_list = l, use_list = u, lookup = t, pending = eq # pe, proof_forest = pf,
            pf_labels = pfl, input = ip\<rparr>"] unfolding congruence_closure.extend_def
      by simp
    show ?case
    proof(cases "rep_of l (left eq) = rep_of l (right eq)")
      case True
      have IH: "propagate
     \<lparr>cc_list = l, use_list = u, lookup = t, pending = pe, proof_forest = pf, pf_labels = pfl,
        input = ip\<rparr> =
    congruence_closure.truncate
     (propagate_t
       (congruence_closure.extend
         \<lparr>cc_list = l, use_list = u, lookup = t, pending = pe, proof_forest = pf,
            pf_labels = pfl, input = ip\<rparr>
         \<lparr>time = k, timestamps = ti\<rparr>))" using 2 True by blast
      then show ?thesis unfolding propagate.psimps(2)[OF 2(1)] propagate_t.psimps[OF t_dom]
          Let_def congruence_closure.select_convs
          congruence_closure.extend_def congruence_closure.truncate_def
          congruence_closure_t.select_convs
        using True by force
    next
      case False
      then have IH: "propagate (propagate_step l u t pe pf pfl ip (left eq) (right eq) eq) =
    congruence_closure.truncate
     (propagate_t
       (congruence_closure.extend (propagate_step l u t pe pf pfl ip (left eq) (right eq) eq)
         \<lparr>time = k, timestamps = ti\<rparr>))" using 2 False by blast
      have *:"(propagate_t
       (congruence_closure.extend
         \<lparr>cc_list = l, use_list = u, lookup = t, pending = eq # pe, proof_forest = pf,
            pf_labels = pfl, input = ip\<rparr>
         \<lparr>time = k, timestamps = ti\<rparr>)) =
propagate_t (propagate_step_t l u t pe pf pfl ip (left eq) (right eq) eq k ti)
\<and> (propagate
         \<lparr>cc_list = l, use_list = u, lookup = t, pending = eq # pe, proof_forest = pf,
            pf_labels = pfl, input = ip\<rparr> =
propagate (propagate_step l u t pe pf pfl ip (left eq) (right eq) eq))"
        unfolding propagate.psimps(2)[OF 2(1)] propagate_t.psimps[OF t_dom]
          Let_def congruence_closure.extend_def congruence_closure.select_convs
        using False by simp
      have "(propagate_step l u t pe pf pfl ip (left eq) (right eq) eq) =
congruence_closure.truncate (propagate_step_t l u t pe pf pfl ip (left eq) (right eq) eq k ti)"
        using False IH
          propagate_step_propagate_step_t_equivalence
        by fast
      then have "propagate (propagate_step l u t pe pf pfl ip (left eq) (right eq) eq) =
    congruence_closure.truncate
     (propagate_t (propagate_step_t l u t pe pf pfl ip (left eq) (right eq) eq k ti))"
        using "2.IH"(2) False by blast
      then show ?thesis using False IH *
        by argo
    qed
  qed
qed

lemma merge_merge_t_equivalence:
  assumes "cc_invar cc"
    "nr_vars cc > 0"
    "valid_vars eq (nr_vars cc)"
  shows "merge cc eq =
congruence_closure.truncate (merge_t (congruence_closure.extend cc \<lparr>time = k, timestamps = ti\<rparr>) eq)"
  using assms proof(induction cc eq rule: merge.induct)
  case (1 l u t pe pf pfl ip a b)
  then have "cc_invar \<lparr>cc_list = l, use_list = u, lookup = t, pending = One (a \<approx> b) # pe, proof_forest = pf,
        pf_labels = pfl, input = insert (a \<approx> b) ip\<rparr>"
    "nr_vars \<lparr>cc_list = l, use_list = u, lookup = t, pending = One (a \<approx> b) # pe, proof_forest = pf,
        pf_labels = pfl, input = insert (a \<approx> b) ip\<rparr> > 0" using cc_invar_merge1 by auto
  then show ?case
    unfolding merge_t.simps(1) merge.simps(1) Let_def congruence_closure.select_convs
      congruence_closure.extend_def congruence_closure.truncate_def congruence_closure_t.select_convs
    using propagate_propagate_t_equivalence[of "\<lparr>cc_list = l, use_list = u, lookup = t, pending = One (a \<approx> b) # pe, proof_forest = pf,
        pf_labels = pfl, input = insert (a \<approx> b) ip\<rparr>"] unfolding congruence_closure.extend_def congruence_closure.truncate_def
    by auto
next
  case (2 l u t pe pf pfl ip a\<^sub>1 a\<^sub>2 a)
  then have " lookup_Some t l (F a\<^sub>1 a\<^sub>2 \<approx> a) \<Longrightarrow> cc_invar \<lparr>cc_list = l, use_list = u, lookup = t,
             pending = link_to_lookup t l (F a\<^sub>1 a\<^sub>2 \<approx> a) # pe, proof_forest = pf,
             pf_labels = pfl, input = insert (F a\<^sub>1 a\<^sub>2 \<approx> a) ip\<rparr>"
    "nr_vars \<lparr>cc_list = l, use_list = u, lookup = t,
             pending = link_to_lookup t l (F a\<^sub>1 a\<^sub>2 \<approx> a) # pe, proof_forest = pf,
             pf_labels = pfl, input = insert (F a\<^sub>1 a\<^sub>2 \<approx> a) ip\<rparr> > 0"
    using cc_invar_merge2 by auto
  then show ?case
    apply (cases "(lookup_Some t l (F a\<^sub>1 a\<^sub>2 \<approx> a))")
    using propagate_propagate_t_equivalence[of "\<lparr>cc_list = l, use_list = u, lookup = t,
             pending = link_to_lookup t l (F a\<^sub>1 a\<^sub>2 \<approx> a) # pe, proof_forest = pf,
             pf_labels = pfl, input = insert (F a\<^sub>1 a\<^sub>2 \<approx> a) ip\<rparr>"]
    unfolding merge_t.simps(2) merge.simps(2) Let_def congruence_closure.select_convs If_def
      congruence_closure.extend_def congruence_closure.truncate_def congruence_closure_t.select_convs
    unfolding congruence_closure.extend_def congruence_closure.truncate_def
    by auto
qed

section \<open>Induction rules\<close>

thm propagate_t.pinduct
lemma propagate_t_induct[consumes 1]:
  assumes "propagate_t_dom a0"
"\<And>l u t pf pfl ip k ti  .
propagate_t_dom \<lparr>cc_list = l, use_list = u, lookup = t, pending = [], proof_forest = pf,
 pf_labels = pfl, input = ip, time = k, timestamps = ti\<rparr> \<Longrightarrow>
P \<lparr>cc_list = l, use_list = u, lookup = t, pending = [], proof_forest = pf,
 pf_labels = pfl, input = ip, time = k, timestamps = ti\<rparr>"
"(\<And>l u t pe pf pfl ip k ti a b eq.
propagate_t_dom \<lparr>cc_list = l, use_list = u, lookup = t, pending = (eq # pe), proof_forest = pf,
 pf_labels = pfl, input = ip, time = k, timestamps = ti\<rparr> \<Longrightarrow>
a = left eq \<Longrightarrow> b = right eq \<Longrightarrow>
rep_of l a = rep_of l b \<Longrightarrow>
P \<lparr>cc_list = l, use_list = u, lookup = t, pending = pe, proof_forest = pf,
 pf_labels = pfl, input = ip, time = k, timestamps = ti\<rparr> \<Longrightarrow>
P (\<lparr>cc_list = l, use_list = u, lookup = t, pending = eq # pe, proof_forest = pf, pf_labels = pfl,
input = ip, time = k, timestamps = ti\<rparr>))"
"(\<And>l u t pe pf pfl ip k ti a b eq.
propagate_t_dom \<lparr>cc_list = l, use_list = u, lookup = t, pending = (eq # pe), proof_forest = pf,
pf_labels = pfl, input = ip, time = k, timestamps = ti\<rparr> \<Longrightarrow>
a = left eq \<Longrightarrow> b = right eq \<Longrightarrow>
rep_of l a \<noteq> rep_of l b \<Longrightarrow>
P (propagate_step_t l u t pe pf pfl ip a b eq k ti)
\<Longrightarrow> P \<lparr>cc_list = l, use_list = u, lookup = t, pending = (eq # pe),
proof_forest = pf, pf_labels = pfl,
input = ip, time = k, timestamps = ti\<rparr>)"
shows "P a0"
  using assms proof(induction a0 rule: propagate_t.pinduct)
  case (1 cc_t)
  then show ?case proof(cases "pending cc_t")
    case Nil
    then show ?thesis
      using 1
      by (metis (full_types) congruence_closure_t.surjective old.unit.exhaust)
  next
    case (Cons eq list)
    obtain l u t pe pf pfl ip k ti
        where cc_t: "cc_t = \<lparr>cc_list = l, use_list = u, lookup = t, pending = pe, proof_forest = pf, pf_labels = pfl,
input = ip, time = k, timestamps = ti\<rparr>"
      using congruence_closure_t.cases by blast
    then show ?thesis
    proof(cases "rep_of (cc_list cc_t) (left eq) = rep_of (cc_list cc_t) (right eq)")
      case True
      have "P \<lparr>cc_list = l, use_list = u, lookup = t, pending = list, proof_forest = pf, pf_labels = pfl,
input = ip, time = k, timestamps = ti\<rparr>"
        using 1(2) "1.prems" True Cons unfolding cc_t congruence_closure.select_convs congruence_closure_t.select_convs
        by blast
      then show ?thesis using 1(1,5) cc_t True Cons by force
    next
      case False
      have "P (propagate_step_t l u t list pf pfl ip (left eq) (right eq) eq k ti)"
        using 1(3) "1.prems" False Cons unfolding cc_t congruence_closure.select_convs congruence_closure_t.select_convs
        by blast
      then show ?thesis using 1(1,6) cc_t False Cons by simp
    qed
  qed
qed

thm merge_t.induct
lemma merge_t_induct:
  assumes "(\<And>l u t pe pf pfl ip k ti a b.
P \<lparr>cc_list = l, use_list = u, lookup = t, pending = pe, proof_forest = pf, pf_labels = pfl,
input = ip, time = k, timestamps = ti\<rparr> (a \<approx> b))"
"(\<And>l u t pe pf pfl ip k ti a\<^sub>1 a\<^sub>2 a. P \<lparr>cc_list = l, use_list = u, lookup = t, pending = pe,
proof_forest = pf, pf_labels = pfl,
input = ip, time = k, timestamps = ti\<rparr> (F a\<^sub>1 a\<^sub>2 \<approx> a))"
shows "P a0 a1"
  using assms merge_t.induct congruence_closure_t.cases by metis

end


chapter \<open>The prover\<close>

section \<open>Proof search procedure\<close>

theory Prover
  imports SeCaV
    "HOL-Library.Stream"
    Abstract_Completeness.Abstract_Completeness
    Abstract_Soundness.Finite_Proof_Soundness
    "HOL-Library.Countable"
    "HOL-Library.Code_Lazy"
begin

text \<open>This theory defines the actual proof search procedure.\<close>

subsection \<open>Datatypes\<close>

text \<open>A sequent is a list of formulas\<close>
type_synonym sequent = \<open>fm list\<close>

text \<open>We introduce a number of rules to prove sequents.
  These rules mirror the proof system of SeCaV, but are higher-level in the sense that they apply to
  all formulas in the sequent at once. This obviates the need for the structural Ext rule.
  There is also no Basic rule, since this is implicit in the prover.\<close>
datatype rule
  = AlphaDis | AlphaImp  | AlphaCon
  | BetaCon | BetaImp | BetaDis
  | DeltaUni | DeltaExi
  | NegNeg
  | GammaExi | GammaUni

subsection \<open>Auxiliary functions\<close>

text \<open>Before defining what the rules do, we need to define a number of auxiliary functions needed
  for the semantics of the rules.\<close>

text \<open>listFunTm is a list of function and constant names in a term\<close>
primrec listFunTm :: \<open>tm \<Rightarrow> nat list\<close> and listFunTms :: \<open>tm list \<Rightarrow> nat list\<close>where
  \<open>listFunTm (Fun n ts) = n # listFunTms ts\<close>
| \<open>listFunTm (Var n) = []\<close>
| \<open>listFunTms [] = []\<close>
| \<open>listFunTms (t # ts) = listFunTm t @ listFunTms ts\<close>

text \<open>generateNew uses the \<open>listFunTms\<close> function to obtain a fresh function index\<close>
definition generateNew :: \<open>tm list \<Rightarrow> nat\<close> where
  \<open>generateNew ts \<equiv> 1 + foldr max (listFunTms ts) 0\<close>

text \<open>subtermTm returns a list of all terms occurring within a term\<close>
primrec subtermTm :: \<open>tm \<Rightarrow> tm list\<close> where
  \<open>subtermTm (Fun n ts) = Fun n ts # remdups (concat (map subtermTm ts))\<close>
| \<open>subtermTm (Var n) = [Var n]\<close>

text \<open>subtermFm returns a list of all terms occurring within a formula\<close>
primrec subtermFm :: \<open>fm \<Rightarrow> tm list\<close> where
  \<open>subtermFm (Pre _ ts) = concat (map subtermTm ts)\<close>
| \<open>subtermFm (Imp p q) = subtermFm p @ subtermFm q\<close>
| \<open>subtermFm (Dis p q) = subtermFm p @ subtermFm q\<close>
| \<open>subtermFm (Con p q) = subtermFm p @ subtermFm q\<close>
| \<open>subtermFm (Exi p) = subtermFm p\<close>
| \<open>subtermFm (Uni p) = subtermFm p\<close>
| \<open>subtermFm (Neg p) = subtermFm p\<close>

text \<open>subtermFms returns a list of all terms occurring within a list of formulas\<close>
abbreviation \<open>subtermFms z \<equiv> concat (map subtermFm z)\<close>

text \<open>subterms returns a list of all terms occurring within a sequent.
  This is used to determine which terms to instantiate Gamma-formulas with.
  We must always be able to instantiate Gamma-formulas, so if there are no terms in the sequent,
  the function simply returns a list containing the first function.\<close>
definition subterms :: \<open>sequent \<Rightarrow> tm list\<close> where
  \<open>subterms z \<equiv> case remdups (subtermFms z) of
                [] \<Rightarrow> [Fun 0 []]
              | ts \<Rightarrow> ts\<close>

text \<open>We need to be able to detect if a sequent is an axiom to know whether a branch of the proof
  is done. The disjunct \<open>Neg (Neg p) \<in> set z\<close> is not necessary for the prover, but makes the proof
  of the lemma \<open>branchDone_contradiction\<close> easier.\<close>
fun branchDone :: \<open>sequent \<Rightarrow> bool\<close> where
  \<open>branchDone [] = False\<close>
| \<open>branchDone (Neg p # z) = (p \<in> set z \<or> Neg (Neg p) \<in> set z \<or> branchDone z)\<close>
| \<open>branchDone (p # z) = (Neg p \<in> set z \<or> branchDone z)\<close>

subsection \<open>Effects of rules\<close>

text \<open>This defines the resulting formulas when applying a rule to a single formula.
  This definition mirrors the semantics of SeCaV.
  If the rule and the formula do not match, the resulting formula is simply the original formula.
  Parameter A should be the list of terms on the branch.\<close>
definition parts :: \<open>tm list \<Rightarrow> rule \<Rightarrow> fm \<Rightarrow> fm list list\<close> where
  \<open>parts A r f = (case (r, f) of
      (NegNeg, Neg (Neg p)) \<Rightarrow> [[p]]
    | (AlphaImp, Imp p q) \<Rightarrow> [[Neg p, q]]
    | (AlphaDis, Dis p q) \<Rightarrow> [[p, q]]
    | (AlphaCon, Neg (Con p q)) \<Rightarrow> [[Neg p, Neg q]]
    | (BetaImp, Neg (Imp p q)) \<Rightarrow> [[p], [Neg q]]
    | (BetaDis, Neg (Dis p q)) \<Rightarrow> [[Neg p], [Neg q]]
    | (BetaCon, Con p q) \<Rightarrow> [[p], [q]]
    | (DeltaExi, Neg (Exi p)) \<Rightarrow> [[Neg (sub 0 (Fun (generateNew A) []) p)]]
    | (DeltaUni, Uni p) \<Rightarrow> [[sub 0 (Fun (generateNew A) []) p]]
    | (GammaExi, Exi p) \<Rightarrow> [Exi p # map (\<lambda>t. sub 0 t p) A]
    | (GammaUni, Neg (Uni p)) \<Rightarrow> [Neg (Uni p) # map (\<lambda>t. Neg (sub 0 t p)) A]
    | _ \<Rightarrow> [[f]])\<close>

text \<open>This function defines the Cartesian product of two lists.
  This is needed to create the list of branches created when applying a beta rule.\<close>
primrec list_prod :: \<open>'a list list \<Rightarrow> 'a list list \<Rightarrow> 'a list list\<close> where
  \<open>list_prod _ [] = []\<close>
| \<open>list_prod hs (t # ts) = map (\<lambda>h. h @ t) hs @ list_prod hs ts\<close>

text \<open>This function computes the children of a node in the proof tree.
  For Alpha rules, Delta rules and Gamma rules, there will be only one sequent, which is the result
  of applying the rule to every formula in the current sequent.
  For Beta rules, the proof tree will branch into two branches once for each formula in the sequent
  that matches the rule, which results in \<open>2\<^sup>n\<close> branches (created using \<^text>\<open>list_prod\<close>).
  The list of terms in the sequent needs to be updated after applying the rule to each formula since
  Delta rules and Gamma rules may introduce new terms.
  Note that any formulas that don't match the rule are left unchanged in the new sequent.\<close>
primrec children :: \<open>tm list \<Rightarrow> rule \<Rightarrow> sequent \<Rightarrow> sequent list\<close> where
  \<open>children _ _ [] = [[]]\<close>
| \<open>children A r (p # z) =
  (let hs = parts A r p; A' = remdups (A @ subtermFms (concat hs))
   in list_prod hs (children A' r z))\<close>

text \<open>The proof state is the combination of a list of terms and a sequent.\<close>
type_synonym state = \<open>tm list \<times> sequent\<close>

text \<open>This function defines the effect of applying a rule to a proof state.
  If the sequent is an axiom, the effect is to end the branch of the proof tree, so an empty set of
  child branches is returned.
  Otherwise, we compute the children generated by applying the rule to the current proof state,
  then add any new subterms to the proof states of the children.\<close>
primrec effect :: \<open>rule \<Rightarrow> state \<Rightarrow> state fset\<close> where
  \<open>effect r (A, z) =
  (if branchDone z then {||} else
    fimage (\<lambda>z'. (remdups (A @ subterms z @ subterms z'), z'))
    (fset_of_list (children (remdups (A @ subtermFms z)) r z)))\<close>

subsection \<open>The rule stream\<close>

text \<open>We need to define an infinite stream of rules that the prover should try to apply.
  Since rules simply do nothing if they don't fit the formulas in the sequent, the rule stream is
  just all rules in the order: Alpha, Delta, Beta, Gamma, which guarantees completeness.\<close>
definition \<open>rulesList \<equiv> [
  NegNeg, AlphaImp, AlphaDis, AlphaCon,
  DeltaExi, DeltaUni,
  BetaImp, BetaDis, BetaCon,
  GammaExi, GammaUni
]\<close>

text \<open>By cycling the list of all rules we obtain an infinite stream with every rule occurring
  infinitely often.\<close>
definition rules where
  \<open>rules = cycle rulesList\<close>

subsection \<open>Abstract completeness\<close>

text \<open>We write effect as a relation to use it with the abstract completeness framework.\<close>
definition eff where
  \<open>eff \<equiv> \<lambda>r s ss. effect r s = ss\<close>

text \<open>To use the framework, we need to prove enabledness.
  This is trivial because all of our rules are always enabled and simply do nothing if they don't
  match the formulas.\<close>
lemma all_rules_enabled: \<open>\<forall>st. \<forall>r \<in> i.R (cycle rulesList). \<exists>sl. eff r st sl\<close>
  unfolding eff_def by blast

text \<open>The first step of the framework is to prove that our prover fits the framework.\<close>
interpretation RuleSystem eff rules UNIV
  unfolding rules_def RuleSystem_def
  using all_rules_enabled stream.set_sel(1)
  by blast

text \<open>Next, we need to prove that our rules are persistent.
  This is also trivial, since all of our rules are always enabled.\<close>
lemma all_rules_persistent: \<open>\<forall>r. r \<in> R \<longrightarrow> per r\<close>
  by (metis all_rules_enabled enabled_def per_def rules_def)

text \<open>We can then prove that our prover fully fits the framework.\<close>
interpretation PersistentRuleSystem eff rules UNIV
  unfolding PersistentRuleSystem_def RuleSystem_def PersistentRuleSystem_axioms_def
  using all_rules_persistent enabled_R
  by blast

text \<open>We can then use the framework to define the prover.
  The mkTree function applies the rules to build the proof tree using the effect relation, but the
  prover is not actually executable yet.\<close>
definition \<open>secavProver \<equiv> mkTree rules\<close>

abbreviation \<open>rootSequent t \<equiv> snd (fst (root t))\<close>

end


(******************************************************************************
 * Clean
 *
 * Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of the copyright holders nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ******************************************************************************)

(*
 * IsPrime-Test
 *
 * Authors : Burkhart Wolff, Frédéric Tuong
 *)

chapter \<open> Clean Semantics : Another Clean Example\<close>

theory IsPrime
  imports Clean.Clean
          Clean.Hoare_Clean
          Clean.Clean_Symbex
          "HOL-Computational_Algebra.Primes"
begin

section\<open>The Primality-Test Example at a Glance\<close>

definition "SQRT_UINT_MAX = (65536::nat)"
definition "UINT_MAX = (2^32::nat) - 1"

function_spec isPrime(n :: nat) returns bool
pre          "\<open>n \<le> SQRT_UINT_MAX\<close>"
post         "\<open>\<lambda>res. res \<longleftrightarrow> prime n \<close>"
local_vars   i :: nat
defines " if\<^sub>C \<open>n < 2\<close>
            then return\<^bsub>local_isPrime_state.result_value_update\<^esub> \<open>False\<close>
            else skip\<^sub>S\<^sub>E
          fi ;-
          \<open>i := 2\<close> ;-
          while\<^sub>C \<open>i < SQRT_UINT_MAX \<and> i*i \<le> n  \<close>
            do if\<^sub>C \<open>n mod i = 0\<close>
                  then return\<^bsub>local_isPrime_state.result_value_update\<^esub> \<open>False\<close>
                  else skip\<^sub>S\<^sub>E
                fi ;-
                \<open>i := i + 1 \<close>
            od ;-
         return\<^bsub>local_isPrime_state.result_value_update\<^esub> \<open>True\<close>"

find_theorems name:isPrime name:core

lemma XXX :
"isPrime_core n \<equiv>
     if\<^sub>C (\<lambda>\<sigma>. n < 2) then (return\<^bsub>result_value_update\<^esub> (\<lambda>\<sigma>. False))
                     else skip\<^sub>S\<^sub>E fi;-
     i_update :==\<^sub>L (\<lambda>\<sigma>. 2) ;-
     while\<^sub>C (\<lambda>\<sigma>. (hd\<circ>i)\<sigma> < SQRT_UINT_MAX \<and> (hd\<circ>i)\<sigma> * (hd\<circ>i)\<sigma> \<le> n)
     do
        (if\<^sub>C (\<lambda>\<sigma>. n mod (hd \<circ> i) \<sigma> = 0)
         then (return\<^bsub>result_value_update\<^esub> (\<lambda>\<sigma>. False))
         else skip\<^sub>S\<^sub>E fi ;-
        i_update :==\<^sub>L (\<lambda>\<sigma>. (hd \<circ> i) \<sigma> + 1))
     od ;-
     return\<^bsub>result_value_update\<^esub> (\<lambda>\<sigma>. True)"

  by(simp add: isPrime_core_def)

lemma YYY:
"isPrime n \<equiv> block\<^sub>C push_local_isPrime_state
                    (isPrime_core n)
                    pop_local_isPrime_state"
  by(simp add: isPrime_def)

lemma isPrime_correct :
  "\<lbrace>\<lambda>\<sigma>.   \<triangleright> \<sigma> \<and> isPrime_pre (n)(\<sigma>) \<and> \<sigma> = \<sigma>\<^sub>p\<^sub>r\<^sub>e \<rbrace>
     isPrime n
   \<lbrace>\<lambda>r \<sigma>. \<triangleright> \<sigma> \<and> isPrime_post(n) (\<sigma>\<^sub>p\<^sub>r\<^sub>e)(\<sigma>)(r) \<rbrace>"
   oops

end


theory NBA_Rule
imports Scoring_Rules
        "Compositional_Structures/Basic_Modules/Scoring_Module"
        "Compositional_Structures/Basic_Modules/NBA_Module"
        "Compositional_Structures/Elect_Composition"

begin

lemma mvp_elect:
  shows "electoral_module (elector mvp)"
proof(unfold mvp.simps)
  show "electoral_module (elector (max_eliminator (scoring vector_A_mvp)))"
    using scoring_mod_A by blast
qed

lemma mvp_hom:
  shows "homogeneity (elector mvp)" unfolding mvp.simps
  using scoring_rules_homogeneity
  by blast

lemma mvp_reinforcement:
  shows "reinforcement (elector mvp)" unfolding mvp.simps
  using scoring_module_rein
  by blast

end


section "Solution to Day 7 of AoC 2020"

theory day7
  imports Main "HOL.Code_Numeral" string_utils list_natural_utils natural_utils list_utils
begin

text "This is a solution to the puzzle for day 7"

subsection "Input parsing"

text "Input parsing for today was a pain in the butt. If I had a language with powerful and easy to
use string manipulations then this would be easy. Unfortunately I do not. So some of the string functions
have been added for dealing with today's input. The input is still just a line-by-line thing, but it's
presented in natural language. Fortunately it's quite predictable though."

text "The bag\\_desc function takes one line of the input in the form of a list of tokens.
A token is just one word from the input, where a word is defined such that you can tokenise the text
simply by splitting on spaces. bag\\_desc figures out the name of the bag that this line
describes, and then returns the token list for the subbag descriptions"

primrec bag_desc :: "string \<Rightarrow> (string list) \<Rightarrow> (string * (string list))"
  where
    "bag_desc parsed [] = ('''', [''''])"
    |"bag_desc parsed (Cons t toks) = (
      if t = ''bags'' then
        (parsed, tl toks)
      else
        bag_desc (parsed @ '' '' @ t) toks
    )"

text "sub\\_bags\\_parse takes the tokens that bag\\_desc didn't parse, and then produces a list of sub bag information.
Each sub bag is a pair with a number (the number of bags of this type contained in the outer bag) and a name"

fun sub_bags_parse :: "(natural * string) list \<Rightarrow> (natural * string) \<Rightarrow> string list \<Rightarrow> (natural * string) list"
  where
    "sub_bags_parse a part [] = a"
  |"sub_bags_parse a part (Cons n rest) =
    (let (part_n, part_label) = part in
    (if contains n [''bag,'',''bags,'',''bag.'',''bags.''] then
       sub_bags_parse (a @ [(part_n, trim part_label)]) (0, '''') rest
    else
      (if part_n = 0 then
        if n = ''no'' then
          a
        else
        (let next_n = str_to_nat n in
          sub_bags_parse a (next_n, '''') rest
        )
      else
        sub_bags_parse a (part_n, part_label @ '' '' @ n) rest
      )
    )
)"

text "Parsing a line of text is done by combining the two functions above, this is the parse\\_line
function. parse\\_all returns a list of all bags in an input text"

definition parse_line :: "string \<Rightarrow> (string * ((natural * string) list))"
  where "parse_line line = (let t = split CHR '' '' line in
    let (bd, sub_bags) = bag_desc '''' t in
    (trim bd, sub_bags_parse [] (0, '''') sub_bags)
  )"

definition parse_all where "parse_all s = map parse_line (split CHR ''\<newline>'' (trim s))"

subsection "Solution Algorithm"

text "The task concerns calculating some information about the shiny gold bag specifically. In part 1 we need
to know how many different types of bag could hold a shiny gold bag at an arbitrary depth."

definition p1col where "p1col = ''shiny gold''"

text "First I define a function for getting information about a particular bag"

primrec get_bag_info where
  "get_bag_info [] bag_col = undefined"
|"get_bag_info (Cons bag1_def bag_defs) bag_col =
  (if fst bag1_def = bag_col then snd bag1_def else get_bag_info bag_defs bag_col)
  "

text "Then a function for getting all of the names of bags that we know about"

definition all_bag_names where "all_bag_names bag_defs = map fst bag_defs"

text "can\\_hold tells us what bags another bag can hold \\_directly\\_"

definition can_hold where "can_hold bag_defs bag_col =
  (let names = all_bag_names bag_defs in
    filter (\<lambda> name . contains bag_col (map snd (get_bag_info bag_defs name))) names
  )
"

text "can\\_hold\\_rec tells us what bags another bag can hold \\_recursively\\_. To make sure that this function
always terminates, I implemented a recursion limit."

fun can_hold_rec :: "natural \<Rightarrow> (string \<times> (natural \<times> string) list) list \<Rightarrow> string list \<Rightarrow> string list" where
"can_hold_rec limit bag_defs bag_cols = (if limit = 0 then undefined else  (let new_list =
  (reduce uniq_ins bag_cols (flatten (map (can_hold bag_defs) bag_cols)))
  in
  if natural_len new_list = natural_len bag_cols then bag_cols else can_hold_rec (limit - 1) bag_defs new_list
))
"

text "part 1 is now simply the number of bags in can\\_hold\\_rec for the shiny gold bag"

definition part1 :: "string \<Rightarrow> natural"
  where "part1 s = (natural_len (can_hold_rec 99 (parse_all s) [p1col])) - 1"

text "part 2 is actually a bit simpler than part 1. it's faster than part1 given the data structure
that I came up with for this task. It involves determining how many bags should end up inside the shiny
gold bag. num\\_held calculates one more than this number"

fun num_held :: "natural \<Rightarrow> _"
  where "num_held limit bag_defs bag_col =
  (if limit = 0 then undefined else
    (let subbags = get_bag_info bag_defs bag_col in
      (if (natural_len subbags) = 0 then 1 else
        (reduce (+) 0 (map (\<lambda> (n, name) . n * (num_held (limit - 1) bag_defs name)) subbags)) + 1
      )
    )
  )"

definition part2 :: "string \<Rightarrow> natural"
  where "part2 s = (let bags = parse_all s in
    (num_held 99 bags p1col) - 1
  )"

subsection "Testing"

definition example_input::string where "example_input = ''
light red bags contain 1 bright white bag, 2 muted yellow bags.
dark orange bags contain 3 bright white bags, 4 muted yellow bags.
bright white bags contain 1 shiny gold bag.
muted yellow bags contain 2 shiny gold bags, 9 faded blue bags.
shiny gold bags contain 1 dark olive bag, 2 vibrant plum bags.
dark olive bags contain 3 faded blue bags, 4 dotted black bags.
vibrant plum bags contain 5 faded blue bags, 6 dotted black bags.
faded blue bags contain no other bags.
dotted black bags contain no other bags.
''"

lemma "part1 example_input = 4"
  by eval

lemma "part2 example_input = 32"
  by eval

export_code "part1" "part2" in Haskell module_name Solution

end