theory Output_Interface_Replace
imports
  Ipassmt
  Routing_IpAssmt
  Common_Primitive_toString
begin

section\<open>Replacing output interfaces by their IP ranges according to Routing\<close>

text\<open>Copy of @{file "Interface_Replace.thy"}\<close>

definition ipassmt_iface_replace_dstip_mexpr
  :: "'i::len ipassignment \<Rightarrow> iface \<Rightarrow> 'i common_primitive match_expr" where
  "ipassmt_iface_replace_dstip_mexpr ipassmt ifce \<equiv> case ipassmt ifce of
          None \<Rightarrow> Match (OIface ifce)
        | Some ips \<Rightarrow> (match_list_to_match_expr (map (Match \<circ> Dst) (map (uncurry IpAddrNetmask) ips)))"

lemma matches_ipassmt_iface_replace_dstip_mexpr:
    "matches (common_matcher, \<alpha>) (ipassmt_iface_replace_dstip_mexpr ipassmt ifce) a p \<longleftrightarrow> (case ipassmt ifce of
            None \<Rightarrow> match_iface ifce (p_oiface p)
          | Some ips \<Rightarrow> p_dst p \<in> ipcidr_union_set (set ips)
          )"
proof(cases "ipassmt ifce")
case None thus ?thesis by(simp add: ipassmt_iface_replace_dstip_mexpr_def primitive_matcher_generic.Iface_single[OF primitive_matcher_generic_common_matcher])
next
case (Some ips)
  have "matches (common_matcher, \<alpha>) (match_list_to_match_expr (map (Match \<circ> Dst \<circ> (uncurry IpAddrNetmask)) ips)) a p \<longleftrightarrow>
       (\<exists>m\<in>set ips. p_dst p \<in> (uncurry ipset_from_cidr m))"
       by(simp add: match_list_to_match_expr_disjunction[symmetric]
                    match_list_matches match_simplematcher_SrcDst ipt_iprange_to_set_uncurry_IpAddrNetmask)
  with Some show ?thesis
    by(simp add: ipassmt_iface_replace_dstip_mexpr_def bunch_of_lemmata_about_matches ipcidr_union_set_uncurry)
qed

fun oiface_rewrite
  :: "'i::len ipassignment \<Rightarrow> 'i common_primitive match_expr \<Rightarrow> 'i common_primitive match_expr"
where
  "oiface_rewrite _       MatchAny = MatchAny" |
  "oiface_rewrite ipassmt (Match (OIface ifce)) = ipassmt_iface_replace_dstip_mexpr ipassmt ifce" |
  "oiface_rewrite _       (Match a) = Match a" |
  "oiface_rewrite ipassmt (MatchNot m) = MatchNot (oiface_rewrite ipassmt m)" |
  "oiface_rewrite ipassmt (MatchAnd m1 m2) = MatchAnd (oiface_rewrite ipassmt m1) (oiface_rewrite ipassmt m2)"

context
begin
  (*helper1: used in induction case MatchNot*)
  private lemma oiface_rewrite_matches_Primitive:
          "matches (common_matcher, \<alpha>) (MatchNot (oiface_rewrite ipassmt (Match x))) a p = matches (common_matcher, \<alpha>) (MatchNot (Match x)) a p \<longleftrightarrow>
           matches (common_matcher, \<alpha>) (oiface_rewrite ipassmt (Match x)) a p = matches (common_matcher, \<alpha>) (Match x) a p"
  proof(cases x)
  case (OIface ifce)
    have "(matches (common_matcher, \<alpha>) (MatchNot (ipassmt_iface_replace_dstip_mexpr ipassmt ifce)) a p = (\<not> match_iface ifce (p_oiface p))) \<longleftrightarrow>
      (matches (common_matcher, \<alpha>) (ipassmt_iface_replace_dstip_mexpr ipassmt ifce) a p = match_iface ifce (p_oiface p))"
    proof(cases "ipassmt ifce")
    case None thus ?thesis
       apply(simp add: matches_ipassmt_iface_replace_dstip_mexpr)
       apply(simp add: ipassmt_iface_replace_dstip_mexpr_def primitive_matcher_generic.Iface_single_not[OF primitive_matcher_generic_common_matcher])
       done
     next
     case (Some ips)
       {  fix ips
          have "matches (common_matcher, \<alpha>)
                 (MatchNot (match_list_to_match_expr (map (Match \<circ> Dst \<circ> (uncurry IpAddrNetmask)) ips))) a p \<longleftrightarrow>
                 (p_dst p \<notin> ipcidr_union_set (set ips))"
        apply(induction ips)
         apply(simp add: bunch_of_lemmata_about_matches ipcidr_union_set_uncurry)
        apply(simp add: MatchOr_MatchNot)
        apply(simp add: ipcidr_union_set_uncurry)
        apply(simp add: match_simplematcher_SrcDst_not)
        apply(thin_tac _)
        apply(simp add: ipt_iprange_to_set_uncurry_IpAddrNetmask)
        done
       } note helper=this
       from Some show ?thesis
         apply(simp add: matches_ipassmt_iface_replace_dstip_mexpr)
         apply(simp add: ipassmt_iface_replace_dstip_mexpr_def)
         apply(simp add: helper)
         done
     qed
     with OIface show ?thesis
      by(simp add: primitive_matcher_generic.Iface_single_not[OF primitive_matcher_generic_common_matcher]
            primitive_matcher_generic.Iface_single[OF primitive_matcher_generic_common_matcher])
  qed(simp_all)

  lemma ipassmt_disjoint_matcheq_iifce_dstip:
        assumes ipassmt_nowild: "ipassmt_sanity_nowildcards ipassmt"
            and ipassmt_disjoint: "ipassmt_sanity_disjoint ipassmt"
            and ifce: "ipassmt ifce = Some i_ips"
            and p_ifce: "ipassmt (Iface (p_oiface p)) = Some p_ips \<and> p_dst p \<in> ipcidr_union_set (set p_ips)"
        shows   "match_iface ifce (p_oiface p) \<longleftrightarrow> p_dst p \<in> ipcidr_union_set (set i_ips)"
    proof
     assume "match_iface ifce (p_oiface p)"
     thus "p_dst p \<in> ipcidr_union_set (set i_ips)"
       apply(cases "ifce = Iface (p_oiface p)")
        using ifce p_ifce apply force
       by (metis domI iface.sel iface_is_wildcard_def ifce ipassmt_nowild ipassmt_sanity_nowildcards_def match_iface.elims(2) match_iface_case_nowildcard)
   next
     assume a: "p_dst p \<in> ipcidr_union_set (set i_ips)"
     --\<open>basically, we need to reverse the map @{term ipassmt}\<close>

     from ipassmt_disjoint_nonempty_inj[OF ipassmt_disjoint ifce] a have ipassmt_inj: "\<forall>k. ipassmt k = Some i_ips \<longrightarrow> k = ifce" by blast

     from ipassmt_disjoint_inj_k[OF ipassmt_disjoint ifce _ a] have ipassmt_inj_k:
      "\<And>k ips'. ipassmt k = Some ips' \<Longrightarrow> p_dst p \<in> ipcidr_union_set (set ips') \<Longrightarrow> k = ifce" by simp

     have ipassmt_inj_p: "\<forall>ips'. p_dst p \<in> ipcidr_union_set (set ips') \<and> (\<exists>k. ipassmt k = Some ips') \<longrightarrow> ips' = i_ips"
     (*using ipassmt_inj_k ifce by force*)
     proof(intro allI impI; elim conjE exE)
       fix ips' k
       assume as: "p_dst p \<in> ipcidr_union_set (set ips')" "ipassmt k = Some ips'"
       hence "k = ifce" using ipassmt_inj_k by simp
       thus "ips' = i_ips" using ifce as by simp
     qed

     from p_ifce have "(Iface (p_oiface p)) = ifce" using ipassmt_inj_p ipassmt_inj by blast

     thus "match_iface ifce (p_oiface p)" using match_iface_refl by blast
   qed

  (*helper2: used in induction base case*)
  private lemma matches_ipassmt_iface_replace_dstip_mexpr_case_Iface:
        fixes ifce::iface
        assumes "ipassmt_sanity_nowildcards ipassmt"
            and "ipassmt_sanity_disjoint ipassmt"
            and "ipassmt (Iface (p_oiface p)) = Some p_ips \<and> p_dst p \<in> ipcidr_union_set (set p_ips)"
        shows   "matches (common_matcher, \<alpha>) (ipassmt_iface_replace_dstip_mexpr ipassmt ifce) a p \<longleftrightarrow>
                 matches (common_matcher, \<alpha>) (Match (OIface ifce)) a p"
  proof -
    have "matches (common_matcher, \<alpha>) (ipassmt_iface_replace_dstip_mexpr ipassmt ifce) a p = match_iface ifce (p_oiface p)"
      proof -
        show ?thesis
        proof(cases "ipassmt ifce")
          case None thus ?thesis by(simp add: matches_ipassmt_iface_replace_dstip_mexpr)
          next
          case (Some y) with assms(2) have "p_dst p \<in> ipcidr_union_set (set y) = match_iface ifce (p_oiface p)"
            using assms(1) assms(3) ipassmt_disjoint_matcheq_iifce_dstip by blast
            with Some show ?thesis by(simp add: matches_ipassmt_iface_replace_dstip_mexpr)
        qed
    qed
    thus ?thesis by(simp add: primitive_matcher_generic.Iface_single[OF primitive_matcher_generic_common_matcher])
  qed

  lemma matches_oiface_rewrite_ipassmt:
       "normalized_nnf_match m \<Longrightarrow> ipassmt_sanity_nowildcards ipassmt \<Longrightarrow> ipassmt_sanity_disjoint ipassmt \<Longrightarrow>
        (\<exists>p_ips. ipassmt (Iface (p_oiface p)) = Some p_ips \<and> p_dst p \<in> ipcidr_union_set (set p_ips)) \<Longrightarrow>
        matches (common_matcher, \<alpha>) (oiface_rewrite ipassmt m) a p \<longleftrightarrow> matches (common_matcher, \<alpha>) m a p"
    proof(induction m)
    case MatchAny thus ?case by simp
    next
    case (MatchNot m)
      hence IH: "normalized_nnf_match m \<Longrightarrow>
        matches (common_matcher, \<alpha>) (oiface_rewrite ipassmt m) a p =matches (common_matcher, \<alpha>) m a p" by blast
      with MatchNot.prems IH show ?case by(induction m) (simp_all add: oiface_rewrite_matches_Primitive)
    next
    case(Match x) thus ?case
      proof(cases x)
        case (OIface ifce) with Match show ?thesis
        apply(cases "ipassmt (Iface (p_oiface p))")
         prefer 2
          apply(simp add: matches_ipassmt_iface_replace_dstip_mexpr_case_Iface; fail)
        by auto
      qed(simp_all)
    next
    case (MatchAnd m1 m2) thus ?case by(simp add: bunch_of_lemmata_about_matches)
    qed

  lemma matches_oiface_rewrite:
       "normalized_nnf_match m \<Longrightarrow> ipassmt_sanity_nowildcards ipassmt (*TODO: check?*) \<Longrightarrow>
        correct_routing rt \<Longrightarrow>
        ipassmt = map_of (routing_ipassmt rt) \<Longrightarrow>
        output_iface (routing_table_semantics rt (p_dst p)) = p_oiface p \<Longrightarrow>
        matches (common_matcher, \<alpha>) (oiface_rewrite ipassmt m) a p \<longleftrightarrow> matches (common_matcher, \<alpha>) m a p"
  apply(rule matches_oiface_rewrite_ipassmt; assumption?)
   apply(simp add: correct_routing_def routing_ipassmt_ipassmt_sanity_disjoint; fail)
  apply(simp)
  apply(rule routing_ipassmt; assumption?)
   apply(simp add: correct_routing_def; fail)
  done
end

