section "Executable Instance Relations"

theory Instances
  imports Term
begin

(*
  Executable versions for the following definitions

  Do by computing such a \<rho>

  First using partial functions, then with alists

  definition "tinstT T1 T2 \<equiv> \<exists>\<rho>. tsubstT T2 \<rho> = T1"
  definition "tinst t1 t2 \<equiv> \<exists>\<rho>. tsubst t2 \<rho> = t1"
  definition "inst t1 t2 \<equiv> \<exists>\<rho>. subst t2 \<rho> = t1"
*)

(* Straight forward code translation from ML code in distribution *)
fun raw_match :: "typ \<Rightarrow> typ \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) option"
  and raw_matches :: "typ list \<Rightarrow> typ list \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) option"
  where
  "raw_match (Tv v S) T subs =
    (case subs (v,S) of
      None \<Rightarrow> Some (subs((v,S) := Some T))
    | Some U \<Rightarrow> (if U = T then Some subs else None))"
| "raw_match (Ty a Ts) (Ty b Us) subs =
    (if a=b then raw_matches Ts Us subs else None)"
| "raw_match _ _ _ = None"
| "raw_matches (T#Ts) (U#Us) subs = Option.bind (raw_match T U subs) (raw_matches Ts Us)"
| "raw_matches [] [] subs = Some subs"
| "raw_matches _ _ subs = None"

(* Probably easier to use *)
function (sequential) raw_match'
  :: "typ \<Rightarrow> typ \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) option" where
  "raw_match' (Tv v S) T subs =
    (case subs (v,S) of
      None \<Rightarrow> Some (subs((v,S) := Some T))
    | Some U \<Rightarrow> (if U = T then Some subs else None))"
| "raw_match' (Ty a Ts) (Ty b Us) subs =
    (if a=b \<and> length Ts = length Us
      then fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip Ts Us) (Some subs)
      else None)"
| "raw_match' T U subs = (if T = U then Some subs else None)"
  by pat_completeness auto
termination proof (relation "measure (\<lambda>(T, U, subs) . size T + size U)", goal_cases)
  case 1
  then show ?case
    by auto
next
  case (2 a Ts b Us subs x xa y xb aa)
  hence "length Ts = length Us" "a=b"
    by auto
  from this 2(2-) show ?case
    by (induction Ts Us rule: list_induct2) auto
qed

lemma length_neq_imp_not_raw_matches: "length Ts \<noteq> length Us \<Longrightarrow> raw_matches Ts Us subs = None"
  by (induction Ts Us subs rule: raw_match_raw_matches.induct(2) [where P = "\<lambda>T U subs . True"])
    (auto cong: Option.bind_cong)

