           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               December 2004               |
            |                   June 2005  (modified)   |
            |              September 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |                October 2005  (modified)   |
            |                January 2006  (modified)   |
            |                  April 2006  (modified)   |
            |                  March 2007  (modified)   |
            |                 August 2007  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2009         |
            |                   June 2009  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_law_basic
imports CSP_F_law_decompo CSP_T_law_basic
begin

(*****************************************************************

         1. Commutativity
         2. Associativity
         3. Idempotence
         4. Left Commutativity
         5. IF

 *****************************************************************)

(*********************************************************
                       IF bool
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_IF_split:
  "IF b THEN P ELSE Q =F[M,M] (if b then P else Q)"
apply (simp add: cspF_semantics)
apply (simp add: traces_iff)
apply (simp add: failures_iff)
done

lemma cspF_IF_True:
  "IF True THEN P ELSE Q =F[M,M] P"
apply (rule cspF_rw_left)
apply (rule cspF_IF_split)
by (simp)

lemma cspF_IF_False:
  "IF False THEN P ELSE Q =F[M,M] Q"
apply (rule cspF_rw_left)
apply (rule cspF_IF_split)
by (simp)

lemmas cspF_IF = cspF_IF_True cspF_IF_False

(*-----------------------------------*
 |           Idempotence             |
 *-----------------------------------*)

lemma cspF_Ext_choice_idem:
  "P [+] P =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_idem)
apply (rule order_antisym)
 apply (rule, simp add: in_traces in_failures)
 apply (elim conjE disjE)
 apply (simp_all)
 apply (rule proc_F2_F4)
 apply (simp_all)
 apply (rule, simp add: in_traces in_failures)
done

lemma cspF_Int_choice_idem:
  "P |~| P =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_idem)
apply (rule order_antisym)
 apply (rule, simp add: in_failures)+
done

(*------------------*
 |      csp law     |
 *------------------*)

lemmas cspF_idem = cspF_Ext_choice_idem cspF_Int_choice_idem

(*-----------------------------------*
 |          Commutativity            |
 *-----------------------------------*)

(*********************************************************
                      Ext choice
 *********************************************************)

lemma cspF_Ext_choice_commut:
  "P [+] Q =F[M,M] Q [+] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_commut)

apply (rule order_antisym)
apply (rule, simp add: in_failures, fast)+
done

(*********************************************************
                      Int choice
 *********************************************************)

lemma cspF_Int_choice_commut:
  "P |~| Q =F[M,M] Q |~| P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_commut)
apply (rule order_antisym)
apply (rule, simp add: in_failures, fast)+
done

(*********************************************************
                      Parallel
 *********************************************************)

lemma cspF_Parallel_commut:
  "P |[X]| Q =F[M,M] Q |[X]| P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Parallel_commut)
apply (rule order_antisym)

apply (rule, simp add: in_failures)
apply (elim conjE exE)
apply (rule_tac x="Z" in exI)
apply (rule_tac x="Y" in exI, simp)
apply (rule conjI, fast)
apply (rule_tac x="t" in exI)
apply (rule_tac x="sa" in exI)
apply (simp add: par_tr_sym)

apply (rule, simp add: in_failures)
apply (elim conjE exE)
apply (rule_tac x="Z" in exI)
apply (rule_tac x="Y" in exI, simp)
apply (rule conjI, fast)
apply (rule_tac x="t" in exI)
apply (rule_tac x="sa" in exI)
apply (simp add: par_tr_sym)
done

(*------------------*
 |      csp law     |
 *------------------*)

lemmas cspF_commut = cspF_Ext_choice_commut cspF_Int_choice_commut cspF_Parallel_commut

(*-----------------------------------*
 |          Associativity            |
 *-----------------------------------*)

lemma cspF_Ext_choice_assoc:
  "P [+] (Q [+] R) =F[M,M] (P [+] Q) [+] R"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_assoc)
apply (rule order_antisym)
apply (rule, simp add: in_failures in_traces)
apply (force)
apply (rule, simp add: in_failures in_traces)
apply (force)
done

lemma cspF_Ext_choice_assoc_sym:
  "(P [+] Q) [+] R =F[M,M] P [+] (Q [+] R)"
apply (rule cspF_sym)
apply (simp add: cspF_Ext_choice_assoc)
done

lemma cspF_Int_choice_assoc:
  "P |~| (Q |~| R) =F[M,M] (P |~| Q) |~| R"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_assoc)
apply (rule order_antisym)
apply (rule, simp add: in_failures)+
done

lemma cspF_Int_choice_assoc_sym:
  "(P |~| Q) |~| R =F[M,M] P |~| (Q |~| R)"
apply (rule cspF_sym)
apply (simp add: cspF_Int_choice_assoc)
done

(*------------------*
 |      csp law     |
 *------------------*)

lemmas cspF_assoc = cspF_Ext_choice_assoc cspF_Int_choice_assoc
lemmas cspF_assoc_sym = cspF_Ext_choice_assoc_sym cspF_Int_choice_assoc_sym

(*-----------------------------------*
 |        Left Commutativity         |
 *-----------------------------------*)

lemma cspF_Ext_choice_left_commut:
  "P [+] (Q [+] R) =F[M,M] Q [+] (P [+] R)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_left_commut)
apply (rule order_antisym)
apply (rule, simp add: in_failures in_traces)
apply (force)
apply (rule, simp add: in_failures in_traces)
apply (force)
done

lemma cspF_Int_choice_left_commut:
  "P |~| (Q |~| R) =F[M,M] Q |~| (P |~| R)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_left_commut)
apply (rule order_antisym)
 apply (rule, simp add: in_failures)+
done

lemmas cspF_left_commut =
       cspF_Ext_choice_left_commut cspF_Int_choice_left_commut

(*-----------------------------------*
 |              Unit                 |
 *-----------------------------------*)

(*** STOP [+] P ***)

lemma cspF_Ext_choice_unit_l:
  "STOP [+] P =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_unit_l)
apply (rule order_antisym)
 apply (rule, simp add: in_traces in_failures)
 apply (elim conjE disjE)
 apply (simp_all)
 apply (rule proc_F2_F4)
 apply (simp_all)

 apply (rule, simp add: in_failures)
done

lemma cspF_Ext_choice_unit_r:
  "P [+] STOP =F[M,M] P"
apply (rule cspF_rw_left)
apply (rule cspF_Ext_choice_commut)
apply (simp add: cspF_Ext_choice_unit_l)
done

lemmas cspF_Ext_choice_unit =
       cspF_Ext_choice_unit_l cspF_Ext_choice_unit_r

lemma cspF_Int_choice_unit_l:
  "DIV |~| P =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_unit_l)
apply (rule order_antisym)
 apply (rule, simp add: in_failures)
 apply (rule, simp add: in_failures)
done

lemma cspF_Int_choice_unit_r:
  "P |~| DIV =F[M,M] P"
apply (rule cspF_rw_left)
apply (rule cspF_Int_choice_commut)
apply (simp add: cspF_Int_choice_unit_l)
done

lemmas cspF_Int_choice_unit =
       cspF_Int_choice_unit_l cspF_Int_choice_unit_r

lemmas cspF_unit = cspF_Ext_choice_unit cspF_Int_choice_unit

(*-----------------------------------*
 |           !!-empty                |
 *-----------------------------------*)

lemma cspF_Rep_int_choice_sum_DIV:
   "sumset C = {} ==> !! : C .. Pf =F[M1,M2] DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_DIV)
apply (simp add: failures_iff)
apply (simp add: empF_def)
done

lemma cspF_Rep_int_choice_nat_DIV:
   "!nat :{} .. Pf =F[M1,M2] DIV"
by (simp add: Rep_int_choice_ss_def cspF_Rep_int_choice_sum_DIV)

lemma cspF_Rep_int_choice_set_DIV:
   "!set :{} .. Pf =F[M1,M2] DIV"
by (simp add: Rep_int_choice_ss_def cspF_Rep_int_choice_sum_DIV)

lemma cspF_Rep_int_choice_com_DIV:
   "! :{} .. Pf =F[M1,M2] DIV"
by (simp add: Rep_int_choice_com_def cspF_Rep_int_choice_set_DIV)

lemma cspF_Rep_int_choice_f_DIV:
   "inj f ==> !<f> :{} .. Pf =F[M1,M2] DIV"
by (simp add: Rep_int_choice_f_def cspF_Rep_int_choice_com_DIV)

lemmas cspF_Rep_int_choice_DIV = cspF_Rep_int_choice_sum_DIV
                                 cspF_Rep_int_choice_nat_DIV
                                 cspF_Rep_int_choice_set_DIV
                                 cspF_Rep_int_choice_com_DIV
                                 cspF_Rep_int_choice_f_DIV