lemma oiface_rewrite_preserves_nodisc:
  "\<forall>a. \<not> disc (Dst a) \<Longrightarrow> \<not> has_disc disc m \<Longrightarrow> \<not> has_disc disc (oiface_rewrite ipassmt m)"
  proof(induction ipassmt m rule: oiface_rewrite.induct)
  case 2
    have "\<forall>a. \<not> disc (Dst a) \<Longrightarrow> \<not> disc (OIface ifce) \<Longrightarrow> \<not> has_disc disc (ipassmt_iface_replace_dstip_mexpr ipassmt ifce)"
      for ifce ipassmt
      apply(simp add: ipassmt_iface_replace_dstip_mexpr_def split: option.split)
      apply(intro allI impI, rename_tac ips)
      apply(drule_tac X=Dst and ls="map (uncurry IpAddrNetmask) ips" in match_list_to_match_expr_not_has_disc)
      apply(simp)
      done
    with 2 show ?case by simp
  qed(simp_all)

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |                  April 2006               |
            |                  March 2007  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2009         |
            |                   June 2009  (modified)   |
            |                October 2009  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_law_etc
imports CSP_F_law_aux CSP_T.CSP_T_law_etc
begin

(*------------------------*
         |~| --> !!
 *------------------------*)

lemma cspF_Int_choice_to_Rep:
  "(P |~| Q) =F[M,M] (!nat n:{0, (Suc 0)} .. (IF (n = 0) THEN P ELSE Q))"
apply (rule cspF_rw_right)
apply (subgoal_tac
 "(!nat n:{0, (Suc 0)} .. IF (n = 0) THEN P ELSE Q) =F[M,M]
  (!nat n:({0} Un {(Suc 0)}) .. IF (n = 0) THEN P ELSE Q)")
apply (assumption)
apply (rule cspF_decompo)
apply (fast)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_Rep_int_choice_union_Int)
apply (rule cspF_decompo)

apply (rule cspF_rw_right)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (simp)

apply (rule cspF_rw_right)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (simp)
done

(*** cspF_Rep_int_choice_set_input ***)

lemma cspF_Rep_int_choice_sum_set_input:
  "!! c:C .. (!set X:(Xsf c) .. (? :X -> (Pff c)))
   =F[M,M] !set X:(Union {(Xsf c) |c. c : sumset C}) ..
          (? a:X -> (!! c:{c:C. EX X. X:(Xsf c) & a:X}s .. (Pff c a)))"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_sum_set_input)
apply (rule order_antisym)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE bexE exE)
 apply (simp_all)

  apply (rule_tac x="Xsf c" in exI)
  apply (rule conjI)
  apply (force)

  apply (rule_tac x="Xa" in bexI)
  apply (simp)
  apply (simp)

  apply (rule_tac x="Xsf c" in exI)
  apply (rule conjI)
  apply (force)
  apply (rule conjI)
  apply (force)
  apply (force)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE bexE)
 apply (simp)
  apply (rule_tac x="c" in bexI)
  apply (rule_tac x="Xa" in bexI)
  apply (simp_all)

  apply (rule_tac x="ca" in bexI)
  apply (simp)
  apply (force)
  apply (simp)
done

lemma cspF_Rep_int_choice_set_input:
  "!nat n:N .. (!set X:(Xsf n) .. (? :X -> (Pff n)))
   =F[M,M] !set X:(Union {(Xsf n) |n. n : N}) ..
          (? a:X -> (!nat n:{n:N. EX X. X:(Xsf n) & a:X} .. (Pff n a)))"
apply (simp add: Rep_int_choice_nat_def)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_sum_set_input)
apply (rule cspF_decompo)
apply (force)
apply (simp)
done

(*** cspF_Rep_int_choice_set_set_DIV ***)

lemma cspF_Rep_int_choice_set_set_DIV:
  "[| Xs ~= {} ; Ys ~= {} |] ==>
   !set X:Xs .. (!set Y:Ys .. (? a:(X Un Y) -> DIV))
   =F[M,M] !set Z:{X Un Y |X Y. X:Xs & Y:Ys} .. (? a:Z -> DIV)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_set_set_DIV)
apply (rule order_antisym)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE bexE exE)
  apply (rule_tac x="Xa Un Xb" in exI)
  apply (force)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE bexE exE)
 apply (simp)

  apply (rule_tac x="Xb" in bexI)
  apply (rule_tac x="Y" in bexI)
  apply (simp_all)
done

(*********************************************************
               (P [+] SKIP) |~| (Q [+] SKIP)
 *********************************************************)

(* p.289 *)

lemma cspF_Int_choice_Ext_choice_SKIP:
  "(P [+] SKIP) |~| (Q [+] SKIP) =F[M,M] (P [+] Q [+] SKIP)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_Ext_choice_SKIP)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)

(* <= *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)
done

(*********************************************************
               (P [+] DIV) |~| (Q [+] DIV)
 *********************************************************)

lemma cspF_Int_choice_Ext_choice_DIV:
  "(P [+] DIV) |~| (Q [+] DIV) =F[M,M] (P [+] Q [+] DIV)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_Ext_choice_DIV)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)

(* <= *)
 apply (rule, simp add: in_traces in_failures)
 apply (force)
done

(*********************************************************
             (P [+] SKIP) |~| (Q [+] DIV)
 *********************************************************)

lemma cspF_Int_choice_Ext_choice_SKIP_DIV:
  "(P [+] SKIP) |~| (Q [+] DIV) =F[M,M] (P [+] Q [+] SKIP)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_Ext_choice_SKIP_DIV)
apply (rule order_antisym)
apply (rule, simp add: in_traces in_failures, force)+
done

(*********************************************************
             (P [+] DIV) |~| (Q [+] SKIP)
 *********************************************************)

lemma cspF_Int_choice_Ext_choice_DIV_SKIP:
  "(P [+] DIV) |~| (Q [+] SKIP) =F[M,M] (P [+] Q [+] SKIP)"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
apply (rule cspF_rw_left)
apply (rule cspF_Int_choice_Ext_choice_SKIP_DIV)
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (rule cspF_commut)
apply (rule cspF_reflex)
apply (rule cspF_reflex)
done

(*********************************************************
         (P [+] SKIP or DIV) |~| (Q [+] DIV or SKIP)
 *********************************************************)

lemma cspF_Int_choice_Ext_choice_SKIP_or_DIV:
  "[| P2 = SKIP | P2 = DIV ; Q2 = SKIP | Q2 = DIV |] ==>
   (P1 [+] P2) |~| (Q1 [+] Q2) =F[M,M] (P1 [+] Q1 [+] (P2 |~| Q2))"
apply (elim disjE)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_idem)
apply (simp add: cspF_Int_choice_Ext_choice_SKIP)

apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_unit)
apply (simp add: cspF_Int_choice_Ext_choice_SKIP_DIV)

apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_unit)
apply (simp add: cspF_Int_choice_Ext_choice_DIV_SKIP)

apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_reflex)
apply (rule cspF_unit)
apply (simp add: cspF_Int_choice_Ext_choice_DIV)
done

(*********************************************************
                    (P [+] DIV) |~| P
 *********************************************************)

lemma cspF_Ext_choice_DIV_Int_choice_Id:
  "(P [+] DIV) |~| P =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_DIV_Int_choice_Id)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_failures)
 apply (elim disjE conjE exE)
 apply (simp_all add: in_traces)
 apply (rule memF_F2)
 apply (rule proc_F4)
 apply (simp)
 apply (simp)
 apply (simp)

(* <= *)
 apply (rule, simp add: in_failures)
done

(* =================================================== *
 |             addition for CSP-Prover 5               |
 |                    (renaming)                       |
 * =================================================== *)