(* Making sure I did not mess up my version of the definition *)
lemma "raw_match T U subs = raw_match' T U subs"
proof (induction T U subs rule: raw_match_raw_matches.induct(1)
      [where Q = "\<lambda>Ts Us subs . raw_matches Ts Us subs
        = (if length Ts = length Us
      then fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip Ts Us) (Some subs)
      else None)"])
  case (4 T Ts U Us subs)
  then show ?case
  proof (cases "raw_match T U subs")
    case None
    then show ?thesis
    proof (cases "length Ts = length Us")
      case True
      then show ?thesis using 4 None by (induction Ts Us rule: list_induct2) auto
    next
      case False
      then show ?thesis using 4 None length_neq_imp_not_raw_matches by auto
    qed
  next
    case (Some a)
    then show ?thesis using 4 by auto
  qed
qed simp_all

lemma raw_match'_map_le: "raw_match' T U subs = Some subs' \<Longrightarrow> map_le subs subs'"
proof (induction T U subs arbitrary: subs' rule: raw_match'.induct)
  case (2 a Ts b Us subs)
  have "length Ts = length Us"
    using "2.prems" by (auto split: if_splits)
  moreover have I: "(a,b) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' a b subs = Some subs' \<Longrightarrow> subs \<subseteq>\<^sub>m subs'"
      for a b subs subs'
    using "2.prems" by (auto split: if_splits intro: "2.IH")
  ultimately show ?case using "2.prems"
  proof (induction Ts Us arbitrary: subs subs' rule: rev_induct2)
    case Nil
    then show ?case
      by (auto split: if_splits)
  next
    case (snoc x xs y ys)
    then show ?case
      using map_le_trans by (fastforce split: if_splits prod.splits simp add: bind_eq_Some_conv)
  qed
qed (auto simp add: map_le_def split: if_splits option.splits)

(* Specializing for raw_match' *)
lemma fold_matches_first_step_not_None:
  assumes
    "fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip (x#xs) (y#ys)) (Some subs) = Some subs'"
  obtains point where
    "raw_match' x y subs = Some point"
    "fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip (xs) (ys)) (Some point) = Some subs'"
  using fold_matches_first_step_not_None assms .
lemma fold_matches_last_step_not_None:
  assumes
    "length xs = length ys"
    "fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip (xs@[x]) (ys@[y])) (Some subs) = Some subs'"
  obtains point where
    "fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip (xs) (ys)) (Some subs) = Some point"
    "raw_match' x y point = Some subs'"
  using fold_matches_last_step_not_None assms .

corollary raw_match'_Type_conds:
  assumes "raw_match' (Ty a Ts) (Ty b Us) subs = Some subs'"
  shows "a=b" "length Ts = length Us"
  using assms by (auto split: if_splits)

corollary fold_matches_first_step_not_None':
  assumes "length xs = length ys"
    "fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip (x#xs) (y#ys)) (Some subs) = Some subs'"
  shows "raw_match' x y subs ~= None"
  using assms fold_matches_first_step_not_None
  by (metis option.discI)

corollary raw_match'_hd_raw_match':
  assumes "raw_match' (Ty a (T#Ts)) (Ty b (U#Us)) subs = Some subs'"
  shows "raw_match' T U subs ~= None"
  using assms fold_matches_first_step_not_None' raw_match'_Type_conds
  by (metis (no_types, lifting) length_Cons nat.simps(1) raw_match'.simps(2))

corollary raw_match'_eq_Some_at_point_not_None':
  assumes "length Ts = length Us"
  assumes "raw_match' (Ty a (Ts@Ts')) (Ty b (Us@Us')) subs = Some subs'"
  shows "raw_match' (Ty a (Ts)) (Ty b (Us)) subs ~= None"
  using assms fold_Option_bind_eq_Some_at_point_not_None' by (fastforce split: if_splits)

(* I should have defined a custom induction rule here, instead I copied the structure of the proof
  each time... Clean up when time
*)

lemma raw_match'_tvsT_subset_dom_res: "raw_match' T U subs = Some subs' \<Longrightarrow> tvsT T \<subseteq> dom subs'"
proof (induction T U subs arbitrary: subs' rule: raw_match'.induct)
  case (2 a Ts b Us subs)
  have l: "length Ts = length Us" "a = b" using 2
    by (metis option.discI raw_match'.simps(2))+

  from this 2 have better_IH:
    "(x, y) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' x y subs = Some subs' \<Longrightarrow> tvsT x \<subseteq> dom subs'"
    for x y subs subs' by simp
  from l "2.prems" better_IH show ?case
  proof (induction Ts Us arbitrary: a b subs subs' rule: list_induct2)
    case Nil
    then show ?case by simp
  next
    case (Cons x xs y ys)
    obtain point where point: "raw_match' x y subs = Some point"
      and rest: "raw_match' (Ty a xs) (Ty b ys) point = Some subs'"
      by (metis (no_types, lifting) Cons.hyps Cons.prems(1) Cons.prems(2) fold_matches_first_step_not_None
          raw_match'.simps(2) raw_match'_Type_conds(2))

    have "tvsT (Ty a xs) \<subseteq> dom subs'"
      apply (rule Cons.IH[of _ b point])
      using Cons.prems rest apply blast+
      by (metis Cons.prems(3) list.set_intros(2) zip_Cons_Cons)
    moreover have "tvsT x \<subseteq> dom point"
      by (metis Cons.prems(3) list.set_intros(1) point zip_Cons_Cons)
    moreover have "dom point \<subseteq> dom subs'"
      using map_le_implies_dom_le raw_match'_map_le rest by blast
    ultimately show ?case
      by auto
  qed
qed (auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)

lemma raw_match'_dom_res_subset_tvsT:
  "raw_match' T U subs = Some subs' \<Longrightarrow> dom subs' \<subseteq> tvsT T \<union> dom subs"
proof (induction T U subs arbitrary: subs' rule: raw_match'.induct)
  case (2 a Ts b Us subs)
  have l: "length Ts = length Us" "a = b" using 2
    by (metis option.discI raw_match'.simps(2))+

  from this 2 have better_IH:
    "(x, y) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' x y subs = Some subs'
      \<Longrightarrow> dom subs' \<subseteq> tvsT x \<union> dom subs"
    for x y subs subs' by blast
  from l "2.prems" better_IH show ?case
  proof (induction Ts Us arbitrary: a b subs subs' rule: list_induct2)
    case Nil
    then show ?case by simp
  next
    case (Cons x xs y ys)
    obtain point where first: "raw_match' x y subs = Some point"
      and rest: "raw_match' (Ty a xs) (Ty b ys) point = Some subs'"
      by (metis (no_types, lifting) Cons.hyps Cons.prems(1) Cons.prems(2) fold_matches_first_step_not_None raw_match'.simps(2) raw_match'_Type_conds(2))

    from first have "dom point \<subseteq> tvsT x \<union> dom subs"
      using Cons.prems(3) by fastforce
    moreover have "dom subs' \<subseteq> tvsT (Ty a xs) \<union> dom point"
      apply (rule Cons.IH)
      using Cons.prems(1) apply simp
      using Cons.prems(2) rest apply simp
      by (metis Cons.prems(3) list.set_intros(2) zip_Cons_Cons)

    ultimately show ?case using Cons.prems in_mono
      apply (clarsimp split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv domIff)
      by (smt UN_iff Un_iff domIff in_mono option.distinct(1))
      (*by fastforce, but too slow, check later *)
  qed
qed (auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)

corollary raw_match'_dom_res_eq_tvsT:
  "raw_match' T U subs = Some subs' \<Longrightarrow> dom subs' = tvsT T \<union> dom subs"
  by (simp add: map_le_implies_dom_le raw_match'_tvsT_subset_dom_res
      raw_match'_dom_res_subset_tvsT raw_match'_map_le subset_antisym)

corollary raw_match'_dom_res_eq_tvsT_empty:
  "raw_match' T U (\<lambda>x. None) = Some subs' \<Longrightarrow> dom subs' = tvsT T"
  using raw_match'_dom_res_eq_tvsT by simp

lemma raw_match'_map_defined: "raw_match' T U subs = Some subs' \<Longrightarrow> p\<in>tvsT T \<Longrightarrow> subs' p ~= None"
  using raw_match'_dom_res_eq_tvsT by blast

lemma raw_match'_extend_map_preserve:
  "raw_match' T U subs = Some subs' \<Longrightarrow> map_le subs' subs'' \<Longrightarrow> p\<in>tvsT T \<Longrightarrow> subs'' p = subs' p"
  using raw_match'_dom_res_eq_tvsT domIff map_le_implies_dom_le
  by (simp add: map_le_def)

abbreviation "convert_subs subs \<equiv> (\<lambda>v S . the_default (Tv v S) (subs (v, S)))"

lemma map_eq_on_tvsT_imp_map_eq_on_typ:
  "(\<And>p . p\<in>tvsT T \<Longrightarrow> subs p = subs' p)
  \<Longrightarrow> tsubstT T (convert_subs subs)
    = tsubstT T (convert_subs subs')"
  by (induction T) auto

lemma raw_match'_extend_map_preserve':
  assumes "raw_match' T U subs = Some subs'" "map_le subs' subs''"
  shows "tsubstT T (convert_subs subs')
    = tsubstT T (convert_subs subs'')"
  apply (rule map_eq_on_tvsT_imp_map_eq_on_typ)
  using raw_match'_extend_map_preserve assms by metis

lemma raw_match'_produces_matcher:
  "raw_match' T U subs = Some subs'
    \<Longrightarrow> tsubstT T (convert_subs subs') = U"
proof (induction T U subs arbitrary: subs' rule: raw_match'.induct)
  case (2 a Ts b Us subs)
  hence l: "length Ts = length Us" "a=b" by (simp_all split: if_splits)
  from this 2 have better_IH:
    "(x, y) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' x y subs = Some subs'
    \<Longrightarrow> tsubstT x (convert_subs subs') = y"
    for x y subs subs' by simp
  from l better_IH show ?case using 2
  proof(induction Ts Us arbitrary: subs subs' rule: list_induct2)
    case Nil
    then show ?case by simp
  next
    case (Cons x xs y ys)
    obtain point where first: "raw_match' x y subs = Some point"
      and rest: "raw_match' (Ty a xs) (Ty b ys) point = Some subs'"
      by (metis (no_types, lifting) Cons.hyps Cons.prems(4) fold_matches_first_step_not_None l(2) length_Cons raw_match'.simps(2))

    have "tsubstT x (convert_subs point) = y"
      using Cons.prems(2) first by auto
    moreover have "map_le point subs'"
      using raw_match'_map_le rest by blast
    ultimately have subs'_hd: "tsubstT x (convert_subs subs') = y"
      using raw_match'_extend_map_preserve' first by simp

    show ?case using Cons by (auto simp add: bind_eq_Some_conv subs'_hd first)
  qed
qed (auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)

lemma tsubstT_matcher_imp_raw_match'_unchanged:
  "tsubstT T \<rho> = U \<Longrightarrow> raw_match' T U (\<lambda>(idx, S). Some (\<rho> idx S)) = Some (\<lambda>(idx, S). Some (\<rho> idx S))"
proof (induction T arbitrary: U \<rho>)
  case (Ty a Ts)
  then show ?case
  proof (induction Ts arbitrary: U)
    case Nil
    then show ?case by auto
  next
    case (Cons T Ts)
    then show ?case
      by auto
  qed
qed auto

lemma raw_match'_imp_raw_match'_on_map_le:
  assumes "raw_match' T U subs = Some subs'"
  assumes "map_le lesubs subs"
  shows "\<exists>lesubs'. raw_match' T U lesubs = Some lesubs' \<and> map_le lesubs' subs'"
  using assms proof (induction T U subs arbitrary: lesubs subs' rule: raw_match'.induct)
  case (1 v S T subs lesubs subs')
  then show ?case
    by (force split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv map_le_def
        intro!: domI)
next
  case (2 a Ts b Us subs)
  hence l: "length Ts = length Us" "a=b" by (simp_all split: if_splits)
  from this 2 have better_IH:
    "(x, y) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' x y subs = Some subs'
    \<Longrightarrow> lesubs \<subseteq>\<^sub>m subs \<Longrightarrow> \<exists>lesubs'. raw_match' x y lesubs = Some lesubs' \<and> lesubs' \<subseteq>\<^sub>m subs'"
    for x y subs lesubs subs' by simp
  from l better_IH show ?case using 2
  proof(induction Ts Us arbitrary: subs lesubs subs' rule: list_induct2)
    case Nil
    then show ?case by simp
  next
    case (Cons x xs y ys)
    obtain point where first: "raw_match' x y subs = Some point"
      and rest: "raw_match' (Ty a xs) (Ty b ys) point = Some subs'"
      by (metis (no_types, lifting) Cons.hyps Cons.prems(4) fold_matches_first_step_not_None l(2) length_Cons raw_match'.simps(2))

    have "\<exists>lepoint. raw_match' x y lesubs = Some lepoint \<and> lepoint \<subseteq>\<^sub>m point"
      using Cons first by auto
    from this obtain lepoint where
        comp_lepoint: "raw_match' x y lesubs = Some lepoint" and le_lepoint: "lepoint \<subseteq>\<^sub>m point"
      by auto

    have "\<exists>lesubs'. raw_match' (Ty a xs) (Ty b ys) lepoint = Some lesubs' \<and> lesubs' \<subseteq>\<^sub>m subs'"
      using Cons rest le_lepoint by auto
    from this obtain lesubs' where
        comp_lesubs': "raw_match' (Ty a xs) (Ty b ys) lepoint = Some lesubs'"
        and le_lesubs': "lesubs' \<subseteq>\<^sub>m subs'"
      by auto

    show ?case using Cons.prems Cons.hyps comp_lepoint comp_lesubs' le_lesubs' by auto
  qed
qed (auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)

lemma map_le_same_dom_imp_same_map: "dom f = dom g \<Longrightarrow> map_le f g \<Longrightarrow> f = g"
  by (simp add: map_le_antisym map_le_def)

corollary map_le_produces_same_raw_match':
  assumes "raw_match' T U subs = Some subs'"
  assumes "dom subs \<subseteq> tvsT T"
  assumes "map_le lesubs subs"
  shows "raw_match' T U lesubs = Some subs'"
proof-
  have "dom subs' = tvsT T"
    using assms(1) assms(2) raw_match'_dom_res_eq_tvsT by auto
  moreover obtain lesubs' where "raw_match' T U lesubs = Some lesubs'" "map_le lesubs' subs'"
    using raw_match'_imp_raw_match'_on_map_le assms(1) assms(3) by blast
  moreover hence "dom lesubs' = tvsT T"
    using \<open>dom subs' = tvsT T\<close> map_le_implies_dom_le raw_match'_tvsT_subset_dom_res by fastforce

  ultimately show ?thesis using map_le_same_dom_imp_same_map by metis
qed

corollary "raw_match' T U subs = Some subs' \<Longrightarrow> dom subs \<subseteq> tvsT T \<Longrightarrow>
  raw_match' T U (\<lambda>p . None) = Some subs'"
  using map_le_empty map_le_produces_same_raw_match' by blast

lemma raw_match'_restriction:
  assumes "raw_match' T U subs = Some subs'"
  assumes " tvsT T \<subseteq> restriction "
  shows "raw_match' T U (subs|`restriction) = Some (subs'|`restriction)"
using assms proof (induction T U subs arbitrary: restriction subs' rule: raw_match'.induct)
  case (1 v S T subs)
  then show ?case
    apply simp
    by (smt fun_upd_restrict_conv option.case_eq_if option.discI option.sel restrict_fun_upd)
next
  case (2 a Ts b Us subs)
  hence l: "length Ts = length Us" "a=b" by (simp_all split: if_splits)
  from this 2 have better_IH:
    "(x, y) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' x y subs = Some subs' \<Longrightarrow> tvsT x \<subseteq> restriction
    \<Longrightarrow> raw_match' x y (subs |` restriction) = Some (subs' |` restriction)"
    for x y subs restriction subs' by simp
  from l better_IH show ?case using 2
  proof(induction Ts Us arbitrary: subs subs' rule: list_induct2)
    case Nil
    then show ?case by simp
  next
    case (Cons x xs y ys)
    obtain point where first: "raw_match' x y subs = Some point"
      and rest: "raw_match' (Ty a xs) (Ty b ys) point = Some subs'"
      by (metis (no_types, lifting) Cons.hyps Cons.prems(4) fold_matches_first_step_not_None l(2)
          length_Cons raw_match'.simps(2))

    have "raw_match' x y (subs |` restriction)
      = Some (point |` restriction)"
      using Cons first by simp

    moreover have "raw_match' (Ty a xs) (Ty b ys) (point |` restriction)
      = Some (subs' |` restriction)"
      using Cons rest by simp

     ultimately show ?case by (simp split: if_splits)
  qed
qed (auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)

corollary raw_match'_restriction_on_tvsT:
  assumes "raw_match' T U subs = Some subs'"
  shows "raw_match' T U (subs|`tvsT T) = Some (subs'|`tvsT T)"
  using raw_match'_restriction assms by simp

lemma tinstT_imp_ex_raw_match':
  assumes "tinstT T1 T2"
  shows "\<exists>subs. raw_match' T2 T1 (\<lambda>p . None) = Some subs"
proof-
  obtain \<rho> where "tsubstT T2 \<rho> = T1" using assms tinstT_def by auto
  hence "raw_match' T2 T1 (\<lambda>(idx, S). Some (\<rho> idx S)) = Some (\<lambda>(idx, S). Some (\<rho> idx S))"
    using tsubstT_matcher_imp_raw_match'_unchanged by auto

  hence "raw_match' T2 T1 ((\<lambda>(idx, S). Some (\<rho> idx S))|`tvsT T2)
    = Some ((\<lambda>(idx, S). Some (\<rho> idx S))|`tvsT T2)"
    using raw_match'_restriction_on_tvsT by simp
  moreover have "dom ((\<lambda>(idx, S). Some (\<rho> idx S))|`tvsT T2) = tvsT T2" by auto
  ultimately show ?thesis using map_le_produces_same_raw_match'
    using map_le_empty by blast
qed

lemma ex_raw_match'_imp_tinstT:
  assumes "\<exists>subs. raw_match' T2 T1 (\<lambda>p . None) = Some subs"
  shows "tinstT T1 T2"
proof-
  obtain subs where "raw_match' T2 T1 (\<lambda>p . None) = Some subs"
    using assms by auto
  hence "tsubstT T2 (convert_subs subs) = T1"
    using raw_match'_produces_matcher by blast
  thus ?thesis unfolding tinstT_def by fast
qed

corollary tinstT_iff_ex_raw_match':
  "tinstT T1 T2 \<longleftrightarrow> (\<exists>subs. raw_match' T2 T1 (\<lambda>p . None) = Some subs)"
  using ex_raw_match'_imp_tinstT tinstT_imp_ex_raw_match' by blast

function (sequential) raw_match_term
  :: "term \<Rightarrow> term \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) option"
  where
  "raw_match_term (Ct a T) (Ct b U) subs = (if a = b then raw_match' T U subs else None)"
| "raw_match_term (Fv a T) (Fv b U) subs = (if a = b then raw_match' T U subs else None)"
| "raw_match_term (Bv i) (Bv j) subs = (if i = j then Some subs else None)"
| "raw_match_term (Abs T t) (Abs U u) subs =
    Option.bind (raw_match' T U subs) (raw_match_term t u)"
| "raw_match_term (f $ u) (f' $ u') subs = Option.bind (raw_match_term f f' subs) (raw_match_term u u')"
| "raw_match_term _ _ _ = None"
  by pat_completeness auto
termination by size_change

lemma raw_match_term_map_le: "raw_match_term t u subs = Some subs' \<Longrightarrow> map_le subs subs'"
  by (induction t u subs arbitrary: subs' rule: raw_match_term.induct)
    (auto split: if_splits prod.splits intro: map_le_trans raw_match'_map_le simp add: bind_eq_Some_conv)

lemma raw_match_term_tvs_subset_dom_res:
  "raw_match_term t u subs = Some subs' \<Longrightarrow> tvs t \<subseteq> dom subs'"
proof (induction t u subs arbitrary: subs' rule: raw_match_term.induct)
  case (4 T t U u subs)
  from this obtain bsubs where bsubs: "raw_match' T U subs = Some bsubs"
    by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
  moreover hence body: "raw_match_term t u bsubs = Some subs'"
    using "4.prems" by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)

  ultimately have 1: "tvs t \<subseteq> dom subs'"
    using 4 by fastforce

  from bsubs have "tvsT T \<subseteq> dom bsubs"
    using raw_match'_tvsT_subset_dom_res by auto

  moreover have "bsubs \<subseteq>\<^sub>m subs'" using raw_match_term_map_le body by blast

  ultimately have 2: "tvsT T \<subseteq> dom subs'"
    using map_le_implies_dom_le by blast
  then show ?case
    using "4.prems" 1 2 by (simp split: if_splits)
next
  case (5 f u f' u' subs)
  from this obtain fsubs where f: "raw_match_term f f' subs = Some fsubs"
    by (auto simp add: bind_eq_Some_conv)
  hence u: "raw_match_term u u' fsubs = Some subs'"
    using "5.prems" by auto

  have 1: "tvs u \<subseteq> dom subs'"
    using f u "5.IH" by auto

  have "tvs f \<subseteq> dom fsubs"
    using 5 f by simp
  moreover have "fsubs \<subseteq>\<^sub>m subs'" using raw_match_term_map_le u by blast
  ultimately have 2: "tvs f \<subseteq> dom subs'"
    using map_le_implies_dom_le by blast

  then show ?case using 1 by simp
qed (use raw_match'_tvsT_subset_dom_res in \<open>auto split: option.splits if_splits prod.splits\<close>)

lemma raw_match_term_dom_res_subset_tvs:
  "raw_match_term t u subs = Some subs' \<Longrightarrow> dom subs' \<subseteq> tvs t \<union> dom subs"
proof (induction t u subs arbitrary: subs' rule: raw_match_term.induct)
  case (4 T t U u subs)
  from this obtain bsubs where bsubs: "raw_match' T U subs = Some bsubs"
    by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
  moreover hence body: "raw_match_term t u bsubs = Some subs'"
    using "4.prems" by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)

  ultimately have 1: "dom subs' \<subseteq> tvs t \<union> dom bsubs"
    using 4 by fastforce

  from bsubs have "dom bsubs \<subseteq> tvsT T \<union> dom bsubs"
    using raw_match'_dom_res_subset_tvsT by auto

  moreover have "subs \<subseteq>\<^sub>m bsubs" using bsubs raw_match'_map_le by blast

  ultimately have 2: "dom bsubs \<subseteq> tvsT T \<union> dom subs"
    using bsubs raw_match'_dom_res_subset_tvsT by auto
  then show ?case
    using "4.prems" 1 2 by (auto split: if_splits)
next
  case (5 f u f' u' subs)
  from this obtain fsubs where f: "raw_match_term f f' subs = Some fsubs"
    by (auto simp add: bind_eq_Some_conv)
  hence u: "raw_match_term u u' fsubs = Some subs'"
    using "5.prems" by auto

  have 1: "dom fsubs \<subseteq> tvs f \<union> dom subs"
    using 5 f u by simp

  have "dom subs' \<subseteq> tvs u \<union> dom fsubs"
    using 5 f by simp
  moreover have "fsubs \<subseteq>\<^sub>m subs'" using raw_match_term_map_le u by blast
  ultimately have 2: "dom subs' \<subseteq> tvs f \<union> tvs u \<union> dom subs"
    by (smt "1" Un_commute inf_sup_aci(6) subset_Un_eq)
  then show ?case using 1 by simp
qed (use raw_match'_dom_res_subset_tvsT in \<open>auto split: option.splits if_splits prod.splits\<close>)

corollary raw_match_term_dom_res_eq_tvs:
  "raw_match_term t u subs = Some subs' \<Longrightarrow> dom subs' = tvs t \<union> dom subs"
  by (simp add: map_le_implies_dom_le raw_match_term_tvs_subset_dom_res
      raw_match_term_dom_res_subset_tvs raw_match_term_map_le subset_antisym)

lemma raw_match_term_extend_map_preserve:
  "raw_match_term t u subs = Some subs' \<Longrightarrow> map_le subs' subs'' \<Longrightarrow> p\<in>tvs t \<Longrightarrow> subs'' p = subs' p"
  using raw_match_term_dom_res_eq_tvs domIff map_le_implies_dom_le
  by (simp add: map_le_def)

lemma map_eq_on_tvs_imp_map_eq_on_term:
  "(\<And>p . p\<in>tvs t \<Longrightarrow> subs p = subs' p)
  \<Longrightarrow> tsubst t (convert_subs subs)
    = tsubst t (convert_subs subs')"
  by (induction t) (use map_eq_on_tvsT_imp_map_eq_on_typ in \<open>fastforce+\<close>)

lemma raw_match_extend_map_preserve':
  assumes "raw_match_term t u subs = Some subs'" "map_le subs' subs''"
  shows "tsubst t (convert_subs subs')
    = tsubst t (convert_subs subs'')"
  apply (rule map_eq_on_tvs_imp_map_eq_on_term)
  using raw_match_term_extend_map_preserve assms by fastforce

lemma raw_match_term_produces_matcher:
  "raw_match_term t u subs = Some subs'
    \<Longrightarrow> tsubst t (convert_subs subs') = u"
proof (induction t u subs arbitrary: subs' rule: raw_match_term.induct)
  case (4 T t U u subs)
  from this obtain bsubs where bsubs: "raw_match' T U subs = Some bsubs"
    by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
  moreover hence body: "raw_match_term t u bsubs = Some subs'"
    using "4.prems" by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)

  ultimately have 1: "tsubst t (convert_subs subs') = u"
    using 4 by fastforce

  from bsubs have "tsubstT T (convert_subs bsubs) = U"
    using raw_match'_produces_matcher by blast

  moreover have "bsubs \<subseteq>\<^sub>m subs'" using raw_match_term_map_le body by blast

  ultimately have 2: "tsubstT T (convert_subs subs') = U"
    using raw_match'_extend_map_preserve'[OF bsubs, of subs'] by simp

  then show ?case
    using "4.prems" 1 2 by (simp split: if_splits)
next
  case (5 f u f' u' subs)
  from this obtain fsubs where f: "raw_match_term f f' subs = Some fsubs"
    by (auto simp add: bind_eq_Some_conv)
  hence u: "raw_match_term u u' fsubs = Some subs'"
    using "5.prems" by auto

  have 1: "tsubst u (convert_subs subs') = u'"
    using f u "5.IH" by auto

  have "tsubst f (convert_subs fsubs) = f'"
    using 5 f by simp
  moreover have "fsubs \<subseteq>\<^sub>m subs'" using raw_match_term_map_le u by blast
  ultimately have 2: "tsubst f (convert_subs subs') = f'"
    using raw_match_extend_map_preserve'[OF f, of subs'] by simp

  then show ?case using raw_match'_extend_map_preserve' 1 by auto
qed (auto split: if_splits simp add: bind_eq_Some_conv raw_match'_produces_matcher)

lemma ex_raw_match_term_imp_tinst:
  assumes "\<exists>subs. raw_match_term t2 t1 (\<lambda>p . None) = Some subs"
  shows "tinst t1 t2"
proof-
  obtain subs where "raw_match_term t2 t1 (\<lambda>p . None) = Some subs"
    using assms by auto
  hence "tsubst t2 (convert_subs subs) = t1"
    using raw_match_term_produces_matcher by blast
  thus ?thesis unfolding tinst_def by fast
qed

lemma tsubst_matcher_imp_raw_match_term_unchanged:
  "tsubst t \<rho> = u \<Longrightarrow> raw_match_term t u (\<lambda>(idx, S). Some (\<rho> idx S)) = Some (\<lambda>(idx, S). Some (\<rho> idx S))"
  by (induction t arbitrary: u \<rho>) (auto simp add: tsubstT_matcher_imp_raw_match'_unchanged)

lemma raw_match_term_restriction:
  assumes "raw_match_term t u subs = Some subs'"
  assumes "tvs t \<subseteq> restriction "
  shows "raw_match_term t u (subs|`restriction) = Some (subs'|`restriction)"
  using assms by (induction t u subs arbitrary: restriction subs' rule: raw_match_term.induct)
    (use raw_match'_restriction in
    \<open>auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv\<close>)

corollary raw_match_term_restriction_on_tvs:
  assumes "raw_match_term t u subs = Some subs'"
  shows "raw_match_term t u (subs|`tvs t) = Some (subs'|`tvs t)"
  using raw_match_term_restriction assms by simp

lemma raw_match_term_imp_raw_match_term_on_map_le:
  assumes "raw_match_term t u subs = Some subs'"
  assumes "map_le lesubs subs"
  shows "\<exists>lesubs'. raw_match_term t u lesubs = Some lesubs' \<and> map_le lesubs' subs'"
using assms proof (induction t u subs arbitrary: lesubs subs' rule: raw_match_term.induct)
  case (4 T t U u subs)
  from this obtain bsubs where bsubs: "raw_match' T U subs = Some bsubs"
    by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
  hence body: "raw_match_term t u bsubs = Some subs'"
    using "4.prems" by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)

  from bsubs 4 obtain lebsubs where
    lebsubs: "raw_match' T U subs = Some lebsubs" "map_le lebsubs bsubs"
    using raw_match'_map_le map_le_trans
    by (fastforce split: if_splits simp add: bind_eq_Some_conv raw_match'_produces_matcher)
  from this obtain lesubs' where
    lesubs':"raw_match_term t u lebsubs = Some lesubs'" "map_le lesubs' subs'"
    using "4.prems"
    by (auto split: if_splits simp add: bind_eq_Some_conv raw_match'_produces_matcher)

  show ?case
    using lebsubs lesubs' 4 apply ( auto split: if_splits simp add: bind_eq_Some_conv)
    by (meson raw_match'_imp_raw_match'_on_map_le)
next
  case (5 f u f' u' subs)
    from this obtain fsubs where f: "raw_match_term f f' subs = Some fsubs"
      by (auto simp add: bind_eq_Some_conv)
    hence u: "raw_match_term u u' fsubs = Some subs'"
      using "5.prems" by auto

   from 5 obtain lefsubs where
    lefsubs: "raw_match_term f f' subs = Some lefsubs" "map_le lefsubs fsubs"
    using raw_match_term_map_le map_le_trans f by auto
  from this obtain lesubs' where
    lesubs':"raw_match_term u u' lefsubs = Some lesubs'" "map_le lesubs' subs'"
    using "5.prems"
    by (auto split: if_splits simp add: bind_eq_Some_conv raw_match'_produces_matcher)

  from lefsubs lesubs' show ?case using 5 by (fastforce split: if_splits simp add: bind_eq_Some_conv)
qed (use raw_match'_imp_raw_match'_on_map_le in
    \<open>auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv\<close>)

corollary map_le_produces_same_raw_match_term:
  assumes "raw_match_term t u subs = Some subs'"
  assumes "dom subs \<subseteq> tvs t"
  assumes "map_le lesubs subs"
  shows "raw_match_term t u lesubs = Some subs'"
proof-
  have "dom subs' = tvs t"
    using assms(1) assms(2) raw_match_term_dom_res_eq_tvs by auto
  moreover obtain lesubs' where "raw_match_term t u lesubs = Some lesubs'" "map_le lesubs' subs'"
    using raw_match_term_imp_raw_match_term_on_map_le assms(1) assms(3) by blast
  moreover hence "dom lesubs' = tvs t"
    using \<open>dom subs' = tvs t\<close> map_le_implies_dom_le raw_match_term_tvs_subset_dom_res by fastforce

  ultimately show ?thesis using map_le_same_dom_imp_same_map by metis
qed

lemma tinst_imp_ex_raw_match_term:
  assumes "tinst t1 t2"
  shows "\<exists>subs. raw_match_term t2 t1 (\<lambda>p . None) = Some subs"
proof-
  obtain \<rho> where "tsubst t2 \<rho> = t1" using assms tinst_def by auto
  hence "raw_match_term t2 t1 (\<lambda>(idx, S). Some (\<rho> idx S)) = Some (\<lambda>(idx, S). Some (\<rho> idx S))"
    using tsubst_matcher_imp_raw_match_term_unchanged by auto

  hence "raw_match_term t2 t1 ((\<lambda>(idx, S). Some (\<rho> idx S))|`tvs t2)
    = Some ((\<lambda>(idx, S). Some (\<rho> idx S))|`tvs t2)"
    using raw_match_term_restriction_on_tvs by simp
  moreover have "dom ((\<lambda>(idx, S). Some (\<rho> idx S))|`tvs t2) = tvs t2" by auto
  ultimately show ?thesis using map_le_produces_same_raw_match_term
    using map_le_empty by blast
qed

corollary tinst_iff_ex_raw_match_term:
  "tinst t1 t2 \<longleftrightarrow> (\<exists>subs. raw_match_term t2 t1 (\<lambda>p . None) = Some subs)"
  using ex_raw_match_term_imp_tinst tinst_imp_ex_raw_match_term by blast

(* Now transfer to assoc lists for executability *)

function (sequential) assoc_match
  :: "typ \<Rightarrow> typ \<Rightarrow> ((variable \<times> sort) \<times> typ) list \<Rightarrow> ((variable \<times> sort) \<times> typ) list option" where
  "assoc_match (Tv v S) T subs =
    (case lookup (\<lambda>x. x=(v,S)) subs of
      None \<Rightarrow> Some (((v,S), T) # subs)
    | Some U \<Rightarrow> (if U = T then Some subs else None))"
| "assoc_match (Ty a Ts) (Ty b Us) subs =
    (if a=b \<and> length Ts = length Us
      then fold (\<lambda>(T, U) subs . Option.bind subs (assoc_match T U)) (zip Ts Us) (Some subs)
      else None)"
| "assoc_match T U subs = (if T = U then Some subs else None)"
  by (pat_completeness) auto
termination proof (relation "measure (\<lambda>(T, U, subs) . size T + size U)", goal_cases)
  case 1
  then show ?case
    by auto
next
  case (2 a Ts b Us subs x xa y xb aa)
  hence "length Ts = length Us" "a=b"
    by auto
  from this 2(2-) show ?case
    by (induction Ts Us rule: list_induct2) auto
qed

corollary assoc_match_Type_conds:
  assumes "assoc_match (Ty a Ts) (Ty b Us) subs = Some subs'"
  shows "a=b" "length Ts = length Us"
  using assms by (auto split: if_splits)

lemma fold_assoc_matches_first_step_not_None:
  assumes
    "fold (\<lambda>(T, U) subs . Option.bind subs (assoc_match T U)) (zip (x#xs) (y#ys)) (Some subs) = Some subs'"
  obtains point where
    "assoc_match x y subs = Some point"
    "fold (\<lambda>(T, U) subs . Option.bind subs (assoc_match T U)) (zip (xs) (ys)) (Some point) = Some subs'"
  using assms apply (simp split: option.splits)
  by (metis fold_Option_bind_eq_Some_start_not_None' not_None_eq)

lemma assoc_match_subset: "assoc_match T U subs = Some subs' \<Longrightarrow> set subs \<subseteq> set subs'"
proof (induction T U subs arbitrary: subs' rule: assoc_match.induct)
  case (2 a Ts b Us subs)
  hence l: "length Ts = length Us" "a = b" by (simp_all split: if_splits)
  have better_IH: "(x, y) \<in> set (zip Ts Us) \<Longrightarrow>
    assoc_match x y subs = Some subs' \<Longrightarrow> set subs \<subseteq> set subs'"
    for x y subs subs' using 2 by (simp split: if_splits)
  from l better_IH "2.prems" show ?case
  proof (induction Ts Us arbitrary: subs rule: list_induct2)
    case Nil
    then show ?case by simp
  next
    case (Cons x xs y ys)

    obtain point where first: "assoc_match x y subs = Some point"
      and rest: "assoc_match (Ty a xs) (Ty b ys) point = Some subs'"
      using fold_assoc_matches_first_step_not_None
      by (metis (no_types, lifting) Cons.hyps Cons.prems assoc_match.simps(2) assoc_match_Type_conds(2))

    then show ?case
      using Cons.IH Cons.prems(2) by (fastforce split: option.splits prod.splits if_splits
          simp add: lookup_present_eq_key bind_eq_Some_conv)
  qed
qed (auto split: option.splits prod.splits if_splits simp add: lookup_present_eq_key)

lemma assoc_match_distinct: "assoc_match T U subs = Some subs' \<Longrightarrow> distinct (map fst subs)
  \<Longrightarrow> distinct (map fst subs')"
proof (induction T U subs arbitrary: subs' rule: assoc_match.induct)
  case (2 a Ts b Us subs)
  hence l: "length Ts = length Us" "a = b" by (simp_all split: if_splits)
  have better_IH: "(x, y) \<in> set (zip Ts Us) \<Longrightarrow>
    assoc_match x y subs = Some subs' \<Longrightarrow> distinct (map fst subs) \<Longrightarrow> distinct (map fst subs')"
    for x y subs subs' using 2 by (simp split: if_splits)
  from l better_IH "2.prems" show ?case
  proof (induction Ts Us arbitrary: subs subs' rule: list_induct2)
    case Nil
    then show ?case by simp
  next
    case (Cons x xs y ys)

    obtain point where first: "assoc_match x y subs = Some point"
      and rest: "assoc_match (Ty a xs) (Ty b ys) point = Some subs'"
      using fold_assoc_matches_first_step_not_None
      by (metis (no_types, lifting) Cons.hyps Cons.prems assoc_match.simps(2) assoc_match_Type_conds(2))

    have dst_point: "distinct (map fst point)"
      apply (rule Cons.prems)
      using first Cons.prems by simp_all

    have "distinct (map fst subs')"
      apply (rule Cons.IH)
      using Cons.prems rest apply simp
      using Cons.prems apply auto[1]
      using rest apply simp
      using dst_point apply simp
      done

    then show ?case
      using Cons.IH Cons.prems(2) by simp
  qed
qed (auto split: option.splits prod.splits if_splits simp add: lookup_present_eq_key)

(* Seems that distinct is not even necessary, as both take the first one in case of duplicates*)
lemma lookup_eq_map_of_ap:
  shows "lookup (\<lambda>x. x=k) subs = map_of subs k"
  by (induction subs arbitrary: k) auto

(* Ugly proof, but should mean that I can replace raw_match' with the executable assoc_match *)
lemma raw_match'_assoc_match:
  shows "raw_match' T U (map_of subs) = map_option map_of (assoc_match T U subs)"
  proof (induction T U "map_of subs" arbitrary: subs rule: raw_match'.induct)
case (1 v S T)
  then show ?case
    by (auto split: option.splits prod.splits simp add: lookup_present_eq_key lookup_eq_map_of_ap)
next
  case (2 a Ts b Us subs)
  then show ?case
  proof(cases "(raw_match' (Ty a Ts) (Ty b Us) (map_of subs))")
    case None
    then show ?thesis
    proof (cases "a = b \<and> length Ts = length Us")
      case True
      hence "length Ts = length Us" "a = b" by auto
      then show ?thesis using 2 None
      proof (induction Ts Us arbitrary: subs rule: list_induct2)
        case Nil
        then show ?case by simp
      next
        case (Cons x xs y ys)

        hence eq_hd: "raw_match' x y (map_of subs) = map_option map_of (assoc_match x y subs)"
          by auto

        then show ?case
        proof(cases "assoc_match x y subs")
          case None
          hence "raw_match' x y (map_of subs) = None" using eq_hd by simp
          then show ?thesis
            using fold_Option_bind_at_some_point_None_eq_None fold_assoc_matches_first_step_not_None
              Cons.prems
            by (auto split: option.splits prod.splits if_splits
                simp add: fold_Option_bind_eq_None_start_None)
        next
          case (Some res)
          hence "raw_match' x y (map_of subs) = Some (map_of res)" using eq_hd by simp
          then show ?thesis
            using fold_assoc_matches_first_step_not_None fold_Option_bind_eq_Some_at_each_point_Some
              Cons.prems Cons.IH
            by (auto split: option.splits prod.splits if_splits
                simp add: fold_Option_bind_eq_None_start_None)
        qed
      qed
    next
      case False
      then show ?thesis using None 2 by auto
    qed
  next
    case (Some res)
    hence l: "length Ts = length Us" "a = b" by (simp_all split: if_splits)
    have better_IH: "(x, y) \<in> set (zip Ts Us) \<Longrightarrow>
    raw_match' x y (map_of subs) = map_option map_of (assoc_match x y subs)"
      for x y subs using 2 Some by (simp split: if_splits)
    from l better_IH Some "2.prems" show ?thesis
    proof (induction Ts Us arbitrary: subs res rule: list_induct2)
      case Nil
      then show ?case by simp
    next
      case (Cons x xs y ys)

      obtain point where first: "raw_match' x y (map_of subs) = Some (map_of point)"
        and rest: "raw_match' (Ty a xs) (Ty b ys) (map_of point) = Some res"
        using fold_matches_first_step_not_None Cons.prems
        by (simp split: option.splits prod.splits if_splits) (smt map_option_eq_Some)

      have 1: "raw_match' x y (map_of subs) = map_option map_of (assoc_match x y subs)"
        using Cons.prems by simp

      have 2: "raw_match' (Ty a xs) (Ty b ys) (map_of point)
        = map_option map_of (assoc_match (Ty a xs) (Ty b ys) point)"
        using Cons rest by auto

      show ?case
        using 1 2 first rest
        apply (simp split: if_splits option.splits prod.splits)
        by (smt Cons.IH Cons.prems(2) assoc_match.simps(2) list.set_intros(2) map_option_eq_Some
            rest zip_Cons_Cons)
    qed
  qed
qed (auto split: option.splits prod.splits simp add: lookup_present_eq_key)

lemma dom_eq_and_eq_on_dom_imp_eq: "dom m = dom m' \<Longrightarrow> \<forall>x\<in>dom m . m x = m' x \<Longrightarrow> m = m'"
  by (simp add: map_le_def map_le_same_dom_imp_same_map)

lemma list_of_map:
  assumes "finite (dom subs)"
  shows "\<exists>l. map_of l = subs"
proof-
  have "finite {(k, the (subs k)) | k . k\<in>dom subs}" using assms by simp
  from this obtain l where l: "set l = {(k, the (subs k)) | k . k\<in>dom subs}"
    using finite_list by fastforce

  hence "dom (map_of l) = fst ` {(k, the (subs k)) | k . k\<in>dom subs}"
    by (simp add: dom_map_of_conv_image_fst)
  also have "\<dots> = dom subs"
    by (simp add: Setcompr_eq_image domI image_image)
  finally have "dom (map_of l) = dom subs" .
  moreover have "map_of l x = subs x" if "x\<in>dom subs" for x
    using that
    by (smt l domIff fst_conv map_of_SomeD mem_Collect_eq option.collapse prod.sel(2) weak_map_of_SomeI)
  ultimately have "map_of l = subs"
    by (simp add: dom_eq_and_eq_on_dom_imp_eq)
  thus ?thesis ..
qed

corollary tinstT_iff_assoc_match[code]: "tinstT T1 T2 \<longleftrightarrow> assoc_match T2 T1 [] ~= None"
  using tinstT_iff_ex_raw_match' list_of_map raw_match'_assoc_match
  by (smt map_of_eq_empty_iff map_option_is_None option.collapse option.distinct(1))

function (sequential) assoc_match_term
  :: "term \<Rightarrow> term \<Rightarrow> ((variable \<times> sort) \<times> typ) list \<Rightarrow> ((variable \<times> sort) \<times> typ) list option"
  where
  "assoc_match_term (Ct a T) (Ct b U) subs = (if a = b then assoc_match T U subs else None)"
| "assoc_match_term (Fv a T) (Fv b U) subs = (if a = b then assoc_match T U subs else None)"
| "assoc_match_term (Bv i) (Bv j) subs = (if i = j then Some subs else None)"
| "assoc_match_term (Abs T t) (Abs U u) subs =
    Option.bind (assoc_match T U subs) (assoc_match_term t u)"
| "assoc_match_term (f $ u) (f' $ u') subs = Option.bind (assoc_match_term f f' subs) (assoc_match_term u u')"
| "assoc_match_term _ _ _ = None"
  by pat_completeness auto
termination by size_change

lemma raw_match_term_assoc_match_term:
  "raw_match_term t u (map_of subs) = map_option map_of (assoc_match_term t u subs)"
proof (induction t u "map_of subs" arbitrary: subs rule: raw_match_term.induct)
  case (4 T t U u)

  then show ?case
  proof (cases "assoc_match T U subs")
    case None
    then show ?thesis using raw_match'_assoc_match by simp
  next
    case (Some bsubs)
    hence 1: "raw_match' T U (map_of subs) = Some (map_of bsubs)"
      using raw_match'_assoc_match by simp
    hence "raw_match_term t u (map_of bsubs) = map_option map_of (assoc_match_term t u bsubs)"
      using 4 by blast
    then show ?thesis by (simp add: Some 1)
  qed
next
  case (5 f u f' u')
  (* Do a real proof here when time *)
  from "5.hyps"(1) "5.hyps"(2) have "Option.bind (map_option map_of (assoc_match_term f f' subs))
     (raw_match_term u u') =
    map_option map_of (Option.bind (assoc_match_term f f' subs) (assoc_match_term u u'))"
    by (smt None_eq_map_option_iff bind.bind_lunit bind_eq_None_conv option.collapse option.map_sel)
  with 5 show ?case
    using raw_match'_assoc_match 5
    by (auto split: option.splits prod.splits simp add: lookup_present_eq_key bind_eq_Some_conv bind_eq_None_conv)
qed (use raw_match'_assoc_match in \<open>auto split: option.splits prod.splits\<close>)

(* Automation surprisingly broke on translation :( *)
corollary tinst_iff_assoc_match_term[code]: "tinst t1 t2 \<longleftrightarrow> assoc_match_term t2 t1 [] \<noteq> None"
proof
  assume "tinst t1 t2"
  from this obtain asubs where "raw_match_term t2 t1 Map.empty = Some asubs"
    using tinst_imp_ex_raw_match_term by blast
  from this obtain csubs where "assoc_match_term t2 t1 [] = Some csubs"
    by (metis empty_eq_map_of_iff map_option_eq_Some raw_match_term_assoc_match_term)
  thus "assoc_match_term t2 t1 [] \<noteq> None" by simp
next
  assume "assoc_match_term t2 t1 [] \<noteq> None"
  from this obtain csubs where "assoc_match_term t2 t1 [] = Some csubs"
    by blast
  from this obtain asubs where "raw_match_term t2 t1 Map.empty = Some asubs"
    by (metis empty_eq_map_of_iff option.simps(9) raw_match_term_assoc_match_term)
  thus "tinst t1 t2"
    using tinst_iff_ex_raw_match_term by blast
qed

hide_fact fold_matches_first_step_not_None fold_matches_last_step_not_None

end


section "CRDT Specifications Part 2"
theory crdt_specs2
  imports crdt_specs
    crdt_specs_v
    "fuzzyrule.fuzzyrule"
    "fuzzyrule.fuzzy_goal_cases"
begin

text "We now relate the original CRDT specifications and the ones that are better
suited for verification of applications."

subsection "Register"

definition latest_assignments' :: "callId set \<Rightarrow> (callId \<Rightarrow> 'op) \<Rightarrow> (callId \<times> callId) set \<Rightarrow> ('v registerOp \<Rightarrow> 'op) \<Rightarrow> (callId \<times> 'v) set"  where
"latest_assignments' vis op hb C \<equiv>
   {(c,v). c\<in>vis \<and> op c = C (Assign v) \<and> (\<nexists>c' v'. c'\<in>vis \<and> op c' = C (Assign v') \<and> (c,c')\<in>hb)}"

definition
"latest_values' vis op hb C \<equiv> snd ` (latest_assignments' vis op hb C)"

lemma latest_assignments'_exists:
  assumes fin: "finite vis"
    and acyclic: "acyclic hb"
    and a: "\<exists>c y. c\<in>vis \<and> op c = C (Assign y)"
  shows "\<exists>x. x\<in> latest_assignments' vis op hb C"
proof (auto simp add: latest_assignments'_def)

  define all_assignments where "all_assignments \<equiv> {c\<in>vis. \<exists>y. op c = C (Assign y)}"

  have "all_assignments \<noteq> {}"
    using a by (auto simp add: all_assignments_def)

  have "finite all_assignments"
    by (rule finite_subset[rotated, OF fin], auto simp add: all_assignments_def)

  obtain c
    where c_in: "c \<in> all_assignments"
      and c_max: "\<forall>c'\<in>all_assignments. \<not>(c,c')\<in>hb"
    by (metis (mono_tags, lifting) \<open>finite all_assignments\<close> a acyclic all_assignments_def exists_max mem_Collect_eq)

  hence "c \<in> vis \<and> (\<exists>b. op c = C (Assign b)) \<and> (\<forall>c'. c' \<in> vis \<longrightarrow> (\<forall>v'. op c' \<noteq> C (Assign v')) \<or> (c, c') \<notin> hb)"
    by (auto simp add: all_assignments_def)

  thus "\<exists>a. a \<in> vis \<and> (\<exists>b. op a = C (Assign b)) \<and> (\<forall>c'. c' \<in> vis \<longrightarrow> (\<forall>v'. op c' \<noteq> C (Assign v')) \<or> (a, c') \<notin> hb)" ..
qed

lemma latest_values'_exists:
  assumes fin: "finite vis"
    and acyclic: "acyclic hb"
    and a: "\<exists>c y. c\<in>vis \<and> op c = C (Assign y)"
  shows "\<exists>x. x\<in> latest_values' vis op hb C"
  unfolding latest_values'_def
  using a acyclic fin latest_assignments'_exists by fastforce

definition register_spec' :: "('res::default) \<Rightarrow> ('op, 'res registerOp, 'res) ccrdtSpec" where
"register_spec' initial oper vis op hb C  res \<equiv>
  case oper of
    Assign _ \<Rightarrow> res = default
  | Read \<Rightarrow>
      is_from res initial (latest_values' vis op hb C)"

definition firstValue' :: "'a \<Rightarrow> ('b \<times> 'a) set \<Rightarrow> 'a" where
"firstValue' d m \<equiv> if m = {} then d else
  let maxK = wo_rel.minim some_well_order (fst ` m) in
  wo_rel.minim some_well_order {y. (maxK,y)\<in>m}
  "

lemma firstValue'_to_firstValue:
  shows
    "firstValue' initial {(x, y). f x \<triangleq> y}
     = firstValue initial f"
proof (auto simp add: firstValue'_def firstValue_def)

  fix a y
  assume c0: "f a \<triangleq> y"

  have h1: "(fst ` {(x, y). f x \<triangleq> y}) =  (dom f)"
    by (auto simp add: image_iff)

  show "wo_rel.minim some_well_order {y. f (wo_rel.minim some_well_order (fst ` {(x, y). f x \<triangleq> y})) \<triangleq> y}
      = the (f (wo_rel.minim some_well_order (dom f)))"

  proof (cases "f = Map.empty")
    case True
    then show ?thesis
      using c0 by (auto simp add: h1)
  next
    case False
    then show ?thesis
      by (auto simp add: h1, smt False domIff dom_eq_empty_conv mem_Collect_eq option.exhaust_sel option.sel some_well_order_includes_all some_well_order_is_wo_rel wo_rel.minim_in)
  qed
qed

definition lww_register_spec' :: "('v::default) \<Rightarrow> ('op, 'v registerOp, 'v) ccrdtSpec" where
"lww_register_spec' initial oper vis op hb C  res \<equiv>
  case oper of
    Assign x \<Rightarrow> res = default
  | Read \<Rightarrow> res = firstValue' initial (latest_assignments' vis op hb C)"

lemma wo_rel_minim_singleton:
  assumes "S = {y}"
  shows "wo_rel.minim some_well_order S = y"
  by (metis assms insert_not_empty singletonD some_well_order_includes_all some_well_order_is_wo_rel wo_rel.minim_in)

lemma wo_rel_minim_singleton2:
  assumes "f \<triangleq> y"
  shows "wo_rel.minim some_well_order {y. f \<triangleq> y} = y"
  by (metis (mono_tags, lifting) assms emptyE mem_Collect_eq option.sel some_well_order_includes_all some_well_order_is_wo_rel wo_rel.minim_in)

lemma map_chain_eq_some:
  "((f \<ggreater> g) x \<triangleq> z) \<longleftrightarrow> (\<exists>y. f x \<triangleq> y \<and> g y \<triangleq> z)"
  by (simp add: bind_eq_Some_conv map_chain_def)

lemma  latest_assignments_rel:
  assumes is_rev: "is_reverse C_in C_out"
  shows "(latest_assignments' (dom (map_map (calls ctxt) call_operation \<ggreater> C_in) \<inter> Cs) (extract_op (calls ctxt)) (happensBefore ctxt) C_out)
      = {(x,y) | x y. latestAssignments (sub_context C_in Cs ctxt) x \<triangleq> y}"
proof (auto simp add: latest_assignments'_def latestAssignments_def  latestAssignments_h_def
    map_chain_eq_some dom_def cOp_def
    split: option.splits registerOp.splits call.splits,
    fuzzy_goal_cases A B C D E F G H)
  case (A a b y)
  then show ?case
    by (simp add: calls_sub_context)
next
  case (B a b y x1a c' v' r' x2)
  then show ?case
    by (auto simp add: calls_sub_context option_bind_def restrict_map_def happens_before_sub_context split: if_splits option.splits)
     (metis (mono_tags, lifting) call_operation_def extract_op_def' is_rev is_reverse_1 option.simps(5))
next
  case (C a b y x1a x2)
  then show ?case
    by (auto simp add: calls_sub_context option_bind_def restrict_map_def  call_operation_def extract_op_def is_rev is_reverse_2 split: if_splits option.splits)

next
  case (D a b y x2)
  then show ?case
    by (auto simp add: calls_sub_context option_bind_def restrict_map_def  call_operation_def extract_op_def is_rev is_reverse_2 split: if_splits option.splits)
next
  case (E a b x2a x1a)
  then show ?case
    by (auto simp add: calls_sub_context option_bind_def restrict_map_def  call_operation_def extract_op_def is_rev is_reverse_2 split: if_splits option.splits)
next
  case (F a b x2a x1a)
  then show ?case
    by (auto simp add: calls_sub_context option_bind_def restrict_map_def  call_operation_def extract_op_def is_rev is_reverse_2 split: if_splits option.splits)
next
  case (G a b x2a x1a)
  then show ?case
    by (auto simp add: calls_sub_context option_bind_def restrict_map_def  call_operation_def extract_op_def is_rev is_reverse_2 split: if_splits option.splits call.splits)
      (use is_rev is_reverse_1 in fastforce)

next
  case (H a b c' y v' x2a x1a)
  then show ?case
    by (auto simp add: calls_sub_context option_bind_def restrict_map_def  call_operation_def extract_op_def is_rev is_reverse_2  split: if_splits option.splits call.splits)
     (metis (mono_tags, lifting) H(5) bind.bind_lunit call.sel(1) calls_sub_context domI happens_before_sub_context option.simps(5) restrict_map_def)
qed

lemma  latest_assignments_rel2:
  assumes is_rev: "is_reverse C_in C_out"
    and Cs_subset: "Cs \<subseteq> dom (map_map (calls ctxt) call_operation \<ggreater> C_in)"
  shows "(latest_assignments' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out)
      = {(x,y) | x y. latestAssignments (sub_context C_in Cs ctxt) x \<triangleq> y}"
  by (metis (mono_tags, lifting) Collect_cong Cs_subset inf.absorb_iff2 is_rev latest_assignments_rel)

lemma  latest_assignments_rel3:
  assumes is_rev: "is_reverse C_in C_out"
    and Cs_subset: "Cs \<subseteq> dom (calls ctxt)"
  shows "(latest_assignments' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out)
      = {(x,y) | x y. latestAssignments (sub_context C_in Cs ctxt) x \<triangleq> y}"
  using Cs_subset
  by (auto simp add: latest_assignments'_def latestAssignments_def latestAssignments_h_def
      cOp_def
      sub_context_def restrict_ctxt_op_def
      restrict_ctxt_def fmap_map_values_def
      ctxt_restrict_calls_def option_bind_def
      in_dom
      extract_op_def
      is_reverse_2[OF is_rev] is_reverse_1[OF is_rev]
      restrict_relation_def restrict_map_def
      split: option.splits registerOp.splits if_splits)
    (metis is_rev is_reverse_1 option.sel, use  is_rev is_reverse_2 in fastforce)

lemma lww_register_spec_rel[intro!]:
"crdt_spec_rel (lww_register_spec initial) (lww_register_spec' initial) "
  unfolding crdt_spec_rel_def
  by (auto simp add: lww_register_spec_def lww_register_spec'_def
          latest_assignments_rel3 firstValue'_to_firstValue split: registerOp.splits)

lemma latestValues_rel:
  assumes is_rev: "is_reverse C_in C_out"
    and subset: "Cs \<subseteq> dom (calls ctxt)"
shows "latestValues (sub_context C_in Cs ctxt)
     = latest_values' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out"
  by (auto simp add: latestValues_def latest_values'_def latest_assignments_rel3[OF is_rev subset] ran_def in_img_simp)

lemma register_spec_rel[intro!]:
"crdt_spec_rel (register_spec initial) (register_spec' initial) "
  unfolding crdt_spec_rel_def
  by (auto simp add: register_spec_def register_spec'_def is_from_def
          latestValues_rel firstValue'_to_firstValue split: registerOp.splits)

lemma latest_assignments'_wf:
  assumes a1: "map_same_on Cs' op op'"
and a2: "rel_same_on Cs' hb hb'"
and a3: "Cs' \<subseteq> Cs"
and a4: "\<forall>c\<in>Cs. (\<exists>y. C_out y = op c) \<longrightarrow> c\<in>Cs'"
shows " latest_assignments' Cs op hb C_out =  latest_assignments' Cs' op' hb' C_out"
  using a1 a2 a3 by (auto simp add: latest_assignments'_def  map_same_on_def rel_same_on_def)
    (metis a4 in_mono)+

lemma latest_values'_wf:
  assumes "map_same_on Cs' op op'"
and "rel_same_on Cs' hb hb'"
and "Cs' \<subseteq> Cs"
and "\<forall>c\<in>Cs. (\<exists>y. C_out y = op c) \<longrightarrow> c\<in>Cs'"
shows " latest_values' Cs op hb C_out =  latest_values' Cs' op' hb' C_out"
  by (auto simp add: latest_values'_def latest_assignments'_wf[OF assms])

lemma register_spec_wf[simp]:
"ccrdtSpec_wf (register_spec' i)"
  by (auto simp add: ccrdtSpec_wf_def register_spec'_def latest_values'_wf split: registerOp.splits)

lemma lww_register_spec_wf[simp]:
"ccrdtSpec_wf (lww_register_spec' i)"
  by (auto simp add: ccrdtSpec_wf_def lww_register_spec'_def latest_assignments'_wf split: registerOp.splits)

subsection "Sets"

text_raw \<open>\DefineSnippet{set_rw_spec2}{\<close>
definition set_rw_spec' :: "('op, 'v setOp, ('r::{default,from_bool})) ccrdtSpec" where
"set_rw_spec' oper vis op hb C  res \<equiv>
  case oper of
    Add _ => res = default
  | Remove _ \<Rightarrow> res = default
  | Contains v \<Rightarrow> res = from_bool
        (\<exists>a\<in>vis. op a = C (Add v)
           \<and> (\<forall>r\<in>vis. op r = C (Remove v)
                 \<longrightarrow> (\<exists>a'\<in>vis. op a' = C (Add v) \<and> (r,a')\<in>hb)))"
text_raw \<open>}%EndSnippet\<close>

lemma sub_context_operationContext_wf:
  assumes wf: "operationContext_wf ctxt"
  shows "operationContext_wf (sub_context C_in Cs ctxt)"
  unfolding operationContext_wf_def
proof (intro conjI)
  have a0: "trans (happensBefore ctxt)"
    by (simp add: local.wf operationContext_wf_trans)

  have a1: "wf ((happensBefore ctxt)\<inverse>)"
    by (simp add: local.wf operationContext_wf_wf)

  have a2: "Field (happensBefore ctxt) \<subseteq> dom (calls ctxt)"
    by (simp add: local.wf operationContext_wf_hb_field)

  show "trans (happensBefore (sub_context C_in Cs ctxt))"
    by (metis (mono_tags, lifting) a0 happens_before_sub_context trans_def)

  show "irrefl (happensBefore (sub_context C_in Cs ctxt))"
    by (meson a1 acyclic_converse happens_before_sub_context irrefl_def local.wf operationContext_wf_finite_hb wf_acyclic wf_asym wf_iff_acyclic_if_finite)

  show "Field (happensBefore (sub_context C_in Cs ctxt)) \<subseteq> dom (calls (sub_context C_in Cs ctxt))"
    using a2
    by (auto simp add: sub_context_def restrict_ctxt_op_def ctxt_restrict_calls_def restrict_ctxt_def
          restrict_relation_def fmap_map_values_def restrict_map_def Field_def)

  show "finite (dom (calls (sub_context C_in Cs ctxt)))"
  proof (rule finite_subset)
    show "dom (calls (sub_context C_in Cs ctxt)) \<subseteq> dom (calls ctxt)"
      by (auto simp add: sub_context_def restrict_ctxt_op_def restrict_ctxt_def ctxt_restrict_calls_def fmap_map_values_def option_bind_def restrict_map_def split: option.splits if_splits)
    show "finite (dom (calls ctxt))"
      using local.wf operationContext_wf_def by blast
  qed
qed

lemma Op_subcontext:
"Op (sub_context C_in Cs ctxt) c \<triangleq> op
\<longleftrightarrow> (\<exists>op'. c\<in>Cs \<and> Op ctxt c \<triangleq> op' \<and> C_in op' \<triangleq> op)"
  by (auto simp add: sub_context_def restrict_ctxt_op_def restrict_ctxt_def restrict_hb_def cOp_def
      ctxt_restrict_calls_def restrict_map_def
      fmap_map_values_def option_bind_def split: option.splits call.splits)

lemma calls_subcontext:
"calls (sub_context C_in Cs ctxt)
  = (\<lambda>c. if c\<in>Cs then
            case calls ctxt c of
              None \<Rightarrow> None
            | Some (Call op r) \<Rightarrow> C_in op \<bind> (\<lambda>op'. Some (Call op' r))
         else None)"
  by (auto simp add: sub_context_def restrict_ctxt_op_def restrict_ctxt_def restrict_hb_def cOp_def
      ctxt_restrict_calls_def restrict_map_def
      fmap_map_values_def option_bind_def split: option.splits call.splits intro!: ext)

lemma calls_subcontext_dom:
"dom (calls (sub_context C_in Cs ctxt))
= {c | c op. c\<in>Cs \<and> Op ctxt c \<triangleq> op \<and> C_in op \<noteq> None}"
  by (auto simp add: calls_subcontext option_bind_def cOp_def split: if_splits option.splits call.splits)

lemma calls_subcontext_dom_exists:
"(\<exists>c\<in>dom (calls (sub_context C_in Cs ctxt)). P c)
= (\<exists>c\<in>Cs. \<exists>op. Op ctxt c \<triangleq> op \<and> C_in op \<noteq> None \<and> P c)"
  by (auto simp add: calls_subcontext_dom)

lemma calls_subcontext_dom_forall:
"(\<forall>c\<in>dom (calls (sub_context C_in Cs ctxt)). P c)
= (\<forall>c\<in>Cs. \<forall>op. Op ctxt c \<triangleq> op \<longrightarrow> C_in op \<noteq> None \<longrightarrow> P c)"
  by (auto simp add: calls_subcontext_dom)

lemma calls_subcontext_some:
"calls (sub_context C_in Cs ctxt) c \<triangleq> ci
\<longleftrightarrow> c\<in>Cs \<and> (\<exists>ci'. calls ctxt c \<triangleq> ci' \<and> call_res ci = call_res ci' \<and> C_in (call_operation ci') \<triangleq> call_operation ci)"
  by (auto simp add: calls_subcontext option_bind_def split: if_splits option.splits call.splits)

lemma calls_subcontext_some':
"calls (sub_context C_in Cs ctxt) c \<triangleq> ci
\<longleftrightarrow> c\<in>Cs \<and> (\<exists>op'. calls ctxt c \<triangleq> Call op' (call_res ci) \<and> C_in op' \<triangleq> call_operation ci)"
  by (auto simp add: calls_subcontext option_bind_def split: if_splits option.splits call.splits)

lemma forall_call_expand:
"(\<forall>c. P c) \<longleftrightarrow> (\<forall>op r. P (Call op r))"
  by (metis call.exhaust)

lemma not_some_the[simp]: "y \<noteq> Some (the y) \<longleftrightarrow> y = None"
  by (cases y) auto

lemma set_rw_spec_rel[intro!]:
  shows "crdt_spec_rel set_rw_spec set_rw_spec'"
proof (rule show_crdt_spec_rel)

  show "set_rw_spec op (sub_context C_in Cs ctxt) r = set_rw_spec' op Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out r"
    if irev: "is_reverse C_in C_out"
      and c1: "C_in outer_op \<triangleq> op"
      and wf: "operationContext_wf ctxt"
      and CS_subset: "Cs \<subseteq> dom (calls ctxt)"
    for  C_in C_out ctxt outer_op op r Cs
  proof (cases op)
    case (Add x1)
    then show ?thesis
      by (simp add: set_rw_spec'_def)
  next
    case (Remove x2)
    then show ?thesis
      by (simp add: set_rw_spec'_def)
  next
    case (Contains x3)

    have wf': "operationContext_wf (sub_context C_in Cs ctxt)"
      by (simp add: local.wf sub_context_operationContext_wf)

    show ?thesis
      unfolding Contains
        set_rw_spec_Contains_iff[OF wf']
        set_rw_spec'_def
      apply (simp add: calls_subcontext_dom_exists calls_subcontext_dom_forall
        extract_op_into_sub_context'[OF irev]
        happens_before_into_sub_context[OF irev]
        Op_subcontext
        , rule from_bool_eq_simp')
      apply (auto simp add: sub_context_def restrict_ctxt_op_def restrict_ctxt_def ctxt_restrict_calls_def
restrict_relation_def fmap_map_values_def restrict_map_def
option_bind_def domExists_simp cOp_def extract_op_def
is_reverse_1[OF irev] is_reverse_2[OF irev]
 split: option.splits)
         apply force
      subgoal for a z r
        by (smt CS_subset domIff irev is_reverse_def option.collapse subset_iff)
      subgoal
        using CS_subset irev is_reverse_2 by fastforce
      subgoal
        by (smt CS_subset domIff irev is_reverse_def option.collapse option.sel subsetD)
      done

  qed
qed

lemma set_rw_spec_wf[simp]:
  "ccrdtSpec_wf set_rw_spec'"
  by (auto simp add: ccrdtSpec_wf_def set_rw_spec'_def map_same_on_def rel_same_on_def subset_eq
      split: setOp.splits
      intro!: arg_cong[where f=from_bool])
    metis+

text_raw \<open>\DefineSnippet{set_aw_spec2}{\<close>
definition set_aw_spec' :: "('op, 'v setOp, ('r::{default,from_bool})) ccrdtSpec" where
"set_aw_spec' oper vis op hb C  res \<equiv>
  case oper of
    Add _ => res = default
  | Remove _ \<Rightarrow> res = default
  | Contains v \<Rightarrow> res = from_bool
        (\<exists>a\<in>vis. op a = C (Add v)
           \<and> \<not>(\<exists>r\<in>vis. op r = C (Remove v) \<and> (a,r)\<in>hb))"
text_raw \<open>}%EndSnippet\<close>

schematic_goal set_aw_spec'_contains:
"set_aw_spec' (Contains x) vis op hb id res \<longleftrightarrow> ?x"
  using [[simp_trace,simp_trace_depth_limit=10000]]
  by (subst set_aw_spec'_def, simp del: bex_simps(8))

text \<open>
\DefineSnippet{set_aw_spec2_contains}{
  @{thm [display] set_aw_spec'_contains}
}%EndSnippet\<close>

lemma set_aw_spec_wf[simp]:
  "ccrdtSpec_wf set_aw_spec'"
  by (auto simp add: ccrdtSpec_wf_def set_aw_spec'_def map_same_on_def rel_same_on_def subset_eq
      split: setOp.splits
      intro!: arg_cong[where f=from_bool])
    metis+

lemma set_aw_spec_rel[intro!]:
  shows "crdt_spec_rel set_aw_spec set_aw_spec'"
proof (rule show_crdt_spec_rel, fuzzy_goal_cases A)
  case (A C_in C_out ctxt outer_op op r Cs)
  show ?case
  proof (cases op)
    case (Add x1)
    then show ?thesis
      by (auto simp add: set_aw_spec'_def)
  next
    case (Remove x2)
    then show ?thesis
      by (auto simp add: set_aw_spec'_def)
  next
    case (Contains x3)
    thus ?thesis
    proof auto
      assume a: "set_aw_spec (Contains x3) (sub_context C_in Cs ctxt) r"

      have owf: \<open>operationContext_wf (sub_context C_in Cs ctxt)\<close>
        by (simp add: A.operationContext_wf sub_context_operationContext_wf)

      show "set_aw_spec' (Contains x3) Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out r"
        apply (auto simp add: set_aw_spec_Contains[OF a owf] set_aw_spec'_def  intro!: arg_cong[where f=from_bool])
        subgoal for a
          apply (rule bexI[where x=a], auto)
            apply (auto simp add:  Op_subcontext happens_before_sub_context calls_subcontext_dom)
           apply (auto simp add: cOp_def extract_op_def is_reverse_1[OF A.is_reverse] is_reverse_2[OF A.is_reverse])
          using A.less_eq  is_reverse_2[OF A.is_reverse] by fastforce
        subgoal for a
          apply (rule exI[where x=a], auto)
           apply (auto simp add:  Op_subcontext happens_before_sub_context calls_subcontext_dom)
           apply (auto simp add: cOp_def extract_op_def is_reverse_1[OF A.is_reverse] is_reverse_2[OF A.is_reverse])
          using A.less_eq  is_reverse_2[OF A.is_reverse] by fastforce
        done

    next

      assume a: "set_aw_spec' (Contains x3) Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out r"

      hence "r =
        from_bool
         (\<exists>a\<in>Cs.
             extract_op (calls ctxt) a = C_out (Add x3) \<and>
             (\<forall>r\<in>Cs. extract_op (calls ctxt) r = C_out (Remove x3) \<longrightarrow> (a, r) \<notin> happensBefore ctxt))"
        unfolding set_aw_spec'_def
        by simp

      from is_reverse_2[OF A.is_reverse]
      have [simp]: "C_in (C_out x) \<triangleq> x" for x .

      from is_reverse_1[OF A.is_reverse]
      have [simp]: "C_in x \<triangleq> y \<Longrightarrow> C_out y = x" for x y .

      show "set_aw_spec (Contains x3) (sub_context C_in Cs ctxt) r"
      proof (rule set_aw_spec_Contains2)
        show "operationContext_wf (sub_context C_in Cs ctxt)"
          by (simp add: A.operationContext_wf sub_context_operationContext_wf)
        show "r =
            from_bool
             (\<exists>a. Op (sub_context C_in Cs ctxt) a \<triangleq> Add x3 \<and>
                  (\<nexists>r. Op (sub_context C_in Cs ctxt) r \<triangleq> Remove x3 \<and>
                       (a, r) \<in> happensBefore (sub_context C_in Cs ctxt)))"
          using a
          apply (auto simp add: set_aw_spec'_def intro!: arg_cong[where f=from_bool])
           apply (auto simp add:  Op_subcontext happens_before_sub_context calls_subcontext_dom)
           apply (auto simp add: cOp_def extract_op_def)
          subgoal for a
            apply (rule exI[where x=a])
            apply auto
            by (meson A.is_reverse A.less_eq domIff is_reverse_2 not_some_the subsetD)
          subgoal for a z
            apply (rule bexI[where x=a])
            using A.less_eq apply (auto simp add: subset_iff)
            by (metis (mono_tags, lifting) \<open>\<And>x. C_in (C_out x) \<triangleq> x\<close> domIff not_some_the option.discI)
          done
      qed
    qed
  qed
qed

subsection "Maps"

text_raw \<open>\DefineSnippet{map_sdw_spec'}{\<close>
definition
"restrict_calls vis op C k \<equiv>
{c\<in>vis. \<exists>u. op c = C (NestedOp k u) }"

definition map_spec' :: "
      (callId set  \<Rightarrow> (callId \<Rightarrow>'op) \<Rightarrow> callId rel \<Rightarrow> (('k, 'opn) mapOp \<Rightarrow> 'op) \<Rightarrow> 'k \<Rightarrow> callId set)
    \<Rightarrow> ('op, 'opn::crdt_op, 'r) ccrdtSpec
    \<Rightarrow> ('op, ('k, 'opn) mapOp, ('r::{default,from_bool})) ccrdtSpec" where
"map_spec' deleted_calls nestedSpec oper vis op hb C res \<equiv>
  case oper of
    DeleteKey k \<Rightarrow> res = default
  | KeyExists k \<Rightarrow> res = from_bool (\<exists>c\<in>vis. \<exists>upd_op. op c = C (NestedOp k upd_op) \<and> is_update upd_op \<and>  c \<notin> deleted_calls vis op hb C k)
  | NestedOp k nested_op \<Rightarrow>
     nestedSpec nested_op (vis - deleted_calls vis op hb C k) op hb (\<lambda>x. C (NestedOp k x))  res
"

definition deleted_calls_sdw' :: "callId set \<Rightarrow> (callId \<Rightarrow>'op) \<Rightarrow> callId rel \<Rightarrow> (('k, 'opn) mapOp \<Rightarrow> 'op) \<Rightarrow> 'k \<Rightarrow> callId set" where
"deleted_calls_sdw' vis op hb C k \<equiv> {c\<in>vis. \<exists>d\<in>vis. op d = C (DeleteKey k) \<and> (d,c)\<notin>hb}"

definition
"map_sdw_spec' \<equiv>  map_spec' deleted_calls_sdw'"
text_raw \<open>}%EndSnippet\<close>

lemma in_deleted_calls_sdw':
"c\<in>deleted_calls_sdw' vis op hb C k \<longleftrightarrow> c\<in>vis \<and> (\<exists>d\<in>vis. op d = C (DeleteKey k) \<and> (d,c)\<notin>hb)"
  by (auto simp add: deleted_calls_sdw'_def)

definition "C_out_calls C_out op vis \<equiv> {c\<in>vis. \<exists>x. op c = C_out x}"

lemma restrict_calls_def2: "restrict_calls vis op C k = C_out_calls (C \<circ> (\<lambda>u. NestedOp k u)) op vis"
  by (auto simp add: restrict_calls_def C_out_calls_def)

lemma subcontext_calls:
  assumes in_out: "is_reverse C_in C_out"
  shows "(calls (sub_context C_in Cs ctxt) c \<triangleq> Call op r)
     \<longleftrightarrow> (calls ctxt c \<triangleq> Call (C_out op) r \<and> c\<in>Cs \<and> C_in (C_out op) \<triangleq> op)"

  by (auto simp add:   sub_context_def restrict_ctxt_op_def restrict_ctxt_def fmap_map_values_def ctxt_restrict_calls_def restrict_map_def option_bind_def split: option.splits call.splits,
      (simp add: in_out[simplified is_reverse_def])+)

lemma subcontext_of_subcontext_collapse:
"sub_context C_inA CsA (sub_context C_inB CsB ctxt)
= sub_context (\<lambda>x. C_inB x \<bind> C_inA) (CsA \<inter> CsB) ctxt"
  by (auto simp add: sub_context_def restrict_ctxt_op_def restrict_ctxt_def restrict_hb_def
      fmap_map_values_def ctxt_restrict_calls_def restrict_map_def option_bind_def
      restrict_relation_def
      intro!: ext split: option.splits call.splits)

lemma deleted_calls_sdw_rel:
  assumes "is_reverse C_in C_out"
  assumes "L = deleted_calls_sdw (sub_context C_in Cs ctxt) k"
and "R = deleted_calls_sdw' (dom (map_map (calls ctxt) call_operation \<ggreater> C_in) \<inter> Cs) (extract_op (calls ctxt)) (happensBefore ctxt) C_out k"
shows "L = R"
  by (auto simp add: deleted_calls_sdw_def deleted_calls_sdw'_def sub_context_def assms restrict_ctxt_op_def restrict_ctxt_def
      fmap_map_values_def option_bind_def ctxt_restrict_calls_def restrict_map_def
      restrict_relation_def extract_op_def'  map_map_def map_chain_def cOp_def
      split: option.splits call.splits if_splits,
   (metis (mono_tags, lifting) IntI assms(1) call.sel(1) comp_eq_dest_lhs domIff is_reverse_1 option.simps(3) option.simps(5)),
   (metis assms(1) call.collapse call.sel(1) is_reverse_2 option.sel),
   (metis assms(1) call.collapse call.sel(1) is_reverse_2 option.sel))

lemma map_spec_rel[intro]:
  fixes nestedSpec :: "('opn::crdt_op, 'res::{default,from_bool}) crdtSpec"
    and nestedSpec' :: "('op, 'opn, 'res) ccrdtSpec"
    and deletedCalls :: "(('k, 'opn) mapOp, 'res) operationContext \<Rightarrow> 'k \<Rightarrow> callId set"
    and deletedCalls' :: "callId set \<Rightarrow> (callId \<Rightarrow> 'op) \<Rightarrow> (callId \<times> callId) set \<Rightarrow> (('k, 'opn) mapOp \<Rightarrow> 'op) \<Rightarrow> 'k \<Rightarrow> callId set"
  assumes nested_rel: "crdt_spec_rel nestedSpec nestedSpec'"
    and nested_wf: "ccrdtSpec_wf nestedSpec'"
and deletedCalls_rel:
    "\<And>ctxt C_in C_out Cs k c. \<lbrakk>
      is_reverse C_in C_out;
      Cs \<subseteq> dom (calls ctxt);
      \<exists>co. Op ctxt c \<triangleq> C_out co
     \<rbrakk> \<Longrightarrow>
          c \<in> deleted_calls (sub_context C_in Cs ctxt) k
      \<longleftrightarrow> c \<in> deleted_calls' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k"
shows "crdt_spec_rel (map_spec deleted_calls  nestedSpec) (map_spec' deleted_calls'  nestedSpec') "
  unfolding crdt_spec_rel_def
proof (intro allI impI)

  show "map_spec deleted_calls nestedSpec op (sub_context C_in Cs ctxt) r
      = map_spec' deleted_calls' nestedSpec' op Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out r"
    (is "?l = ?r")
    if is_rev: "is_reverse C_in C_out"
   and in_out: "C_in outer_op \<triangleq> op"
   and Cs_sub: "Cs \<subseteq> dom (calls ctxt)"
   and wf: "operationContext_wf ctxt"
   for  C_in C_out ctxt outer_op op r Cs
  proof -
(*
    from Cs_sub
    have Cs_sub': "\<forall>c\<in>Cs. \<exists>op op' r. calls ctxt c \<triangleq> Call op r \<and> C_in op \<triangleq> op'"
      by (smt call.collapse in_dom map_chain_eq_some map_map_apply_eq_some)
*)

    show "?l = ?r"
    proof (cases op)
      case (NestedOp k nestedOp)

      have h1: "((restrict_calls (dom (calls ctxt) \<inter> Cs) (extract_op (calls ctxt)) C_out k)
                   - deleted_calls' (dom (calls ctxt) \<inter> Cs) (extract_op (calls ctxt)) (happensBefore ctxt) C_out k) =
            {c \<in> dom (calls ctxt). c \<in> Cs \<and> (\<exists>u. extract_op (calls ctxt) c = C_out (NestedOp k u))
               \<and> c \<notin> deleted_calls' (dom (calls ctxt) \<inter> Cs) (extract_op (calls ctxt)) (happensBefore ctxt) C_out k}
              "
         by (auto simp add: restrict_calls_def)

      show ?thesis
      proof (simp add: NestedOp h1 map_spec_def map_spec'_def subcontext_calls[OF is_rev] deletedCalls_rel subcontext_of_subcontext_collapse)

        have sc2: "(sub_context (\<lambda>x. C_in x \<bind> nested_op_on_key k) (- deleted_calls (sub_context C_in Cs ctxt) k \<inter> Cs) ctxt)
            = (sub_context (\<lambda>x. C_in x \<bind> nested_op_on_key k) (- deleted_calls (sub_context C_in Cs ctxt) k
                    \<inter> {c\<in>Cs. \<exists>x y z. calls ctxt c \<triangleq> Call x y \<and> C_in x \<triangleq> z \<and> nested_op_on_key k z \<noteq>None  }  ) ctxt)"
          by (auto simp add: operationContext_ext calls_sub_context happens_before_sub_context restrict_map_def option_bind_def
              intro!: ext split: option.splits if_splits call.splits)
           (metis call.collapse)+

        show "nestedSpec nestedOp
           (sub_context (\<lambda>x. C_in x \<bind> nested_op_on_key k) (- deleted_calls (sub_context C_in Cs ctxt) k \<inter> Cs) ctxt) r =
          nestedSpec' nestedOp (Cs - deleted_calls' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k)
     (extract_op (calls ctxt)) (happensBefore ctxt) (\<lambda>x. C_out (NestedOp k x)) r "
        proof (subst sc2, subst use_crdt_spec_rel[OF nested_rel])

          show is_rev_combined: "is_reverse (\<lambda>x. C_in x \<bind> nested_op_on_key k) (\<lambda>x. C_out (NestedOp k x))"
            by (auto simp add: is_reverse_def option_bind_def nested_op_on_key_def
                is_reverse_1[OF is_rev] is_reverse_2[OF is_rev] split: option.splits mapOp.splits)

          show "(C_in (C_out (NestedOp k nestedOp)) \<bind> nested_op_on_key k) \<triangleq> nestedOp"
            using is_rev_combined is_reverse_def by fastforce

          have h1: "c \<in> deleted_calls (sub_context C_in Cs ctxt) k
               \<longleftrightarrow> c \<in> deleted_calls' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k"
            if "\<exists>co. Op ctxt c \<triangleq> C_out co"
            for c
            using Cs_sub that
            by (rule deletedCalls_rel[OF is_rev])

          have h2: "\<exists>co'. Op ctxt c \<triangleq> C_out co'"
            if "calls ctxt c \<triangleq> Call co cr"
                and "C_in co \<triangleq> co'"
              for c co cr co'
            by (metis cOp_def call.sel(1) is_rev is_reverse_1 option.simps(9) that(1) that(2))

          have h2': "\<exists>co'. Op ctxt c \<triangleq> C_out co'"
            if "C_out (NestedOp k y) = extract_op (calls ctxt) c"
              and "c \<in> Cs"
            for c y
            by (metis (mono_tags, lifting) Cs_sub cOp_def extract_op_def in_dom option.sel option.simps(9) that(1) that(2))

          have h3: "c \<in> deleted_calls (sub_context C_in Cs ctxt) k
               \<longleftrightarrow> c \<in> deleted_calls' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k"
            if "calls ctxt c \<triangleq> Call co cr"
              and "C_in co \<triangleq> co'"
            for c co cr co'
            using h1[OF  h2[OF that]]
            by auto

          have h4: "
             (dom (map_map (calls ctxt) call_operation \<ggreater> (\<lambda>x. C_in x \<bind> nested_op_on_key k)) \<inter> (- DC  \<inter> Cs) )
             =
             ({c \<in> dom (map_map (calls ctxt) call_operation \<ggreater> C_in).
               c \<in> Cs \<and> (\<exists>u. extract_op (calls ctxt) c = C_out (NestedOp k u))} - DC)"
            if "DC = deleted_calls' (dom (map_map (calls ctxt) call_operation \<ggreater> C_in) \<inter> Cs) (extract_op (calls ctxt)) (happensBefore ctxt) C_out k"
            for DC
            by (auto simp add: map_map_def map_chain_def option_bind_def split: option.splits,
              auto simp add: nested_op_on_key_def extract_op_def' is_reverse_2[OF is_rev] split: option.splits mapOp.splits if_splits call.splits,
              use is_rev is_reverse_1 in fastforce)

          show "- deleted_calls (sub_context C_in Cs ctxt) k \<inter>
              {c \<in> Cs. \<exists>x y z. calls ctxt c \<triangleq> Call x y \<and> C_in x \<triangleq> z \<and> nested_op_on_key k z \<noteq> None}
              \<subseteq> dom (calls ctxt)"
            using Cs_sub
            by (auto simp add: map_chain_def option_bind_def map_map_def dom_def dest!: subset_h1 split: option.splits)

          have subset: "(- deleted_calls' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k \<inter>
                    {c \<in> Cs. \<exists>x. (\<exists>y. calls ctxt c \<triangleq> Call x y) \<and> (\<exists>z. C_in x \<triangleq> z \<and> (\<exists>y. nested_op_on_key k z \<triangleq> y))})
              \<subseteq> (Cs - deleted_calls' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k) "
            by auto

          show "nestedSpec' nestedOp
             (- deleted_calls (sub_context C_in Cs ctxt) k \<inter>
              {c \<in> Cs. \<exists>x y z. calls ctxt c \<triangleq> Call x y \<and> C_in x \<triangleq> z \<and> nested_op_on_key k z \<noteq> None})
             (extract_op (calls ctxt)) (happensBefore ctxt) (\<lambda>x. C_out (NestedOp k x)) r =
            nestedSpec' nestedOp (Cs - deleted_calls' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k)
             (extract_op (calls ctxt)) (happensBefore ctxt) (\<lambda>x. C_out (NestedOp k x)) r"
            apply (rule use_ccrdtSpec_wf'[OF nested_wf, symmetric])
               apply (auto simp add: h1 h2' h2 )
            by (smt Cs_sub bind.bind_lunit extract_op_eq is_rev is_rev_combined is_reverse_def subsetD)

          show "operationContext_wf ctxt"
            by (simp add: local.wf)

        qed
      qed

    next
      case (KeyExists k)
      show ?thesis
      proof (simp add: KeyExists map_spec_def map_spec'_def,
              rule arg_cong[where f="\<lambda>x. r = from_bool x"])

        show "(\<exists>c op.
                (\<exists>r. calls (sub_context C_in Cs ctxt) c \<triangleq> Call (NestedOp k op) r) \<and>
                is_update op \<and> c \<notin> deleted_calls (sub_context C_in Cs ctxt) k) =
            (\<exists>c\<in>Cs.
                \<exists>upd_op.
                   extract_op (calls ctxt) c = C_out (NestedOp k upd_op) \<and>
                   is_update upd_op \<and> c \<notin> deleted_calls' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k)"
        proof (auto simp add: Bex_def calls_sub_context option_bind_def dom_map_chain restrict_map_def split: option.splits, fuzzy_goal_cases A B)
          case (A c y)
          show ?case
          proof (auto intro!: exI[where x=c])
            show "c \<in> Cs"
              using A(1) A(2) by auto
            show "\<exists>upd_op.
             extract_op (calls ctxt) c = C_out (NestedOp k upd_op) \<and>
             is_update upd_op \<and> c \<notin> deleted_calls' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k"
              using A
            proof (auto simp add: extract_op_def' split: option.splits call.splits )
              fix x1 :: 'op and x2 :: 'res
              assume a1: "y = Call x1 x2"
              have "\<forall>m z. C_out m = z \<or> C_in z \<noteq> Some m"
                by (meson is_rev is_reverse_def)
              then show "\<exists>z. x1 = C_out (NestedOp k z) \<and> is_update z \<and> c \<notin> deleted_calls' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k"
                by (smt A(2) A.All_conj Cs_sub a1 assms(3) cOp_def call.sel(1) is_rev option.exhaust_sel option.map(2))
            qed
          qed

        next
          case (B c upd_op)
          show ?case
          proof (rule exI[where x=c], auto)
            show " \<exists>y. calls ctxt c \<triangleq> y"
              using B.member Cs_sub by blast
            show "\<And>x2. \<lbrakk>C_in (call_operation x2) = None; calls ctxt c \<triangleq> x2\<rbrakk> \<Longrightarrow> False"
              by (metis B.extract_op_eq extract_op_def is_rev is_reverse_2 option.discI option.sel)

            show "\<exists>op. x2a = NestedOp k op \<and> is_update op \<and> c \<notin> deleted_calls (sub_context C_in Cs ctxt) k"
              if c0: "C_in (call_operation x2) \<triangleq> x2a"
                and c1: "calls ctxt c \<triangleq> x2"
                and c2: "c \<in> Cs"
              for  x2 x2a
              by (smt B.extract_op_eq B.is_update B.not_member Cs_sub c0 c1 cOp_def deletedCalls_rel extract_op_def is_rev is_reverse_2 option.sel option.simps(9))

            show "\<And>x2 x2a. \<lbrakk>C_in (call_operation x2) \<triangleq> x2a; calls ctxt c \<triangleq> x2\<rbrakk> \<Longrightarrow> c \<in> Cs"
              by (simp add: B.member)
          qed
        qed
      qed
    next
      case (DeleteKey k)
      then show ?thesis
        by (auto simp add: map_spec_def map_spec'_def)
    qed

  qed
qed

lemma map_sdw_spec_rel[intro!]:
  fixes nestedSpec' :: "('op, 'opn::crdt_op, 'res::from_bool) ccrdtSpec"
  assumes nested_rel: "crdt_spec_rel nestedSpec nestedSpec'"
    and nested_wf: "ccrdtSpec_wf nestedSpec'"
  shows "crdt_spec_rel (map_sdw_spec nestedSpec) (map_sdw_spec' nestedSpec') "
  unfolding map_sdw_spec'_def map_sdw_spec_def
proof (rule map_spec_rel[OF nested_rel nested_wf])

  show "(c \<in> deleted_calls_sdw (sub_context C_in Cs ctxt) k) = (c \<in> deleted_calls_sdw' Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out k)"
    if c0: "is_reverse C_in C_out"
      and c1: "Cs \<subseteq> dom (calls ctxt)"
      and c2: "\<exists>co. Op ctxt c \<triangleq> C_out co"
    for  ctxt C_in C_out Cs k c
  apply (auto simp add: deleted_calls_sdw_def deleted_calls_sdw'_def calls_subcontext_some)
    apply (auto simp add: Op_subcontext)
    apply (auto simp add: cOp_def sub_context_def
restrict_ctxt_op_def restrict_ctxt_def ctxt_restrict_calls_def restrict_relation_def
fmap_map_values_def extract_op_def
is_reverse_1[OF c0] is_reverse_2[OF c0])
  subgoal
  using c0 is_reverse_1 by force
  subgoal for d
  proof -
    assume a0: "c \<in> Cs"
      and a1: "d \<in> Cs"
      and a2: "call_operation (the (calls ctxt d)) = C_out (DeleteKey k)"
      and a3: "(d, c) \<notin> happensBefore ctxt"

    obtain x_call where "calls ctxt c \<triangleq> x_call"
      using a0 c1 by auto

    show "\<exists>y ci'. calls ctxt c \<triangleq> ci' \<and> call_res y = call_res ci' \<and> C_in (call_operation ci') \<triangleq> call_operation y"
    proof (intro conjI exI)
      show "calls ctxt c \<triangleq> x_call"
        by (simp add: \<open>calls ctxt c \<triangleq> x_call\<close>)

      show "call_res (Call (the (C_in (call_operation x_call))) (call_res x_call)) = call_res x_call"
        by simp

      show "C_in (call_operation x_call) \<triangleq> call_operation (Call (the (C_in (call_operation x_call))) (call_res x_call))"
        apply auto
        by (metis \<open>calls ctxt c \<triangleq> x_call\<close> c0 c2 cOp_def is_reverse_def map_option_eq_Some option.sel)
    qed
  qed

  subgoal
    using c0 c1 is_reverse_2 by force
  done
qed

lemma restrict_calls_wf:
  assumes " map_same_on Cs op op'"
  shows "restrict_calls Cs op C_out k
  = restrict_calls Cs op' C_out k"
  using assms by (auto simp add: restrict_calls_def map_same_on_def)

lemma map_spec_wf[simp]:
  assumes nested: "\<And>oper. ccrdtSpec_wf nested"
    and dwf: "\<forall>oper Cs Cs' op op' hb hb' C_out k c.
      map_same_on Cs' op op'
      \<longrightarrow> rel_same_on Cs' hb hb'
      \<longrightarrow> Cs' \<subseteq> Cs
      \<longrightarrow> (\<forall>c\<in>Cs. (\<exists>y. C_out y = op c) \<longrightarrow> c \<in> Cs')
      \<longrightarrow> c \<in> Cs'
      \<longrightarrow> (c \<in> deleted_calls Cs op hb C_out k \<longleftrightarrow> c \<in> deleted_calls Cs' op' hb' C_out k)"
  shows
    "ccrdtSpec_wf (map_spec' deleted_calls nested)"
proof (simp add: ccrdtSpec_wf_def; intro impI allI)

  show "map_spec' deleted_calls nested opr Cs op hb C_out r = map_spec' deleted_calls nested opr Cs' op' hb' C_out r"
    if c0: "map_same_on Cs' op op'"
      and c1: "rel_same_on Cs' hb hb'"
      and c2: "Cs' \<subseteq> Cs"
      and c3: "\<forall>c\<in>Cs. (\<exists>y. C_out y = op c) \<longrightarrow> c \<in> Cs'"
    for  opr Cs Cs' op op' hb hb' C_out r
  proof -

    show "map_spec' deleted_calls nested opr Cs op hb C_out r
        = map_spec' deleted_calls nested opr Cs' op' hb' C_out r"
      unfolding map_spec'_def proof (cases opr; clarsimp)
      case (NestedOp k nop)

      show "nested nop (Cs - deleted_calls Cs op hb C_out k) op hb (\<lambda>x. C_out (NestedOp k x)) r
          = nested nop (Cs' - deleted_calls Cs' op' hb' C_out k) op' hb' (\<lambda>x. C_out (NestedOp k x)) r"
      proof (rule use_ccrdtSpec_wf'[OF nested])
        show "map_same_on (Cs' - deleted_calls Cs' op' hb' C_out k) op op'"
          by (meson DiffD1 c0 map_same_on_def)
        show "rel_same_on (Cs' - deleted_calls Cs' op' hb' C_out k) hb hb'"
          by (meson DiffD1 c1 rel_same_on_def)
        show "Cs' - deleted_calls Cs' op' hb' C_out k \<subseteq> Cs - deleted_calls Cs op hb C_out k"
          apply auto
          using c2 apply blast
          using c0 c1 c2 c3 dwf by blast
        show "\<And>c. \<lbrakk>c \<in> Cs - deleted_calls Cs op hb C_out k; \<exists>y. C_out (NestedOp k y) = op c\<rbrakk> \<Longrightarrow> c \<in> Cs' - deleted_calls Cs' op' hb' C_out k"
          apply (auto simp add: Diff_iff)
          using c3 apply blast
          using c0 c1 c2 c3 dwf by blast
      qed
    next
      case (KeyExists x2)
      show "(r =
           from_bool
            (\<exists>c\<in>Cs. \<exists>upd_op. op c = C_out (NestedOp x2 upd_op) \<and> is_update upd_op \<and> c \<notin> deleted_calls Cs op hb C_out x2)) =
          (r =
           from_bool
            (\<exists>c\<in>Cs'. \<exists>upd_op. op' c = C_out (NestedOp x2 upd_op) \<and> is_update upd_op \<and> c \<notin> deleted_calls Cs' op' hb' C_out x2))"
        apply (auto intro!: arg_cong[where f="from_bool"])
        subgoal for c upd_op
          apply (rule bexI[where x=c])
           apply (rule exI[where x=upd_op])
           apply auto
            apply (metis c0 c3 map_same_on_def)
           apply (metis (mono_tags, lifting) c0 c1 c2 c3 dwf)
          using c3 by fastforce
        subgoal for c upd_op
          apply (rule bexI[where x=c])
           apply (rule exI[where x=upd_op])
           apply auto
            apply (metis c0 map_same_on_def)
           apply (metis (mono_tags, lifting) c0 c1 c2 c3 dwf)
          using c2 by blast
        subgoal for c upd_op
          apply (rule bexI[where x=c])
           apply (rule exI[where x=upd_op])
           apply auto
            apply (metis c0 map_same_on_def)
           apply (metis (mono_tags, lifting) c0 c1 c2 c3 dwf)
          using c2 by blast
        subgoal for c upd_op
          apply (rule bexI[where x=c])
           apply (rule exI[where x=upd_op])
           apply auto
            apply (metis c0 c3 map_same_on_def)
           apply (metis (mono_tags, lifting) c0 c1 c2 c3 dwf)
          using c3 by fastforce
        done
    qed
  qed
qed

lemma map_sdw_spec_wf[intro!]:
  assumes nested_rel: "ccrdtSpec_wf nestedSpec"
  shows "ccrdtSpec_wf (map_sdw_spec' nestedSpec)"
  unfolding map_sdw_spec'_def using nested_rel
proof (rule map_spec_wf; intro allI impI)

  show "(c \<in> deleted_calls_sdw' Cs op hb C_out k) = (c \<in> deleted_calls_sdw' Cs' op' hb' C_out k)"
    if c0: "ccrdtSpec_wf nestedSpec"
      and c1: "map_same_on Cs' op op'"
      and c2: "rel_same_on Cs' hb hb'"
      and c3: "Cs' \<subseteq> Cs"
      and c4: "\<forall>c\<in>Cs. (\<exists>y. C_out y = op c) \<longrightarrow> c \<in> Cs'"
      and c5: "c \<in> Cs'"
    for  oper Cs Cs' op op' hb hb' C_out k c
    apply (auto simp add: deleted_calls_sdw'_def map_same_on_def rel_same_on_def)
    subgoal
      using c5 by auto
    subgoal
      by (smt c1 c2 c4 c5 map_same_on_def rel_same_on_def)
    subgoal
      using c3 by blast
    subgoal
      by (smt c1 c2 c3 in_mono map_same_on_def rel_same_on_def)
    done
qed

subsection "Structs"

definition struct_field' :: "('opn \<Rightarrow> 'a) \<Rightarrow> ('op, 'opn, 'res) ccrdtSpec \<Rightarrow> ('op, 'a, 'res) ccrdtSpec " where
"struct_field' C_out spec opr  \<equiv>
  \<lambda> vis op hb x_C_out res.
    case select_field C_out opr of
      Some i_op \<Rightarrow> spec i_op vis op hb (x_C_out \<circ> C_out)  res
    | None \<Rightarrow> False
"

definition compose_struct' :: "('op, 'opn, 'r) ccrdtSpec \<Rightarrow> ('op, 'opn, 'r) ccrdtSpec \<Rightarrow> ('op, 'opn, 'r) ccrdtSpec" (infixr ".\<or>.." 30) where
"A .\<or>.. B \<equiv> \<lambda>opr vis op hb f r. A opr vis op hb f r \<or> B opr vis op hb f r"

lemma compose_struct'_simp[simp]:
"(A .\<or>.. B) opr vis op hb f r \<longleftrightarrow> A opr vis op hb f r \<or> B opr vis op hb f r"
  unfolding compose_struct'_def by auto

lemma struct_field'_same[simp]:
  assumes "inj f"
  shows "struct_field' f spec (f opr) vis op hb out1 r  \<longleftrightarrow> spec opr vis op hb (out1 \<circ> f) r"
  using assms by (auto simp add: struct_field'_def is_reverse_2 select_field_reverse split: option.splits)

lemma struct_field'_different[simp]:
  assumes "\<And>x y. f x \<noteq> g y"
  shows "\<not>struct_field' f spec (g opr) vis op hb out1 r"
  by (metis (no_types, lifting) assms option.simps(4) select_field_def struct_field'_def)

lemma crdt_spec_rel_struct_field[intro!]:
  fixes nspec :: "('opn, 'r) crdtSpec"
    and nspec' :: "('op, 'opn, 'r) ccrdtSpec"
  assumes rel: "crdt_spec_rel nspec nspec'"
    and f_inj: "inj f"
  shows "crdt_spec_rel (struct_field f nspec) (struct_field' f nspec')"
proof (rule show_crdt_spec_rel')

  show "struct_field f nspec op (sub_context C_in Cs ctxt) r
      = struct_field' f nspec' op Cs (extract_op (calls ctxt)) (happensBefore ctxt) C_out r"
    if c0: "is_reverse C_in C_out"
      and c1: "operationContext_wf ctxt"
      and c2: "C_in outer_op \<triangleq> op"
      and c3: "Cs \<subseteq> dom (calls ctxt)"
    for  C_in C_out ctxt outer_op op r Cs
   unfolding struct_field_def struct_field'_def
  proof (cases "select_field f op"; clarsimp)
    case (Some op')

    show "nspec op' (restrict_ctxt_op (select_field f) (sub_context C_in Cs ctxt)) r
        = nspec' op' Cs (extract_op (calls ctxt))
          (happensBefore ctxt) (C_out \<circ> f) r"
    proof (fuzzy_rule use_crdt_spec_rel[OF rel])

      show "is_reverse (C_in \<ggreater> select_field f) (C_out \<circ> f)"
        by (simp add: c0 f_inj is_reverse_combine select_field_reverse)

      show "(C_in \<ggreater> select_field f) outer_op \<triangleq> op'"
        by (simp add: Some c2 map_chain_eq_some)

      show "operationContext_wf ctxt" using c1 .

      show " Cs \<subseteq> dom (calls ctxt)"
        by (simp add: c3)

      show "sub_context (C_in \<ggreater> select_field f) Cs ctxt
         = restrict_ctxt_op (select_field f) (sub_context C_in Cs ctxt)"
        using is_reverse_1[OF c0]
        by (auto simp add: sub_context_def C_out_calls_def select_field_def
            restrict_ctxt_op_def restrict_ctxt_def restrict_hb_def
            ctxt_restrict_calls_def restrict_map_def extract_op_def
            option_bind_def map_chain_def
            restrict_relation_def
            fmap_map_values_def intro!: HOL.ext
            split: option.splits if_splits)
          metis+
    qed
  qed
qed

lemma crdt_spec_rel_compose[intro!]:
  assumes relA: "crdt_spec_rel specA specA'"
    and relB: "crdt_spec_rel specB specB'"
  shows "crdt_spec_rel (specA .\<or>. specB) (specA' .\<or>.. specB')"
  using assms  by (auto simp add: compose_struct_def compose_struct'_def dom_calls_sub_context_rewrite
      use_crdt_spec_rel1 dom_calls_sub_context_rewrite inf.absorb_iff2 use_crdt_spec_rel2 intro!: show_crdt_spec_rel)

lemma struct_field_wf[intro!]:
  assumes nested_rel: "ccrdtSpec_wf nestedSpec"
  shows "ccrdtSpec_wf (struct_field' C_out nestedSpec)"
proof (clarsimp simp add: ccrdtSpec_wf_def struct_field'_def C_out_calls_def split: option.splits)

  show "nestedSpec x2 Cs op hb (C_outa \<circ> C_out) r
    = nestedSpec x2 Cs' op' hb' (C_outa \<circ> C_out) r"
    if c0: "map_same_on Cs' op op'"
   and c1: "rel_same_on Cs' hb hb'"
   and c2: "Cs' \<subseteq> Cs"
   and c3: "\<forall>c\<in>Cs. (\<exists>y. C_outa y = op c) \<longrightarrow> c \<in> Cs'"
   and c4: "select_field C_out opr \<triangleq> x2"
 for  opr Cs Cs' op op' hb hb' C_outa r x2
    by (metis (mono_tags, lifting) c0 c1 c2 c3 comp_apply nested_rel use_ccrdtSpec_wf')
qed

lemma struct_compose_wf[intro!]:
  assumes wfA: "ccrdtSpec_wf specA"
    and wfB: "ccrdtSpec_wf specB"
  shows "ccrdtSpec_wf (specA .\<or>.. specB)"
  by (auto simp add: ccrdtSpec_wf_def compose_struct'_def use_ccrdtSpec_wf'1[OF wfA] use_ccrdtSpec_wf'1[OF wfB]
      use_ccrdtSpec_wf'2[OF wfA] use_ccrdtSpec_wf'2[OF wfB])

lemma sub_context_id:
  assumes calls_sub: "dom (calls ctxt) \<subseteq> c_calls"
    and hb_wf: "Field (happensBefore ctxt) \<subseteq> dom (calls ctxt)"
  shows "(sub_context Some c_calls ctxt) = ctxt"
proof (auto simp add: operationContext_ext calls_sub_context happens_before_sub_context restrict_map_def intro!: ext)
  show "\<And>c. c \<notin> c_calls \<Longrightarrow> None = calls ctxt c"
using calls_sub domIff by force
  show "\<And>a b. \<lbrakk>(a, b) \<in> happensBefore ctxt; a \<in> c_calls\<rbrakk> \<Longrightarrow> \<exists>y. calls ctxt a \<triangleq> y"
    by (meson FieldI1 hb_wf in_dom)
  show "\<And>a b. (a, b) \<in> happensBefore ctxt \<Longrightarrow> a \<in> c_calls"
    by (meson FieldI1 calls_sub hb_wf subset_h1)
  show "\<And>a b. \<lbrakk>(a, b) \<in> happensBefore ctxt; b \<in> c_calls\<rbrakk> \<Longrightarrow> \<exists>y. calls ctxt b \<triangleq> y"
    by (meson FieldI2 hb_wf in_dom)
  show "\<And>a b. (a, b) \<in> happensBefore ctxt \<Longrightarrow> b \<in> c_calls "
    by (meson FieldI2 calls_sub hb_wf subset_h1)
qed

lemma sub_context_id2:
  assumes  hb_wf: "Field (happensBefore ctxt) \<subseteq> dom (calls ctxt)"
  shows "(sub_context Some (dom (calls ctxt)) ctxt) = ctxt"
  by (simp add: hb_wf sub_context_id)

lemma sub_context_id3:
  assumes  wf: "operationContext_wf ctxt"
  shows "(sub_context Some (dom (calls ctxt)) ctxt) = ctxt"
proof (rule sub_context_id2)
  show "Field (happensBefore ctxt) \<subseteq> dom (calls ctxt)"
    by (simp add: local.wf operationContext_wf_hb_field)
qed

end