lemmas cspF_Rep_int_choice_DIV_sym = cspF_Rep_int_choice_DIV[THEN cspF_sym]
lemmas cspF_Rep_int_choice_empty = cspF_Rep_int_choice_DIV

lemma cspF_DIV_top: "P <=F DIV"
apply (simp add: cspF_semantics)
apply (simp add: traces_iff failures_iff)
done

(*-----------------------------------*
 |             !!-unit               |
 *-----------------------------------*)

lemma cspF_Rep_int_choice_sum_unit:
  "sumset C ~= {} ==> !! c:C .. P =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_unit)
apply (rule order_antisym)
 apply (rule, simp add: in_failures)
 apply (rule, simp add: in_failures)
 apply (force)
done

lemma cspF_Rep_int_choice_nat_unit:
  "N ~= {} ==> !nat n:N .. P =F[M,M] P"
by (simp add: Rep_int_choice_ss_def cspF_Rep_int_choice_sum_unit)

lemma cspF_Rep_int_choice_set_unit:
  "Xs ~= {} ==> !set X:Xs .. P =F[M,M] P"
by (simp add: Rep_int_choice_ss_def cspF_Rep_int_choice_sum_unit)

lemma cspF_Rep_int_choice_com_unit:
  "X ~= {} ==> ! a:X .. P =F[M,M] P"
by (simp add: Rep_int_choice_com_def cspF_Rep_int_choice_set_unit)

lemma cspF_Rep_int_choice_f_unit:
  "X ~= {} ==> !<f> a:X .. P =F[M,M] P"
by (simp add: Rep_int_choice_f_def cspF_Rep_int_choice_com_unit)

lemmas cspF_Rep_int_choice_unit =
       cspF_Rep_int_choice_sum_unit
       cspF_Rep_int_choice_nat_unit
       cspF_Rep_int_choice_set_unit
       cspF_Rep_int_choice_com_unit
       cspF_Rep_int_choice_f_unit

(*-----------------------------------*
 |             !!-const              |
 *-----------------------------------*)

(* const *)

lemma cspF_Rep_int_choice_sum_const:
  "[| sumset C ~= {} ; ALL c: sumset C. Pf c = P |] ==> !! :C .. Pf =F[M,M] P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_const)
apply (rule order_antisym)
 apply (rule, simp add: in_failures)
 apply (rule, simp add: in_failures)
 apply (force)
done

lemma cspF_Rep_int_choice_nat_const:
  "[| N ~= {} ; ALL n:N. Pf n = P |] ==> !nat :N .. Pf =F[M,M] P"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_sum_const, auto)

lemma cspF_Rep_int_choice_set_const:
  "[| Xs ~= {} ; ALL X:Xs. Pf X = P |] ==> !set :Xs .. Pf =F[M,M] P"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_sum_const, auto)

lemma cspF_Rep_int_choice_com_const:
  "[| X ~= {} ; ALL a:X. Pf a = P |] ==> ! :X .. Pf =F[M,M] P"
apply (simp add: Rep_int_choice_com_def)
by (rule cspF_Rep_int_choice_set_const, auto)

lemma cspF_Rep_int_choice_f_const:
  "[| inj f ; X ~= {} ; ALL a:X. Pf a = P |] ==> !<f> :X .. Pf =F[M,M] P"
apply (simp add: Rep_int_choice_f_def)
by (rule cspF_Rep_int_choice_com_const, auto)

lemmas cspF_Rep_int_choice_const =
       cspF_Rep_int_choice_sum_const
       cspF_Rep_int_choice_nat_const
       cspF_Rep_int_choice_set_const
       cspF_Rep_int_choice_com_const
       cspF_Rep_int_choice_f_const

(*-----------------------------------*
 |           |~|-!!-union            |
 *-----------------------------------*)

lemma cspF_Int_Rep_int_choice_sum_union:
  "C1 =type= C2 ==>
   (!! :C1 .. P1f) |~| (!! :C2 .. P2f)
   =F[M,M] (!! c:(C1 Uns C2) ..
          IF (c : sumset C1 & c : sumset C2) THEN (P1f c |~| P2f c)
          ELSE IF (c : sumset C1) THEN P1f c ELSE P2f c)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_Rep_int_choice_union)
apply (rule order_antisym)

 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE bexE disjE)
  apply (rule_tac x="c" in bexI)
  apply (simp)
  apply (simp)
  apply (rule_tac x="c" in bexI)
  apply (simp)
  apply (simp)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE exE bexE)
 apply (simp_all)
 apply (elim disjE)
 apply (simp_all)
 apply (case_tac "c : sumset C2")
 apply (simp add: in_failures)
 apply (force)
 apply (simp add: in_failures)
 apply (force)
 apply (case_tac "c : sumset C1")
 apply (simp add: in_failures)
 apply (force)
 apply (simp add: in_failures)
 apply (force)
done

lemma cspF_Int_Rep_int_choice_nat_union:
  "(!nat :N1 .. P1f) |~| (!nat :N2 .. P2f)
   =F[M,M] (!nat n:(N1 Un N2) ..
          IF (n : N1 & n : N2) THEN (P1f n |~| P2f n)
          ELSE IF (n : N1) THEN P1f n ELSE P2f n)"
apply (simp add: Rep_int_choice_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Int_Rep_int_choice_sum_union)
apply (simp_all)
apply (rule cspF_decompo)
by (auto)

lemma cspF_Int_Rep_int_choice_set_union:
  "(!set :Xs1 .. P1f) |~| (!set :Xs2 .. P2f)
   =F[M,M] (!set X:(Xs1 Un Xs2) ..
          IF (X : Xs1 & X : Xs2) THEN (P1f X |~| P2f X)
          ELSE IF (X : Xs1) THEN P1f X ELSE P2f X)"
apply (simp add: Rep_int_choice_ss_def)
apply (rule cspF_rw_left)
apply (rule cspF_Int_Rep_int_choice_sum_union)
apply (simp_all)
apply (rule cspF_decompo)
by (auto)

lemma cspF_Int_Rep_int_choice_com_union:
  "(! :X1 .. P1f) |~| (! :X2 .. P2f)
   =F[M,M] (! a:(X1 Un X2) ..
          IF (a : X1 & a : X2) THEN (P1f a |~| P2f a)
          ELSE IF (a : X1) THEN P1f a ELSE P2f a)"
apply (simp add: Rep_int_choice_com_def)
apply (rule cspF_rw_left)
apply (rule cspF_Int_Rep_int_choice_set_union)
apply (simp_all)
apply (rule cspF_decompo)
by (auto)

lemma cspF_Int_Rep_int_choice_f_union:
  "inj f ==>
  (!<f> :X1 .. P1f) |~| (!<f> :X2 .. P2f)
   =F[M,M] (!<f> a:(X1 Un X2) ..
          IF (a : X1 & a : X2) THEN (P1f a |~| P2f a)
          ELSE IF (a : X1) THEN P1f a ELSE P2f a)"
apply (simp add: Rep_int_choice_f_def)
apply (rule cspF_rw_left)
apply (rule cspF_Int_Rep_int_choice_com_union)
apply (rule cspF_decompo)
apply (auto simp add: inj_image_mem_iff)
done

lemmas cspF_Int_Rep_int_choice_union =
       cspF_Int_Rep_int_choice_sum_union
       cspF_Int_Rep_int_choice_nat_union
       cspF_Int_Rep_int_choice_set_union
       cspF_Int_Rep_int_choice_com_union
       cspF_Int_Rep_int_choice_f_union

(*-----------------------------------*
 |           !!-union-|~|            |
 *-----------------------------------*)

lemma cspF_Rep_int_choice_sum_union_Int:
  "C1 =type= C2 ==>
  (!! :(C1 Uns C2) .. Pf)
   =F[M,M] (!! c:C1 .. Pf c) |~| (!! c:C2 .. Pf c)"
apply (rule cspF_rw_right)
apply (rule cspF_Int_Rep_int_choice_union)
apply (simp)
apply (rule cspF_decompo)
apply (simp)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
apply (simp add: cspF_idem[THEN cspF_sym])
apply (intro impI)
apply (rule cspF_rw_right)
apply (rule cspF_IF_split)
apply (simp)
done

lemma cspF_Rep_int_choice_nat_union_Int:
  "(!nat :(N1 Un N2) .. Pf)
   =F[M,M] (!nat n:N1 .. Pf n) |~| (!nat n:N2 .. Pf n)"
apply (simp add: Rep_int_choice_ss_def)
apply (rule cspF_rw_right)
apply (rule cspF_Rep_int_choice_sum_union_Int[THEN cspF_sym])
apply (simp_all)
done

