(*
 * Copyright 2016, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the GNU General Public License version 2. Note that NO WARRANTY is provided.
 * See "LICENSE_GPLv2.txt" for details.
 *
 * @TAG(NICTA_GPL)
 *)

theory FsopSyncR
imports
  "../lib/CogentCorres"
  "../refine/AfsFsopR"
  "../refine/OstoreR"
begin

definition
 rsync_res :: "(afs_state \<times> (unit,ErrCode) R\<^sub>T) \<Rightarrow> FsopFsP\<^sub>T \<times> (32 word, unit) R\<^sub>1\<^sub>1 \<Rightarrow> bool"
where
 "rsync_res \<equiv> (\<lambda>(afs, ra) (fsr, rc). ra = rc \<and> afs_fsop_rel afs (FsopFsP.fs_st\<^sub>f fsr))"

lemmas rsync_simp = rsync_res_def afs_fsop_rel_def Let_def
   afmsu_def afs_fsop_match_step_updates_def match_afs_data_fs_state_def

lemma fold_comp[rule_format]:
  "xs = ys @ zs \<longrightarrow> fold f xs accu = (fold f zs (fold f ys accu))"
  by (induct_tac xs, simp+)

lemma corres_sync_err:
"afs_fsop_rel afs fs_st \<Longrightarrow>
 cogent_corres rsync_res (return (afs, R\<^sub>1\<^sub>1.Error e)) (\<lparr>FsopFsP.ex\<^sub>f = ex, fs_st\<^sub>f = fs_st\<rparr>, R\<^sub>1\<^sub>1.Error e)"
  by (simp add: rsync_res_def cogent_corres_def  return_def)

lemma length_updates_eqD:
 "afs_fsop_rel afs fs_st \<Longrightarrow>
 length (\<alpha>_updates (FsState.ostore_st\<^sub>f fs_st)) = length (a_medium_updates afs)"
 by (clarsimp simp: rsync_simp)

lemma afs_fsop_match_updates:
 "afs_fsop_match (fold id xs' a) (fold id ys' c) \<Longrightarrow> xs' = xs \<Longrightarrow> ys' = ys \<Longrightarrow>
  afs_fsop_match (fold id xs a) (fold id ys c)"
by simp

lemma updates_take_eq:
 "na \<le> (length xs - n) \<Longrightarrow>
  n \<le> length xs \<Longrightarrow>
  length xs = length ys \<Longrightarrow>
  take (min (length ys) n + min (length (drop n ys)) na) xs =
    take n xs @ take na (drop n xs)"
  by (simp add: min_absorb2 take_add)

lemma refine_sync:
notes length_drop[simp del]
assumes rel:"afs_fsop_rel afs fs_st"
shows
  "\<And>ex. cogent_corres rsync_res
         (afs_sync afs) (fsop_sync_fs (FsopFsP.make ex fs_st))"
  unfolding afs_sync_def fsop_sync_fs_def[simplified tuple_simps sanitizers, folded eIO_def]
using [[goals_limit=5]]
  apply (rule cogent_corres_conc_let_exec, simp only: prod.case_eq_if)
  apply (rule cogent_corres_conc_let_exec, simp only: prod.case_eq_if)
  apply (rule cogent_corres_conc_let_exec, simp only: prod.case_eq_if)
  apply (rule cogent_corres_if)
    apply (simp add: FsopFsP.make_def)
    apply (fold eRoFs_def)
    apply (rule corres_sync_err[OF rel])
   apply (rule cogent_corres_conc_let_exec, simp only: prod.case_eq_if)
   apply (rule cogent_corres_conc_let_exec, simp only: prod.case_eq_if)
   apply (simp only:  FsopFsP.defs)
   apply (fold ostoreWriteNone_def)

   apply (rule ostore_sync_ret)
       using rel apply (simp add: rsync_simp)
      using rel apply (simp add: rsync_simp)
     using rel apply (simp add: rsync_simp)
     apply (clarsimp)
    apply (rule_tac v="length (a_medium_updates afs)" in cogent_corres_select, simp)
    apply (simp add: Let_def)
    apply (rule cogent_corres_return)
    using rel apply (clarsimp simp add: rsync_simp prod.case_eq_if)
    apply (erule_tac x="length (a_medium_updates afs)" in allE)
    apply (clarsimp simp: updated_afs_def id_def a_afs_updated_def \<alpha>_ostore_uptodate_def)
    apply (drule afs_inv_steps_updated_afsD)
    apply (simp add: afs_inv_steps_def updated_afs_def a_afs_updated_def id_def)
   apply clarsimp
   apply (rule_tac v="n" in cogent_corres_select)
    apply (simp)
    using length_updates_eqD[OF rel]
    apply simp
   using length_updates_eqD[OF rel]
   apply (simp add: Let_def)
   apply (rule_tac v="e" in cogent_corres_select, simp)
   apply (rule cogent_corres_return)
   using rel apply (clarsimp simp add: rsync_simp updated_afs_def)
    apply (rule conjI)
    apply (simp add: afs_inv_steps_def updated_afs_def a_afs_updated_def id_def)
     apply (fold id_def)
     apply clarsimp
     apply (subst fold_comp[symmetric], rule refl)+
     apply (erule_tac x="n+na" in allE)
     apply (fastforce simp add: take_add length_drop)
   apply (rule conjI)
    using length_updates_eqD[OF rel]
    apply (fastforce simp add: length_drop)
   apply clarsimp
    apply (rename_tac na)
    apply (erule_tac x="n + na" in allE)
    apply (erule impE)
     apply (drule sym[where s="length _" and t = "length _"])
     apply (simp only: length_drop)
     apply (subst fold_comp[symmetric], rule refl)+
     apply (erule afs_fsop_match_updates)
     apply (fastforce simp only: take_add)+
   using rel
   apply (simp add: rsync_simp FsopFsP.defs)
 done