lemma cspF_Ext_pre_choice_Renaming_fun_step:
  "(? x:X -> Pf x)[[<rel> f]] =F[M,M]
   (? y:(f ` X) -> (! x:{x:X. y = f x} .. (Pf x[[<rel> f]])))"
apply (rule cspF_rw_left)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (simp add: fun_to_rel_def)
apply (force)

apply (rule cspF_decompo)
apply (simp add: fun_to_rel_def)
apply (force)
done

(* Act prefix event *)

lemma cspF_Act_prefix_Renaming_fun_step:
  "(a -> P)[[<rel> f]] =F[M,M] f(a) -> P[[<rel> f]]"
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_step)

apply (rule cspF_rw_left)
apply (rule cspF_Ext_pre_choice_Renaming_fun_step)

apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (simp)

apply (simp)
apply (subgoal_tac
  "{x. x = a & f a = f x}={a}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_const_com_rule)
apply (auto)
apply (rule cspF_rw_left)
apply (rule cspF_IF_split)
apply (auto)
done

lemmas cspF_Renaming_fun_step
     = cspF_Ext_pre_choice_Renaming_fun_step
       cspF_Act_prefix_Renaming_fun_step

(* -------- event -------- *)

(* <--> *)

lemma cspF_Act_prefix_Renaming1_event1_step_in:
  "(a -> P)[[a<-->b]] =F[M,M] b -> P[[a<-->b]]"
apply (simp add: Renaming_event_def Renaming_event_fun_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemma cspF_Act_prefix_Renaming1_event2_step_in:
  "(a -> P)[[b<-->a]] =F[M,M] b -> P[[b<-->a]]"
by (simp add: cspF_Act_prefix_Renaming1_event1_step_in Renaming_commut)

lemma cspF_Act_prefix_Renaming1_event_step_notin:
  "[| a ~= c ; b ~= c |] ==> (c -> P)[[a<-->b]] =F[M,M] c -> P[[a<-->b]]"
apply (simp add: Renaming_event_def Renaming_event_fun_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemmas cspF_Act_prefix_Renaming1_event_step =
       cspF_Act_prefix_Renaming1_event1_step_in
       cspF_Act_prefix_Renaming1_event2_step_in
       cspF_Act_prefix_Renaming1_event_step_notin

(* <<- *)

lemma cspF_Act_prefix_Renaming2_set_event_step_in:
  "a:A ==> (a -> P)[[A<<-b]] =F[M,M] b -> P[[A<<-b]]"
apply (simp add: Renaming_event_def Renaming_event_fun_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemma cspF_Act_prefix_Renaming2_set_event_step_notin:
  "c~:A ==> (c -> P)[[A<<-b]] =F[M,M] c -> P[[A<<-b]]"
apply (simp add: Renaming_event_def Renaming_event_fun_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemma cspF_Act_prefix_Renaming2_set_event_step:
  "(a -> P)[[A<<-b]] =F[M,M]
   IF (a:A) THEN (b -> P[[A<<-b]])
            ELSE (a -> P[[A<<-b]])"
apply (case_tac "a:A")
apply (rule cspF_rw_left)
apply (rule cspF_Act_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Act_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

lemmas cspF_Act_prefix_Renaming2_set_event_steps =
       cspF_Act_prefix_Renaming2_set_event_step_in
       cspF_Act_prefix_Renaming2_set_event_step_notin

(* <-- *)

lemma cspF_Act_prefix_Renaming2_event_step_in:
  "(a -> P)[[a<--b]] =F[M,M] b -> P[[a<--b]]"
by (simp add: cspF_Act_prefix_Renaming2_set_event_step_in)

lemma cspF_Act_prefix_Renaming2_event_step_notin:
  "a ~= c ==> (c -> P)[[a<--b]] =F[M,M] c -> P[[a<--b]]"
by (simp add: cspF_Act_prefix_Renaming2_set_event_step_notin)

lemmas cspF_Act_prefix_Renaming2_event_step =
       cspF_Act_prefix_Renaming2_event_step_in
       cspF_Act_prefix_Renaming2_event_step_notin

lemmas cspF_Act_prefix_Renaming_event_step =
       cspF_Act_prefix_Renaming1_event_step
       cspF_Act_prefix_Renaming2_event_step

(* -------- channel -------- *)

(* Act prefix channel *)

(* <==> *)

lemma cspF_Act_prefix_Renaming1_channel1_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f v -> P)[[f<==>g]] =F[M,M] g v -> P[[f<==>g]]"
apply (simp add: Renaming_channel_fun_def Renaming_channel_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemma cspF_Act_prefix_Renaming1_channel2_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f v -> P)[[g<==>f]] =F[M,M] g v -> P[[g<==>f]]"
by (simp add: Renaming_commut cspF_Act_prefix_Renaming1_channel1_step_in)

lemma cspF_Act_prefix_Renaming1_channel_step_notin:
  "[| (ALL x. a ~= f x) | a ~: range f ;
      (ALL x. a ~= g x) | a ~: range g |]
   ==> (a -> P)[[f<==>g]] =F[M,M] a -> P[[f<==>g]]"
apply (simp add: Renaming_channel_fun_def Renaming_channel_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemmas cspF_Act_prefix_Renaming1_channel_step =
       cspF_Act_prefix_Renaming1_channel1_step_in
       cspF_Act_prefix_Renaming1_channel2_step_in
       cspF_Act_prefix_Renaming1_channel_step_notin

(* <== *)

lemma cspF_Act_prefix_Renaming2_channel_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f v -> P)[[f<==g]] =F[M,M] g v -> P[[f<==g]]"
apply (simp add: Renaming_channel_fun_def Renaming_channel_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemma cspF_Act_prefix_Renaming2_channel_step_notin:
  "[| (ALL x. a ~= f x) | a ~: range f |]
   ==> (a -> P)[[f<==g]] =F[M,M] a -> P[[f<==g]]"
apply (simp add: Renaming_channel_fun_def Renaming_channel_def)
by (rule cspF_rw_left, rule cspF_Act_prefix_Renaming_fun_step, auto)

lemmas cspF_Act_prefix_Renaming2_channel_step =
       cspF_Act_prefix_Renaming2_channel_step_in
       cspF_Act_prefix_Renaming2_channel_step_notin

lemmas cspF_Act_prefix_Renaming_channel_step =
       cspF_Act_prefix_Renaming1_channel_step
       cspF_Act_prefix_Renaming2_channel_step

(* -------*)

lemmas cspF_Act_prefix_Renaming_step =
       cspF_Act_prefix_Renaming_fun_step
       cspF_Act_prefix_Renaming_event_step
       cspF_Act_prefix_Renaming_channel_step

(* --- Ext_pre_choice_Renaming_even --- *)

(* <--> *)

lemma cspF_Ext_pre_choice_Renaming1_event1_step:
  "a ~= b ==>
     (? x:X -> Pf x)[[a<-->b]] =F[M,M]
     (IF (a:X) THEN (b -> (Pf a)[[a<-->b]]) ELSE STOP) [+]
     (IF (b:X) THEN (a -> (Pf b)[[a<-->b]]) ELSE STOP) [+]
      (? x:(X - {a,b}) -> (Pf x)[[a<-->b]])"
apply (rule cspF_rw_left)
apply (simp add: Renaming_event_def)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (case_tac "a:X")
 apply (case_tac "b:X")
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

  apply (simp)

   apply (case_tac "aa = a")
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (rule cspF_rw_left)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (simp)

   apply (case_tac "aa = b")
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac "{x. x ~= b & (x ~= b --> x = a)}={a}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

   (* etc *)
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
     "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))}={aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

 (* b~:X *)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

  apply (simp)

   apply (case_tac "aa = b")
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac "{x. x ~= b & (x ~= b --> x = a)}={a}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
   "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))} = {aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

(* a~:X *)
 apply (case_tac "b:X")

  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

  apply (simp)

   apply (case_tac "aa = a")
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (rule cspF_Rep_int_choice_singleton)

   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
   "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))} = {aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

 (* b~:X *)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
   "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))} = {aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)
done

lemma cspF_Ext_pre_choice_Renaming1_event2_step:
  "a = b ==>
     (? x:X -> Pf x)[[a<-->b]] =F[M,M]
     (IF (a:X) THEN (b -> (Pf a)[[a<-->b]]) ELSE STOP) [+]
     (IF (b:X) THEN (a -> (Pf b)[[a<-->b]]) ELSE STOP) [+]
      (? x:(X - {a,b}) -> (Pf x)[[a<-->b]])"
apply (simp)
apply (rule cspF_rw_left)
apply (simp add: Renaming_event_def)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_idem)
apply (rule cspF_reflex)

 apply (case_tac "b:X")
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

  apply (simp)

   apply (case_tac "aa = b")
   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (rule cspF_Rep_int_choice_singleton)

   apply (simp)
   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
     "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))}={aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)

 (* b~:X *)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_IF_split)
  apply (rule cspF_reflex)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_decompo)
  apply (rule cspF_step)
  apply (rule cspF_reflex)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: image_def Renaming_event_fun_def)
  apply (force)

   apply ((rule cspF_rw_right, rule cspF_IF_split | rule cspF_decompo)| simp)+
   apply (simp add: image_def Renaming_event_fun_def)
   apply (subgoal_tac
   "{x. x ~= b & (x ~= b --> x ~= a & (x ~= a --> x : X & aa = x))} = {aa}")
   apply (simp)
   apply (rule cspF_Rep_int_choice_singleton)
   apply (force)
done

lemma cspF_Ext_pre_choice_Renaming1_event_step:
  "(? x:X -> Pf x)[[a<-->b]] =F[M,M]
     (IF (a:X) THEN (b -> (Pf a)[[a<-->b]]) ELSE STOP) [+]
     (IF (b:X) THEN (a -> (Pf b)[[a<-->b]]) ELSE STOP) [+]
      (? x:(X - {a,b}) -> (Pf x)[[a<-->b]])"
apply (case_tac "a=b")
apply (rule cspF_Ext_pre_choice_Renaming1_event2_step)
apply (simp_all)
apply (rule cspF_Ext_pre_choice_Renaming1_event1_step)
apply (simp_all)
done

(* <<- *)

lemma cspF_Ext_pre_choice_Renaming2_set_event_step_in:
  "X Int A ~= {} ==>
     (? x:X -> Pf x)[[A<<-a]] =F[M,M]
      a -> (! x:(X Int A) .. (Pf x)[[A<<-a]])
     [+] ? x:(X-A) -> (Pf x)[[A<<-a]]"
apply (rule cspF_rw_left)
apply (simp add: Renaming_event_def)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)
apply (simp add: image_def)

apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_step)
apply (rule cspF_reflex)
apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (simp add: Renaming_event_fun_def)
apply (blast)

apply (simp)

apply (case_tac "aa = a")
 apply (simp)
 apply (case_tac "a : X & a ~: A")
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_ref_eq)

  (* <= *)
  apply (rule cspF_Int_choice_right)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (rule cspF_Rep_int_choice_left)
   apply (rule_tac x="aaa" in exI)
   apply (simp)
   apply (simp add: Renaming_event_fun_def)

   apply (rule cspF_Rep_int_choice_left)
   apply (rule_tac x="a" in exI)
   apply (simp)
   apply (simp add: Renaming_event_fun_def)

  (* => *)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (elim conjE bexE)
   apply (simp add: Renaming_event_fun_def)
   apply (case_tac "aaa : A")

    apply (simp)
    apply (rule cspF_Int_choice_left1)
    apply (rule cspF_Rep_int_choice_left)
    apply (simp)
    apply (rule_tac x="aaa" in exI)
    apply (simp)

    apply (simp)
    apply (rule cspF_Int_choice_left2)
    apply (simp)

 (* ~(a : X & a ~: A) *)
  apply (simp (no_asm_simp))
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)

  apply (rule cspF_decompo)
  apply (simp add: Renaming_event_fun_def)
  apply (fast)
  apply (simp)

(* aa ~= a *)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (simp add: Renaming_event_fun_def)
 apply (subgoal_tac "{x. x ~: A & (x ~: A --> x : X & aa = x)}={aa}")
 apply (simp)
 apply (rule cspF_Rep_int_choice_singleton)
 apply (force)
done

lemma cspF_Ext_pre_choice_Renaming2_set_event_step_notin:
  "[| X Int A = {} |] ==>
     (? x:X -> Pf x)[[A<<-b]] =F[M,M] ? x:X -> (Pf x)[[A<<-b]]"
apply (simp add: Renaming_event_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (rule cspF_decompo)
apply (simp add: Image_def image_def)
apply (simp add: Renaming_event_fun_def)
apply (force)
apply (simp add: Renaming_event_fun_def)
apply (subgoal_tac
  "{x. (x : A --> x : X & a = b) & (x ~: A --> x : X & a = x)} = {a}")
apply (simp)
apply (rule cspF_Rep_int_choice_singleton)
apply (force)
done

lemma cspF_Ext_pre_choice_Renaming2_set_event_step:
  "(? x:X -> Pf x)[[A<<-a]] =F[M,M]
  IF (X Int A ~= {})
  THEN (a -> (! x:(X Int A) .. (Pf x)[[A<<-a]])
        [+] ? x:(X-A) -> (Pf x)[[A<<-a]])
  ELSE (? x:X -> (Pf x)[[A<<-a]])"
apply (case_tac "X Int A ~= {}")
apply (rule cspF_rw_left)
apply (rule cspF_Ext_pre_choice_Renaming2_set_event_step_in)
apply (simp)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Ext_pre_choice_Renaming2_set_event_step_notin)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

(* <-- *)

lemma cspF_Ext_pre_choice_Renaming2_event_step:
  "(? x:X -> Pf x)[[a<--b]] =F[M,M]
  IF (a : X)
  THEN (b -> (Pf a)[[a<--b]]
        [+] ? x:(X-{a}) -> (Pf x)[[a<--b]])
  ELSE (? x:X -> (Pf x)[[a<--b]])"
apply (rule cspF_rw_left)
apply (rule cspF_Ext_pre_choice_Renaming2_set_event_step)
apply (case_tac "a:X")

 apply (rule cspF_decompo)
 apply (simp)
 apply (rule cspF_decompo)
 apply (rule cspF_decompo)
 apply (simp)
 apply (subgoal_tac "X Int {a} = {a}")
 apply (simp)
 apply (rule cspF_Rep_int_choice_singleton)
 apply (force)
 apply (simp)
 apply (simp)

 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_IF_split)
 apply (simp)
done

lemmas cspF_Ext_pre_choice_Renaming_event_step =
       cspF_Ext_pre_choice_Renaming1_event_step
       cspF_Ext_pre_choice_Renaming2_set_event_step
       cspF_Ext_pre_choice_Renaming2_event_step

(* sending -- event -- *)

(* <--> *)

lemma cspF_Send_prefix_Renaming1_event1_step_in:
  "inj f ==> (f!v -> P)[[a<-->f v]] =F[M,M] a -> P[[a<-->f v]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemma cspF_Send_prefix_Renaming1_event2_step_in:
  "inj f ==> (f!v -> P)[[f v<-->a]] =F[M,M] a -> P[[f v<-->a]]"
by (simp add: Renaming_commut cspF_Send_prefix_Renaming1_event1_step_in)

lemma cspF_Send_prefix_Renaming1_event_step_notin:
  "[| a ~= f v | f v ~= a ; b ~= f v | f v ~= b |]
   ==> (f!v -> P)[[a<-->b]] =F[M,M] f!v -> P[[a<-->b]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemmas cspF_Send_prefix_Renaming1_event_step =
       cspF_Send_prefix_Renaming1_event1_step_in
       cspF_Send_prefix_Renaming1_event2_step_in
       cspF_Send_prefix_Renaming1_event_step_notin

(* <<- *)

lemma cspF_Send_prefix_Renaming2_set_event_step_in:
  "f v : A ==> (f!v -> P)[[A<<-a]] =F[M,M] a -> P[[A<<-a]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming2_set_event_step_in)
done

lemma cspF_Send_prefix_Renaming2_set_event_step_notin:
  "f v ~: A
   ==> (f!v -> P)[[A<<-b]] =F[M,M] f!v -> P[[A<<-b]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming2_set_event_step_notin)
done

lemma cspF_Send_prefix_Renaming2_set_event_step:
  "(f!v -> P)[[A<<-a]] =F[M,M]
   IF (f v : A) THEN (a -> P[[A<<-a]]) ELSE (f!v -> P[[A<<-a]])"
apply (case_tac "f v : A")
apply (rule cspF_rw_left)
apply (rule cspF_Send_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Send_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

(* <-- *)

lemma cspF_Send_prefix_Renaming2_event_step_in:
  "(f!v -> P)[[f v<--a]] =F[M,M] a -> P[[f v<--a]]"
by (simp add: cspF_Send_prefix_Renaming2_set_event_step_in)

lemma cspF_Send_prefix_Renaming2_event_step_notin:
  "[| a ~= f v | f v ~= a |]
   ==> (f!v -> P)[[a<--b]] =F[M,M] f!v -> P[[a<--b]]"
by (simp add: cspF_Send_prefix_Renaming2_set_event_step_notin)

lemmas cspF_Send_prefix_Renaming2_event_step =
       cspF_Send_prefix_Renaming2_event_step_in
       cspF_Send_prefix_Renaming2_event_step_notin

lemmas cspF_Send_prefix_Renaming_event_step =
       cspF_Send_prefix_Renaming1_event_step
       cspF_Send_prefix_Renaming2_event_step

(* sending -- channel -- *)

(* <==> *)

lemma cspF_Send_prefix_Renaming1_channel1_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f!v -> P)[[f<==>g]] =F[M,M] g!v -> P[[f<==>g]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemma cspF_Send_prefix_Renaming1_channel2_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f!v -> P)[[g<==>f]] =F[M,M] g!v -> P[[g<==>f]]"
by (simp add: Renaming_commut cspF_Send_prefix_Renaming1_channel1_step_in)

lemma cspF_Send_prefix_Renaming1_channel_step_notin:
  "[| (ALL x. h v ~= f x) | h v ~: range f ;
      (ALL x. h v ~= g x) | h v ~: range g |]
    ==> (h!v -> P)[[f<==>g]] =F[M,M] h!v -> P[[f<==>g]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemmas cspF_Send_prefix_Renaming1_channel_step =
       cspF_Send_prefix_Renaming1_channel1_step_in
       cspF_Send_prefix_Renaming1_channel2_step_in
       cspF_Send_prefix_Renaming1_channel_step_notin

(* <== *)

lemma cspF_Send_prefix_Renaming2_channel_step_in:
  "[| inj f ; ALL x y. f x ~= g y |]
   ==> (f!v -> P)[[f<==g]] =F[M,M] g!v -> P[[f<==g]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemma cspF_Send_prefix_Renaming2_channel_step_notin:
  "[| (ALL x. h v ~= f x) | h v ~: range f |]
    ==> (h!v -> P)[[f<==g]] =F[M,M] h!v -> P[[f<==g]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: cspF_Act_prefix_Renaming_step)
done

lemmas cspF_Send_prefix_Renaming2_channel_step =
       cspF_Send_prefix_Renaming2_channel_step_in
       cspF_Send_prefix_Renaming2_channel_step_notin

lemmas cspF_Send_prefix_Renaming_channel_step =
       cspF_Send_prefix_Renaming1_channel_step
       cspF_Send_prefix_Renaming2_channel_step

(* -- *)

lemmas cspF_Send_prefix_Renaming_step =
       cspF_Send_prefix_Renaming_event_step
       cspF_Send_prefix_Renaming_channel_step

(* --- Rec_prefix_Renaming_even --- *)

(* <--> *)

lemma cspF_Rec_prefix_Renaming1_event1_step_in:
  "[| inj f ; v:X ; ALL x:X. a ~= f x |] ==>
     (f ? x:X -> Pf x)[[a<-->f v]] =F[M,M]
     (a -> (Pf v)[[a<-->f v]]) [+] f ? x:(X-{v}) -> (Pf x)[[a<-->f v]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (simp add: Renaming_event_def)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_step)
apply (rule cspF_reflex)
apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (simp add: inj_on_def)
apply (simp add: Image_def image_def)
apply (simp add: Renaming_event_fun_def)
apply (blast)

apply (simp)
apply (rule cspF_ref_eq)

(* <= *)
apply (case_tac "aa = a")

 (* aa = a *)
 apply (simp)
 apply (case_tac "a : f ` (X - {v})")
  apply (simp add: image_iff)

  (* a ~: f ` (X - {v})" *)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_Rep_int_choice_left)
  apply (rule_tac x="f v" in exI)
  apply (simp add: Renaming_event_fun_def)

 (* aa ~= a *)
 apply (simp)

 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)

 apply (rule cspF_Rep_int_choice_left)
 apply (rule_tac x="aa" in exI)
 apply (simp)

 apply (simp add: image_iff)
 apply (erule bexE)
 apply (simp add: inj_on_def)
 apply (simp add: Renaming_event_fun_def)
 apply (force)

(* => *)
apply (simp add: Renaming_event_fun_def)
apply (case_tac "aa = a")

 (* aa = a *)
 apply (simp)
 apply (case_tac "a : f ` (X - {v})")

  apply (simp add: image_iff)

  (* a ~: f ` (X - {v})" *)
  apply (simp)
  apply (rule cspF_rw_left)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_rw_left)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_Rep_int_choice_right)
  apply (force)

 (* aa ~= a *)
 apply (simp)

 apply (rule cspF_rw_left)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_IF_split)
 apply (simp)

 apply (rule cspF_Rep_int_choice_right)
 apply (auto)
done

lemma cspF_Rec_prefix_Renaming1_event2_step_in:
  "[| inj f ; v:X ; ALL x:X. a ~= f x |] ==>
     (f ? x:X -> Pf x)[[f v<-->a]] =F[M,M]
     (a -> (Pf v)[[f v<-->a]]) [+] f ? x:(X-{v}) -> (Pf x)[[f v<-->a]]"
apply (simp add: Renaming_commut)
apply (simp add: cspF_Rec_prefix_Renaming1_event1_step_in)
done

lemma cspF_Rec_prefix_Renaming1_event_step_notin:
  "[| (ALL x:X. a ~= f x) | a ~: f ` X ;
      (ALL x:X. b ~= f x) | b ~: f ` X |] ==>
     (f ? x:X -> Pf x)[[a<-->b]] =F[M,M] f ? x:X -> (Pf x)[[a<-->b]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: Renaming_event_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (rule cspF_decompo)
apply (simp add: Image_def image_def)
apply (simp add: Renaming_event_fun_def)
apply (force)
apply (subgoal_tac
  "{x : f ` X. aa = Renaming1_event_fun a b x} = {aa}")
apply (simp)
apply (rule cspF_Rep_int_choice_singleton)

apply (simp add: Renaming_event_fun_def)
apply (force)
done

lemmas cspF_Rec_prefix_Renaming1_event_step =
       cspF_Rec_prefix_Renaming1_event1_step_in
       cspF_Rec_prefix_Renaming1_event2_step_in
       cspF_Rec_prefix_Renaming1_event_step_notin

(* <<- *)

lemma cspF_Rec_prefix_Renaming2_set_event_step_in:
  "[| inj f ; EX x:X. f x : A |] ==>
     (f ? x:X -> Pf x)[[A<<-a]] =F[M,M]
      a -> (!<f> x:{x:X. f x : A} .. (Pf x)[[A<<-a]])
     [+] f ? x:(X-{x. f x : A}) -> (Pf x)[[A<<-a]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (simp add: Renaming_event_def)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)
apply (simp add: image_def)

apply (rule cspF_rw_right)
apply (rule cspF_decompo)
apply (rule cspF_step)
apply (rule cspF_reflex)
apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
apply (simp add: Renaming_event_fun_def)
apply (blast)

apply (simp)

apply (case_tac "aa = a")
 apply (simp)
 apply (case_tac "EX x:X - {x. f x : A}. a = f x")
  apply (simp add: image_iff)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (elim conjE bexE)
  apply (simp)

  apply (rule cspF_ref_eq)

  (* <= *)
  apply (rule cspF_Int_choice_right)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (simp)
   apply (rule cspF_Rep_int_choice_left)
   apply (rule_tac x="f aaa" in exI)
   apply (simp)
   apply (simp add: Renaming_event_fun_def)
   apply (fast)

   apply (rule cspF_Rep_int_choice_left)
   apply (rule_tac x="a" in exI)
   apply (simp)
   apply (rule conjI)
    apply (blast)
   apply (simp add: Renaming_event_fun_def)

  (* => *)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (elim conjE bexE)
   apply (simp add: Renaming_event_fun_def)
   apply (case_tac "f xb : A")

    apply (simp)
    apply (rule cspF_Int_choice_left1)
    apply (rule cspF_Rep_int_choice_left)
    apply (simp)
    apply (rule_tac x="xb" in exI)
    apply (simp)

    apply (simp)
    apply (rule cspF_Int_choice_left2)
    apply (simp add: inj_on_def)
    apply (force)

 (* ~(EX x:X - {x. f x : A}. a = f x) *)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)
  apply (rule cspF_rw_right)
  apply (rule cspF_IF_split)
  apply (simp)

  apply (rule cspF_ref_eq)

  (* <= *)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (simp)
   apply (rule cspF_Rep_int_choice_left)
   apply (rule_tac x="f aaa" in exI)
   apply (simp)
   apply (simp add: Renaming_event_fun_def)
   apply (fast)

  (* => *)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)
   apply (rule cspF_Rep_int_choice_left)
   apply (simp)
   apply (elim conjE bexE)
   apply (simp add: Renaming_event_fun_def)
   apply (case_tac "f xa : A")

    apply (simp)
    apply (rule_tac x="xa" in exI)
    apply (simp)
    apply (simp)

 (* aa ~= a *)
 apply (simp)

 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_IF_split)
 apply (simp)
 apply (rule cspF_ref_eq)

  (* => *)
  apply (rule cspF_Rep_int_choice_left)
  apply (rule_tac x="aa" in exI)
  apply (simp)
  apply (erule bexE)
  apply (simp add: inj_on_def)
  apply (simp add: Renaming_event_fun_def)
  apply (force)

 (* <= *)
  apply (rule cspF_Rep_int_choice_right)
  apply (simp)
  apply (elim conjE bexE)
  apply (simp add: Renaming_event_fun_def)
   apply (case_tac "f xb : A")
   apply (simp)
   apply (simp add: inj_on_def)
   apply (force)