lemma cspF_Rep_int_choice_set_union_Int:
  "(!set :(Xs1 Un Xs2) .. Pf)
   =F[M,M] (!set X:Xs1 .. Pf X) |~| (!set X:Xs2 .. Pf X)"
apply (simp add: Rep_int_choice_ss_def)
apply (rule cspF_rw_right)
apply (rule cspF_Rep_int_choice_sum_union_Int[THEN cspF_sym])
apply (simp_all)
done

lemma cspF_Rep_int_choice_com_union_Int:
  "(! :(X1 Un X2) .. Pf)
   =F[M,M] (! a:X1 .. Pf a) |~| (! a:X2 .. Pf a)"
apply (simp add: Rep_int_choice_com_def)
apply (rule cspF_rw_right)
apply (rule cspF_Rep_int_choice_set_union_Int[THEN cspF_sym])
apply (rule cspF_decompo)
apply (auto)
done

lemma cspF_Rep_int_choice_f_union_Int:
  "(!<f> :(X1 Un X2) .. Pf)
   =F[M,M] (!<f> x:X1 .. Pf x) |~| (!<f> x:X2 .. Pf x)"
apply (simp add: Rep_int_choice_f_def)
apply (rule cspF_rw_right)
apply (rule cspF_Rep_int_choice_com_union_Int[THEN cspF_sym])
apply (rule cspF_decompo)
apply (auto)
done

lemmas cspF_Rep_int_choice_union_Int =
       cspF_Rep_int_choice_sum_union_Int
       cspF_Rep_int_choice_nat_union_Int
       cspF_Rep_int_choice_set_union_Int
       cspF_Rep_int_choice_com_union_Int
       cspF_Rep_int_choice_f_union_Int

(*********************************************************
                     Depth_rest
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Depth_rest_Zero:
  "P |. 0 =F[M1,M2] DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Depth_rest_Zero)
apply (rule order_antisym)

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

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

lemma cspF_Depth_rest_min:
  "P |. n |. m =F[M,M] P |. min n m"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Depth_rest_min)
apply (simp add: failures.simps)
apply (simp add: min_rs)
done

lemma cspF_Depth_rest_congE:
  "[| P =F[M1,M2] Q ; ALL m. P |. m =F[M1,M2] Q |. m ==> S |] ==> S"
apply (simp add: cspF_semantics)
apply (simp add: traces.simps)
apply (simp add: failures.simps)
done

lemma cspF_Depth_rest_n:
  "P |. n |. n =F[M,M] P |. n"
apply (rule cspF_rw_left)
apply (rule cspF_Depth_rest_min)
apply (simp)
done

(*------------------*
 |     !nat-rest    |
 *------------------*)

lemma cspF_nat_Depth_rest_UNIV:
  "P =F[M,M] !nat n .. (P |. n)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_nat_Depth_rest_UNIV)