end


           (*-------------------------------------------*
            |                DFP package                |
            |                   June 2005               |
            |               December 2005  (modified)   |
            |                                           |
            |   DFP on CSP-Prover ver.3.0               |
            |              September 2006  (modified)   |
            |                  April 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory DFP_Network
imports DFP_subseteqEX
begin

(*  The following simplification rules are deleted in this theory file *)
(*  because they unexpectly rewrite UnionT and InterT.                 *)
(*                  Union (B ` A) = (UN x:A. B x)                      *)
(*                  Inter (B ` A) = (INT x:A. B x)                     *)

(*
declare Union_image_eq [simp del]
declare Inter_image_eq [simp del]
*)
declare Sup_image_eq [simp del]
declare Inf_image_eq [simp del]

(*  The following simplification rules are deleted in this theory file *)
(*  because they unexpectly rewrite (notick | t = []t)                 *)
(*                                                                     *)
(*                  disj_not1: (~ P | Q) = (P --> Q)                   *)

declare disj_not1 [simp del]

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

         1.
         2.
         3.
         4.

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

(*********************************************************
                    definitions
 *********************************************************)

(*** network ***)

type_synonym ('i,'p,'a) Network  = "('i set * ('i => (('p,'a) proc * 'a set)))"

definition
  PAR  :: "('i,'p,'a) Network => ('p,'a) proc" ("(1PAR _)" [77] 77)
  where
  PAR_def :
    "PAR V == [||]i:(fst V) .. ((snd V) i)"