done

lemma cspF_Rec_prefix_Renaming2_set_event_step_notin:
  "[| (ALL x:X. f x ~: A) | A Int f ` X = {} |] ==>
     (f ? x:X -> Pf x)[[A<<-b]] =F[M,M] f ? x:X -> (Pf x)[[A<<-b]]"
apply (simp add: csp_prefix_ss_def)
apply (simp add: Renaming_event_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (fold Renaming_event_def)

apply (rule cspF_decompo)
apply (simp add: Image_def image_def)
apply (simp add: Renaming_event_fun_def)
apply (force)
apply (subgoal_tac
  "{x : f ` X. a = Renaming2_event_fun A b x} = {a}")
apply (simp)
apply (rule cspF_Rep_int_choice_singleton)

apply (simp add: Renaming_event_fun_def)
apply (force)
done

lemma cspF_Rec_prefix_Renaming2_set_event_step:
  "inj f ==>
  (f ? x:X -> Pf x)[[A<<-a]] =F[M,M]
  IF (EX x:X. f x : A)
  THEN (a -> (!<f> x:{x:X. f x : A} .. (Pf x)[[A<<-a]])
       [+] f ? x:(X-{x. f x : A}) -> (Pf x)[[A<<-a]])
  ELSE (f ? x:X -> (Pf x)[[A<<-a]])"
apply (case_tac "EX x:X. f x : A")
apply (rule cspF_rw_left)
apply (rule cspF_Rec_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rec_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

(* <-- *)

lemma cspF_Rec_prefix_Renaming2_event_step_in:
  "[| inj f ; v:X ; ALL x:X. a ~= f x |] ==>
     (f ? x:X -> Pf x)[[f v<--a]] =F[M,M]
     (a -> (Pf v)[[f v<--a]]) [+] f ? x:(X-{v}) -> (Pf x)[[f v<--a]]"
apply (rule cspF_rw_left)
apply (rule cspF_Rec_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (simp)
apply (force)
apply (simp)

apply (rule cspF_decompo)
 apply (rule cspF_decompo)
 apply (simp)
 apply (subgoal_tac "{x : X. f x = f v}={v}")
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Rep_int_choice_singleton)
 apply (simp)
 apply (simp)
 apply (simp add: inj_on_def)
 apply (force)

 apply (subgoal_tac "{x. f x = f v}={v}")
 apply (simp)
 apply (simp add: inj_on_def)
 apply (force)
done

lemma cspF_Rec_prefix_Renaming2_event_step_notin:
  "[| (ALL x:X. a ~= f x) | a ~: f ` X |] ==>
     (f ? x:X -> Pf x)[[a<--b]] =F[M,M] f ? x:X -> (Pf x)[[a<--b]]"
apply (rule cspF_rw_left)
apply (rule cspF_Rec_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (force)
apply (simp)
done

lemmas cspF_Rec_prefix_Renaming2_event_step =
       cspF_Rec_prefix_Renaming2_event_step_in
       cspF_Rec_prefix_Renaming2_event_step_notin

lemmas cspF_Rec_prefix_Renaming_event_step =
       cspF_Rec_prefix_Renaming1_event_step
       cspF_Rec_prefix_Renaming2_event_step

(* <==> *)

lemma cspF_Rec_prefix_Renaming1_channel1_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
     (f ? x:X -> Pf x)[[f<==>g]] =F[M,M] g ? x:X -> (Pf x)[[f<==>g]]"
apply (simp add: Renaming_channel_def)
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (rule cspF_decompo)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: image_iff)
apply (erule bexE)
apply (simp)
apply (subgoal_tac
  "{xa. (EX x:X. xa = f x) & g x = Renaming1_channel_fun f g xa} = {f x}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)

apply (auto)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: inj_on_def)
apply (force)
apply (simp add: Renaming_channel_fun_simp)
done

lemma cspF_Rec_prefix_Renaming1_channel2_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
     (f ? x:X -> Pf x)[[g<==>f]] =F[M,M] g ? x:X -> (Pf x)[[g<==>f]]"
apply (simp add: Renaming_commut)
apply (simp add: cspF_Rec_prefix_Renaming1_channel1_step_in)
done

(*
lemma Renaming_channel_fun_h:
   "[| ALL x y. f x ~= g y ; ALL x y. f x ~= h y ; ALL x y. g x ~= h y |]
    ==> Renaming_channel_fun f g (h x) = h x"
by (auto simp add: Renaming_channel_fun_def)

lemma Renaming_channel_fun_map_h:
   "[| (ALL x y. f x ~= h y) ;
       (ALL x y. g x ~= h y) ;
       ALL x y. f x ~= g y |]
    ==> Renaming_channel_fun f g ` h ` X = h ` X"
apply (simp add: image_def)
apply (auto simp add: Renaming_channel_fun_h)
done
*)

lemma cspF_Rec_prefix_Renaming1_channel_step_notin:
  "[| inj h;
      (ALL x y. f x ~= h y) | range f Int range h = {} ;
      (ALL x y. g x ~= h y) | range g Int range h = {} ;
       ALL x y. f x ~= g y |] ==>
    (h ? x:X -> Pf x)[[f<==>g]] =F[M,M] h ? x:X -> (Pf x)[[f<==>g]]"
apply (subgoal_tac "(ALL x y. f x ~= h y) & (ALL x y. g x ~= h y)")
apply (simp add: Renaming_channel_def)
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (rule cspF_decompo)
apply (simp add: Renaming_channel_fun_simp)

apply (simp add: image_iff)
apply (erule bexE)
apply (simp)
apply (subgoal_tac
  "{xa. (EX x:X. xa = h x) & h x = Renaming1_channel_fun f g xa} = {h x}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)

apply (auto)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: Renaming_channel_fun_simp)
apply (blast)+
done

lemmas cspF_Rec_prefix_Renaming1_channel_step =
       cspF_Rec_prefix_Renaming1_channel1_step_in
       cspF_Rec_prefix_Renaming1_channel2_step_in
       cspF_Rec_prefix_Renaming1_channel_step_notin

(* <== *)

lemma cspF_Rec_prefix_Renaming2_channel_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
     (f ? x:X -> Pf x)[[f<==g]] =F[M,M] g ? x:X -> (Pf x)[[f<==g]]"
apply (simp add: Renaming_channel_def)
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (rule cspF_decompo)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: image_iff)
apply (erule bexE)
apply (simp)
apply (subgoal_tac
  "{xa. (EX x:X. xa = f x) & g x = Renaming2_channel_fun f g xa} = {f x}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)

apply (auto)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: inj_on_def)
apply (force)
apply (simp add: Renaming_channel_fun_simp)
done

lemma cspF_Rec_prefix_Renaming2_channel_step_notin:
  "[| inj h;
      (ALL x y. f x ~= h y) | range f Int range h = {} ;
       ALL x y. f x ~= g y |] ==>
    (h ? x:X -> Pf x)[[f<==g]] =F[M,M] h ? x:X -> (Pf x)[[f<==g]]"
apply (subgoal_tac "(ALL x y. f x ~= h y)")
apply (simp add: Renaming_channel_def)
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Renaming_fun_step)
apply (rule cspF_decompo)
apply (simp add: Renaming_channel_fun_simp)

apply (simp add: image_iff)
apply (erule bexE)
apply (simp)
apply (subgoal_tac
  "{xa. (EX x:X. xa = h x) & h x = Renaming2_channel_fun f g xa} = {h x}")
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_singleton)
apply (simp)

apply (auto)
apply (simp add: Renaming_channel_fun_simp)
apply (simp add: Renaming_channel_fun_simp)
apply (blast)+
done

lemmas cspF_Rec_prefix_Renaming2_channel_step =
       cspF_Rec_prefix_Renaming2_channel_step_in
       cspF_Rec_prefix_Renaming2_channel_step_notin

lemmas cspF_Rec_prefix_Renaming_channel_step =
       cspF_Rec_prefix_Renaming1_channel_step
       cspF_Rec_prefix_Renaming2_channel_step

lemmas cspF_Rec_prefix_Renaming_step =
       cspF_Rec_prefix_Renaming_event_step
       cspF_Rec_prefix_Renaming_channel_step

(* Nondet Sending *)

(* <--> *)

lemma cspF_Nondet_send_prefix_Renaming1_event1_step_in:
  "[| inj f ; v:X ; ALL x. a ~= f x |] ==>
     (f !? x:X -> Pf x)[[a<-->f v]] =F[M,M]
     (a -> (Pf v)[[a<-->f v]]) |~| f !? x:(X-{v}) -> (Pf x)[[a<-->f v]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (subgoal_tac "(f ` X) = {f v} Un (f ` (X - {v}))")
apply (simp del: Un_insert_left)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_int_choice_com_union_Int)
apply (rule cspF_decompo)

 (* 1 *)
 apply (rule cspF_rw_left)
 apply (rule cspF_Rep_int_choice_singleton)
 apply (simp add: cspF_Act_prefix_Renaming_event_step)

 (* 2 *)
 apply (rule cspF_decompo)
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Act_prefix_Renaming_event_step)
 apply (auto)
 apply (simp add: inj_on_def)
done

lemma cspF_Nondet_send_prefix_Renaming1_event2_step_in:
  "[| inj f ; v:X ; ALL x. a ~= f x |] ==>
     (f !? x:X -> Pf x)[[f v<-->a]] =F[M,M]
     (a -> (Pf v)[[f v<-->a]]) |~| f !? x:(X-{v}) -> (Pf x)[[f v<-->a]]"
apply (simp add: Renaming_commut)
apply (simp add: cspF_Nondet_send_prefix_Renaming1_event1_step_in)
done

lemma cspF_Nondet_send_prefix_Renaming1_event_step_notin:
  "[| (ALL x. a ~= f x) | a ~: range f ;
      (ALL x. b ~= f x) | b ~: range f |] ==>
   (f !? x:X -> Pf x)[[a<-->b]] =F[M,M] f !? x:X -> (Pf x)[[a<-->b]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_decompo)
apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Act_prefix_Renaming_event_step)
 apply (auto)
done

lemmas cspF_Nondet_send_prefix_Renaming1_event_step =
       cspF_Nondet_send_prefix_Renaming1_event1_step_in
       cspF_Nondet_send_prefix_Renaming1_event2_step_in
       cspF_Nondet_send_prefix_Renaming1_event_step_notin

(* <<- *)

lemma cspF_Nondet_send_prefix_Renaming2_set_event_step_in:
  "[| inj f ; EX x:X. f x : A |] ==>
     (f !? x:X -> Pf x)[[A<<-a]] =F[M,M]
      a -> (!<f> x:{x:X. f x : A} .. (Pf x)[[A<<-a]])
     |~| f !? x:(X-{x. f x : A}) -> (Pf x)[[A<<-a]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_step)

apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_step)

apply (subgoal_tac "(f ` X) = (f ` {x : X. f x : A}) Un (f ` (X - {x. f x : A}))") (* 1 *)
 apply (simp del: Un_insert_left)
 apply (rule cspF_rw_left)
 apply (rule cspF_Rep_int_choice_com_union_Int)
 apply (rule cspF_decompo)

 (* left *)
 apply (subgoal_tac
  "a -> (!<f> x:{x : X. f x : A} .. Pf x [[A<<-a]])
   =F[M,M] !<f> x:{x : X. f x : A} .. a -> Pf x [[A<<-a]]")  (* 2 *)

  apply (rule cspF_rw_right)
  apply (assumption)
  apply (simp add: Rep_int_choice_f_def)
  apply (rule cspF_decompo)
  apply (simp)
  apply (simp add: image_iff)
  apply (elim conjE exE bexE)
  apply (simp)

  apply (rule cspF_rw_right)
  apply (rule cspF_step)
  apply (rule cspF_decompo)
  apply (simp add: Renaming_event_def)
  apply (simp add: Renaming_event_fun_def)
  apply (simp add: fun_to_rel_def)
  apply (force)

  apply (rule cspF_ref_eq)

   (* <= *)
   apply (rule cspF_Rep_int_choice_left)
   apply (simp add: Renaming_event_def)
   apply (simp add: Renaming_event_fun_def)
   apply (simp add: fun_to_rel_def)
   (* => *)
   apply (rule cspF_Rep_int_choice_right)
   apply (simp)

 (* 2 *)
  apply (rule cspF_rw_right)
  apply (rule cspF_choice_delay)
  apply (simp)
  apply (subgoal_tac "~(ALL x. x : X --> f x ~: A)")
   apply (simp (no_asm_simp))
   apply (rule cspF_rw_right)
   apply (rule cspF_IF_split)
   apply (simp)
  apply (force)

 (* right *)
 apply (rule cspF_decompo)
 apply (simp)

 apply (rule cspF_rw_right)
 apply (rule cspF_step)
 apply (rule cspF_decompo)
  apply (simp add: Renaming_event_def)
  apply (simp add: Renaming_event_fun_def)
  apply (simp add: fun_to_rel_def)
  apply (force)

 apply (simp)
 apply (rule cspF_ref_eq)

  (* <= *)
  apply (rule cspF_Rep_int_choice_left)
  apply (simp add: Renaming_event_def)
  apply (simp add: Renaming_event_fun_def)
  apply (simp add: fun_to_rel_def)
  apply (force)

  (* => *)
  apply (rule cspF_Rep_int_choice_right)
  apply (simp)

(* 1 *)
apply (auto)
done

lemma cspF_Nondet_send_prefix_Renaming2_set_event_step_notin:
  "[| (ALL x:X. f x ~: A) | A Int f ` X = {} |] ==>
     (f !? x:X -> Pf x)[[A<<-a]] =F[M,M]
      f !? x:X -> (Pf x)[[A<<-a]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_decompo)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_step)

apply (rule cspF_rw_left)
apply (rule cspF_step)

apply (rule cspF_rw_right)
apply (rule cspF_step)

apply (rule cspF_decompo)
 apply (simp add: Renaming_event_def)
 apply (simp add: Renaming_event_fun_def)
 apply (simp add: fun_to_rel_def)
 apply (force)

apply (simp)
 apply (rule cspF_ref_eq)

  (* <= *)
  apply (rule cspF_Rep_int_choice_left)
  apply (simp add: Renaming_event_def)
  apply (simp add: Renaming_event_fun_def)
  apply (simp add: fun_to_rel_def)
  apply (force)

  (* => *)
  apply (rule cspF_Rep_int_choice_right)
  apply (simp)
done

lemma cspF_Nondet_send_prefix_Renaming2_set_event_step:
  "inj f ==>
  (f !? x:X -> Pf x)[[A<<-a]] =F[M,M]
   IF (EX x:X. f x : A)
   THEN (a -> (!<f> x:{x:X. f x : A} .. (Pf x)[[A<<-a]])
         |~| f !? x:(X-{x. f x : A}) -> (Pf x)[[A<<-a]])
   ELSE (f !? x:X -> (Pf x)[[A<<-a]])"
apply (case_tac "EX x:X. f x : A")
apply (rule cspF_rw_left)
apply (rule cspF_Nondet_send_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (rule cspF_rw_left)
apply (rule cspF_Nondet_send_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

(* <-- *)

lemma cspF_Nondet_send_prefix_Renaming2_event_step_in:
  "[| inj f ; v:X ; ALL x. a ~= f x |] ==>
     (f !? x:X -> Pf x)[[f v<--a]] =F[M,M]
     (a -> (Pf v)[[f v<--a]]) |~| f !? x:(X-{v}) -> (Pf x)[[f v<--a]]"
apply (rule cspF_rw_left)
apply (rule cspF_Nondet_send_prefix_Renaming2_set_event_step_in)
apply (simp)
apply (simp)
apply (force)
apply (simp)

apply (rule cspF_decompo)
 apply (rule cspF_decompo)
 apply (simp)
 apply (subgoal_tac "{x : X. f x = f v}={v}")
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Rep_int_choice_singleton)
 apply (simp)
 apply (simp)
 apply (simp add: inj_on_def)
 apply (force)

 apply (subgoal_tac "{x. f x = f v}={v}")
 apply (simp)
 apply (simp add: inj_on_def)
 apply (force)
done

lemma cspF_Nondet_send_prefix_Renaming2_event_step_notin:
  "[| (ALL x. a ~= f x) | a ~: range f |] ==>
   (f !? x:X -> Pf x)[[a<--b]] =F[M,M] f !? x:X -> (Pf x)[[a<--b]]"
apply (rule cspF_rw_left)
apply (rule cspF_Nondet_send_prefix_Renaming2_set_event_step_notin)
apply (simp)
apply (force)
apply (simp)
done

lemmas cspF_Nondet_send_prefix_Renaming2_event_step =
       cspF_Nondet_send_prefix_Renaming2_event_step_in
       cspF_Nondet_send_prefix_Renaming2_event_step_notin

lemmas cspF_Nondet_send_prefix_Renaming_event_step =
       cspF_Nondet_send_prefix_Renaming1_event_step
       cspF_Nondet_send_prefix_Renaming2_event_step

(* <==> *)

lemma cspF_Nondet_send_prefix_Renaming1_channel1_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
   (f !? x:X -> Pf x)[[f<==>g]] =F[M,M] g !? x:X -> (Pf x)[[f<==>g]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_ref_eq)

(* <= *)
 apply (rule cspF_Rep_int_choice_right)
 apply (simp add: image_iff)
 apply (erule bexE)
 apply (simp)

 apply (rule cspF_Rep_int_choice_left)
 apply (rule_tac x="f x" in exI)
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Act_prefix_Renaming_channel_step)
 apply (simp_all)

(* => *)
 apply (rule cspF_Rep_int_choice_right)
 apply (simp add: image_iff)
 apply (erule bexE)
 apply (simp)

 apply (rule cspF_Rep_int_choice_left)
 apply (rule_tac x="g x" in exI)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_Act_prefix_Renaming_channel_step)
 apply (simp_all)