apply (rule order_antisym)

 (* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (case_tac "noTick s")

  apply (rule_tac x="Suc (lengtht s)" in exI)
  apply (simp)

  apply (rule_tac x="lengtht s" in exI)
  apply (simp)
  apply (rule_tac x="(butlastt s)" in exI)
  apply (simp add: Tick_decompo)
  apply (simp add: noTick_butlast)

 (* => *)
 apply (rule)
 apply (simp add: in_failures)
done

lemma cspF_nat_Depth_rest_lengthset:
   "P =F[M,M] !nat n:(lengthset P (fstF o M)) .. (P |. n)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_nat_Depth_rest_lengthset)
apply (rule order_antisym)

 (* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (case_tac "noTick s")

  apply (rule_tac x="Suc (lengtht s)" in bexI)
  apply (simp)
  apply (simp add: lengthset_def)
  apply (rule_tac x="s" in exI)
  apply (simp add: proc_T2)

  apply (rule_tac x="lengtht s" in bexI)
  apply (simp)
  apply (rule_tac x="(butlastt s)" in exI)
  apply (simp add: Tick_decompo)
  apply (simp add: noTick_butlast)
  apply (simp add: lengthset_def)
  apply (rule_tac x="s" in exI)
  apply (simp add: proc_T2)

 (* => *)
 apply (rule)
 apply (simp add: in_failures)
done

lemmas cspF_nat_Depth_rest = cspF_nat_Depth_rest_UNIV
                             cspF_nat_Depth_rest_lengthset

(*------------------*
 |    ?-partial     |
 *------------------*)

lemma cspF_Ext_pre_choice_partial:
  "? :X -> Pf =F[M,M] ? x:X -> (IF (x:X) THEN Pf x ELSE DIV)"
apply (rule cspF_decompo)
apply (simp_all)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (simp)
done

(*------------------*
 |   !!-partial     |
 *------------------*)

lemma cspF_Rep_int_choice_sum_partial:
  "!! :C .. Pf =F[M,M] !! c:C .. (IF (c: sumset C) THEN Pf c ELSE DIV)"
apply (rule cspF_decompo)
apply (simp_all)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (simp)
done

lemma cspF_Rep_int_choice_nat_partial:
  "!nat :N .. Pf =F[M,M] !nat n:N .. (IF (n:N) THEN Pf n ELSE DIV)"
apply (rule cspF_decompo)
apply (simp_all)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (simp)
done

lemma cspF_Rep_int_choice_set_partial:
  "!set :Xs .. Pf =F[M,M] !set X:Xs .. (IF (X:Xs) THEN Pf X ELSE DIV)"
apply (rule cspF_decompo)
apply (simp_all)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (simp)
done

lemma cspF_Rep_int_choice_com_partial:
  "! :X .. Pf =F[M,M] ! a:X .. (IF (a:X) THEN Pf a ELSE DIV)"
apply (rule cspF_decompo)
apply (simp_all)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (simp)
done

lemma cspF_Rep_int_choice_f_partial:
  "inj f ==> !<f> :X .. Pf =F[M,M] !<f> a:X .. (IF (a:X) THEN Pf a ELSE DIV)"
apply (rule cspF_decompo)
apply (simp_all)
apply (rule cspF_rw_right)
apply (rule cspF_IF)
apply (simp)
done

lemmas cspF_Rep_int_choice_partial =
       cspF_Rep_int_choice_sum_partial
       cspF_Rep_int_choice_nat_partial
       cspF_Rep_int_choice_set_partial
       cspF_Rep_int_choice_com_partial
       cspF_Rep_int_choice_f_partial

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

(* --------------------------------------------------- *
       unfold only the first Sending and Receiving
 * --------------------------------------------------- *)

lemma cspF_first_Send_prefix:
  "a ! v -> P =F[M,M] a v -> P"
by (simp add: csp_prefix_ss_def)

lemma cspF_first_Rec_prefix:
  "a ? x:X -> Pf x =F[M,M] ? : (a ` X) -> (%x. (Pf ((inv a) x)))"
by (simp add: csp_prefix_ss_def)

lemma cspF_first_Int_pre_choice:
  "! :X -> Pf =F[M,M]  ! :X .. (%x. x -> (Pf x))"
by (simp add: csp_prefix_ss_def)

lemma cspF_first_Nondet_send_prefix:
  "a !? x:X -> Pf x =F[M,M] ! :(a ` X) -> (%x. (Pf ((inv a) x)))"
by (simp add: csp_prefix_ss_def)

lemmas cspF_first_prefix_ss =
       cspF_first_Send_prefix
       cspF_first_Rec_prefix
       cspF_first_Int_pre_choice
       cspF_first_Nondet_send_prefix

(* --------------------------------------------------- *
      Associativity of Sequential composition
 * --------------------------------------------------- *)

lemma cspF_Seq_compo_assoc:
  "(P ;; Q) ;; R =F[M,M] P ;; (Q ;; R)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Seq_compo_assoc)
apply (rule order_antisym)

 apply (rule)
 apply (simp add: in_traces in_failures)
 apply (elim disjE conjE exE)
  apply (force)

  apply (rule disjI2)
  apply (simp)
  apply (rule_tac x="sa" in exI)
  apply (rule_tac x="t" in exI)
  apply (simp)

  apply (subgoal_tac "noTick (sa ^^^ <Tick>)")
  apply (rotate_tac 3)
  apply (erule rem_asmE)
  apply (simp)
  apply (simp)

  apply (simp)
  apply (rule disjI2)
  apply (simp add: appt_decompo)
  apply (elim disjE conjE exE)

   apply (simp)
   apply (elim disjE conjE exE)
   apply (simp)
   apply (simp)
   apply (rule_tac x="sb" in exI)
   apply (rule_tac x="t" in exI)
   apply (simp)
   apply (rule disjI2)
   apply (rule_tac x="<>" in exI)
   apply (rule_tac x="t" in exI)
   apply (simp)

   apply (simp)
   apply (rotate_tac -2)
   apply (drule sym)
   apply (simp)
   apply (rotate_tac -2)
   apply (drule sym)
   apply (simp)

   apply (simp)
   apply (rule_tac x="sb" in exI)
   apply (rule_tac x="u ^^^ t" in exI)
   apply (simp add: appt_assoc)
   apply (rule disjI2)
   apply (rule_tac x="u" in exI)
   apply (rule_tac x="t" in exI)
   apply (simp)

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

  apply (simp)

  apply (rule disjI1)
  apply (simp)
  apply (rule disjI2)
  apply (rule_tac x="sa" in exI)
  apply (rule_tac x="t" in exI)
  apply (simp)

  apply (rule disjI2)
  apply (rule_tac x="sa ^^^ sb" in exI)
  apply (rule_tac x="ta" in exI)
  apply (simp add: appt_assoc)
  apply (rule disjI2)
  apply (rule_tac x="sa" in exI)
  apply (rule_tac x="sb ^^^ <Tick>" in exI)
  apply (simp)
done

lemma cspF_Seq_compo_assoc_sym:
  "P ;; (Q ;; R) =F[M,M] (P ;; Q) ;; R"
apply (rule cspF_sym)
apply (simp add: cspF_Seq_compo_assoc)
done

(* ---------------------------------------------- *
         decompose right internal choice
 * ---------------------------------------------- *)

lemma cspF_Int_choice_eq_right:
  "[| P =F[M1,M2] Q1 ; P =F[M1,M2] Q2 |]
   ==> P =F[M1,M2] Q1 |~| Q2"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_eq_right)
apply (rule order_antisym)
apply (rule)
apply (simp add: in_failures)
apply (rule)
apply (simp add: in_failures)
done

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

lemma cspF_Rep_int_choice_sum_eq_right_ALL:
  "[| sumset C ~= {} ; ALL c : (sumset C). P =F[M1,M2] Qf c |]
               ==> P =F[M1,M2] !! :C .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_sum_eq_right_ALL)
apply (rule order_antisym)
apply (rule)
apply (simp add: in_failures)
apply (subgoal_tac "EX c. c: sumset C")
apply (erule exE)
apply (drule_tac x="c" in bspec, simp)
apply (erule conjE)
apply (erule order_antisymE)
apply (erule subsetFE_ALL)
apply (drule_tac x="s" in spec)
apply (drule_tac x="X" in spec)
apply (simp)
apply (fast)
apply (fast)

apply (rule)
apply (simp add: in_failures)
apply (erule bexE)
apply (drule_tac x="c" in bspec, simp)
apply (erule conjE)
apply (erule order_antisymE)
apply (rotate_tac -1)
apply (erule subsetFE_ALL)
apply (drule_tac x="s" in spec)
apply (drule_tac x="X" in spec)
apply (simp)
done

lemma cspF_Rep_int_choice_sum_eq_right:
  "[| sumset C ~= {} ; !! c. c : (sumset C) ==> P =F[M1,M2] Qf c |]
               ==> P =F[M1,M2] !! :C .. Qf"
by (simp add: cspF_Rep_int_choice_sum_eq_right_ALL)

(* nat *)

lemma cspF_Rep_int_choice_nat_eq_right:
  "[| N ~= {} ; !! n. n : N ==> P =F[M1,M2] Qf n |]
               ==> P =F[M1,M2] !nat :N .. Qf"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_sum_eq_right, auto)

lemma cspF_Rep_int_choice_set_eq_right:
  "[| Xs ~= {} ; !! X. X : Xs ==> P =F[M1,M2] Qf X |]
               ==> P =F[M1,M2] !set :Xs .. Qf"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_sum_eq_right, auto)

lemma cspF_Rep_int_choice_com_eq_right:
  "[| X ~= {} ; !! a. a:X ==> P =F[M1,M2] Qf a |]
               ==> P =F[M1,M2] ! :X .. Qf"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_sum_eq_right, auto)

lemma cspF_Rep_int_choice_f_eq_right:
  "[| inj f ; X ~= {} ; !! a. a:X ==> P =F[M1,M2] Qf a |]
               ==> P =F[M1,M2] !<f> :X .. Qf"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_sum_eq_right, auto)

lemmas cspF_int_eq_right =
       cspF_Rep_int_choice_sum_eq_right
       cspF_Rep_int_choice_nat_eq_right
       cspF_Rep_int_choice_set_eq_right
       cspF_Rep_int_choice_com_eq_right
       cspF_Rep_int_choice_f_eq_right
       cspF_Int_choice_eq_right

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

lemma cspF_Int_choice_eq_left:
  "[| Q1 =F[M1,M2] P ; Q2 =F[M1,M2] P |]
   ==> Q1 |~| Q2 =F[M1,M2] P"
apply (rule cspF_sym)
apply (rule cspF_int_eq_right)
apply (rule cspF_sym, simp)
apply (rule cspF_sym, simp)
done

lemma cspF_Rep_int_choice_sum_eq_left:
  "[| sumset C ~= {} ; !! c. c : (sumset C) ==> Qf c =F[M1,M2] P |]
               ==> !! :C .. Qf =F[M1,M2] P"
apply (rule cspF_sym, rule cspF_int_eq_right, simp)
apply (rule cspF_sym, simp)
done

lemma cspF_Rep_int_choice_nat_eq_left:
  "[| N ~= {} ; !! n. n : N ==> Qf n =F[M1,M2] P |]
               ==> !nat :N .. Qf =F[M1,M2] P"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_sum_eq_left, auto)

lemma cspF_Rep_int_choice_set_eq_left:
  "[| Xs ~= {} ; !! X. X : Xs ==> Qf X =F[M1,M2] P |]
               ==> !set :Xs .. Qf =F[M1,M2] P"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_sum_eq_left, auto)

lemma cspF_Rep_int_choice_com_eq_left:
  "[| X ~= {} ; !! a. a:X ==> Qf a =F[M1,M2] P |]
               ==> ! :X .. Qf =F[M1,M2] P"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_sum_eq_left, auto)

lemma cspF_Rep_int_choice_f_eq_left:
  "[| inj f ; X ~= {} ; !! a. a:X ==> Qf a =F[M1,M2] P |]
               ==> !<f> :X .. Qf =F[M1,M2] P"
apply (simp add: Rep_int_choice_ss_def)
by (rule cspF_Rep_int_choice_sum_eq_left, auto)

lemmas cspF_int_eq_left =
       cspF_Rep_int_choice_sum_eq_left
       cspF_Rep_int_choice_nat_eq_left
       cspF_Rep_int_choice_set_eq_left
       cspF_Rep_int_choice_com_eq_left
       cspF_Rep_int_choice_f_eq_left
       cspF_Int_choice_eq_left

(* ---------------------------------------------- *
      replicated internal choice -> binary ...
 * ---------------------------------------------- *)

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

(* nat *)

lemma cspF_Rep_int_choice_nat_Un:
  "!nat n:(N1 Un N2) .. Pf n =F[M,M] !nat n:N1 .. Pf n |~| !nat n:N2 .. Pf n"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_nat_Un)
apply (rule order_antisym)
apply (auto simp add: in_failures)
done

(* set *)

lemma cspF_Rep_int_choice_set_Un:
  "!set X:(Xs1 Un Xs2) .. Pf X =F[M,M] !set X:Xs2 .. Pf X |~| !set X:Xs1 .. Pf X"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_set_Un)
apply (rule order_antisym)
apply (auto simp add: in_failures)
done

(* com *)

lemma cspF_Rep_int_choice_com_Un:
  "! x:(X1 Un X2) .. Pf x =F[M,M] ! x:X1 .. Pf x |~| ! x:X2 .. Pf x"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_com_Un)
apply (rule order_antisym)
apply (auto simp add: in_failures)
done

(* f *)

lemma cspF_Rep_int_choice_f_Un:
  "inj f ==>
   !<f> x:(X1 Un X2) .. Pf x =F[M,M] !<f> x:X1 .. Pf x |~| !<f> x:X2 .. Pf x"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_f_Un)
apply (rule order_antisym)
apply (auto simp add: in_failures)
done

lemmas cspF_Rep_int_choice_Un =
       cspF_Rep_int_choice_nat_Un
       cspF_Rep_int_choice_set_Un
       cspF_Rep_int_choice_com_Un
       cspF_Rep_int_choice_f_Un

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

(* nat *)

lemma cspF_Rep_int_choice_nat_insert:
  "!nat n:(insert m N) .. Pf n =F[M,M] Pf m |~| !nat n:N .. Pf n"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_nat_insert)