syntax
  "@Network" ::
     "(('p,'a) proc * 'a set) => pttrn => 'i set
      => ('i,'p,'a) Network"  ("(1{ _ | /_:_ }net)" [77,900,90] 900)

translations
  "{ PX | i:I }net"  == "(I, (%i. PX))"

(*** failure set of network ***)

type_synonym ('i,'a) NetworkF = "('i set * ('i => (('a failure set) * 'a set)))"

syntax
  "@NetworkF" ::
     "(('a failure set) * 'a set) => pttrn => 'i set
                      => ('i,'a) NetworkF"  ("(1{ _ | /_:_ }Fnet)" [77,900,90] 900)

translations
  "{ FX | i:I }Fnet"  == "(I, (%i. FX))"

(*** Network and NetworkF ***)

abbreviation
  Network_pro ::
     "('i set * ('i => ('b * 'a set))) => 'i => 'b"
                          ("netElement _<_>" [900,0] 1000)
where
  "netElement V<i> == fst ((snd V) i)"

abbreviation
  Network_alp ::
     "('i set * ('i => ('b * 'a set))) => 'i => 'a set"
                          ("netAlpha _<_>" [900,0] 1000)
where
  "netAlpha V<i>  == snd ((snd V) i)"

definition
  isFailureOf ::
   "('i,'a) NetworkF => ('i,'p,'a) Network => bool"
                                           ("(1_ /isFailureOf /_)" [55,55] 55)

  where
  isFailureOf_def :
   "VF isFailureOf V ==
        fst V = fst VF &
       (ALL i : fst VF.
                fst (snd VF i) <=EX failures (fst (snd V i)) MF
                                    restRefusal (Ev ` snd (snd VF i)) &
                snd (snd V i) = snd (snd VF i))"

(*** short notations ***)

definition
  ALP  :: "('i set * ('i => ('b * 'a set))) => 'a set"
  where
  ALP_def  : "ALP V == {a. EX i:(fst V). a : snd((snd V) i)}"

(*** state ***)

type_synonym ('i,'a) net_state = "('a trace * ('i => 'a event set))"

definition
  isStateOf ::
   "('i,'a) net_state => ('i,'a) NetworkF => bool"
                                           ("(1_ /isStateOf /_)" [55,55] 55)
  where
  isStateOf_def :
   "sigma isStateOf VF ==
     sett(fst sigma) <= Ev ` (ALP VF) &
    (ALL i: fst VF. (fst sigma rest-tr snd ((snd VF) i), (snd sigma) i)
                     : fst ((snd VF) i) &
                    (snd sigma) i <= Ev ` snd ((snd VF) i))"

(*********************************************************
                    small lemmas
 *********************************************************)

lemma decompo_V:
  "EX I PXf. (V::('i,'p,'a) Network) = (I,PXf)"
apply (rule_tac x="fst V" in exI)
apply (rule_tac x="snd V" in exI)
by (simp)

lemma isFailureOf_subset_index:
   "[| (I, FXf) isFailureOf (I, PXf) ; J <= I |]
    ==> (J, FXf) isFailureOf (J, PXf)"
apply (simp add: isFailureOf_def)
by (auto)

lemma isFailureOf_subset_alpha1:
   "[| (I, FXf) isFailureOf (I, PXf) ; i : I ; (s, Y) : fst (FXf i) ; e : Y |]
    ==> e : Ev ` snd (PXf i)"
apply (simp add: isFailureOf_def)
apply (drule_tac x="i" in bspec, simp)
apply (simp add: subseteqEX_def restRefusal_def)
apply (auto)
done

lemma isFailureOf_subset_alpha2:
   "[| (I, FXf) isFailureOf (I, PXf) ; i : I ; (s, Y) : fst (FXf i) ; e : Y |]
    ==> e : Ev ` snd (FXf i)"
apply (simp add: isFailureOf_def)
apply (drule_tac x="i" in bspec, simp)
apply (simp add: subseteqEX_def restRefusal_def)
apply (auto)
done

lemmas isFailureOf_subset_alpha = isFailureOf_subset_alpha1
                                  isFailureOf_subset_alpha2

lemma isFailureOf_not_Tick[simp]:
   "[| (I, FXf) isFailureOf (I, PXf) ; i : I ; (s, Y) : fst (FXf i) |]
    ==> Tick ~: Y"
apply (simp add: isFailureOf_def)
apply (drule_tac x="i" in bspec, simp)
apply (simp add: subseteqEX_def restRefusal_def)
apply (auto)
done

lemma isFailureOf_same_alpha:
   "(I, FXf) isFailureOf (I, PXf)
    ==> ALL i:I. snd (PXf i) = snd (FXf i)"
by (simp add: isFailureOf_def)

(*********************************************************
                 StateOf subset
 *********************************************************)

lemma isStateOf_subset_alpha1:
   "[| (I, FXf) isFailureOf (I, PXf) ;
       (t, Yf) isStateOf (I, FXf) ;
       i : I ; e : Yf i|]
    ==> e : (Ev ` (snd (PXf i)))"
apply (simp add: isStateOf_def)
apply (auto simp add: isFailureOf_same_alpha)
done

lemma isStateOf_subset_alpha2:
   "[| (I, FXf) isFailureOf (I, PXf) ;
       (t, Yf) isStateOf (I, FXf) ;
       i : I ; e : Yf i|]
    ==> e : (Ev ` (snd (FXf i)))"
apply (simp add: isStateOf_def)
apply (auto)
done

lemmas isStateOf_subset_alpha = isStateOf_subset_alpha1
                                isStateOf_subset_alpha2

lemma isStateOf_each_element:
   "[| (t, Yf) isStateOf (I, FXf) ; i : I |]
    ==> (t rest-tr snd (FXf i), Yf) isStateOf ({i}, FXf)"
apply (simp add: isStateOf_def)
apply (rule conjI)

 apply (simp add: ALP_def)
 apply (case_tac "Tick : sett t")
  apply (force)
  apply (subgoal_tac "sett (t rest-tr snd (FXf i)) <= sett (t rest-tr UNIV)")
  apply (case_tac "Tick : sett (t rest-tr snd (FXf i))", simp)

  apply (insert rest_tr_subset_event[of t "snd (FXf i)"])
  apply (blast)
  apply (rule rest_tr_sett_subseteq_sett)
  apply (simp)

apply (simp add: rest_tr_of_rest_tr_subset)
done

(*********************************************************
                        PAR
 *********************************************************)

(*---------------------------------*
 |           flattening            |
 *---------------------------------*)

(*** SF ***)

(* lemmas *)

lemma domSF_PAR_flattening_lm1:
   "ALP (V x) = Union (snd ` (%(i, j). snd (V j) i) ` {(i, x) |i. i : fst (V x)})"
by (auto simp add: ALP_def)

lemma domSF_PAR_flattening_lm2:
   "Union (snd ` (%i. ([||]:(fst (V i)) (snd (V i)), ALP (V i))) ` F) =
    Union (snd ` (%(i, j). snd (V j) i) ` {(i, j). j : F & i : fst (V j)})"
apply (auto simp add: ALP_def)
apply (rule_tac x="ia" in exI)
apply (rule_tac x="i" in exI)
apply (simp)
apply (rule_tac x="ba" in bexI)
apply (rule_tac x="aa" in bexI)
apply (simp_all)
done

(* main *)

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

lemma cspF_PAR_flattening:
   "[| finite J ; ALL j:J. finite (fst (V j)) |]
    ==> (PAR { (PAR (V j), ALP (V j)) | j:J }net) =F[M,M]
        (PAR { ((snd (V j)) i) | (i,j):{(i, j). j : J & i : fst (V j)}}net)"
(*
apply (induct set: Finites)     Isabelle 2005
*)
apply (induct set: finite)     (* Isabelle 2007 *)

(* base *)
apply (simp add: PAR_def)

(* step *)
apply (simp add: PAR_def)
apply (rule cspF_rw_left)
apply (rule cspF_Rep_parallel_induct)
apply (simp_all)

apply (rule cspF_rw_left)
apply (rule cspF_Alpha_parallel_cong)
apply (simp)
apply (simp)
apply (rule cspF_reflex)

apply (subgoal_tac
   "[||] i:F .. ([||]:(fst (V i)) (snd (V i)), ALP (V i))
  =F[M,M]
    [||] (i, j):{(i, j). j : F & i : (fst (V j))} .. (snd (V j)) i")
                                      (* ... sub 1 *)
apply (simp)
 (* sub 1 *)
 apply (simp add: eqF_semF[THEN sym])

apply (subgoal_tac
   "{(i, j). (j = x | j : F) & i : fst (V j)} =
    {(i,x) |i. i : fst (V x)} Un {(i, j). j : F & i : fst (V j)}")
                                      (* ... sub 2 *)
apply (simp)

apply (subgoal_tac "finite {(i, x)|i. i : fst (V x)}")
                                      (* ... sub 3 *)
apply (subgoal_tac "finite {(i, j). j : F & i : fst (V j)}")
                                      (* ... sub 4 *)
apply (rule cspF_rw_right)
apply (rule cspF_Rep_parallel_assoc)
apply (force)
apply (simp)+
apply (rule cspF_Alpha_parallel_cong)
apply (simp add: domSF_PAR_flattening_lm1)
apply (simp add: domSF_PAR_flattening_lm2)
apply (rule cspF_Rep_parallel_index_eq)
 apply (simp)
 apply (rule_tac x="(%i. (i, x))" in exI)
 apply (simp)
 apply (simp add: inj_on_def)
 apply (force)
 apply (simp)

(* sub 4 *)
apply (simp add: finite_pair_set)

(* sub 3 *)
apply (subgoal_tac "{(i, x) |i. i : fst (V x)} = (%i. (i,x)) ` (fst (V x))")
apply (force)
apply (force)

(* sub 2 *)
apply (force)
done

(*** T and F ***)

lemma traces_PAR_flattening:
   "[| finite J ; ALL j:J. finite (fst (V j)) |] ==>
       traces (PAR { (PAR (V j), ALP (V j)) | j:J }net) M =
       traces (PAR { ((snd (V j)) i) | (i,j):{(i, j). j : J & i : fst (V j)} }net) M"
apply (insert cspF_PAR_flattening[of J V "(%p. (M p,,maxFof (M p)))"])
apply (simp add: cspF_eqF_semantics)
apply (subgoal_tac "(fstF o (%p. (M p ,, maxFof (M p)))) = M")
apply (simp)
apply (simp add: fun_eq_iff)
apply (rule allI)
apply (simp add: maxFof_domF pairF_fstF)
done

lemma failures_PAR_flattening:
   "[| finite J ; ALL j:J. finite (fst (V j)) |] ==>
       failures (PAR { (PAR (V j), ALP (V j)) | j:J }net) M =
       failures (PAR { ((snd (V j)) i) | (i,j):{(i, j). j : J & i : fst (V j)} }net) M"
apply (insert cspF_PAR_flattening[of J V M])
apply (simp add: cspF_eqF_semantics)
done

(*********************************************************
                      sub network
 *********************************************************)

(*** state ***)

lemma isStateOf_subset:
  "[| (t,Yf) isStateOf (I,FXf) ; J <= I ;
      X = {sY. EX i:J. sY : snd (FXf i)} |]
  ==> (t rest-tr X, Yf) isStateOf (J, FXf)"
apply (simp add: isStateOf_def ALP_def)
apply (rule conjI)
apply (insert rest_tr_subset_event[of t "X"])
apply (subgoal_tac "Tick ~: sett (t rest-tr X)")
apply (blast)
apply (force)

apply (rule ballI)
apply (elim conjE)
apply (drule_tac x="i" in bspec, fast)

apply (subgoal_tac "snd (FXf i) <= {sY. EX i:J. sY : snd (FXf i)}")
apply (simp add: rest_tr_of_rest_tr_subset)
by (auto)

lemma isStateOf_subsetI:
  "[| (t,Yf) isStateOf (I,FXf) ;
      J <= I ; X = Union {(snd (FXf i))|i. i:J} |]
  ==> (t rest-tr X, Yf) isStateOf (J, FXf)"
apply (subgoal_tac "Union {(snd (FXf i))|i. i:J} = {sY. EX i:J. sY : snd (FXf i)}")
apply (simp add: isStateOf_subset)
by (auto)

(*********************************************************
                      isFailureOf
 *********************************************************)

lemma isFailureOf_largest:
   "{ ({(s,Y Int (Ev ` snd (PXf i)))|s Y.
        (s,Y) :f failures (fst (PXf i)) MF}, snd (PXf i)) | i:I }Fnet
     isFailureOf (I, PXf)"