done

lemma cspF_Nondet_send_prefix_Renaming1_channel2_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
   (f !? x:X -> Pf x)[[g<==>f]] =F[M,M] g !? x:X -> (Pf x)[[g<==>f]]"
apply (simp add: Renaming_commut)
apply (simp add: cspF_Nondet_send_prefix_Renaming1_channel1_step_in)
done

lemma cspF_Nondet_send_prefix_Renaming1_channel_step_notin:
  "[| (ALL x y. f x ~= h y) | (range f Int range h = {}) ;
      (ALL x y. g x ~= h y) | (range g Int range h = {}) |] ==>
   (h !? x:X -> Pf x)[[f<==>g]] =F[M,M] h !? x:X -> (Pf x)[[f<==>g]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_decompo)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_Act_prefix_Renaming_channel_step)
apply (blast)
apply (blast)
apply (simp)
done

lemmas cspF_Nondet_send_prefix_Renaming1_channel_step =
       cspF_Nondet_send_prefix_Renaming1_channel1_step_in
       cspF_Nondet_send_prefix_Renaming1_channel2_step_in
       cspF_Nondet_send_prefix_Renaming1_channel_step_notin

(* <== *)

lemma cspF_Nondet_send_prefix_Renaming2_channel_step_in:
  "[| inj f ; inj g ; ALL x y. f x ~= g y |] ==>
   (f !? x:X -> Pf x)[[f<==g]] =F[M,M] g !? x:X -> (Pf x)[[f<==g]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_ref_eq)