apply (rule order_antisym)
apply (auto simp add: in_failures)
done

(* set *)

lemma cspF_Rep_int_choice_set_insert:
  "!set X:(insert Y Xs) .. Pf X =F[M,M] Pf Y |~| !set X:Xs .. Pf X"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_set_insert)
apply (rule order_antisym)
apply (auto simp add: in_failures)
done

(* com *)

lemma cspF_Rep_int_choice_com_insert:
  "! x:(insert a X) .. Pf x =F[M,M] Pf a |~| ! x:X .. Pf x"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_com_insert)
apply (rule order_antisym)
apply (auto simp add: in_failures)
done

(* f *)

lemma cspF_Rep_int_choice_f_insert:
  "inj f ==> !<f> x:(insert a X) .. Pf x =F[M,M] Pf a |~| !<f> x:X .. Pf x"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_f_insert)
apply (rule order_antisym)
apply (auto simp add: in_failures)
done

lemmas cspF_Rep_int_choice_insert =
       cspF_Rep_int_choice_nat_insert
       cspF_Rep_int_choice_set_insert
       cspF_Rep_int_choice_com_insert
       cspF_Rep_int_choice_f_insert

lemmas cspF_Rep_int_choice_sepa =
       cspF_Rep_int_choice_insert
       cspF_Rep_int_choice_Un

(* ---------------------------------------------- *
       simplify replicated internal choice
 * ---------------------------------------------- *)

lemma cspF_Rep_int_choice_com_map_f:
  "inj f ==> ! x:(f ` X) .. Pf x =F[M,M] !<f> x:X .. Pf (f x)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_com_map_f)
apply (rule order_antisym)
apply (auto simp add: in_failures)
done

lemma cspF_Rep_int_choice_f_map_f:
  "[| inj f ; inj g |] ==> !<f> x:(g ` X) .. Pf x =F[M,M] !<f o g> x:X .. Pf (g x)"
apply (subgoal_tac "inj (f o g)")
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_f_map_f)
apply (rule order_antisym)
apply (auto simp add: in_failures)
apply (auto simp add: inj_on_def)
done

lemmas cspF_Rep_int_choice_f_map =
       cspF_Rep_int_choice_com_map_f
       cspF_Rep_int_choice_f_map_f

end


(*  Title:      HOL/HOLCF/Sfun.thy
    Author:     Brian Huffman
*)

section \<open>The Strict Function Type\<close>

theory Sfun
imports Cfun
begin

pcpodef ('a, 'b) sfun (infixr "\<rightarrow>!" 0)
  = "{f :: 'a \<rightarrow> 'b. f\<cdot>\<bottom> = \<bottom>}"
by simp_all

type_notation (ASCII)
  sfun  (infixr "->!" 0)

text \<open>TODO: Define nice syntax for abstraction, application.\<close>

definition
  sfun_abs :: "('a \<rightarrow> 'b) \<rightarrow> ('a \<rightarrow>! 'b)"
where
  "sfun_abs = (\<Lambda> f. Abs_sfun (strictify\<cdot>f))"

definition
  sfun_rep :: "('a \<rightarrow>! 'b) \<rightarrow> 'a \<rightarrow> 'b"
where
  "sfun_rep = (\<Lambda> f. Rep_sfun f)"

lemma sfun_rep_beta: "sfun_rep\<cdot>f = Rep_sfun f"
  unfolding sfun_rep_def by (simp add: cont_Rep_sfun)

lemma sfun_rep_strict1 [simp]: "sfun_rep\<cdot>\<bottom> = \<bottom>"
  unfolding sfun_rep_beta by (rule Rep_sfun_strict)

lemma sfun_rep_strict2 [simp]: "sfun_rep\<cdot>f\<cdot>\<bottom> = \<bottom>"
  unfolding sfun_rep_beta by (rule Rep_sfun [simplified])

lemma strictify_cancel: "f\<cdot>\<bottom> = \<bottom> \<Longrightarrow> strictify\<cdot>f = f"
  by (simp add: cfun_eq_iff strictify_conv_if)

lemma sfun_abs_sfun_rep [simp]: "sfun_abs\<cdot>(sfun_rep\<cdot>f) = f"
  unfolding sfun_abs_def sfun_rep_def
  apply (simp add: cont_Abs_sfun cont_Rep_sfun)
  apply (simp add: Rep_sfun_inject [symmetric] Abs_sfun_inverse)
  apply (simp add: cfun_eq_iff strictify_conv_if)
  apply (simp add: Rep_sfun [simplified])
  done

lemma sfun_rep_sfun_abs [simp]: "sfun_rep\<cdot>(sfun_abs\<cdot>f) = strictify\<cdot>f"
  unfolding sfun_abs_def sfun_rep_def
  apply (simp add: cont_Abs_sfun cont_Rep_sfun)
  apply (simp add: Abs_sfun_inverse)
  done

lemma sfun_eq_iff: "f = g \<longleftrightarrow> sfun_rep\<cdot>f = sfun_rep\<cdot>g"
by (simp add: sfun_rep_def cont_Rep_sfun Rep_sfun_inject)

lemma sfun_below_iff: "f \<sqsubseteq> g \<longleftrightarrow> sfun_rep\<cdot>f \<sqsubseteq> sfun_rep\<cdot>g"
by (simp add: sfun_rep_def cont_Rep_sfun below_sfun_def)

end


(*  Title:      HOL/SPARK/Examples/RIPEMD-160/Round.thy
    Author:     Fabian Immler, TU Muenchen

Verification of the RIPEMD-160 hash function
*)

theory Round
imports RMD_Specification
begin

spark_open \<open>rmd/round\<close>

abbreviation from_chain :: "chain \<Rightarrow> RMD.chain" where
  "from_chain c \<equiv> (
    word_of_int (h0 c),
    word_of_int (h1 c),
    word_of_int (h2 c),
    word_of_int (h3 c),
    word_of_int (h4 c))"

abbreviation from_chain_pair :: "chain_pair \<Rightarrow> RMD.chain \<times> RMD.chain" where
  "from_chain_pair cc \<equiv> (
    from_chain (left cc),
    from_chain (right cc))"

abbreviation to_chain :: "RMD.chain \<Rightarrow> chain" where
  "to_chain c \<equiv>
    (let (h0, h1, h2, h3, h4) = c in
      (|h0 = uint h0,
        h1 = uint h1,
        h2 = uint h2,
        h3 = uint h3,
        h4 = uint h4|))"

abbreviation to_chain_pair :: "RMD.chain \<times> RMD.chain \<Rightarrow> chain_pair" where
  "to_chain_pair c == (let (c1, c2) = c in
    (| left = to_chain c1,
      right = to_chain c2 |))"

abbreviation steps' :: "chain_pair \<Rightarrow> int \<Rightarrow> block \<Rightarrow> chain_pair" where
  "steps' cc i b == to_chain_pair (steps
    (\<lambda>n. word_of_int (b (int n)))
    (from_chain_pair cc)
    (nat i))"

abbreviation round_spec :: "chain \<Rightarrow> block \<Rightarrow> chain" where
  "round_spec c b == to_chain (round (\<lambda>n. word_of_int (b (int n))) (from_chain c))"

spark_proof_functions
  steps = steps'
  round_spec = round_spec

lemma uint_word_of_int_id:
  assumes "0 <= (x::int)"
  assumes "x <= 4294967295"
  shows"uint(word_of_int x::word32) = x"
  using assms by (simp add: take_bit_int_eq_self)

lemma steps_step: "steps X cc (Suc i) = step_both X (steps X cc i) i"
  unfolding steps_def
  by (induct i) simp_all

lemma from_to_id: "from_chain_pair (to_chain_pair CC) = CC"
proof (cases CC)
  fix a::RMD.chain
  fix b c d e f::word32
  assume "CC = (a, b, c, d, e, f)"
  thus ?thesis by (cases a) simp
qed

lemma steps_to_steps':
  "F A (steps X cc i) B =
   F A (from_chain_pair (to_chain_pair (steps X cc i))) B"
  unfolding from_to_id ..