apply (simp add: isFailureOf_def)
apply (simp add: subseteqEX_Int)
done

lemma isFailureOf_EX: "EX VF. VF isFailureOf V"
apply (rule_tac x=
  "{ ({(s,Y Int (Ev ` snd ((snd V) i))) |s Y.
        (s,Y) :f failures (fst ((snd V) i)) MF},
      snd ((snd V) i)) | i: fst V }Fnet" in exI)
apply (insert decompo_V[of V])
apply (elim exE)
apply (simp add: isFailureOf_largest)
done

(****************** to add it again ******************)

declare disj_not1   [simp]
(*
declare Union_image_eq [simp]
declare Inter_image_eq [simp]
*)

declare Sup_image_eq [simp]
declare Inf_image_eq [simp]

end


theory IDE_CP_App2
  imports Phi_Types
begin

section \<open>Value \& Its Settings\<close>

subsection \<open>Reasoning Rules\<close>

paragraph \<open>Implication\<close>

lemma Val_transformation [\<phi>reason]:
  \<open> y \<Ztypecolon> U \<i>\<m>\<p>\<l>\<i>\<e>\<s> x \<Ztypecolon> T \<a>\<n>\<d> P
\<Longrightarrow> y \<Ztypecolon> Val v U \<i>\<m>\<p>\<l>\<i>\<e>\<s> x \<Ztypecolon> Val v T \<a>\<n>\<d> P\<close>
  unfolding Imply_def by (simp add: \<phi>expns)

paragraph \<open>Action\<close>

lemma [\<phi>reason 1200]:
  \<open> y \<Ztypecolon> U \<i>\<m>\<p>\<l>\<i>\<e>\<s> x \<Ztypecolon> T \<a>\<n>\<d> P @action A
\<Longrightarrow> y \<Ztypecolon> Val v U \<i>\<m>\<p>\<l>\<i>\<e>\<s> x \<Ztypecolon> Val v T \<a>\<n>\<d> P @action \<A>_structural A\<close>
  unfolding Action_Tag_def using Val_transformation .

lemma [\<phi>reason 1200]:
  \<open> y \<Ztypecolon> U \<i>\<m>\<p>\<l>\<i>\<e>\<s> x \<Ztypecolon> T \<a>\<n>\<d> P @action to A
\<Longrightarrow> y \<Ztypecolon> Val v U \<i>\<m>\<p>\<l>\<i>\<e>\<s> x \<Ztypecolon> Val v T \<a>\<n>\<d> P @action to A\<close>
  unfolding Action_Tag_def using Val_transformation .

lemma [\<phi>reason 1200]:
  \<open> y \<Ztypecolon> U \<i>\<m>\<p>\<l>\<i>\<e>\<s> x \<Ztypecolon> T \<a>\<n>\<d> P @action as A
\<Longrightarrow> y \<Ztypecolon> Val v U \<i>\<m>\<p>\<l>\<i>\<e>\<s> x \<Ztypecolon> Val v T \<a>\<n>\<d> P @action as A\<close>
  unfolding Action_Tag_def using Val_transformation .