(* <= *)
 apply (rule cspF_Rep_int_choice_right)
 apply (simp add: image_iff)
 apply (erule bexE)
 apply (simp)

 apply (rule cspF_Rep_int_choice_left)
 apply (rule_tac x="f x" in exI)
 apply (simp)
 apply (rule cspF_rw_left)
 apply (rule cspF_Act_prefix_Renaming_channel_step)
 apply (simp_all)

(* => *)
 apply (rule cspF_Rep_int_choice_right)
 apply (simp add: image_iff)
 apply (erule bexE)
 apply (simp)

 apply (rule cspF_Rep_int_choice_left)
 apply (rule_tac x="g x" in exI)
 apply (simp)
 apply (rule cspF_rw_right)
 apply (rule cspF_Act_prefix_Renaming_channel_step)
 apply (simp_all)
done

lemma cspF_Nondet_send_prefix_Renaming2_channel_step_notin:
  "[| (ALL x y. f x ~= h y) | (range f Int range h = {}) |] ==>
   (h !? x:X -> Pf x)[[f<==g]] =F[M,M] h !? x:X -> (Pf x)[[f<==g]]"
apply (simp add: csp_prefix_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Dist)
apply (rule cspF_decompo)
apply (simp)

apply (rule cspF_rw_left)
apply (rule cspF_Act_prefix_Renaming_channel_step)
apply (blast)
apply (simp)
done

lemmas cspF_Nondet_send_prefix_Renaming2_channel_step =
       cspF_Nondet_send_prefix_Renaming2_channel_step_in
       cspF_Nondet_send_prefix_Renaming2_channel_step_notin

lemmas cspF_Nondet_send_prefix_Renaming_channel_step =
       cspF_Nondet_send_prefix_Renaming1_channel_step
       cspF_Nondet_send_prefix_Renaming2_channel_step

lemmas cspF_Nondet_send_prefix_Renaming_step =
       cspF_Nondet_send_prefix_Renaming_event_step
       cspF_Nondet_send_prefix_Renaming_channel_step

(* ---------------- *
      in or notin
 * ---------------- *)

lemmas cspF_prefix_Renaming_in_step =
       cspF_Act_prefix_Renaming1_event1_step_in
       cspF_Act_prefix_Renaming1_event2_step_in
       cspF_Act_prefix_Renaming1_channel1_step_in
       cspF_Act_prefix_Renaming1_channel2_step_in
       cspF_Send_prefix_Renaming1_event1_step_in
       cspF_Send_prefix_Renaming1_event2_step_in
       cspF_Send_prefix_Renaming1_channel1_step_in
       cspF_Send_prefix_Renaming1_channel2_step_in
       cspF_Rec_prefix_Renaming1_event1_step_in
       cspF_Rec_prefix_Renaming1_event2_step_in
       cspF_Rec_prefix_Renaming1_channel1_step_in
       cspF_Rec_prefix_Renaming1_channel2_step_in
       cspF_Nondet_send_prefix_Renaming1_event1_step_in
       cspF_Nondet_send_prefix_Renaming1_event2_step_in
       cspF_Nondet_send_prefix_Renaming1_channel1_step_in
       cspF_Nondet_send_prefix_Renaming1_channel2_step_in
       cspF_Act_prefix_Renaming2_event_step_in
       cspF_Act_prefix_Renaming2_channel_step_in
       cspF_Send_prefix_Renaming2_event_step_in
       cspF_Send_prefix_Renaming2_channel_step_in
       cspF_Rec_prefix_Renaming2_event_step_in
       cspF_Rec_prefix_Renaming2_channel_step_in
       cspF_Nondet_send_prefix_Renaming2_event_step_in
       cspF_Nondet_send_prefix_Renaming2_channel_step_in

(* notin + <<- + ?X*)

lemmas cspF_prefix_Renaming_notin_step =
       cspF_Act_prefix_Renaming1_event_step_notin
       cspF_Act_prefix_Renaming1_channel_step_notin
       cspF_Send_prefix_Renaming1_event_step_notin
       cspF_Send_prefix_Renaming1_channel_step_notin
       cspF_Rec_prefix_Renaming1_event_step_notin
       cspF_Rec_prefix_Renaming1_channel_step_notin
       cspF_Nondet_send_prefix_Renaming1_event_step_notin
       cspF_Nondet_send_prefix_Renaming1_channel_step_notin
       cspF_Act_prefix_Renaming2_event_step_notin
       cspF_Act_prefix_Renaming2_channel_step_notin
       cspF_Send_prefix_Renaming2_event_step_notin
       cspF_Send_prefix_Renaming2_channel_step_notin
       cspF_Rec_prefix_Renaming2_event_step_notin
       cspF_Rec_prefix_Renaming2_channel_step_notin
       cspF_Nondet_send_prefix_Renaming2_event_step_notin
       cspF_Nondet_send_prefix_Renaming2_channel_step_notin

       cspF_Act_prefix_Renaming2_set_event_step
       cspF_Send_prefix_Renaming2_set_event_step
       cspF_Rec_prefix_Renaming2_set_event_step
       cspF_Nondet_send_prefix_Renaming2_set_event_step

       cspF_Ext_pre_choice_Renaming_event_step

(*
lemmas cspF_prefix_Renaming_in_step =
       cspF_Act_prefix_Renaming_event1_step_in
       cspF_Act_prefix_Renaming_event2_step_in
       cspF_Act_prefix_Renaming_channel1_step_in
       cspF_Act_prefix_Renaming_channel2_step_in
       cspF_Send_prefix_Renaming_event1_step_in
       cspF_Send_prefix_Renaming_event2_step_in
       cspF_Send_prefix_Renaming_channel1_step_in
       cspF_Send_prefix_Renaming_channel2_step_in
       cspF_Rec_prefix_Renaming_event1_step_in
       cspF_Rec_prefix_Renaming_event2_step_in
       cspF_Rec_prefix_Renaming_channel1_step_in
       cspF_Rec_prefix_Renaming_channel2_step_in
       cspF_Nondet_send_prefix_Renaming_event1_step_in
       cspF_Nondet_send_prefix_Renaming_event2_step_in
       cspF_Nondet_send_prefix_Renaming_channel1_step_in
       cspF_Nondet_send_prefix_Renaming_channel2_step_in

lemmas cspF_prefix_Renaming_notin_step =
       cspF_Act_prefix_Renaming_event_step_notin
       cspF_Act_prefix_Renaming_channel_step_notin
       cspF_Send_prefix_Renaming_event_step_notin
       cspF_Send_prefix_Renaming_channel_step_notin
       cspF_Rec_prefix_Renaming_event_step_notin
       cspF_Rec_prefix_Renaming_channel_step_notin
       cspF_Nondet_send_prefix_Renaming_event_step_notin
       cspF_Nondet_send_prefix_Renaming_channel_step_notin
*)