lemma steps'_step:
  assumes "0 <= i"
  shows
  "steps' cc (i + 1) X = to_chain_pair (
     step_both
       (\<lambda>n. word_of_int (X (int n)))
       (from_chain_pair (steps' cc i X))
       (nat i))"
proof -
  have "nat (i + 1) = Suc (nat i)" using assms by simp
  show ?thesis
    unfolding \<open>nat (i + 1) = Suc (nat i)\<close> steps_step steps_to_steps'
    ..
qed

lemma step_from_hyp:
  assumes
  step_hyp:
  "\<lparr>left =
      \<lparr>h0 = a, h1 = b, h2 = c, h3 = d, h4 = e\<rparr>,
    right =
      \<lparr>h0 = a', h1 = b', h2 = c', h3 = d', h4 = e'\<rparr>\<rparr> =
   steps'
     (\<lparr>left =
         \<lparr>h0 = a_0, h1 = b_0, h2 = c_0,
          h3 = d_0, h4 = e_0\<rparr>,
       right =
         \<lparr>h0 = a_0, h1 = b_0, h2 = c_0,
          h3 = d_0, h4 = e_0\<rparr>\<rparr>)
     j x"
  assumes "a <= 4294967295" (is "_ <= ?M")
  assumes                "b  <= ?M" and "c  <= ?M" and "d  <= ?M" and "e  <= ?M"
  assumes "a' <= ?M" and "b' <= ?M" and "c' <= ?M" and "d' <= ?M" and "e' <= ?M"
  assumes "0 <= a " and "0 <= b " and "0 <= c " and "0 <= d " and "0 <= e "
  assumes "0 <= a'" and "0 <= b'" and "0 <= c'" and "0 <= d'" and "0 <= e'"
  assumes "0 <= x (r_l_spec j)" and "x (r_l_spec j) <= ?M"
  assumes "0 <= x (r_r_spec j)" and "x (r_r_spec j) <= ?M"
  assumes "0 <= j" and "j <= 79"
  shows
  "\<lparr>left =
      \<lparr>h0 = e,
         h1 =
           (rotate_left (s_l_spec j)
             ((((a + f_spec j b c d) mod 4294967296 +
                x (r_l_spec j)) mod
               4294967296 +
               k_l_spec j) mod
              4294967296) +
            e) mod
           4294967296,
         h2 = b, h3 = rotate_left 10 c,
         h4 = d\<rparr>,
      right =
        \<lparr>h0 = e',
           h1 =
             (rotate_left (s_r_spec j)
               ((((a' + f_spec (79 - j) b' c' d') mod
                  4294967296 +
                  x (r_r_spec j)) mod
                 4294967296 +
                 k_r_spec j) mod
                4294967296) +
              e') mod
             4294967296,
           h2 = b', h3 = rotate_left 10 c',
           h4 = d'\<rparr>\<rparr> =
   steps'
    (\<lparr>left =
        \<lparr>h0 = a_0, h1 = b_0, h2 = c_0,
           h3 = d_0, h4 = e_0\<rparr>,
        right =
          \<lparr>h0 = a_0, h1 = b_0, h2 = c_0,
             h3 = d_0, h4 = e_0\<rparr>\<rparr>)
    (j + 1) x"
  using step_hyp
proof -
  let ?MM = 4294967296
  have AL: "uint(word_of_int e::word32) = e"
    by (rule uint_word_of_int_id[OF \<open>0 <= e\<close> \<open>e <= ?M\<close>])
  have CL: "uint(word_of_int b::word32) = b"
    by (rule uint_word_of_int_id[OF \<open>0 <= b\<close> \<open>b <= ?M\<close>])
  have DL: "True" ..
  have EL: "uint(word_of_int d::word32) = d"
    by (rule uint_word_of_int_id[OF \<open>0 <= d\<close> \<open>d <= ?M\<close>])
  have AR: "uint(word_of_int e'::word32) = e'"
    by (rule uint_word_of_int_id[OF \<open>0 <= e'\<close> \<open>e' <= ?M\<close>])
  have CR: "uint(word_of_int b'::word32) = b'"
    by (rule uint_word_of_int_id[OF \<open>0 <= b'\<close> \<open>b' <= ?M\<close>])
  have DR: "True" ..
  have ER: "uint(word_of_int d'::word32) = d'"
    by (rule uint_word_of_int_id[OF \<open>0 <= d'\<close> \<open>d' <= ?M\<close>])
  have BL:
    "(uint
      (word_rotl (s (nat j))
        ((word_of_int::int\<Rightarrow>word32)
          ((((a + f_spec j b c d) mod ?MM +
             x (r_l_spec j)) mod ?MM +
            k_l_spec j) mod ?MM))) +
        e) mod ?MM
    =
    uint
              (word_rotl (s (nat j))
                (word_of_int a +
                 f (nat j) (word_of_int b)
                  (word_of_int c) (word_of_int d) +
                 word_of_int (x (r_l_spec j)) +
                 K (nat j)) +
               word_of_int e)"
    (is "(uint (word_rotl _ (_ ((((_ + ?F) mod _ + ?X) mod _ + _) mod _))) + _) mod _ = _")
  proof -
    have "a mod ?MM = a" using \<open>0 <= a\<close> \<open>a <= ?M\<close>
      by simp
    have "?X mod ?MM = ?X" using \<open>0 <= ?X\<close> \<open>?X <= ?M\<close>
      by simp
    have "e mod ?MM = e" using \<open>0 <= e\<close> \<open>e <= ?M\<close>
      by simp
    have "(?MM::int) = 2 ^ LENGTH(32)" by simp
    show ?thesis
      unfolding
        word_add_def
        uint_word_of_int_id[OF \<open>0 <= a\<close> \<open>a <= ?M\<close>]
        uint_word_of_int_id[OF \<open>0 <= ?X\<close> \<open>?X <= ?M\<close>]
      using \<open>a mod ?MM = a\<close>
        \<open>e mod ?MM = e\<close>
        \<open>?X mod ?MM = ?X\<close>
      unfolding \<open>?MM = 2 ^ LENGTH(32)\<close>
      apply (simp only: flip: take_bit_eq_mod add: uint_word_of_int_eq)
      apply (metis (mono_tags, hide_lams) of_int_of_nat_eq ucast_id uint_word_of_int_eq unsigned_of_int)
      done
  qed

  have BR:
    "(uint
      (word_rotl (s' (nat j))
        ((word_of_int::int\<Rightarrow>word32)
          ((((a' + f_spec (79 - j) b' c' d') mod ?MM +
             x (r_r_spec j)) mod ?MM +
            k_r_spec j) mod ?MM))) +
        e') mod ?MM
    =
    uint
              (word_rotl (s' (nat j))
                (word_of_int a' +
                 f (79 - nat j) (word_of_int b')
                  (word_of_int c') (word_of_int d') +
                 word_of_int (x (r_r_spec j)) +
                 K' (nat j)) +
               word_of_int e')"
    (is "(uint (word_rotl _ (_ ((((_ + ?F) mod _ + ?X) mod _ + _) mod _))) + _) mod _ = _")
  proof -
    have "a' mod ?MM = a'" using \<open>0 <= a'\<close> \<open>a' <= ?M\<close>
      by simp
    have "?X mod ?MM = ?X" using \<open>0 <= ?X\<close> \<open>?X <= ?M\<close>
      by simp
    have "e' mod ?MM = e'" using \<open>0 <= e'\<close> \<open>e' <= ?M\<close>
      by simp
    have "(?MM::int) = 2 ^ LENGTH(32)" by simp
    have nat_transfer: "79 - nat j = nat (79 - j)"
      using nat_diff_distrib \<open>0 <= j\<close>  \<open>j <= 79\<close>
      by simp
    show ?thesis
      unfolding
        word_add_def
        uint_word_of_int_id[OF \<open>0 <= a'\<close> \<open>a' <= ?M\<close>]
        uint_word_of_int_id[OF \<open>0 <= ?X\<close> \<open>?X <= ?M\<close>]
        nat_transfer
      using \<open>a' mod ?MM = a'\<close>
        \<open>e' mod ?MM = e'\<close>
        \<open>?X mod ?MM = ?X\<close>
      unfolding \<open>?MM = 2 ^ LENGTH(32)\<close>
      apply (simp only: flip: take_bit_eq_mod add: uint_word_of_int_eq)
      apply (metis (mono_tags, hide_lams) of_nat_nat_take_bit_eq ucast_id unsigned_of_int)
      done
  qed

  show ?thesis
    unfolding steps'_step[OF \<open>0 <= j\<close>] step_hyp[symmetric]
      step_both_def step_r_def step_l_def
    using AL CL EL AR CR ER
    by (simp add: BL DL BR DR take_bit_int_eq_self_iff take_bit_int_eq_self)
qed

spark_vc procedure_round_61
proof -
  let ?M = "4294967295::int"
  have step_hyp:
  "\<lparr>left =
      \<lparr>h0 = ca, h1 = cb, h2 = cc,
         h3 = cd, h4 = ce\<rparr>,
      right =
        \<lparr>h0 = ca, h1 = cb, h2 = cc,
           h3 = cd, h4 = ce\<rparr>\<rparr> =
   steps'
    (\<lparr>left =
        \<lparr>h0 = ca, h1 = cb, h2 = cc,
           h3 = cd, h4 = ce\<rparr>,
        right =
          \<lparr>h0 = ca, h1 = cb, h2 = cc,
             h3 = cd, h4 = ce\<rparr>\<rparr>)
    0 x"
    unfolding steps_def
    using
      uint_word_of_int_id[OF \<open>0 <= ca\<close> \<open>ca <= ?M\<close>]
      uint_word_of_int_id[OF \<open>0 <= cb\<close> \<open>cb <= ?M\<close>]
      uint_word_of_int_id[OF \<open>0 <= cc\<close> \<open>cc <= ?M\<close>]
      uint_word_of_int_id[OF \<open>0 <= cd\<close> \<open>cd <= ?M\<close>]
      uint_word_of_int_id[OF \<open>0 <= ce\<close> \<open>ce <= ?M\<close>]
    by (simp add: take_bit_int_eq_self_iff take_bit_int_eq_self)
  let ?rotate_arg_l =
    "((((ca + f 0 cb cc cd) mod 4294967296 +
        x (r_l 0)) mod 4294967296 + k_l 0) mod 4294967296)"
  let ?rotate_arg_r =
    "((((ca + f 79 cb cc cd) mod 4294967296 +
        x (r_r 0)) mod 4294967296 + k_r 0) mod 4294967296)"
  note returns =
    \<open>wordops__rotate (s_l 0) ?rotate_arg_l =
     rotate_left (s_l 0) ?rotate_arg_l\<close>
    \<open>wordops__rotate (s_r 0) ?rotate_arg_r =
     rotate_left (s_r 0) ?rotate_arg_r\<close>
    \<open>wordops__rotate 10 cc = rotate_left 10 cc\<close>
    \<open>f 0 cb cc cd = f_spec 0 cb cc cd\<close>
    \<open>f 79 cb cc cd = f_spec 79 cb cc cd\<close>
    \<open>k_l 0 = k_l_spec 0\<close>
    \<open>k_r 0 = k_r_spec 0\<close>
    \<open>r_l 0 = r_l_spec 0\<close>
    \<open>r_r 0 = r_r_spec 0\<close>
    \<open>s_l 0 = s_l_spec 0\<close>
    \<open>s_r 0 = s_r_spec 0\<close>

  note x_borders = \<open>\<forall>i. 0 \<le> i \<and> i \<le> 15 \<longrightarrow> 0 \<le> x i \<and> x i \<le> ?M\<close>

  from \<open>0 <= r_l 0\<close> \<open>r_l 0 <= 15\<close> x_borders
  have "0 \<le> x (r_l 0)" by blast
  hence x_lower: "0 <= x (r_l_spec 0)" unfolding returns .

  from \<open>0 <= r_l 0\<close> \<open>r_l 0 <= 15\<close> x_borders
  have "x (r_l 0) <= ?M" by blast
  hence x_upper: "x (r_l_spec 0) <= ?M" unfolding returns .

  from \<open>0 <= r_r 0\<close> \<open>r_r 0 <= 15\<close> x_borders
  have "0 \<le> x (r_r 0)" by blast
  hence x_lower': "0 <= x (r_r_spec 0)" unfolding returns .

  from \<open>0 <= r_r 0\<close> \<open>r_r 0 <= 15\<close> x_borders
  have "x (r_r 0) <= ?M" by blast
  hence x_upper': "x (r_r_spec 0) <= ?M" unfolding returns .

  have "0 <= (0::int)" by simp
  have "0 <= (79::int)" by simp
  note step_from_hyp [OF
    step_hyp
    H2 H4 H6 H8 H10 H2 H4 H6 H8 H10 \<comment> \<open>upper bounds\<close>
    H1 H3 H5 H7 H9  H1 H3 H5 H7 H9  \<comment> \<open>lower bounds\<close>
  ]
  from this[OF x_lower x_upper x_lower' x_upper' \<open>0 <= 0\<close> \<open>0 <= 79\<close>]
    \<open>0 \<le> ca\<close> \<open>0 \<le> ce\<close> x_lower x_lower'
  show ?thesis unfolding returns(1) returns(2) unfolding returns
    by (simp del: mod_pos_pos_trivial mod_neg_neg_trivial)