lemma [\<phi>reason 1200]:
  \<open> x \<Ztypecolon> T \<i>\<m>\<p>\<l>\<i>\<e>\<s> D \<a>\<n>\<d> P @action \<A>_destruct\<phi> T'
\<Longrightarrow> Rewrite_into_\<phi>Type D (y \<Ztypecolon> U)
\<Longrightarrow> x \<Ztypecolon> \<v>\<a>\<l>[v] T \<i>\<m>\<p>\<l>\<i>\<e>\<s> y \<Ztypecolon> \<v>\<a>\<l>[v] U \<a>\<n>\<d> P @action \<A>_destruct\<phi> T'\<close>
  unfolding Action_Tag_def Rewrite_into_\<phi>Type_def
  by (rule Val_transformation, simp)

paragraph \<open>Simplification\<close>

lemma [\<phi>programming_simps]:
    \<open>Val raw (ExTyp T) = (\<exists>\<phi> c. Val raw (T c))\<close>
  by (rule \<phi>Type_eqI) (simp add: \<phi>expns)

lemma [\<phi>programming_simps]:
    \<open>Val raw (T \<phi>\<s>\<u>\<b>\<j> P) = (Val raw T \<phi>\<s>\<u>\<b>\<j> P)\<close>
  by (rule \<phi>Type_eqI) (simp add: \<phi>expns)

lemma \<phi>Val_simp_cong[folded atomize_eq]:
  \<open> (x \<Ztypecolon> T) = (x' \<Ztypecolon> T')
\<Longrightarrow> (x \<Ztypecolon> Val v T) = (x' \<Ztypecolon> Val v T')\<close>
  unfolding set_eq_iff by (simp add: \<phi>expns)

simproc_setup Val_simp_cong ("x \<Ztypecolon> Val v T") = \<open>
  K (fn ctxt => Phi_SimpCong.simproc @{thm \<phi>Val_simp_cong} ctxt)
\<close>

subsection \<open>Application Methods for Transformations\<close>

(*TODO: I really don't like this. It is not generic.
It should be some generic structural morphism.*)

lemma [\<phi>reason 2100 for \<open>
  PROP \<phi>Application (Trueprop (?x \<Ztypecolon> ?T \<i>\<m>\<p>\<l>\<i>\<e>\<s> ?y \<Ztypecolon> ?U \<a>\<n>\<d> ?P))
          (Trueprop (\<c>\<u>\<r>\<r>\<e>\<n>\<t> ?blk [?RR] \<r>\<e>\<s>\<u>\<l>\<t>\<s> \<i>\<n> ?R\<heavy_comma> ?x \<Ztypecolon> Val ?raw ?T)) ?Result
\<close> except \<open>
  PROP \<phi>Application (Trueprop (?x \<Ztypecolon> Val ?raw ?T \<i>\<m>\<p>\<l>\<i>\<e>\<s> ?y \<Ztypecolon> ?U \<a>\<n>\<d> ?P))
          (Trueprop (\<c>\<u>\<r>\<r>\<e>\<n>\<t> ?blk [?RR] \<r>\<e>\<s>\<u>\<l>\<t>\<s> \<i>\<n> ?R)) ?Result
\<close>]:
  \<open> PROP \<phi>Application (Trueprop (x \<Ztypecolon> T \<i>\<m>\<p>\<l>\<i>\<e>\<s> y \<Ztypecolon> U \<a>\<n>\<d> P))
      (Trueprop (\<c>\<u>\<r>\<r>\<e>\<n>\<t> blk [RR] \<r>\<e>\<s>\<u>\<l>\<t>\<s> \<i>\<n> R\<heavy_comma> x \<Ztypecolon> Val raw T))
      (Trueprop ((\<c>\<u>\<r>\<r>\<e>\<n>\<t> blk [RR] \<r>\<e>\<s>\<u>\<l>\<t>\<s> \<i>\<n> R\<heavy_comma> y \<Ztypecolon> Val raw U) \<and> P))\<close>
  unfolding \<phi>Application_def
  using \<phi>apply_implication Val_transformation implies_left_prod by metis

lemma [\<phi>reason 2000 for \<open>
  PROP \<phi>Application (Trueprop (?x' \<Ztypecolon> ?T' \<i>\<m>\<p>\<l>\<i>\<e>\<s> ?y \<Ztypecolon> ?U \<a>\<n>\<d> ?P))
      (Trueprop (\<c>\<u>\<r>\<r>\<e>\<n>\<t> ?blk [?RR] \<r>\<e>\<s>\<u>\<l>\<t>\<s> \<i>\<n> ?R\<heavy_comma> ?x \<Ztypecolon> Val ?raw ?T)) ?Result
\<close> except \<open>
  PROP \<phi>Application (Trueprop (?x \<Ztypecolon> Val ?raw ?T \<i>\<m>\<p>\<l>\<i>\<e>\<s> ?y \<Ztypecolon> ?U \<a>\<n>\<d> ?P))
          (Trueprop (\<c>\<u>\<r>\<r>\<e>\<n>\<t> ?blk [?RR] \<r>\<e>\<s>\<u>\<l>\<t>\<s> \<i>\<n> ?R)) ?Result
\<close>]:
  \<open> SUBGOAL TOP_GOAL G