(* ----------------------------------------------------------- *)

end


(*  Title:      HOL/Library/State_Monad.thy
    Author:     Lars Hupel, TU München
*)

section \<open>State monad\<close>

theory State_Monad
imports Monad_Syntax
begin

datatype ('s, 'a) state = State (run_state: "'s \<Rightarrow> ('a \<times> 's)")

lemma set_state_iff: "x \<in> set_state m \<longleftrightarrow> (\<exists>s s'. run_state m s = (x, s'))"
by (cases m) (simp add: prod_set_defs eq_fst_iff)

lemma pred_stateI[intro]:
  assumes "\<And>a s s'. run_state m s = (a, s') \<Longrightarrow> P a"
  shows "pred_state P m"
proof (subst state.pred_set, rule)
  fix x
  assume "x \<in> set_state m"
  then obtain s s' where "run_state m s = (x, s')"
    by (auto simp: set_state_iff)
  with assms show "P x" .
qed

lemma pred_stateD[dest]:
  assumes "pred_state P m" "run_state m s = (a, s')"
  shows "P a"
proof (rule state.exhaust[of m])
  fix f
  assume "m = State f"
  with assms have "pred_fun (\<lambda>_. True) (pred_prod P top) f"
    by (metis state.pred_inject)
  moreover have "f s = (a, s')"
    using assms unfolding \<open>m = _\<close> by auto
  ultimately show "P a"
    unfolding pred_prod_beta pred_fun_def
    by (metis fst_conv)
qed

lemma pred_state_run_state: "pred_state P m \<Longrightarrow> P (fst (run_state m s))"
by (meson pred_stateD prod.exhaust_sel)

definition state_io_rel :: "('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('s, 'a) state \<Rightarrow> bool" where
"state_io_rel P m = (\<forall>s. P s (snd (run_state m s)))"

lemma state_io_relI[intro]:
  assumes "\<And>a s s'. run_state m s = (a, s') \<Longrightarrow> P s s'"
  shows "state_io_rel P m"
using assms unfolding state_io_rel_def
by (metis prod.collapse)

lemma state_io_relD[dest]:
  assumes "state_io_rel P m" "run_state m s = (a, s')"
  shows "P s s'"
using assms unfolding state_io_rel_def
by (metis snd_conv)

lemma state_io_rel_mono[mono]: "P \<le> Q \<Longrightarrow> state_io_rel P \<le> state_io_rel Q"
by blast

lemma state_ext:
  assumes "\<And>s. run_state m s = run_state n s"
  shows "m = n"
using assms
by (cases m; cases n) auto

context begin

qualified definition return :: "'a \<Rightarrow> ('s, 'a) state" where
"return a = State (Pair a)"

lemma run_state_return[simp]: "run_state (return x) s = (x, s)"
unfolding return_def
by simp

qualified definition ap :: "('s, 'a \<Rightarrow> 'b) state \<Rightarrow> ('s, 'a) state \<Rightarrow> ('s, 'b) state" where
"ap f x = State (\<lambda>s. case run_state f s of (g, s') \<Rightarrow> case run_state x s' of (y, s'') \<Rightarrow> (g y, s''))"

lemma run_state_ap[simp]:
  "run_state (ap f x) s = (case run_state f s of (g, s') \<Rightarrow> case run_state x s' of (y, s'') \<Rightarrow> (g y, s''))"
unfolding ap_def by auto

qualified definition bind :: "('s, 'a) state \<Rightarrow> ('a \<Rightarrow> ('s, 'b) state) \<Rightarrow> ('s, 'b) state" where
"bind x f = State (\<lambda>s. case run_state x s of (a, s') \<Rightarrow> run_state (f a) s')"

lemma run_state_bind[simp]:
  "run_state (bind x f) s = (case run_state x s of (a, s') \<Rightarrow> run_state (f a) s')"
unfolding bind_def by auto

adhoc_overloading Monad_Syntax.bind bind

lemma bind_left_identity[simp]: "bind (return a) f = f a"
unfolding return_def bind_def by simp

lemma bind_right_identity[simp]: "bind m return = m"
unfolding return_def bind_def by simp

lemma bind_assoc[simp]: "bind (bind m f) g = bind m (\<lambda>x. bind (f x) g)"
unfolding bind_def by (auto split: prod.splits)

lemma bind_predI[intro]:
  assumes "pred_state (\<lambda>x. pred_state P (f x)) m"
  shows "pred_state P (bind m f)"
apply (rule pred_stateI)
unfolding bind_def
using assms by (auto split: prod.splits)

qualified definition get :: "('s, 's) state" where
"get = State (\<lambda>s. (s, s))"

lemma run_state_get[simp]: "run_state get s = (s, s)"
unfolding get_def by simp

qualified definition set :: "'s \<Rightarrow> ('s, unit) state" where
"set s' = State (\<lambda>_. ((), s'))"

lemma run_state_set[simp]: "run_state (set s') s = ((), s')"
unfolding set_def by simp

lemma get_set[simp]: "bind get set = return ()"
unfolding bind_def get_def set_def return_def
by simp

lemma set_set[simp]: "bind (set s) (\<lambda>_. set s') = set s'"
unfolding bind_def set_def
by simp

lemma get_bind_set[simp]: "bind get (\<lambda>s. bind (set s) (f s)) = bind get (\<lambda>s. f s ())"
unfolding bind_def get_def set_def
by simp

lemma get_const[simp]: "bind get (\<lambda>_. m) = m"
unfolding get_def bind_def
by simp

fun traverse_list :: "('a \<Rightarrow> ('b, 'c) state) \<Rightarrow> 'a list \<Rightarrow> ('b, 'c list) state" where
"traverse_list _ [] = return []" |
"traverse_list f (x # xs) = do {
  x \<leftarrow> f x;
  xs \<leftarrow> traverse_list f xs;
  return (x # xs)
}"

lemma traverse_list_app[simp]: "traverse_list f (xs @ ys) = do {
  xs \<leftarrow> traverse_list f xs;
  ys \<leftarrow> traverse_list f ys;
  return (xs @ ys)
}"
by (induction xs) auto

lemma traverse_comp[simp]: "traverse_list (g \<circ> f) xs = traverse_list g (map f xs)"
by (induction xs) auto

abbreviation mono_state :: "('s::preorder, 'a) state \<Rightarrow> bool" where
"mono_state \<equiv> state_io_rel (\<le>)"

abbreviation strict_mono_state :: "('s::preorder, 'a) state \<Rightarrow> bool" where
"strict_mono_state \<equiv> state_io_rel (<)"

corollary strict_mono_implies_mono: "strict_mono_state m \<Longrightarrow> mono_state m"
unfolding state_io_rel_def
by (simp add: less_imp_le)

lemma return_mono[simp, intro]: "mono_state (return x)"
unfolding return_def by auto

lemma get_mono[simp, intro]: "mono_state get"
unfolding get_def by auto

lemma put_mono:
  assumes "\<And>x. s' \<ge> x"
  shows "mono_state (set s')"
using assms unfolding set_def
by auto

lemma map_mono[intro]: "mono_state m \<Longrightarrow> mono_state (map_state f m)"
by (auto intro!: state_io_relI split: prod.splits simp: map_prod_def state.map_sel)

lemma map_strict_mono[intro]: "strict_mono_state m \<Longrightarrow> strict_mono_state (map_state f m)"
by (auto intro!: state_io_relI split: prod.splits simp: map_prod_def state.map_sel)

lemma bind_mono_strong:
  assumes "mono_state m"
  assumes "\<And>x s s'. run_state m s = (x, s') \<Longrightarrow> mono_state (f x)"
  shows "mono_state (bind m f)"
unfolding bind_def
apply (rule state_io_relI)
using assms by (auto split: prod.splits dest!: state_io_relD intro: order_trans)

lemma bind_strict_mono_strong1:
  assumes "mono_state m"
  assumes "\<And>x s s'. run_state m s = (x, s') \<Longrightarrow> strict_mono_state (f x)"
  shows "strict_mono_state (bind m f)"
unfolding bind_def
apply (rule state_io_relI)
using assms by (auto split: prod.splits dest!: state_io_relD intro: le_less_trans)

lemma bind_strict_mono_strong2:
  assumes "strict_mono_state m"
  assumes "\<And>x s s'. run_state m s = (x, s') \<Longrightarrow> mono_state (f x)"
  shows "strict_mono_state (bind m f)"
unfolding bind_def
apply (rule state_io_relI)
using assms by (auto split: prod.splits dest!: state_io_relD intro: less_le_trans)

corollary bind_strict_mono_strong:
  assumes "strict_mono_state m"
  assumes "\<And>x s s'. run_state m s = (x, s') \<Longrightarrow> strict_mono_state (f x)"
  shows "strict_mono_state (bind m f)"
using assms by (auto intro: bind_strict_mono_strong1 strict_mono_implies_mono)

qualified definition update :: "('s \<Rightarrow> 's) \<Rightarrow> ('s, unit) state" where
"update f = bind get (set \<circ> f)"

lemma update_id[simp]: "update (\<lambda>x. x) = return ()"
unfolding update_def return_def get_def set_def bind_def
by auto

lemma update_comp[simp]: "bind (update f) (\<lambda>_. update g) = update (g \<circ> f)"
unfolding update_def return_def get_def set_def bind_def
by auto

lemma set_update[simp]: "bind (set s) (\<lambda>_. update f) = set (f s)"
unfolding set_def update_def bind_def get_def set_def
by simp

lemma set_bind_update[simp]: "bind (set s) (\<lambda>_. bind (update f) g) = bind (set (f s)) g"
unfolding set_def update_def bind_def get_def set_def
by simp

lemma update_mono:
  assumes "\<And>x. x \<le> f x"
  shows "mono_state (update f)"
using assms unfolding update_def get_def set_def bind_def
by (auto intro!: state_io_relI)

lemma update_strict_mono:
  assumes "\<And>x. x < f x"
  shows "strict_mono_state (update f)"
using assms unfolding update_def get_def set_def bind_def
by (auto intro!: state_io_relI)

end

end


(*
 * Copyright 2014, NICTA
 *
 * 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.
 *
 * @TAG(NICTA_BSD)
 *)

section "Enumeration extensions and alternative definition"

theory Enumeration
imports Main
begin

abbreviation
  "enum \<equiv> enum_class.enum"
abbreviation
  "enum_all \<equiv> enum_class.enum_all"
abbreviation
  "enum_ex \<equiv> enum_class.enum_ex"

primrec (nonexhaustive)
  the_index :: "'a list \<Rightarrow> 'a \<Rightarrow> nat"
where
  "the_index (x # xs) y = (if x = y then 0 else Suc (the_index xs y))"

lemma the_index_bounded:
  "x \<in> set xs \<Longrightarrow> the_index xs x < length xs"
  by (induct xs, clarsimp+)

lemma nth_the_index:
  "x \<in> set xs \<Longrightarrow> xs ! the_index xs x = x"
  by (induct xs, clarsimp+)

lemma distinct_the_index_is_index[simp]:
  "\<lbrakk> distinct xs ; n < length xs \<rbrakk> \<Longrightarrow> the_index xs (xs ! n) = n"
  by (meson nth_eq_iff_index_eq nth_mem nth_the_index the_index_bounded)

lemma the_index_last_distinct:
  "distinct xs \<and> xs \<noteq> [] \<Longrightarrow> the_index xs (last xs) = length xs - 1"
  apply safe
  apply (subgoal_tac "xs ! (length xs - 1) = last xs")
   apply (subgoal_tac "xs ! the_index xs (last xs) = last xs")
    apply (subst nth_eq_iff_index_eq[symmetric])
       apply assumption
      apply (rule the_index_bounded)
      apply simp_all
   apply (rule nth_the_index)
   apply simp
  apply (induct xs, auto)
  done

context enum begin

(* These two are added for historical reasons. *)
lemmas enum_surj[simp] = enum_UNIV
declare enum_distinct[simp]