qed

spark_vc procedure_round_62
proof -
  let ?M = "4294967295::int"
  let ?rotate_arg_l =
    "((((cla + f (loop__1__j + 1) clb clc cld) mod 4294967296 +
         x (r_l (loop__1__j + 1))) mod 4294967296 +
         k_l (loop__1__j + 1)) mod 4294967296)"
  let ?rotate_arg_r =
    "((((cra + f (79 - (loop__1__j + 1)) crb crc crd) mod
         4294967296 + x (r_r (loop__1__j + 1))) mod 4294967296 +
         k_r (loop__1__j + 1)) mod 4294967296)"

  have s: "78 - loop__1__j = (79 - (loop__1__j + 1))" by simp
  note returns =
    \<open>wordops__rotate (s_l (loop__1__j + 1)) ?rotate_arg_l =
     rotate_left (s_l (loop__1__j + 1)) ?rotate_arg_l\<close>
    \<open>wordops__rotate (s_r (loop__1__j + 1)) ?rotate_arg_r =
     rotate_left (s_r (loop__1__j + 1)) ?rotate_arg_r\<close>
    \<open>f (loop__1__j + 1) clb clc cld =
     f_spec (loop__1__j + 1) clb clc cld\<close>
    \<open>f (78 - loop__1__j) crb crc crd =
     f_spec (78 - loop__1__j) crb crc crd\<close>[simplified s]
    \<open>wordops__rotate 10 clc = rotate_left 10 clc\<close>
    \<open>wordops__rotate 10 crc = rotate_left 10 crc\<close>
    \<open>k_l (loop__1__j + 1) = k_l_spec (loop__1__j + 1)\<close>
    \<open>k_r (loop__1__j + 1) = k_r_spec (loop__1__j + 1)\<close>
    \<open>r_l (loop__1__j + 1) = r_l_spec (loop__1__j + 1)\<close>
    \<open>r_r (loop__1__j + 1) = r_r_spec (loop__1__j + 1)\<close>
    \<open>s_l (loop__1__j + 1) = s_l_spec (loop__1__j + 1)\<close>
    \<open>s_r (loop__1__j + 1) = s_r_spec (loop__1__j + 1)\<close>

  note x_borders = \<open>\<forall>i. 0 \<le> i \<and> i \<le> 15 \<longrightarrow> 0 \<le> x i \<and> x i \<le> ?M\<close>

  from \<open>0 <= r_l (loop__1__j + 1)\<close> \<open>r_l (loop__1__j + 1) <= 15\<close> x_borders
  have "0 \<le> x (r_l (loop__1__j + 1))" by blast
  hence x_lower: "0 <= x (r_l_spec (loop__1__j + 1))" unfolding returns .

  from \<open>0 <= r_l (loop__1__j + 1)\<close> \<open>r_l (loop__1__j + 1) <= 15\<close> x_borders
  have "x (r_l (loop__1__j + 1)) <= ?M" by blast
  hence x_upper: "x (r_l_spec (loop__1__j + 1)) <= ?M" unfolding returns .

  from \<open>0 <= r_r (loop__1__j + 1)\<close> \<open>r_r (loop__1__j + 1) <= 15\<close> x_borders
  have "0 \<le> x (r_r (loop__1__j + 1))" by blast
  hence x_lower': "0 <= x (r_r_spec (loop__1__j + 1))" unfolding returns .

  from \<open>0 <= r_r (loop__1__j + 1)\<close> \<open>r_r (loop__1__j + 1) <= 15\<close> x_borders
  have "x (r_r (loop__1__j + 1)) <= ?M" by blast
  hence x_upper': "x (r_r_spec (loop__1__j + 1)) <= ?M" unfolding returns .

  from \<open>0 <= loop__1__j\<close> have "0 <= loop__1__j + 1" by simp
  from \<open>loop__1__j <= 78\<close> have "loop__1__j + 1 <= 79" by simp

  have "loop__1__j + 1 + 1 = loop__1__j + 2" by simp

  note step_from_hyp[OF H1
    \<open>cla <= ?M\<close>
    \<open>clb <= ?M\<close>
    \<open>clc <= ?M\<close>
    \<open>cld <= ?M\<close>
    \<open>cle <= ?M\<close>
    \<open>cra <= ?M\<close>
    \<open>crb <= ?M\<close>
    \<open>crc <= ?M\<close>
    \<open>crd <= ?M\<close>
    \<open>cre <= ?M\<close>

    \<open>0 <= cla\<close>
    \<open>0 <= clb\<close>
    \<open>0 <= clc\<close>
    \<open>0 <= cld\<close>
    \<open>0 <= cle\<close>
    \<open>0 <= cra\<close>
    \<open>0 <= crb\<close>
    \<open>0 <= crc\<close>
    \<open>0 <= crd\<close>
    \<open>0 <= cre\<close>]
  from this[OF
    x_lower x_upper x_lower' x_upper'
    \<open>0 <= loop__1__j + 1\<close> \<open>loop__1__j + 1 <= 79\<close>]
    \<open>0 \<le> cla\<close> \<open>0 \<le> cle\<close> \<open>0 \<le> cra\<close> \<open>0 \<le> cre\<close> x_lower x_lower'
  show ?thesis unfolding \<open>loop__1__j + 1 + 1 = loop__1__j + 2\<close>
    unfolding returns(1) returns(2) unfolding returns
    by (simp del: mod_pos_pos_trivial mod_neg_neg_trivial)