\<Longrightarrow> x \<Ztypecolon> T \<i>\<m>\<p>\<l>\<i>\<e>\<s> x' \<Ztypecolon> T' \<a>\<n>\<d> Any
\<Longrightarrow> SOLVE_SUBGOAL G
\<Longrightarrow> \<o>\<b>\<l>\<i>\<g>\<a>\<t>\<i>\<o>\<n> True
\<Longrightarrow> PROP \<phi>Application (Trueprop (x' \<Ztypecolon> T' \<i>\<m>\<p>\<l>\<i>\<e>\<s> y \<Ztypecolon> U \<a>\<n>\<d> P))
      (Trueprop (\<c>\<u>\<r>\<r>\<e>\<n>\<t> blk [RR] \<r>\<e>\<s>\<u>\<l>\<t>\<s> \<i>\<n> R\<heavy_comma> x \<Ztypecolon> Val raw T))
      (Trueprop ((\<c>\<u>\<r>\<r>\<e>\<n>\<t> blk [RR] \<r>\<e>\<s>\<u>\<l>\<t>\<s> \<i>\<n> R\<heavy_comma> y \<Ztypecolon> Val raw U) \<and> P))\<close>
  unfolding \<phi>Application_def
  by (meson Val_transformation \<phi>apply_implication implies_left_prod)

subsection \<open>Synthesis\<close>