lemma enum_nonempty[simp]: "(enum :: 'a list) \<noteq> []"
  using enum_surj by fastforce

definition
  maxBound :: 'a where
  "maxBound \<equiv> last enum"

definition
  minBound :: 'a where
  "minBound \<equiv> hd enum"

definition
  toEnum :: "nat \<Rightarrow> 'a" where
  "toEnum n \<equiv> if n < length (enum :: 'a list) then enum ! n else the None"

definition
  fromEnum :: "'a \<Rightarrow> nat" where
  "fromEnum x \<equiv> the_index enum x"

lemma maxBound_is_length:
  "fromEnum maxBound = length (enum :: 'a list) - 1"
  by (simp add: maxBound_def fromEnum_def the_index_last_distinct)

lemma maxBound_less_length:
  "(x \<le> fromEnum maxBound) = (x < length (enum :: 'a list))"
  unfolding maxBound_is_length by (cases "length enum") auto

lemma maxBound_is_bound [simp]:
  "fromEnum x \<le> fromEnum maxBound"
  unfolding maxBound_less_length
  by (fastforce simp: fromEnum_def intro: the_index_bounded)

lemma to_from_enum [simp]:
  fixes x :: 'a
  shows "toEnum (fromEnum x) = x"
proof -
  have "x \<in> set enum" by simp
  then show ?thesis by (simp add: toEnum_def fromEnum_def nth_the_index the_index_bounded)
qed

lemma from_to_enum [simp]:
  "x \<le> fromEnum maxBound \<Longrightarrow> fromEnum (toEnum x) = x"
  unfolding maxBound_less_length by (simp add: toEnum_def fromEnum_def)

lemma map_enum:
  fixes x :: 'a
  shows "map f enum ! fromEnum x = f x"
proof -
  have "fromEnum x \<le> fromEnum (maxBound :: 'a)"
    by (rule maxBound_is_bound)
  then have "fromEnum x < length (enum::'a list)"
    by (simp add: maxBound_less_length)
  then have "map f enum ! fromEnum x = f (enum ! fromEnum x)" by simp
  also
  have "x \<in> set enum" by simp
  then have "enum ! fromEnum x = x"
    by (simp add: fromEnum_def nth_the_index)
  finally
  show ?thesis .
qed

definition
  assocs :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<times> 'b) list" where
 "assocs f \<equiv> map (\<lambda>x. (x, f x)) enum"

end

(* For historical naming reasons. *)
lemmas enum_bool = enum_bool_def

lemma fromEnumTrue [simp]: "fromEnum True = 1"
  by (simp add: fromEnum_def enum_bool)

lemma fromEnumFalse [simp]: "fromEnum False = 0"
  by (simp add: fromEnum_def enum_bool)

class enum_alt =
  fixes enum_alt :: "nat \<Rightarrow> 'a option"

class enumeration_alt = enum_alt +
  assumes enum_alt_one_bound:
    "enum_alt x = (None :: 'a option) \<Longrightarrow> enum_alt (Suc x) = (None :: 'a option)"
  assumes enum_alt_surj:
    "range enum_alt \<union> {None} = UNIV"
  assumes enum_alt_inj:
    "(enum_alt x :: 'a option) = enum_alt y \<Longrightarrow> (x = y) \<or> (enum_alt x = (None :: 'a option))"
begin

lemma enum_alt_inj_2:
  assumes "enum_alt x = (enum_alt y :: 'a option)"
          "enum_alt x \<noteq> (None :: 'a option)"
  shows "x = y"
proof -
  from assms
  have "(x = y) \<or> (enum_alt x = (None :: 'a option))" by (fastforce intro!: enum_alt_inj)
  with assms show ?thesis by clarsimp
qed

lemma enum_alt_surj_2:
  "\<exists>x. enum_alt x = Some y"
proof -
  have "Some y \<in> range enum_alt \<union> {None}" by (subst enum_alt_surj) simp
  then have "Some y \<in> range enum_alt" by simp
  then show ?thesis by auto
qed

end

definition
  alt_from_ord :: "'a list \<Rightarrow> nat \<Rightarrow> 'a option"
where
  "alt_from_ord L \<equiv> \<lambda>n. if (n < length L) then Some (L ! n) else None"

lemma handy_if_lemma: "((if P then Some A else None) = Some B) = (P \<and> (A = B))"
  by simp

class enumeration_both = enum_alt + enum +
  assumes enum_alt_rel: "enum_alt = alt_from_ord enum"

instance enumeration_both < enumeration_alt
  apply (intro_classes; simp add: enum_alt_rel alt_from_ord_def)
    apply auto[1]
   apply (safe; simp)[1]
   apply (rule rev_image_eqI; simp)
    apply (rule the_index_bounded; simp)
   apply (subst nth_the_index; simp)
  apply (clarsimp simp: handy_if_lemma)
  apply (subst nth_eq_iff_index_eq[symmetric]; simp)
  done

instantiation bool :: enumeration_both
begin
  definition enum_alt_bool: "enum_alt \<equiv> alt_from_ord [False, True]"
  instance by (intro_classes, simp add: enum_bool_def enum_alt_bool)
end

definition
  toEnumAlt :: "nat \<Rightarrow> ('a :: enum_alt)" where
 "toEnumAlt n \<equiv> the (enum_alt n)"

definition
  fromEnumAlt :: "('a :: enum_alt) \<Rightarrow> nat" where
 "fromEnumAlt x \<equiv> THE n. enum_alt n = Some x"

definition
  upto_enum :: "('a :: enumeration_alt) \<Rightarrow> 'a \<Rightarrow> 'a list" ("(1[_.e._])") where
 "upto_enum n m \<equiv> map toEnumAlt [fromEnumAlt n ..< Suc (fromEnumAlt m)]"

lemma fromEnum_alt_red[simp]:
  "fromEnumAlt = (fromEnum :: ('a :: enumeration_both) \<Rightarrow> nat)"
  apply (rule ext)
  apply (simp add: fromEnumAlt_def fromEnum_def enum_alt_rel alt_from_ord_def)
  apply (rule theI2)
    apply (rule conjI)
     apply (clarify, rule nth_the_index, simp)
    apply (rule the_index_bounded, simp)
   apply auto
  done

lemma toEnum_alt_red[simp]:
  "toEnumAlt = (toEnum :: nat \<Rightarrow> 'a :: enumeration_both)"
  by (rule ext) (simp add: enum_alt_rel alt_from_ord_def toEnum_def toEnumAlt_def)

lemma upto_enum_red:
  "[(n :: ('a :: enumeration_both)) .e. m] = map toEnum [fromEnum n ..< Suc (fromEnum m)]"
  unfolding upto_enum_def by simp

instantiation nat :: enumeration_alt
begin
  definition enum_alt_nat: "enum_alt \<equiv> Some"
  instance by (intro_classes; simp add: enum_alt_nat UNIV_option_conv)
end

lemma toEnumAlt_nat[simp]: "toEnumAlt = id"
  by (rule ext) (simp add: toEnumAlt_def enum_alt_nat)

lemma fromEnumAlt_nat[simp]: "fromEnumAlt = id"
  by (rule ext) (simp add: fromEnumAlt_def enum_alt_nat)

lemma upto_enum_nat[simp]: "[n .e. m] = [n ..< Suc m]"
  by (subst upto_enum_def) simp

definition
  zipE1 :: "'a :: enum_alt \<Rightarrow> 'b list \<Rightarrow> ('a \<times> 'b) list"
where
  "zipE1 x L \<equiv> zip (map toEnumAlt [fromEnumAlt x ..< fromEnumAlt x + length L]) L"

definition
  zipE2 :: "'a :: enum_alt \<Rightarrow> 'a \<Rightarrow> 'b list \<Rightarrow> ('a \<times> 'b) list"
where
  "zipE2 x xn L \<equiv> zip (map (\<lambda>n. toEnumAlt (fromEnumAlt x + (fromEnumAlt xn - fromEnumAlt x) * n))
                      [0 ..< length L]) L"

definition
  zipE3 :: "'a list \<Rightarrow> 'b :: enum_alt \<Rightarrow> ('a \<times> 'b) list"
where
  "zipE3 L x \<equiv> zip L (map toEnumAlt [fromEnumAlt x ..< fromEnumAlt x + length L])"

definition
  zipE4 :: "'a list \<Rightarrow> 'b :: enum_alt \<Rightarrow> 'b \<Rightarrow> ('a \<times> 'b) list"
where
  "zipE4 L x xn \<equiv> zip L (map (\<lambda>n. toEnumAlt (fromEnumAlt x + (fromEnumAlt xn - fromEnumAlt x) * n))
                         [0 ..< length L])"

lemma to_from_enum_alt[simp]:
  "toEnumAlt (fromEnumAlt x) = (x :: 'a :: enumeration_alt)"
proof -
  have rl: "\<And>a b. a = Some b \<Longrightarrow> the a = b" by simp
  show ?thesis
    unfolding fromEnumAlt_def toEnumAlt_def
    by (rule rl, rule theI') (metis enum_alt_inj enum_alt_surj_2 not_None_eq)
qed

lemma upto_enum_triv [simp]: "[x .e. x] = [x]"
  unfolding upto_enum_def by simp

lemma toEnum_eq_to_fromEnum_eq:
  fixes v :: "'a :: enum"
  shows "n \<le> fromEnum (maxBound :: 'a) \<Longrightarrow> (toEnum n = v) = (n = fromEnum v)"
  by auto

end


(*  Title:      ZF/Induct/Datatypes.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1994  University of Cambridge
*)

section {* Sample datatype definitions *}

theory Datatypes imports Main begin

subsection {* A type with four constructors *}

text {*
  It has four contructors, of arities 0--3, and two parameters @{text
  A} and @{text B}.
*}

consts
  data :: "[i, i] => i"

datatype "data(A, B)" =
    Con0
  | Con1 ("a \<in> A")
  | Con2 ("a \<in> A", "b \<in> B")
  | Con3 ("a \<in> A", "b \<in> B", "d \<in> data(A, B)")

lemma data_unfold: "data(A, B) = ({0} + A) + (A \<times> B + A \<times> B \<times> data(A, B))"
  by (fast intro!: data.intros [unfolded data.con_defs]
    elim: data.cases [unfolded data.con_defs])

text {*
  \medskip Lemmas to justify using @{term data} in other recursive
  type definitions.
*}

lemma data_mono: "[| A \<subseteq> C; B \<subseteq> D |] ==> data(A, B) \<subseteq> data(C, D)"
  apply (unfold data.defs)
  apply (rule lfp_mono)
   apply (rule data.bnd_mono)+
  apply (rule univ_mono Un_mono basic_monos | assumption)+
  done

lemma data_univ: "data(univ(A), univ(A)) \<subseteq> univ(A)"
  apply (unfold data.defs data.con_defs)
  apply (rule lfp_lowerbound)
   apply (rule_tac [2] subset_trans [OF A_subset_univ Un_upper1, THEN univ_mono])
  apply (fast intro!: zero_in_univ Inl_in_univ Inr_in_univ Pair_in_univ)
  done

lemma data_subset_univ:
    "[| A \<subseteq> univ(C); B \<subseteq> univ(C) |] ==> data(A, B) \<subseteq> univ(C)"
  by (rule subset_trans [OF data_mono data_univ])

subsection {* Example of a big enumeration type *}

text {*
  Can go up to at least 100 constructors, but it takes nearly 7
  minutes \dots\ (back in 1994 that is).
*}

consts
  enum :: i

datatype enum =
    C00 | C01 | C02 | C03 | C04 | C05 | C06 | C07 | C08 | C09
  | C10 | C11 | C12 | C13 | C14 | C15 | C16 | C17 | C18 | C19
  | C20 | C21 | C22 | C23 | C24 | C25 | C26 | C27 | C28 | C29
  | C30 | C31 | C32 | C33 | C34 | C35 | C36 | C37 | C38 | C39
  | C40 | C41 | C42 | C43 | C44 | C45 | C46 | C47 | C48 | C49
  | C50 | C51 | C52 | C53 | C54 | C55 | C56 | C57 | C58 | C59

end