qed

spark_vc procedure_round_76
proof -
  let ?M = "4294967295 :: int"
  let ?INIT_CHAIN =
     "\<lparr>h0 = ca_init, h1 = cb_init,
         h2 = cc_init, h3 = cd_init,
         h4 = ce_init\<rparr>"
  have steps_to_steps':
    "steps
       (\<lambda>n::nat. word_of_int (x (int n)))
       (from_chain ?INIT_CHAIN, from_chain ?INIT_CHAIN)
       80 =
    from_chain_pair (
      steps'
      (\<lparr>left = ?INIT_CHAIN, right = ?INIT_CHAIN\<rparr>)
      80
      x)"
    unfolding from_to_id by simp
  from
    \<open>0 \<le> ca_init\<close> \<open>ca_init \<le> ?M\<close>
    \<open>0 \<le> cb_init\<close> \<open>cb_init \<le> ?M\<close>
    \<open>0 \<le> cc_init\<close> \<open>cc_init \<le> ?M\<close>
    \<open>0 \<le> cd_init\<close> \<open>cd_init \<le> ?M\<close>
    \<open>0 \<le> ce_init\<close> \<open>ce_init \<le> ?M\<close>
    \<open>0 \<le> cla\<close> \<open>cla \<le> ?M\<close>
    \<open>0 \<le> clb\<close> \<open>clb \<le> ?M\<close>
    \<open>0 \<le> clc\<close> \<open>clc \<le> ?M\<close>
    \<open>0 \<le> cld\<close> \<open>cld \<le> ?M\<close>
    \<open>0 \<le> cle\<close> \<open>cle \<le> ?M\<close>
    \<open>0 \<le> cra\<close> \<open>cra \<le> ?M\<close>
    \<open>0 \<le> crb\<close> \<open>crb \<le> ?M\<close>
    \<open>0 \<le> crc\<close> \<open>crc \<le> ?M\<close>
    \<open>0 \<le> crd\<close> \<open>crd \<le> ?M\<close>
    \<open>0 \<le> cre\<close> \<open>cre \<le> ?M\<close>
  show ?thesis
    unfolding round_def
    unfolding steps_to_steps'
    unfolding H1[symmetric]
    by (simp add: uint_word_ariths(1) mod_simps
      uint_word_of_int_id take_bit_int_eq_self)
qed

spark_end

end


theory Validity
imports LLEarleyParsing Derivations
begin

context LocalLexing begin

definition wellformed_token :: "('a, 'b, 'c) token \<Rightarrow> bool"
where
  "wellformed_token t = is_terminal (terminal_of_token t)"

definition wellformed_tokens :: "('a, 'b, 'c) tokens \<Rightarrow> bool"
where
  "wellformed_tokens ts = list_all wellformed_token ts"

definition doc_tokens :: "('a, 'b, 'c) tokens \<Rightarrow> bool"
where
  "doc_tokens p = (wellformed_tokens p \<and> is_prefix (chars p) Doc)"

definition wellformed_item :: "('a, 'b) item \<Rightarrow> bool"
where
  "wellformed_item x = (
    item_rule x \<in> \<RR> \<and>
    item_origin x \<le> item_end x \<and>
    item_end x \<le> length Doc \<and>
    item_dot x \<le> length (item_rhs x))"

definition wellformed_items :: "('a, 'b)items \<Rightarrow> bool"
where
  "wellformed_items X = (\<forall> x \<in> X. wellformed_item x)"

lemma is_word_terminals: "wellformed_tokens p \<Longrightarrow> is_word (terminals p)"
by (simp add: is_word_def list_all_length terminals_def wellformed_token_def wellformed_tokens_def)

lemma is_word_subset: "is_word x \<Longrightarrow> set y \<subseteq> set x \<Longrightarrow> is_word y"
by (metis (mono_tags, hide_lams) in_set_conv_nth is_word_def list_all_length subsetCE)

lemma is_word_terminals_take: "wellformed_tokens p \<Longrightarrow> is_word(terminals (take n p))"
by (metis append_take_drop_id is_word_terminals list_all_append wellformed_tokens_def)

lemma is_word_terminals_drop: "wellformed_tokens p \<Longrightarrow> is_word(terminals (drop n p))"
by (metis append_take_drop_id is_word_terminals list_all_append wellformed_tokens_def)

(*list of tokens, valid with regard to an item*)
definition pvalid :: "('a, 'b, 'c) tokens \<Rightarrow> ('a, 'b) item \<Rightarrow> bool"
where
  "pvalid p x = (\<exists> u \<gamma>.
     wellformed_tokens p \<and>
     wellformed_item x \<and>
     u \<le> length p \<and>
     charslength p = item_end x \<and>
     charslength (take u p) = item_origin x \<and>
     is_derivation (terminals (take u p) @ [item_nonterminal x] @ \<gamma>) \<and>
     derives (item_\<alpha> x) (terminals (drop u p)))"

definition Gen :: "('a, 'b, 'c) tokens set \<Rightarrow> ('a, 'b) items"
where
  "Gen P = { x | x p. p \<in> P \<and> pvalid p x }"

lemma "wellformed_items (Gen P)"
  by (auto simp add: Gen_def pvalid_def wellformed_items_def)

lemma "wellformed_items (Init)"
  by (auto simp add: wellformed_items_def Init_def init_item_def wellformed_item_def)

definition pvalid_left :: "('a, 'b, 'c) tokens \<Rightarrow> ('a, 'b)item \<Rightarrow> bool"
where
  "pvalid_left p x = (\<exists> u \<gamma>.
     wellformed_tokens p \<and>
     wellformed_item x \<and>
     u \<le> length p \<and>
     charslength p = item_end x \<and>
     charslength (take u p) = item_origin x \<and>
     is_leftderivation (terminals (take u p) @ [item_nonterminal x] @ \<gamma>) \<and>
     leftderives (item_\<alpha> x) (terminals (drop u p)))"

lemma pvalid_left: "pvalid p x = pvalid_left p x"
proof -
  have right_imp_left: "pvalid_left p x \<Longrightarrow> pvalid p x"
    by (meson CFG.leftderives_implies_derives CFG_axioms LocalLexing.pvalid_def
        LocalLexing.pvalid_left_def LocalLexing_axioms leftderivation_implies_derivation)
  have left_imp_right: "pvalid p x \<Longrightarrow> pvalid_left p x"
  proof -
    assume "pvalid p x"
    then obtain u \<gamma> where
      "wellformed_tokens p \<and>
       wellformed_item x \<and>
       u \<le> length p \<and>
       charslength p = item_end x \<and>
       charslength (take u p) = item_origin x \<and>
       is_derivation (terminals (take u p) @ [item_nonterminal x] @ \<gamma>) \<and>
       derives (item_\<alpha> x) (terminals (drop u p))" by (simp add: pvalid_def, blast)
    thus ?thesis
      apply (auto simp add: pvalid_left_def)
      apply (rule_tac x=u in exI)
      apply auto
      apply (simp add: is_leftderivation_def)
      apply (rule_tac derives_implies_leftderives_cons[where b=\<gamma>])
      apply (erule is_word_terminals_take)
      apply (simp add: is_derivation_def)
      by (metis derives_implies_leftderives is_word_terminals_drop)
  qed
  show ?thesis by (metis left_imp_right right_imp_left)
qed

lemma \<L>\<^sub>P_wellformed_tokens: "terminals p \<in> \<L>\<^sub>P \<Longrightarrow> wellformed_tokens p"
by (metis (mono_tags, lifting) \<L>\<^sub>P_is_word is_word_def length_map list_all_length
    nth_map terminals_def wellformed_token_def wellformed_tokens_def)

end

end