lemma [\<phi>reason 1200 for
  \<open>Synthesis_Parse (?x \<Ztypecolon> (?T::?'a \<Rightarrow> VAL set)) (?X::?'ret \<Rightarrow> assn)\<close>
]:
  \<open>Synthesis_Parse (x \<Ztypecolon> T) (\<lambda>v. x \<Ztypecolon> Val v T)\<close>
  unfolding Synthesis_Parse_def ..

lemma [\<phi>reason 1200 for
  \<open>Synthesis_Parse (?raw::?'a \<phi>arg) (?X::?'ret \<Rightarrow> assn)\<close>
]:
  \<open>Synthesis_Parse raw (\<lambda>_. x \<Ztypecolon> Val raw T)\<close>
  unfolding Synthesis_Parse_def ..

(*
lemma [\<phi>reason 1200 for \<open>?S1 \<i>\<m>\<p>\<l>\<i>\<e>\<s> ?S2\<heavy_comma> SYNTHESIS ?x \<Ztypecolon> Val ?raw ?T\<close>]:
  \<open> \<phi>arg.dest raw \<in> (x \<Ztypecolon> T)
\<Longrightarrow> R \<i>\<m>\<p>\<l>\<i>\<e>\<s> R\<heavy_comma> SYNTHESIS x \<Ztypecolon> \<v>\<a>\<l>[raw] T\<close>
  unfolding Action_Tag_def
  by (cases raw; simp add: Val_expn implies_refl) *)

lemma [\<phi>reason 1200 for \<open>?S1 \<i>\<m>\<p>\<l>\<i>\<e>\<s> ?S2\<heavy_comma> \<blangle> ?x <val-of> (?raw::VAL \<phi>arg) \<Ztypecolon> ?T \<brangle> \<a>\<n>\<d> _\<close>]:
  \<open> \<phi>arg.dest raw \<in> (x \<Ztypecolon> T)
\<Longrightarrow> R \<i>\<m>\<p>\<l>\<i>\<e>\<s> R\<heavy_comma> \<blangle> x <val-of> raw \<Ztypecolon> \<v>\<a>\<l>[raw] T \<brangle>\<close>
  unfolding Action_Tag_def
  by (cases raw; simp add: Val_expn implies_refl)

lemma [\<phi>reason 1200 for
    \<open>\<p>\<r>\<o>\<c> ?GG \<lbrace> ?R \<longmapsto> \<lambda>ret. ?R' \<heavy_comma> \<blangle> ?x <val-of> (?raw::VAL \<phi>arg) \<Ztypecolon> ?T ret \<brangle> \<rbrace> \<t>\<h>\<r>\<o>\<w>\<s> ?E @action synthesis\<close>
]:
  \<open> \<phi>arg.dest raw \<in> (x \<Ztypecolon> T)
\<Longrightarrow> \<p>\<r>\<o>\<c> Return raw \<lbrace> R \<longmapsto> \<lambda>ret. R\<heavy_comma> \<blangle> x <val-of> raw \<Ztypecolon> \<v>\<a>\<l>[ret] T \<brangle> \<rbrace> @action synthesis\<close>
  unfolding Action_Tag_def
  by (cases raw; simp add: \<phi>M_Success)

lemma \<phi>arg_val_varify_type:
  \<open> \<phi>arg.dest raw \<in> (x  \<Ztypecolon> T)
\<Longrightarrow> x \<Ztypecolon> T \<i>\<m>\<p>\<l>\<i>\<e>\<s> x' \<Ztypecolon> T' \<a>\<n>\<d> Any
||| FAIL TEXT(\<open>Expect the value\<close> raw \<open>has spec\<close> (x' \<Ztypecolon> T') \<open>but is specified by\<close>
      (x \<Ztypecolon> T) \<open>actually, and the conversion fails.\<close>)
\<Longrightarrow> \<phi>arg.dest raw \<in> (x' \<Ztypecolon> T')\<close>
  unfolding Imply_def atomize_Branch by blast

lemma [\<phi>reason 1200 for
    \<open>?S1 \<i>\<m>\<p>\<l>\<i>\<e>\<s> ?S2\<heavy_comma> \<blangle> ?x <set-to> (?raw::VAL \<phi>arg) \<Ztypecolon> ?T \<brangle> \<a>\<n>\<d> _ \<close>
]:
  \<open> ERROR TEXT(\<open>Local value is immutable. Cannot assign to\<close> raw)
\<Longrightarrow> R \<i>\<m>\<p>\<l>\<i>\<e>\<s> R\<heavy_comma> \<blangle> x <set-to> (raw::VAL \<phi>arg) \<Ztypecolon> T \<brangle>\<close>
  by simp

lemma [OF \<phi>arg_val_varify_type,
       \<phi>reason 1500 for \<open>PROP Synthesis_by (?raw::VAL \<phi>arg) (Trueprop (\<p>\<r>\<o>\<c> ?f \<lbrace> ?R1 \<longmapsto> \<lambda>ret. ?R2\<heavy_comma> ?x \<Ztypecolon> Val ret ?T \<rbrace> \<t>\<h>\<r>\<o>\<w>\<s> ?E ))\<close>]:
  \<open> \<phi>arg.dest raw \<in> (x \<Ztypecolon> T)
\<Longrightarrow> PROP Synthesis_by raw (Trueprop (\<p>\<r>\<o>\<c> Return raw \<lbrace> R \<longmapsto> \<lambda>ret. R\<heavy_comma> x \<Ztypecolon> Val ret T \<rbrace>))\<close>
  unfolding Synthesis_by_def Action_Tag_def \<phi>Procedure_def Return_def det_lift_def
  by (cases raw; simp add: Val_expn)

subsection \<open>Assignment\<close>

typedecl valname

lemma [OF \<phi>arg_val_varify_type,
       \<phi>reason 1200 for \<open>?S1 \<i>\<m>\<p>\<l>\<i>\<e>\<s> ?S2\<heavy_comma> \<blangle> ?x <val-of> (?name::valname) \<Ztypecolon> ?T \<brangle> \<a>\<n>\<d> _ \<close>]:
  \<open> \<phi>arg.dest (raw <val-of> (name::valname)) \<in> (x \<Ztypecolon> T)
\<Longrightarrow> R \<i>\<m>\<p>\<l>\<i>\<e>\<s> R\<heavy_comma> \<blangle> x <val-of> name \<Ztypecolon> \<v>\<a>\<l>[raw] T \<brangle>\<close>
  unfolding Action_Tag_def
  by (cases raw; simp add: Val_expn)

lemma [OF \<phi>arg_val_varify_type,
       \<phi>reason 1200 for
    \<open>\<p>\<r>\<o>\<c> ?GG \<lbrace> ?R \<longmapsto> \<lambda>ret. ?R' \<heavy_comma> \<blangle> ?x <val-of> (?name::valname) \<Ztypecolon> ?T ret \<brangle> \<rbrace> \<t>\<h>\<r>\<o>\<w>\<s> ?E @action synthesis\<close>
]:
  \<open> \<phi>arg.dest (raw <val-of> (name::valname)) \<in> (x \<Ztypecolon> T)
\<Longrightarrow> \<p>\<r>\<o>\<c> Return raw \<lbrace> R \<longmapsto> \<lambda>ret. R\<heavy_comma> \<blangle> x <val-of> name \<Ztypecolon> \<v>\<a>\<l>[ret] T \<brangle> \<rbrace> @action synthesis\<close>
  unfolding Action_Tag_def
  by (cases raw; simp add: \<phi>M_Success)

lemma "__set_value_rule__":
  \<open> (\<phi>arg.dest (v <val-of> (name::valname)) \<in> (x \<Ztypecolon> T) \<Longrightarrow> \<p>\<r>\<o>\<c> F \<lbrace> R\<heavy_comma> \<blangle> X \<brangle> \<longmapsto> R' \<rbrace> \<t>\<h>\<r>\<o>\<w>\<s> E )
\<Longrightarrow> \<p>\<r>\<o>\<c> F \<lbrace> R\<heavy_comma> \<blangle> x \<Ztypecolon> \<v>\<a>\<l>[v] T\<heavy_comma> X \<brangle> \<longmapsto> R' \<rbrace> \<t>\<h>\<r>\<o>\<w>\<s> E \<close>
  unfolding \<phi>Procedure_def Value_of_def
  by (clarsimp simp add: \<phi>expns)

lemma "__fast_assign_val__":
  \<open> R\<heavy_comma> \<blangle> X \<brangle> \<i>\<m>\<p>\<l>\<i>\<e>\<s> R' \<a>\<n>\<d> P
\<Longrightarrow> R\<heavy_comma> \<blangle> x \<Ztypecolon> \<v>\<a>\<l>[v] T\<heavy_comma> X \<brangle> \<i>\<m>\<p>\<l>\<i>\<e>\<s> R' \<a>\<n>\<d> \<phi>arg.dest (v <val-of> (name::valname)) \<in> (x \<Ztypecolon> T) \<and> P\<close>
  unfolding Imply_def
  by (clarsimp simp add: Val_expn Subjection_expn)

lemma "__fast_assign_val_0__":
  \<open> R\<heavy_comma> \<blangle> Void \<brangle> \<i>\<m>\<p>\<l>\<i>\<e>\<s> R \<close>
  by (simp add: implies_refl)

ML_file \<open>library/additions/local_value.ML\<close>

(*subsection \<open>Deep Representation of Values\<close>

abbreviation Vals :: \<open>(VAL, 'a) \<phi> \<Rightarrow> (VAL list, 'a) \<phi>\<close> ("\<v>\<a>\<l>\<^bold>s _" [51] 50)
  where \<open>Vals \<equiv> List_Item\<close>

translations "(CONST Vals T) \<^emph> (CONST Vals U)" == "XCONST Vals (T \<^emph> U)"*)

subsection \<open>Prove Properties of Value Abstractions by Programming\<close>

subsubsection \<open>Semantic Type\<close>

lemma [\<phi>reason 1000]:
  \<open> PROP \<phi>Programming_Method (Trueprop (S \<i>\<m>\<p>\<l>\<i>\<e>\<s> Well_Type TY)) M D R F
\<Longrightarrow> Friendly_Help TEXT(\<open>Hi! You are trying to show the value abstraction\<close> S \<open>has semantic type\<close> TY
      \<open>Now you entered the programming mode and you need to transform the specification to\<close>
      \<open>some representation of \<phi>-types whose semantic type is know so that we can verify your claim.\<close>)
\<Longrightarrow> PROP \<phi>Programming_Method (Trueprop (\<phi>SemType S TY)) M D R F\<close>
  unfolding \<phi>Programming_Method_def  ToA_Construction_def \<phi>SemType_def Imply_def
  by (simp add: subset_iff)

lemma [\<phi>reason 1000]:
  \<open> \<phi>SemType S TY
\<Longrightarrow> S \<i>\<m>\<p>\<l>\<i>\<e>\<s> Well_Type TY\<close>
  unfolding Imply_def \<phi>SemType_def subset_iff by blast

subsubsection \<open>Zero Value\<close>

consts working_mode_\<phi>Zero :: working_mode

lemma \<phi>deduce_zero_value:
  \<open> \<phi>SemType (x \<Ztypecolon> T) TY
\<Longrightarrow> \<p>\<a>\<r>\<a>\<m> (y \<Ztypecolon> U)
\<Longrightarrow> \<phi>Zero TY U y
\<Longrightarrow> y \<Ztypecolon> U \<i>\<m>\<p>\<l>\<i>\<e>\<s> x \<Ztypecolon> T
\<Longrightarrow> \<o>\<b>\<l>\<i>\<g>\<a>\<t>\<i>\<o>\<n> True
\<Longrightarrow> \<phi>Zero TY T x\<close>
  unfolding ToA_Construction_def \<phi>Zero_def image_iff Inhabited_def Imply_def
  by (simp, blast)

lemma [\<phi>reason 1000]:
  \<open> PROP \<phi>Programming_Method (Trueprop (\<phi>Zero TY T x)) working_mode_\<phi>Zero
                             (Trueprop (\<phi>Zero TY T x))
                             (Trueprop True)
                             (Trueprop True)\<close>
  unfolding \<phi>Programming_Method_def .

subsubsection \<open>Equality\<close>

lemma [\<phi>reason 1000]:
  \<open> PROP \<phi>Programming_Method
          (\<And>x y vx vy. \<p>\<r>\<e>\<m>\<i>\<s>\<e> ceq x y
              \<Longrightarrow> x \<Ztypecolon> \<v>\<a>\<l>[vx] T \<heavy_comma> y \<Ztypecolon> \<v>\<a>\<l>[vy] T \<i>\<m>\<p>\<l>\<i>\<e>\<s> x' \<Ztypecolon> \<v>\<a>\<l>[vx] U \<heavy_comma> y' \<Ztypecolon> \<v>\<a>\<l>[vy] U
                  \<s>\<u>\<b>\<j> U x' y'. Embedded_Reasoning (\<phi>Equal U ceq' eq') \<and> ceq' x' y' \<and> eq x y = eq' x' y')
          M D R F
\<Longrightarrow> Friendly_Help
    TEXT(\<open>Hi! Transform the specification to some representation of \<phi>-types whose\<close> \<phi>Equal
         \<open>property is known so that we can generate proof obligations for your claim.\<close>)
\<Longrightarrow> PROP \<phi>Programming_Method (Trueprop (\<phi>Equal T ceq eq)) M D R F\<close>
  (is \<open>PROP \<phi>Programming_Method (PROP ?IMP) _ _ _ _ \<Longrightarrow> PROP _\<close>
   is \<open>PROP ?PPP \<Longrightarrow> PROP _\<close>)
  unfolding \<phi>Programming_Method_def conjunction_imp
proof -
  have rule: \<open>PROP ?IMP \<Longrightarrow> \<phi>Equal T ceq eq\<close>
  unfolding \<phi>Equal_def Premise_def Imply_def Embedded_Reasoning_def
  by (clarsimp simp add: \<phi>expns \<phi>arg_All, blast)

  assume D: \<open>PROP D\<close>
    and  R: \<open>PROP R\<close>
    and  F: \<open>PROP F\<close>
    and PP: \<open>PROP D \<Longrightarrow> PROP R \<Longrightarrow> PROP F \<Longrightarrow> PROP ?IMP\<close>
  show \<open>\<phi>Equal T ceq eq\<close>
    using PP[OF D R F, THEN rule] .
qed

subsubsection \<open>Finale\<close>

ML_file \<open>library/additions/value_properties.ML\<close>

hide_fact \<phi>deduce_zero_value

(*
TODO: fix this feature
subsubsection \<open>Auto unfolding for value list\<close>

lemma [\<phi>programming_simps]:
  \<open>(\<exists>*x. x \<Ztypecolon> Val rawv Empty_List) = (1 \<s>\<u>\<b>\<j> USELESS (rawv = \<phi>V_nil))\<close>
  unfolding set_eq_iff USELESS_def
  by (cases rawv; simp add: \<phi>expns)

lemma [\<phi>programming_simps]:
  \<open>(\<exists>*x. x \<Ztypecolon> Val rawv (List_Item T))
 = (\<exists>*x. x \<Ztypecolon> Val (\<phi>V_hd rawv) T \<s>\<u>\<b>\<j> USELESS (\<exists>v. rawv = \<phi>V_cons v \<phi>V_nil))\<close>
  unfolding set_eq_iff \<phi>V_cons_def USELESS_def
  apply (cases rawv; clarsimp simp add: \<phi>expns \<phi>V_tl_def \<phi>V_hd_def times_list_def; rule;
          clarsimp simp add: \<phi>arg_All \<phi>arg_exists)
  by blast+

lemma [simp]:
  \<open>[] \<notin> (\<exists>*x. x \<Ztypecolon> (List_Item T \<^emph> L))\<close>
  by (rule; clarsimp simp add: \<phi>expns times_list_def)

lemma [simp]:
  \<open>[] \<notin> (\<exists>*x. x \<Ztypecolon> List_Item T)\<close>
  by (rule; clarsimp simp add: \<phi>expns times_list_def)
*)

end