section \<open> Substitution \<close>

theory utp_subst
imports
  utp_expr
  utp_unrest
  utp_tactics
  utp_lift_parser
begin

subsection \<open> Substitution definitions \<close>

text \<open> Variable substitution, like unrestriction, will be characterised semantically using lenses
  and state-spaces. Effectively a substitution $\sigma$ is simply a function on the state-space which
  can be applied to an expression $e$ using the syntax $\sigma \mathop{\dagger} e$.  We introduce
  a polymorphic constant that will be used to represent application of a substitution, and also a
  set of theorems to represent laws. \<close>

consts
  usubst :: "'s \<Rightarrow> 'a \<Rightarrow> 'b" (infixr "\<dagger>" 80)

named_theorems usubst

text \<open> A substitution is simply a transformation on the alphabet; it shows how variables
  should be mapped to different values. Most of the time these will be homogeneous functions
  but for flexibility we also allow some operations to be heterogeneous. \<close>

type_synonym ('\<alpha>,'\<beta>) psubst = "('\<beta>, '\<alpha>) uexpr"
type_synonym '\<alpha> usubst = "('\<alpha>, '\<alpha>) uexpr"

text \<open> Application of a substitution simply applies the function $\sigma$ to the state binding
  $b$ before it is handed to $e$ as an input. This effectively ensures all variables are updated
  in $e$. \<close>

lift_definition subst :: "('\<alpha>, '\<beta>) psubst \<Rightarrow> ('a, '\<beta>) uexpr \<Rightarrow> ('a, '\<alpha>) uexpr" is
"\<lambda> \<sigma> e b. e (\<sigma> b)" .

adhoc_overloading
  usubst subst

text \<open> Substitutions can be updated by associating variables with expressions. We thus create an
  additional polymorphic constant to represent updating the value of a variable to an expression
  in a substitution, where the variable is modelled by type @{typ "'v"}. This again allows us
  to support different notions of variables, such as deep variables, later. \<close>

(* consts subst_upd :: "('\<alpha>,'\<beta>) psubst \<Rightarrow> 'v \<Rightarrow> ('a, '\<alpha>) uexpr \<Rightarrow> ('\<alpha>,'\<beta>) psubst" *)

text \<open> We can also represent an arbitrary substitution as below. \<close>

lift_definition subst_nil :: "('\<alpha>, '\<beta>) psubst" ("nil\<^sub>s") is "\<lambda> s. undefined" .

lift_definition subst_id :: "'\<alpha> usubst" ("id\<^sub>s") is "\<lambda>s. s" .

lift_definition subst_comp :: "('\<beta>, '\<gamma>) psubst \<Rightarrow> ('\<alpha>, '\<beta>) psubst \<Rightarrow> ('\<alpha>, '\<gamma>) psubst" (infixl "\<circ>\<^sub>s" 55) is
"Fun.comp" .

lift_definition inv_subst :: "('\<alpha>, '\<beta>) psubst \<Rightarrow> ('\<beta>, '\<alpha>) psubst" ("inv\<^sub>s") is inv .
lift_definition inj_subst :: "('\<alpha>, '\<beta>) psubst \<Rightarrow> bool" ("inj\<^sub>s") is inj .
lift_definition bij_subst :: "('\<alpha>, '\<beta>) psubst \<Rightarrow> bool" ("bij\<^sub>s") is bij .

declare inj_subst_def [uexpr_transfer_extra]
declare bij_subst_def [uexpr_transfer_extra]

text \<open> The following function takes a substitution form state-space @{typ "'\<alpha>"} to @{typ "'\<beta>"}, a
  lens with source @{typ "'\<beta>"} and view "'a", and an expression over @{typ "'\<alpha>"} and returning
  a value of type "@{typ "'a"}, and produces an updated substitution. It does this by constructing
  a substitution function that takes state binding $b$, and updates the state first by applying
  the original substitution $\sigma$, and then updating the part of the state associated with lens
  $x$ with expression evaluated in the context of $b$. This effectively means that $x$ is now
  associated with expression $v$. We add this definition to our overloaded constant. \<close>

lift_definition subst_upd :: "('\<alpha>,'\<beta>) psubst \<Rightarrow> ('a \<Longrightarrow> '\<beta>) \<Rightarrow> ('a, '\<alpha>) uexpr \<Rightarrow> ('\<alpha>,'\<beta>) psubst"
is "\<lambda> \<sigma> x v s. put\<^bsub>x\<^esub> (\<sigma> s) (v s)" .

text \<open> The next function looks up the expression associated with a variable in a substitution
  by use of the \emph{get} lens function. \<close>

lift_definition usubst_lookup :: "('\<alpha>,'\<beta>) psubst \<Rightarrow> ('a \<Longrightarrow> '\<beta>) \<Rightarrow> ('a, '\<alpha>) uexpr" ("\<langle>_\<rangle>\<^sub>s")
is "\<lambda> \<sigma> x b. get\<^bsub>x\<^esub> (\<sigma> b)" .

text \<open> Substitutions also exhibit a natural notion of unrestriction which states that $\sigma$
  does not restrict $x$ if application of $\sigma$ to an arbitrary state $\rho$ will not effect
  the valuation of $x$. Put another way, it requires that \emph{put} and the substitution commute. \<close>

lift_definition unrest_usubst :: "('a \<Longrightarrow> '\<alpha>) \<Rightarrow> '\<alpha> usubst \<Rightarrow> bool"
is "\<lambda> x \<sigma>. (\<forall> \<rho> v. \<sigma> (put\<^bsub>x\<^esub> \<rho> v) = put\<^bsub>x\<^esub> (\<sigma> \<rho>) v)" .

syntax
  "_unrest_usubst" :: "salpha \<Rightarrow> logic \<Rightarrow> logic \<Rightarrow> logic" (infix "\<sharp>\<^sub>s" 20)

translations
  "_unrest_usubst x p" == "CONST unrest_usubst x p"
  "_unrest_usubst (_salphaset (_salphamk (x +\<^sub>L y))) P"  <= "_unrest_usubst (x +\<^sub>L y) P"

text \<open> Parallel substitutions allow us to divide the state space into three segments using two
  lens, A and B. They correspond to the part of the state that should be updated by the
  respective substitution. The two lenses should be independent. If any part of the state
  is not covered by either lenses then this area is left unchanged (framed). \<close>

lift_definition par_subst :: "'\<alpha> usubst \<Rightarrow> ('a \<Longrightarrow> '\<alpha>) \<Rightarrow> ('b \<Longrightarrow> '\<alpha>) \<Rightarrow> '\<alpha> usubst \<Rightarrow> '\<alpha> usubst" is
"\<lambda> \<sigma>\<^sub>1 A B \<sigma>\<^sub>2. (\<lambda> s. (s \<oplus>\<^sub>L (\<sigma>\<^sub>1 s) on A) \<oplus>\<^sub>L (\<sigma>\<^sub>2 s) on B)" .

no_utp_lift subst_upd (1) subst usubst usubst_lookup

subsection \<open> Syntax translations \<close>

text \<open> We support two kinds of syntax for substitutions, one where we construct a substitution
  using a maplet-style syntax, with variables mapping to expressions. Such a constructed substitution
  can be applied to an expression. Alternatively, we support the more traditional notation,
  $P \llbracket v / x \rrbracket$, which also support multiple simultaneous substitutions. We
  have to use double square brackets as the single ones are already well used.

  We set up non-terminals to represent a single substitution maplet, a sequence of maplets, a
  list of expressions, and a list of alphabets. The parser effectively uses @{term subst_upd}
  to construct substitutions from multiple variables.
\<close>

nonterminal smaplet and smaplets and salphas

syntax
  "_smaplet"  :: "[salpha, logic] => smaplet"             ("_ /\<mapsto>\<^sub>s/ _")
  ""          :: "smaplet => smaplets"            ("_")
  "_SMaplets" :: "[smaplet, smaplets] => smaplets" ("_,/ _")
  "_SubstUpd" :: "['m usubst, smaplets] => 'm usubst" ("_/'(_')" [900,0] 900)
  "_Subst"    :: "smaplets => logic"            ("(1[_])")
  "_PSubst"   :: "smaplets => logic"            ("(1\<lparr>_\<rparr>)")
  "_psubst"   :: "[logic, svars, uexprs] \<Rightarrow> logic"
  "_subst"    :: "logic \<Rightarrow> uexprs \<Rightarrow> salphas \<Rightarrow> logic" ("(_\<lbrakk>_'/_\<rbrakk>)" [990,0,0] 991)
  "_uexprs"   :: "[logic, uexprs] => uexprs" ("_,/ _")
  ""          :: "logic => uexprs" ("_")
  "_salphas"  :: "[salpha, salphas] => salphas" ("_,/ _")
  ""          :: "salpha => salphas" ("_")
  "_par_subst" :: "logic \<Rightarrow> salpha \<Rightarrow> salpha \<Rightarrow> logic \<Rightarrow> logic" ("_ [_|_]\<^sub>s _" [100,0,0,101] 101)

translations
  "_SubstUpd m (_SMaplets xy ms)"     == "_SubstUpd (_SubstUpd m xy) ms"
  "_SubstUpd m (_smaplet x y)"        => "CONST subst_upd m x U(y)"
  "_SubstUpd m (_smaplet x y)"        <= "CONST subst_upd m x y"
  "_Subst ms"                         == "_SubstUpd id\<^sub>s ms"
  "_Subst (_SMaplets ms1 ms2)"        <= "_SubstUpd (_Subst ms1) ms2"
  "_PSubst ms"                        == "_SubstUpd nil\<^sub>s ms"
  "_PSubst (_SMaplets ms1 ms2)"       <= "_SubstUpd (_PSubst ms1) ms2"
  "_SMaplets ms1 (_SMaplets ms2 ms3)" <= "_SMaplets (_SMaplets ms1 ms2) ms3"
  "_subst P es vs" => "CONST subst (_psubst id\<^sub>s vs es) P"
  "_psubst m (_salphas x xs) (_uexprs v vs)" => "_psubst (_psubst m x v) xs vs"
  "_psubst m x v"  => "CONST subst_upd m x v"
  "_subst P v x" <= "CONST usubst (CONST subst_upd id\<^sub>s x v) P"
  "_subst P v x" <= "_subst P (_spvar x) v"
  "_par_subst \<sigma>\<^sub>1 A B \<sigma>\<^sub>2" == "CONST par_subst \<sigma>\<^sub>1 A B \<sigma>\<^sub>2"

text \<open> Thus we can write things like @{term "\<sigma>(x \<mapsto>\<^sub>s v)"} to update a variable $x$ in $\sigma$ with
  expression $v$, @{term "[x \<mapsto>\<^sub>s e, y \<mapsto>\<^sub>s f]"} to construct a substitution with two variables,
  and finally @{term "P\<lbrakk>v/x\<rbrakk>"}, the traditional syntax.

  We can now express deletion of and restriction to a substitution maplet. \<close>

definition subst_del :: "'\<alpha> usubst \<Rightarrow> ('a \<Longrightarrow> '\<alpha>) \<Rightarrow> '\<alpha> usubst" (infix "-\<^sub>s" 85) where
[uexpr_defs]: "subst_del \<sigma> x = \<sigma>(x \<mapsto>\<^sub>s &x)"

definition subst_restr :: "'\<alpha> usubst \<Rightarrow> ('a \<Longrightarrow> '\<alpha>) \<Rightarrow> '\<alpha> usubst" (infix "\<rhd>\<^sub>s" 85) where
[uexpr_defs]: "subst_restr \<sigma> x = [x \<mapsto>\<^sub>s \<langle>\<sigma>\<rangle>\<^sub>s x]"

subsection \<open> Substitution Application Laws \<close>

text \<open> We set up a simple substitution tactic that applies substitution and unrestriction laws \<close>

method subst_tac = (simp add: usubst unrest)?

text \<open> Evaluation of a substitution expression involves application of the substitution to different
  variables. Thus we first prove laws for these cases. The simplest substitution, $id$, when applied
  to any variable $x$ simply returns the variable expression, since $id$ has no effect. \<close>

lemma usubst_lookup_id [usubst]: "\<langle>id\<^sub>s\<rangle>\<^sub>s x = var x"
  by (transfer, simp)

lemma subst_id_var: "id\<^sub>s = &\<^bold>v"
  by (transfer, auto simp add: lens_defs)

lemma subst_upd_id_lam [usubst]: "subst_upd &\<^bold>v x v = subst_upd id\<^sub>s x v"
  by (simp add: subst_id_var)

lemma subst_id [simp]: "id\<^sub>s \<circ>\<^sub>s \<sigma> = \<sigma>" "\<sigma> \<circ>\<^sub>s id\<^sub>s = \<sigma>"
  by (transfer, auto)+

lemma subst_upd_alt_def: "subst_upd \<sigma> x v = bop (put\<^bsub>x\<^esub>) \<sigma> v"
  by (transfer, simp)

lemma subst_apply_one_lens [usubst]: "\<langle>\<sigma>\<rangle>\<^sub>s (&\<^bold>v)\<^sub>v = \<sigma>"
  by (transfer, simp add: lens_defs)

text \<open> A substitution update naturally yields the given expression. \<close>

lemma usubst_lookup_upd [usubst]:
  assumes "weak_lens x"
  shows "\<langle>\<sigma>(x \<mapsto>\<^sub>s v)\<rangle>\<^sub>s x = v"
  using assms
  by (simp add: subst_upd_def, transfer) (simp)

lemma usubst_lookup_upd_pr_var [usubst]:
  assumes "weak_lens x"
  shows "\<langle>\<sigma>(x \<mapsto>\<^sub>s v)\<rangle>\<^sub>s (pr_var x) = v"
  using assms
  by (simp add: subst_upd_def pr_var_def, transfer) (simp)

text \<open> Substitution update is idempotent. \<close>

lemma usubst_upd_idem [usubst]:
  assumes "mwb_lens x"
  shows "\<sigma>(x \<mapsto>\<^sub>s u, x \<mapsto>\<^sub>s v) = \<sigma>(x \<mapsto>\<^sub>s v)"
  using assms
  by (simp add: subst_upd_def comp_def, transfer, simp)

lemma usubst_upd_idem_sub [usubst]:
  assumes "x \<subseteq>\<^sub>L y" "mwb_lens y"
  shows "\<sigma>(x \<mapsto>\<^sub>s u, y \<mapsto>\<^sub>s v) = \<sigma>(y \<mapsto>\<^sub>s v)"
  using assms
  by (simp add: subst_upd_def assms, transfer, simp add: fun_eq_iff sublens_put_put)

text \<open> Substitution updates commute when the lenses are independent. \<close>

lemma usubst_upd_comm:
  assumes "x \<bowtie> y"
  shows "\<sigma>(x \<mapsto>\<^sub>s u, y \<mapsto>\<^sub>s v) = \<sigma>(y \<mapsto>\<^sub>s v, x \<mapsto>\<^sub>s u)"
  using assms unfolding subst_upd_def
  by (transfer, auto simp add: subst_upd_def assms comp_def lens_indep_comm)

lemma usubst_upd_comm2:
  assumes "z \<bowtie> y"
  shows "\<sigma>(x \<mapsto>\<^sub>s u, y \<mapsto>\<^sub>s v, z \<mapsto>\<^sub>s s) = \<sigma>(x \<mapsto>\<^sub>s u, z \<mapsto>\<^sub>s s, y \<mapsto>\<^sub>s v)"
  using assms
  using assms unfolding subst_upd_def
  by (transfer, auto simp add: subst_upd_def assms comp_def lens_indep_comm)

lemma subst_upd_pr_var: "s(&x \<mapsto>\<^sub>s v) = s(x \<mapsto>\<^sub>s v)"
  by (simp add: pr_var_def)

text \<open> A substitution which swaps two independent variables is an injective function. \<close>

lemma swap_usubst_inj:
  fixes x y :: "('a \<Longrightarrow> '\<alpha>)"
  assumes "vwb_lens x" "vwb_lens y" "x \<bowtie> y"
  shows "inj\<^sub>s [x \<mapsto>\<^sub>s &y, y \<mapsto>\<^sub>s &x]"
proof (simp add: inj_subst_def, rule injI)
  fix b\<^sub>1 :: '\<alpha> and b\<^sub>2 :: '\<alpha>
  assume "\<lbrakk>[x \<mapsto>\<^sub>s &y, y \<mapsto>\<^sub>s &x]\<rbrakk>\<^sub>e b\<^sub>1 = \<lbrakk>[x \<mapsto>\<^sub>s &y, y \<mapsto>\<^sub>s &x]\<rbrakk>\<^sub>e b\<^sub>2"
  hence a: "put\<^bsub>y\<^esub> (put\<^bsub>x\<^esub> b\<^sub>1 (\<lbrakk>&y\<rbrakk>\<^sub>e b\<^sub>1)) (\<lbrakk>&x\<rbrakk>\<^sub>e b\<^sub>1) = put\<^bsub>y\<^esub> (put\<^bsub>x\<^esub> b\<^sub>2 (\<lbrakk>&y\<rbrakk>\<^sub>e b\<^sub>2)) (\<lbrakk>&x\<rbrakk>\<^sub>e b\<^sub>2)"
    by (transfer, simp)
  then have "(\<forall>a b c. put\<^bsub>x\<^esub> (put\<^bsub>y\<^esub> a b) c = put\<^bsub>y\<^esub> (put\<^bsub>x\<^esub> a c) b) \<and>
             (\<forall>a b. get\<^bsub>x\<^esub> (put\<^bsub>y\<^esub> a b) = get\<^bsub>x\<^esub> a) \<and> (\<forall>a b. get\<^bsub>y\<^esub> (put\<^bsub>x\<^esub> a b) = get\<^bsub>y\<^esub> a)"
    by (simp add: assms(3) lens_indep.lens_put_irr2 lens_indep_comm)
  then show "b\<^sub>1 = b\<^sub>2"
    by (metis a assms(1) assms(2) pr_var_def var.rep_eq vwb_lens.source_determination vwb_lens_def wb_lens_def weak_lens.put_get)
qed

lemma usubst_upd_var_id [usubst]:
  "vwb_lens x \<Longrightarrow> [x \<mapsto>\<^sub>s var x] = id\<^sub>s"
  apply (simp add: subst_upd_def subst_id_def id_lens_def)
  apply (transfer)
  apply (rule ext)
  apply (auto)
  done

lemma usubst_upd_pr_var_id [usubst]:
  "vwb_lens x \<Longrightarrow> [x \<mapsto>\<^sub>s var (pr_var x)] = id\<^sub>s"
  apply (simp add: subst_upd_def pr_var_def subst_id_def id_lens_def)
  apply (transfer)
  apply (rule ext)
  apply (auto)
  done

lemma subst_sublens_var [usubst]:
  "\<lbrakk> vwb_lens a; x \<subseteq>\<^sub>L a \<rbrakk> \<Longrightarrow> \<langle>\<sigma>(a \<mapsto>\<^sub>s var b)\<rangle>\<^sub>s x = var ((x /\<^sub>L a) ;\<^sub>L b)"
  by (transfer, auto simp add: fun_eq_iff lens_defs)

lemma subst_nil_comp [usubst]: "nil\<^sub>s \<circ>\<^sub>s \<sigma> = nil\<^sub>s"
  by (simp add: subst_nil_def comp_def, transfer, simp add: comp_def)

lemma subst_nil_apply: "\<lbrakk>nil\<^sub>s\<rbrakk>\<^sub>e x = undefined"
  by (simp add: subst_nil.rep_eq)

lemma usubst_upd_comm_dash [usubst]:
  fixes x :: "('a \<Longrightarrow> '\<alpha>)"
  shows "\<sigma>($x\<acute> \<mapsto>\<^sub>s v, $x \<mapsto>\<^sub>s u) = \<sigma>($x \<mapsto>\<^sub>s u, $x\<acute> \<mapsto>\<^sub>s v)"
  using out_in_indep usubst_upd_comm by blast

lemma subst_upd_lens_plus [usubst]:
  "subst_upd \<sigma> (x +\<^sub>L y) \<guillemotleft>(u,v)\<guillemotright> = \<sigma>(y \<mapsto>\<^sub>s \<guillemotleft>v\<guillemotright>, x \<mapsto>\<^sub>s \<guillemotleft>u\<guillemotright>)"
  by (simp add: lens_defs uexpr_defs subst_upd_def, transfer, auto)

lemma subst_upd_in_lens_plus [usubst]:
  "subst_upd \<sigma> (in_var (x +\<^sub>L y)) \<guillemotleft>(u,v)\<guillemotright> = \<sigma>($y \<mapsto>\<^sub>s \<guillemotleft>v\<guillemotright>, $x \<mapsto>\<^sub>s \<guillemotleft>u\<guillemotright>)"
  by (simp add: lens_defs uexpr_defs subst_upd_def, transfer, auto simp add: prod.case_eq_if)

lemma subst_upd_out_lens_plus [usubst]:
  "subst_upd \<sigma> (out_var (x +\<^sub>L y)) \<guillemotleft>(u,v)\<guillemotright> = \<sigma>($y\<acute> \<mapsto>\<^sub>s \<guillemotleft>v\<guillemotright>, $x\<acute> \<mapsto>\<^sub>s \<guillemotleft>u\<guillemotright>)"
  by (simp add: lens_defs uexpr_defs subst_upd_def, transfer, auto simp add: prod.case_eq_if)

lemma usubst_lookup_upd_indep [usubst]:
  assumes "mwb_lens x" "x \<bowtie> y"
  shows "\<langle>\<sigma>(y \<mapsto>\<^sub>s v)\<rangle>\<^sub>s x = \<langle>\<sigma>\<rangle>\<^sub>s x"
  using assms
  by (simp add: subst_upd_def, transfer, simp)

lemma subst_upd_plus [usubst]:
  "x \<bowtie> y \<Longrightarrow> subst_upd s (x +\<^sub>L y) e = s(x \<mapsto>\<^sub>s fst(e), y \<mapsto>\<^sub>s snd(e))"
  by (simp add: subst_upd_def lens_defs, transfer, auto simp add: fun_eq_iff prod.case_eq_if lens_indep_comm)

text \<open> If a variable is unrestricted in a substitution then it's application has no effect. \<close>

lemma usubst_apply_unrest:
  "\<lbrakk> vwb_lens x; x \<sharp>\<^sub>s \<sigma> \<rbrakk> \<Longrightarrow> \<langle>\<sigma>\<rangle>\<^sub>s x = var x"
  by (transfer, auto simp add: fun_eq_iff)
     (metis mwb_lens_weak vwb_lens_mwb vwb_lens_wb wb_lens.get_put weak_lens.view_determination)

text \<open> There follows various laws about deleting variables from a substitution. \<close>

lemma subst_del_id [usubst]:
  "vwb_lens x \<Longrightarrow> id\<^sub>s -\<^sub>s x = id\<^sub>s"
  by (simp add: subst_del_def subst_upd_def pr_var_def subst_id_def id_lens_def, transfer, auto)

lemma subst_del_upd_same [usubst]:
  "mwb_lens x \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) -\<^sub>s x = \<sigma> -\<^sub>s x"
  by (simp add: subst_del_def subst_upd_def, transfer, simp)

lemma subst_del_upd_in [usubst]:
  "\<lbrakk> mwb_lens a; x \<subseteq>\<^sub>L a \<rbrakk> \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) -\<^sub>s a = \<sigma> -\<^sub>s a"
  by (simp add: subst_del_def subst_upd_def, transfer, simp add: sublens_put_put)

lemma subst_del_upd_diff [usubst]:
  "x \<bowtie> y \<Longrightarrow> \<sigma>(y \<mapsto>\<^sub>s v) -\<^sub>s x = (\<sigma> -\<^sub>s x)(y \<mapsto>\<^sub>s v)"
  by (simp add: subst_del_def subst_upd_def, transfer, simp add: lens_indep_comm)

lemma subst_restr_id [usubst]: "vwb_lens x \<Longrightarrow> id\<^sub>s \<rhd>\<^sub>s x = id\<^sub>s"
  by (simp add: subst_restr_def usubst)

lemma subst_restr_upd_in [usubst]:
  "\<lbrakk> vwb_lens a; x \<subseteq>\<^sub>L a \<rbrakk> \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) \<rhd>\<^sub>s a = (\<sigma> \<rhd>\<^sub>s a)(x \<mapsto>\<^sub>s v)"
  by (simp add: subst_restr_def usubst subst_upd_def, transfer,
      simp add: fun_eq_iff sublens'_prop1 sublens_implies_sublens' sublens_pres_vwb)

lemma subst_restr_upd_out [usubst]:
  "\<lbrakk> vwb_lens a; x \<bowtie> a \<rbrakk> \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) \<rhd>\<^sub>s a = (\<sigma> \<rhd>\<^sub>s a)"
  by (simp add: subst_restr_def usubst subst_upd_def, transfer
     , simp add: lens_indep.lens_put_irr2)

text \<open> If a variable is unrestricted in an expression, then any substitution of that variable
  has no effect on the expression .\<close>

lemma subst_unrest [usubst]: "x \<sharp> P \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) \<dagger> P = \<sigma> \<dagger> P"
  by (simp add: subst_upd_def, transfer, auto)

lemma subst_unrest_sublens [usubst]: "\<lbrakk> a \<sharp> P; x \<subseteq>\<^sub>L a \<rbrakk> \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) \<dagger> P = \<sigma> \<dagger> P"
  by (simp add: subst_upd_def, transfer, auto simp add: fun_eq_iff,
      metis (no_types, lifting) lens.select_convs(2) lens_comp_def sublens_def)

lemma subst_unrest_2 [usubst]:
  fixes P :: "('a, '\<alpha>) uexpr"
  assumes "x \<sharp> P" "x \<bowtie> y"
  shows "\<sigma>(x \<mapsto>\<^sub>s u,y \<mapsto>\<^sub>s v) \<dagger> P = \<sigma>(y \<mapsto>\<^sub>s v) \<dagger> P"
  using assms
  by (simp add: subst_upd_def, transfer, auto, metis lens_indep.lens_put_comm)

lemma subst_unrest_3 [usubst]:
  fixes P :: "('a, '\<alpha>) uexpr"
  assumes "x \<sharp> P" "x \<bowtie> y" "x \<bowtie> z"
  shows "\<sigma>(x \<mapsto>\<^sub>s u, y \<mapsto>\<^sub>s v, z \<mapsto>\<^sub>s w) \<dagger> P = \<sigma>(y \<mapsto>\<^sub>s v, z \<mapsto>\<^sub>s w) \<dagger> P"
  using assms
  by (simp add: subst_upd_def, transfer, auto, metis (no_types, opaque_lifting) lens_indep_comm)

lemma subst_unrest_4 [usubst]:
  fixes P :: "('a, '\<alpha>) uexpr"
  assumes "x \<sharp> P" "x \<bowtie> y" "x \<bowtie> z" "x \<bowtie> u"
  shows "\<sigma>(x \<mapsto>\<^sub>s e, y \<mapsto>\<^sub>s f, z \<mapsto>\<^sub>s g, u \<mapsto>\<^sub>s h) \<dagger> P = \<sigma>(y \<mapsto>\<^sub>s f, z \<mapsto>\<^sub>s g, u \<mapsto>\<^sub>s h) \<dagger> P"
  using assms
  by (simp add: subst_upd_def, transfer, auto, metis (no_types, opaque_lifting) lens_indep_comm)

lemma subst_unrest_5 [usubst]:
  fixes P :: "('a, '\<alpha>) uexpr"
  assumes "x \<sharp> P" "x \<bowtie> y" "x \<bowtie> z" "x \<bowtie> u" "x \<bowtie> v"
  shows "\<sigma>(x \<mapsto>\<^sub>s e, y \<mapsto>\<^sub>s f, z \<mapsto>\<^sub>s g, u \<mapsto>\<^sub>s h, v \<mapsto>\<^sub>s i) \<dagger> P = \<sigma>(y \<mapsto>\<^sub>s f, z \<mapsto>\<^sub>s g, u \<mapsto>\<^sub>s h, v \<mapsto>\<^sub>s i) \<dagger> P"
  using assms
  by (simp add: subst_upd_def, transfer, auto, metis (no_types, opaque_lifting) lens_indep_comm)

lemma subst_compose_upd [usubst]: "x \<sharp>\<^sub>s \<sigma> \<Longrightarrow> \<sigma> \<circ>\<^sub>s \<rho>(x \<mapsto>\<^sub>s v) = (\<sigma> \<circ>\<^sub>s \<rho>)(x \<mapsto>\<^sub>s v) "
  by (simp add: subst_upd_def, transfer, auto simp add: comp_def)

text \<open> Any substitution is a monotonic function. \<close>

lemma subst_mono: "mono (subst \<sigma>)"
  by (simp add: less_eq_uexpr.rep_eq mono_def subst.rep_eq)

subsection \<open> Substitution laws \<close>

text \<open> We now prove the key laws that show how a substitution should be performed for every
  expression operator, including the core function operators, literals, variables, and the
  arithmetic operators. They are all added to the \emph{usubst} theorem attribute so that
  we can apply them using the substitution tactic. \<close>

lemma id_subst [usubst]: "id\<^sub>s \<dagger> v = v"
  unfolding subst_id_def lens_defs by (transfer, simp)

lemma subst_lit [usubst]: "\<sigma> \<dagger> \<guillemotleft>v\<guillemotright> = \<guillemotleft>v\<guillemotright>"
  by (transfer, simp)

lemma subst_var [usubst]: "\<sigma> \<dagger> var x = \<langle>\<sigma>\<rangle>\<^sub>s x"
  by (transfer, simp)

lemma usubst_uabs [usubst]: "\<sigma> \<dagger> (\<lambda>\<^sub>u x \<bullet> P(x)) = (\<lambda>\<^sub>u x \<bullet> \<sigma> \<dagger> P(x))"
  by (transfer, simp)

lemma unrest_usubst_del [unrest]: "\<lbrakk> vwb_lens x; x \<sharp> (\<langle>\<sigma>\<rangle>\<^sub>s x); x \<sharp>\<^sub>s \<sigma> -\<^sub>s x \<rbrakk> \<Longrightarrow>  x \<sharp> (\<sigma> \<dagger> P)"
  by (simp add: subst_del_def subst_upd_def unrest_uexpr_def unrest_usubst_def pr_var_def, transfer, auto)
     (metis vwb_lens.source_determination)

text \<open> We add the symmetric definition of input and output variables to substitution laws
        so that the variables are correctly normalised after substitution. \<close>

lemma subst_appl [usubst]: "\<sigma> \<dagger> f |> v = (\<sigma> \<dagger> f) |> (\<sigma> \<dagger> v)"
  by (transfer, simp)

lemma subst_uop [usubst]: "\<sigma> \<dagger> uop f v = uop f (\<sigma> \<dagger> v)"
  by (transfer, simp)

lemma subst_bop [usubst]: "\<sigma> \<dagger> bop f u v = bop f (\<sigma> \<dagger> u) (\<sigma> \<dagger> v)"
  by (transfer, simp)

lemma subst_trop [usubst]: "\<sigma> \<dagger> trop f u v w = trop f (\<sigma> \<dagger> u) (\<sigma> \<dagger> v) (\<sigma> \<dagger> w)"
  by (transfer, simp)

lemma subst_qtop [usubst]: "\<sigma> \<dagger> qtop f u v w x = qtop f (\<sigma> \<dagger> u) (\<sigma> \<dagger> v) (\<sigma> \<dagger> w) (\<sigma> \<dagger> x)"
  by (transfer, simp)

lemma subst_case_prod [usubst]:
  fixes P :: "'i \<Rightarrow> 'j \<Rightarrow> ('a, '\<alpha>) uexpr"
  shows "\<sigma> \<dagger> case_prod (\<lambda> x y. P x y) v = case_prod (\<lambda> x y. \<sigma> \<dagger> P x y) v"
  by (simp add: case_prod_beta')

lemma subst_plus [usubst]: "\<sigma> \<dagger> (x + y) = \<sigma> \<dagger> x + \<sigma> \<dagger> y"
  by (simp add: plus_uexpr_def subst_bop)

lemma subst_times [usubst]: "\<sigma> \<dagger> (x * y) = \<sigma> \<dagger> x * \<sigma> \<dagger> y"
  by (simp add: times_uexpr_def subst_bop)

lemma subst_power [usubst]: "\<sigma> \<dagger> (e ^ n) = (\<sigma> \<dagger> e) ^ n"
  by (simp add: power_rep_eq subst.rep_eq uexpr_eq_iff)

lemma subst_mod [usubst]: "\<sigma> \<dagger> (x mod y) = \<sigma> \<dagger> x mod \<sigma> \<dagger> y"
  by (simp add: mod_uexpr_def usubst)

lemma subst_div [usubst]: "\<sigma> \<dagger> (x div y) = \<sigma> \<dagger> x div \<sigma> \<dagger> y"
  by (simp add: divide_uexpr_def usubst)

lemma subst_minus [usubst]: "\<sigma> \<dagger> (x - y) = \<sigma> \<dagger> x - \<sigma> \<dagger> y"
  by (simp add: minus_uexpr_def subst_bop)

lemma subst_uminus [usubst]: "\<sigma> \<dagger> (- x) = - (\<sigma> \<dagger> x)"
  by (simp add: uminus_uexpr_def subst_uop)

lemma usubst_sgn [usubst]: "\<sigma> \<dagger> sgn x = sgn (\<sigma> \<dagger> x)"
  by (simp add: sgn_uexpr_def subst_uop)

lemma usubst_abs [usubst]: "\<sigma> \<dagger> abs x = abs (\<sigma> \<dagger> x)"
  by (simp add: abs_uexpr_def subst_uop)

lemma subst_zero [usubst]: "\<sigma> \<dagger> 0 = 0"
  by (simp add: zero_uexpr_def subst_lit)

lemma subst_one [usubst]: "\<sigma> \<dagger> 1 = 1"
  by (simp add: one_uexpr_def subst_lit)

lemma subst_numeral [usubst]: "\<sigma> \<dagger> numeral n = numeral n"
  by (simp add: numeral_uexpr_simp subst_lit)

text \<open> This laws shows the effect of applying one substitution after another -- we simply
  use function composition to compose them. \<close>

lemma subst_subst [usubst]: "\<sigma> \<dagger> \<rho> \<dagger> e = (\<rho> \<circ>\<^sub>s \<sigma>) \<dagger> e"
  by (transfer, simp)

text \<open> The next law is similar, but shows how such a substitution is to be applied to every
  updated variable additionally. \<close>

lemma subst_upd_comp [usubst]:
  fixes x :: "('a \<Longrightarrow> '\<alpha>)"
  shows "\<rho>(x \<mapsto>\<^sub>s v) \<circ>\<^sub>s \<sigma> = (\<rho> \<circ>\<^sub>s \<sigma>)(x \<mapsto>\<^sub>s \<sigma> \<dagger> v)"
  unfolding subst_upd_def by (transfer, auto)

lemma subst_singleton:
  fixes x :: "('a \<Longrightarrow> '\<alpha>)"
  assumes "x \<sharp>\<^sub>s \<sigma>"
  shows "\<sigma>(x \<mapsto>\<^sub>s v) \<dagger> P = (\<sigma> \<dagger> P)\<lbrakk>v/x\<rbrakk>"
  using assms by (simp add: usubst)

lemmas subst_to_singleton = subst_singleton id_subst

subsection \<open> Ordering substitutions \<close>

text \<open> A simplification procedure to reorder substitutions maplets lexicographically by variable syntax \<close>

simproc_setup subst_order ("subst_upd (subst_upd \<sigma> x u) y v") =
  \<open> (fn _ => fn ctx => fn ct =>
        case (Thm.term_of ct) of
          Const (@{const_name subst_upd}, _) $ (Const (@{const_name subst_upd}, _) $ s $ x $ u) $ y $ v
            => if (YXML.content_of (Syntax.string_of_term ctx x) > YXML.content_of(Syntax.string_of_term ctx y))
               then SOME (mk_meta_eq @{thm usubst_upd_comm})
               else NONE  |
          _ => NONE)
  \<close>

subsection \<open> Unrestriction laws \<close>

text \<open> These are the key unrestriction theorems for substitutions and expressions involving substitutions. \<close>

lemma unrest_usubst_single [unrest]:
  "\<lbrakk> mwb_lens x; x \<sharp> v \<rbrakk> \<Longrightarrow> x \<sharp> P\<lbrakk>v/x\<rbrakk>"
  unfolding subst_upd_def by (transfer, auto)

lemma unrest_usubst_id [unrest]:
  "mwb_lens x \<Longrightarrow> x \<sharp>\<^sub>s id\<^sub>s"
  by (transfer, simp)

lemma unrest_usubst_upd [unrest]:
  "\<lbrakk> x \<bowtie> y; x \<sharp>\<^sub>s \<sigma>; x \<sharp> v \<rbrakk> \<Longrightarrow> x \<sharp>\<^sub>s \<sigma>(y \<mapsto>\<^sub>s v)"
  by (transfer, simp add: lens_indep_comm)

lemma unrest_subst [unrest]:
  "\<lbrakk> x \<sharp> P; x \<sharp>\<^sub>s \<sigma> \<rbrakk> \<Longrightarrow> x \<sharp> (\<sigma> \<dagger> P)"
  by (transfer, simp add: unrest_usubst_def)

text \<open> Unrestriction can be demonstrated by showing substitution for its variables is ineffectual. \<close>

lemma unrest_as_subst: "(x \<sharp> P) \<longleftrightarrow> (\<forall> v. P\<lbrakk>\<guillemotleft>v\<guillemotright>/x\<rbrakk> = P)"
  by (transfer, auto simp add: fun_eq_iff)

lemma unrest_by_subst: "\<lbrakk> \<And> v. P\<lbrakk>\<guillemotleft>v\<guillemotright>/x\<rbrakk> = P \<rbrakk> \<Longrightarrow> x \<sharp> P"
  by (simp add: unrest_as_subst)

subsection \<open> Conditional Substitution Laws \<close>

lemma usubst_cond_upd_1 [usubst]:
  "\<sigma>(x \<mapsto>\<^sub>s u) \<triangleleft> b \<triangleright> \<rho>(x \<mapsto>\<^sub>s v) = (\<sigma> \<triangleleft> b \<triangleright> \<rho>)(x \<mapsto>\<^sub>s (u \<triangleleft> b \<triangleright> v))"
  by (simp add: subst_upd_def uexpr_defs, transfer, auto)

lemma usubst_cond_upd_2 [usubst]:
  "\<lbrakk> vwb_lens x; x \<sharp>\<^sub>s \<rho> \<rbrakk> \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s u) \<triangleleft> b \<triangleright> \<rho> = (\<sigma> \<triangleleft> b \<triangleright> \<rho>)(x \<mapsto>\<^sub>s (u \<triangleleft> b \<triangleright> &x))"
  by (simp add: subst_upd_def unrest_usubst_def uexpr_defs pr_var_def, transfer, auto simp add: fun_eq_iff)
     (metis lens_override_def lens_override_idem)

lemma usubst_cond_upd_3 [usubst]:
  "\<lbrakk> vwb_lens x; x \<sharp>\<^sub>s \<sigma> \<rbrakk> \<Longrightarrow> \<sigma> \<triangleleft> b \<triangleright> \<rho>(x \<mapsto>\<^sub>s v) = (\<sigma> \<triangleleft> b \<triangleright> \<rho>)(x \<mapsto>\<^sub>s (&x \<triangleleft> b \<triangleright> v))"
  by (simp add: subst_upd_def unrest_usubst_def uexpr_defs pr_var_def, transfer, auto simp add: fun_eq_iff)
     (metis lens_override_def lens_override_idem)

subsection \<open> Parallel Substitution Laws \<close>

lemma par_subst_id [usubst]:
  "\<lbrakk> vwb_lens A; vwb_lens B \<rbrakk> \<Longrightarrow> id\<^sub>s [A|B]\<^sub>s id\<^sub>s = id\<^sub>s"
  by (transfer, simp)

lemma par_subst_left_empty [usubst]:
  "\<lbrakk> vwb_lens A \<rbrakk> \<Longrightarrow> \<sigma> [\<emptyset>|A]\<^sub>s \<rho> = id\<^sub>s [\<emptyset>|A]\<^sub>s \<rho>"
  by (simp add: par_subst_def pr_var_def)

lemma par_subst_right_empty [usubst]:
  "\<lbrakk> vwb_lens A \<rbrakk> \<Longrightarrow> \<sigma> [A|\<emptyset>]\<^sub>s \<rho> = \<sigma> [A|\<emptyset>]\<^sub>s id\<^sub>s"
  by (simp add: par_subst_def pr_var_def)

lemma par_subst_comm:
  "\<lbrakk> A \<bowtie> B \<rbrakk> \<Longrightarrow> \<sigma> [A|B]\<^sub>s \<rho> = \<rho> [B|A]\<^sub>s \<sigma>"
  by (simp add: par_subst_def lens_override_def lens_indep_comm)

lemma par_subst_upd_left_in [usubst]:
  "\<lbrakk> vwb_lens A; A \<bowtie> B; x \<subseteq>\<^sub>L A \<rbrakk> \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) [A|B]\<^sub>s \<rho> = (\<sigma> [A|B]\<^sub>s \<rho>)(x \<mapsto>\<^sub>s v)"
  by (transfer, simp add: lens_override_put_right_in, simp add: lens_indep_comm lens_override_def sublens_pres_indep)

lemma par_subst_upd_left_out [usubst]:
  "\<lbrakk> vwb_lens A; x \<bowtie> A \<rbrakk> \<Longrightarrow> \<sigma>(x \<mapsto>\<^sub>s v) [A|B]\<^sub>s \<rho> = (\<sigma> [A|B]\<^sub>s \<rho>)"
  by (transfer, simp add: par_subst_def subst_upd_def lens_override_put_right_out)

lemma par_subst_upd_right_in [usubst]:
  "\<lbrakk> vwb_lens B; A \<bowtie> B; x \<subseteq>\<^sub>L B \<rbrakk> \<Longrightarrow> \<sigma> [A|B]\<^sub>s \<rho>(x \<mapsto>\<^sub>s v) = (\<sigma> [A|B]\<^sub>s \<rho>)(x \<mapsto>\<^sub>s v)"
  using lens_indep_sym par_subst_comm par_subst_upd_left_in by fastforce

lemma par_subst_upd_right_out [usubst]:
  "\<lbrakk> vwb_lens B; A \<bowtie> B; x \<bowtie> B \<rbrakk> \<Longrightarrow> \<sigma> [A|B]\<^sub>s \<rho>(x \<mapsto>\<^sub>s v) = (\<sigma> [A|B]\<^sub>s \<rho>)"
  by (simp add: par_subst_comm par_subst_upd_left_out)

subsection \<open> Power Substitutions \<close>

interpretation subst_monoid: monoid_mult subst_id subst_comp
  by (unfold_locales, transfer, auto)

notation subst_monoid.power (infixr "^\<^sub>s" 80)

lemma subst_power_rep_eq: "\<lbrakk>\<sigma> ^\<^sub>s n\<rbrakk>\<^sub>e = \<lbrakk>\<sigma>\<rbrakk>\<^sub>e ^^ n"
  by (induct n, simp_all add: subst_id.rep_eq subst_comp.rep_eq)

update_uexpr_rep_eq_thms

end


(*  Title:       Isabelle Collections Library
    Author:      Peter Lammich <peter dot lammich at uni-muenster.de>
    Maintainer:  Peter Lammich <peter dot lammich at uni-muenster.de>
*)
section {* \isaheader{Additions to RB-Trees} *}
theory RBT_add
imports
  "~~/src/HOL/Library/RBT_Impl"
  "../Iterator/Iterator"
begin
text_raw {*\label{thy:RBT_add}*}

lemma tlt_trans: "\<lbrakk>l |\<guillemotleft> u; u\<le>v\<rbrakk> \<Longrightarrow> l |\<guillemotleft> v"
  by (induct l) auto

lemma trt_trans: "\<lbrakk> u\<le>v; v\<guillemotleft>|r \<rbrakk> \<Longrightarrow> u\<guillemotleft>|r"
  by (induct r) auto

lemmas tlt_trans' = tlt_trans[OF _ less_imp_le]
lemmas trt_trans' = trt_trans[OF less_imp_le]

primrec rm_iterateoi
  :: "('k,'v) RBT_Impl.rbt \<Rightarrow> ('k \<times> 'v, '\<sigma>) set_iterator"
  where
  "rm_iterateoi RBT_Impl.Empty c f \<sigma> = \<sigma>" |
  "rm_iterateoi (RBT_Impl.Branch col l k v r) c f \<sigma> = (
    if (c \<sigma>) then
      let \<sigma>' = rm_iterateoi l c f \<sigma> in
        if (c \<sigma>') then
          rm_iterateoi r c f (f (k, v) \<sigma>')
        else \<sigma>'
    else
      \<sigma>
  )"

lemma rm_iterateoi_abort :
  "\<not>(c \<sigma>) \<Longrightarrow> rm_iterateoi t c f \<sigma> = \<sigma>"
by (cases t) auto

lemma rm_iterateoi_alt_def :
  "rm_iterateoi RBT_Impl.Empty = set_iterator_emp"
  "rm_iterateoi (RBT_Impl.Branch col l k v r) =
   set_iterator_union (rm_iterateoi l)
     (set_iterator_union (set_iterator_sng (k, v)) (rm_iterateoi r))"
by (simp_all add: fun_eq_iff set_iterator_emp_def rm_iterateoi_abort
                  set_iterator_union_def set_iterator_sng_def Let_def)
declare rm_iterateoi.simps[simp del]

primrec rm_reverse_iterateoi
  :: "('k,'v) RBT_Impl.rbt \<Rightarrow> ('k \<times> 'v, '\<sigma>) set_iterator"
  where
  "rm_reverse_iterateoi RBT_Impl.Empty c f \<sigma> = \<sigma>" |
  "rm_reverse_iterateoi (Branch col l k v r) c f \<sigma> = (
    if (c \<sigma>) then
      let \<sigma>' = rm_reverse_iterateoi r c f \<sigma> in
        if (c \<sigma>') then
          rm_reverse_iterateoi l c f (f (k, v) \<sigma>')
        else \<sigma>'
    else
      \<sigma>
  )"

lemma rm_reverse_iterateoi_abort :
  "\<not>(c \<sigma>) \<Longrightarrow> rm_reverse_iterateoi t c f \<sigma> = \<sigma>"
by (cases t) auto

lemma rm_reverse_iterateoi_alt_def :
  "rm_reverse_iterateoi RBT_Impl.Empty = set_iterator_emp"
  "rm_reverse_iterateoi (RBT_Impl.Branch col l k v r) =
   set_iterator_union (rm_reverse_iterateoi r)
     (set_iterator_union (set_iterator_sng (k, v)) (rm_reverse_iterateoi l))"
by (simp_all add: fun_eq_iff set_iterator_emp_def rm_reverse_iterateoi_abort
                  set_iterator_union_def set_iterator_sng_def Let_def)
declare rm_reverse_iterateoi.simps[simp del]

(*
lemma finite_dom_lookup [simp, intro!]: "finite (dom (RBT.lookup t))"
by(simp add: RBT.lookup_def)

instantiation rbt :: ("{equal, linorder}", equal) equal begin

definition "equal_class.equal (r :: ('a, 'b) rbt) r' == RBT.impl_of r = RBT.impl_of r'"

instance
proof
qed (simp add: equal_rbt_def RBT.impl_of_inject)

end
*)

lemma (in linorder) map_to_set_lookup_entries:
   "rbt_sorted t \<Longrightarrow> map_to_set (rbt_lookup t) = set (RBT_Impl.entries t)"
  using map_of_entries[symmetric,of t]
  by (simp add: distinct_entries map_to_set_map_of)

lemma (in linorder) rm_iterateoi_correct:
  fixes t::"('a, 'v) RBT_Impl.rbt"
  assumes is_sort: "rbt_sorted t"
  defines "it \<equiv>
  RBT_add.rm_iterateoi::(('a, 'v) RBT_Impl.rbt \<Rightarrow> ('a \<times> 'v, '\<sigma>) set_iterator)"
  shows "map_iterator_linord (it t) (rbt_lookup t)"
  using is_sort
proof (induct t)
  case Empty
  show ?case unfolding it_def
    by (simp add: rm_iterateoi_alt_def
      map_iterator_linord_emp_correct rbt_lookup_Empty)
next
  case (Branch c l k v r)
  note is_sort_t = Branch(3)

  from Branch(1) is_sort_t have
    l_it: "map_iterator_linord (it l) (rbt_lookup l)" by simp
  from Branch(2) is_sort_t have
    r_it: "map_iterator_linord (it r) (rbt_lookup r)" by simp
  note kv_it = map_iterator_linord_sng_correct[of k v]

  have kv_r_it : "set_iterator_map_linord
     (set_iterator_union (set_iterator_sng (k, v)) (it r))
     (map_to_set [k \<mapsto> v] \<union> map_to_set (rbt_lookup r))"
  proof (rule map_iterator_linord_union_correct [OF kv_it r_it])
    fix kv kv'
    assume pre: "kv \<in> map_to_set [k \<mapsto> v]" "kv' \<in> map_to_set (rbt_lookup r)"
    obtain k' v' where kv'_eq[simp]: "kv' = (k', v')" by (rule prod.exhaust)

    from pre is_sort_t show "fst kv < fst kv'"
      apply (simp add: map_to_set_lookup_entries split: prod.splits)
      apply (metis entry_in_tree_keys rbt_greater_prop)
      done
  qed

  have l_kv_r_it : "set_iterator_map_linord (it (Branch c l k v r))
     (map_to_set (rbt_lookup l)
      \<union> (map_to_set [k \<mapsto> v] \<union> map_to_set (rbt_lookup r)))"
    unfolding it_def rm_iterateoi_alt_def
    unfolding it_def[symmetric]
  proof (rule map_iterator_linord_union_correct [OF l_it kv_r_it])
    fix kv1 kv2
    assume pre: "kv1 \<in> map_to_set (rbt_lookup l)"
                "kv2 \<in> map_to_set [k \<mapsto> v] \<union> map_to_set (rbt_lookup r)"

    obtain k1 v1 where kv1_eq[simp]: "kv1 = (k1, v1)" by (rule prod.exhaust)
    obtain k2 v2 where kv2_eq[simp]: "kv2 = (k2, v2)" by (rule prod.exhaust)

    from pre is_sort_t show "fst kv1 < fst kv2"
      apply (simp add: map_to_set_lookup_entries split: prod.splits)
      by (metis (lifting) map_of_entries neqE option.simps(3)
        ord.rbt_lookup_rbt_greater ord.rbt_lookup_rbt_less rbt_greater_trans
        rbt_less_trans weak_map_of_SomeI)
  qed

  from is_sort_t
  have map_eq: "map_to_set (rbt_lookup l)
    \<union> (map_to_set [k \<mapsto> v] \<union> map_to_set (rbt_lookup r)) =
        map_to_set (rbt_lookup (Branch c l k v r))"
    by (simp add: set_eq_iff map_to_set_lookup_entries)

  from l_kv_r_it[unfolded map_eq]
  show ?case .
qed

lemma (in linorder) rm_reverse_iterateoi_correct:
  fixes t::"('a, 'v) RBT_Impl.rbt"
  assumes is_sort: "rbt_sorted t"
  defines "it \<equiv> RBT_add.rm_reverse_iterateoi
    ::(('a, 'v) RBT_Impl.rbt \<Rightarrow> ('a \<times> 'v, '\<sigma>) set_iterator)"
  shows "map_iterator_rev_linord (it t) (rbt_lookup t)"
  using is_sort
proof (induct t)
  case Empty
  show ?case unfolding it_def
    by (simp add: rm_reverse_iterateoi_alt_def
      map_iterator_rev_linord_emp_correct rbt_lookup_Empty)
next
  case (Branch c l k v r)
  note is_sort_t = Branch(3)

  from Branch(1) is_sort_t have
    l_it: "map_iterator_rev_linord (it l) (rbt_lookup l)" by simp
  from Branch(2) is_sort_t have
    r_it: "map_iterator_rev_linord (it r) (rbt_lookup r)" by simp
  note kv_it = map_iterator_rev_linord_sng_correct[of k v]

  have kv_l_it : "set_iterator_map_rev_linord
     (set_iterator_union (set_iterator_sng (k, v)) (it l))
     (map_to_set [k \<mapsto> v] \<union> map_to_set (rbt_lookup l))"
  proof (rule map_iterator_rev_linord_union_correct [OF kv_it l_it])
    fix kv kv'
    assume pre: "kv \<in> map_to_set [k \<mapsto> v]" "kv' \<in> map_to_set (rbt_lookup l)"
    obtain k' v' where kv'_eq[simp]: "kv' = (k', v')" by (rule prod.exhaust)

    from pre is_sort_t show "fst kv > fst kv'"
      apply (simp add: map_to_set_lookup_entries split: prod.splits)
      apply (metis entry_in_tree_keys rbt_less_prop)
   done
  qed

  have r_kv_l_it : "set_iterator_map_rev_linord (it (Branch c l k v r))
     (map_to_set (rbt_lookup r)
      \<union> (map_to_set [k \<mapsto> v] \<union> map_to_set (rbt_lookup l)))"
    unfolding it_def rm_reverse_iterateoi_alt_def
    unfolding it_def[symmetric]
  proof (rule map_iterator_rev_linord_union_correct [OF r_it kv_l_it])
    fix kv1 kv2
    assume pre: "kv1 \<in> map_to_set (rbt_lookup r)"
                "kv2 \<in> map_to_set [k \<mapsto> v] \<union> map_to_set (rbt_lookup l)"

    obtain k1 v1 where kv1_eq[simp]: "kv1 = (k1, v1)" by (rule prod.exhaust)
    obtain k2 v2 where kv2_eq[simp]: "kv2 = (k2, v2)" by (rule prod.exhaust)

    from pre is_sort_t show "fst kv1 > fst kv2"
      apply (simp add: map_to_set_lookup_entries split: prod.splits)
      by (metis (mono_tags) entry_in_tree_keys neq_iff option.simps(3)
        ord.rbt_greater_prop ord.rbt_lookup_rbt_less rbt_less_trans
        rbt_lookup_in_tree)
  qed

  from is_sort_t
  have map_eq: "map_to_set (rbt_lookup r)
    \<union> (map_to_set [k \<mapsto> v] \<union> map_to_set (rbt_lookup l)) =
        map_to_set (rbt_lookup (Branch c l k v r))"
    by (auto simp add: set_eq_iff map_to_set_lookup_entries)

  from r_kv_l_it[unfolded map_eq]
  show ?case .
qed

lemma pi_rm[icf_proper_iteratorI]:
  "proper_it (RBT_add.rm_iterateoi t) (RBT_add.rm_iterateoi t)"
  by (induct t) (simp_all add: rm_iterateoi_alt_def icf_proper_iteratorI)

lemma pi_rm_rev[icf_proper_iteratorI]:
  "proper_it (RBT_add.rm_reverse_iterateoi t) (RBT_add.rm_reverse_iterateoi t)"
  by (induct t) (simp_all add: rm_reverse_iterateoi_alt_def
    icf_proper_iteratorI)

primrec bheight_aux :: "('a,'b) RBT_Impl.rbt \<Rightarrow> nat \<Rightarrow> nat"
where
  "\<And>acc. bheight_aux RBT_Impl.Empty acc = acc"
| "\<And>acc. bheight_aux (RBT_Impl.Branch c lt k v rt) acc =
     bheight_aux lt (case c of RBT_Impl.B \<Rightarrow> Suc acc | RBT_Impl.R \<Rightarrow> acc)"

lemma bheight_aux_eq: "bheight_aux t a = bheight t + a"
  by (induct t arbitrary: a) (auto split: RBT_Impl.color.split)

definition [code_unfold]: "rbt_bheight t \<equiv> bheight_aux t 0"
lemma "rbt_bheight t = bheight t"
  unfolding rbt_bheight_def by (simp add: bheight_aux_eq)

(*definition "black_height t \<equiv> rbt_bheight (RBT.impl_of t)"*)

end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

(*
   Decompose a meta-conjunction as a proper fact (list of theorems)
*)

theory Conjuncts
imports Main
begin

ML\<open>

structure Conjuncts =
struct

local

  structure Data = Generic_Data
  (
    type T = thm;
    val empty: T = Drule.dummy_thm;
    val extend = I;
    val merge : T * T -> T = (K Drule.dummy_thm);
  );

  fun elim_conjuncts thm =
    case try Conjunction.elim thm of
    SOME (thm', thm'') => elim_conjuncts thm' @ elim_conjuncts thm''
    | NONE => if Thm.prop_of thm = Thm.prop_of (Drule.dummy_thm) then [] else [thm]

  in

  val _ = Context.>> (Context.map_theory (
    (Attrib.setup @{binding "conjuncts"}
      (Scan.lift (Args.mode "accumulate") >> (fn acc =>
        if acc then
        Thm.declaration_attribute (Data.map o (fn x => fn y => Conjunction.intr y x))
        else
        Thm.declaration_attribute Data.put))
      "add meta_conjuncts to \"conjuncts\" named theorem") #>
    Global_Theory.add_thms_dynamic (@{binding "conjuncts"}, elim_conjuncts o Data.get)))

end

end

\<close>

notepad begin

  fix A B C D
  assume ABC[conjuncts]: "(A &&& B) &&& (B &&& C)"
  note ABC' = conjuncts

  have "A" by (rule ABC')
  have "B" by (rule \<open>B\<close>)
  have "C" by (rule ABC'(4))

  (* Disclaimer: only the last declared lemma is stored *)
  assume ABCD[conjuncts]: "A &&& B" "C &&& D"
  note CD = conjuncts

  have "A" by ((rule CD)?,rule ABC')
  have "C" by (rule CD)

  note ABCD(1)[conjuncts]
  note AB = conjuncts

  note ABCD(2)[conjuncts]
  note CD = conjuncts

  (* We can accumulate multi-thms, we just need to clear conjuncts first *)
  note [[conjuncts]]

  note ABCD[conjuncts (accumulate)]
  note ABCD' = conjuncts

end

end


(* Author: Andreas Lochbihler, Digital Asset
   Author: Ognjen Maric, Digital Asset *)

theory Merkle_Interface
imports
  Main
  "HOL-Library.Conditional_Parametricity"
  "HOL-Library.Monad_Syntax"
begin

alias vimage2p = BNF_Def.vimage2p
alias Grp = BNF_Def.Grp
alias setl = Basic_BNFs.setl
alias setr = Basic_BNFs.setr
alias fsts = Basic_BNFs.fsts
alias snds = Basic_BNFs.snds

attribute_setup locale_witness = \<open>Scan.succeed Locale.witness_add\<close>

lemma vimage2p_mono': "R \<le> S \<Longrightarrow> vimage2p f g R \<le> vimage2p f g S"
  by(auto simp add: vimage2p_def le_fun_def)

lemma vimage2p_map_rel_prod:
  "vimage2p (map_prod f g) (map_prod f' g') (rel_prod A B) = rel_prod (vimage2p f f' A) (vimage2p g g' B)"
  by(simp add: vimage2p_def prod.rel_map)

lemma vimage2p_map_list_all2:
  "vimage2p (map f) (map g) (list_all2 A) = list_all2 (vimage2p f g A)"
  by(simp add: vimage2p_def list.rel_map)

lemma equivclp_least:
  assumes le: "r \<le> s" and s: "equivp s"
  shows "equivclp r \<le> s"
  apply(rule predicate2I)
  subgoal by(induction rule: equivclp_induct)(auto 4 3 intro: equivp_reflp[OF s] equivp_transp[OF s] equivp_symp[OF s] le[THEN predicate2D])
  done

lemma reflp_eq_onp: "reflp R \<longleftrightarrow> eq_onp (\<lambda>x. True) \<le> R"
  by(auto simp add: reflp_def eq_onp_def)

lemma eq_onpE:
  assumes "eq_onp P x y"
  obtains "x = y" "P y"
  using assms by(auto simp add: eq_onp_def)

lemma case_unit_parametric [transfer_rule]: "rel_fun A (rel_fun (=) A) case_unit case_unit"
  by(simp add: rel_fun_def split: unit.split)

(************************************************************)
section \<open>Authenticated Data Structures\<close>
(************************************************************)

(************************************************************)
subsection \<open>Interface\<close>
(************************************************************)

(************************************************************)
subsubsection \<open> Types \<close>
(************************************************************)

type_synonym ('a\<^sub>m, 'a\<^sub>h) hash = "'a\<^sub>m \<Rightarrow> 'a\<^sub>h" \<comment> \<open>Type of hash operation\<close>
type_synonym 'a\<^sub>m blinding_of = "'a\<^sub>m \<Rightarrow> 'a\<^sub>m \<Rightarrow> bool"
type_synonym 'a\<^sub>m merge = "'a\<^sub>m \<Rightarrow> 'a\<^sub>m \<Rightarrow> 'a\<^sub>m option" \<comment> \<open> merging that can fail for values with different hashes\<close>

(************************************************************)
subsubsection \<open> Properties \<close>
(************************************************************)

locale merkle_interface =
  fixes h :: "('a\<^sub>m, 'a\<^sub>h) hash"
    and bo :: "'a\<^sub>m blinding_of"
    and m :: "'a\<^sub>m merge"
  assumes merge_respects_hashes: "h a = h b \<longleftrightarrow> (\<exists>ab. m a b = Some ab)"
    and idem: "m a a = Some a"
    and commute: "m a b = m b a"
    and assoc: "m a b \<bind> m c = m b c \<bind> m a"
    and bo_def: "bo a b \<longleftrightarrow> m a b = Some b"
begin

lemma reflp: "reflp bo"
  unfolding bo_def by(rule reflpI)(simp add: idem)

lemma antisymp: "antisymp bo"
  unfolding bo_def by(rule antisympI)(simp add: commute)

lemma hash: "bo \<le> vimage2p h h (=)"
  unfolding bo_def by(auto simp add: vimage2p_def merge_respects_hashes)

lemma join: "m a b = Some ab \<longleftrightarrow> bo a ab \<and> bo b ab \<and> (\<forall>u. bo a u \<longrightarrow> bo b u \<longrightarrow> bo ab u)"
  unfolding bo_def
  by (smt Option.bind_cong bind.bind_lunit commute idem merkle_interface.assoc merkle_interface_axioms)

text \<open>The equivalence closure of the blinding relation are the equivalence classes of the hash function (the kernel).\<close>

lemma equivclp_blinding_of: "equivclp bo = vimage2p h h (=)" (is "?lhs = ?rhs")
proof(rule antisym)
  show "?lhs \<le> ?rhs" by(rule equivclp_least[OF hash])(rule equivp_vimage2p[OF identity_equivp])
  show "?rhs \<le> ?lhs" unfolding vimage2p_def
  proof(rule predicate2I)
    fix x y
    assume "h x = h y"
    then obtain xy where "m x y = Some xy" unfolding merge_respects_hashes ..
    hence "bo x xy" "bo y xy" unfolding join by blast+
    hence "equivclp bo x xy" "equivclp bo xy y" by(blast)+
    thus "equivclp bo x y" by(rule equivclp_trans)
  qed
qed

end

(************************************************************)
subsection \<open> Auxiliary definitions \<close>
(************************************************************)

text \<open> Directly proving that an interface satisfies the specification of a Merkle interface as given
above is difficult. Instead, we provide several layers of auxiliary definitions that can easily be
proved layer-by-layer.

In particular, proving that an interface on recursive datatypes is a Merkle interface requires
induction. As the induction hypothesis only applies to a subset of values of a type, we add
auxiliary definitions equipped with an explicit set @{term A} of values to which the definition
applies. Once the induction proof is complete, we can typically instantiate @{term A} with @{term
UNIV}. In particular, in the induction proof for a layer, we can assume that properties for the
earlier layers hold for \<^emph>\<open>all\<close> values, not just those in the induction hypothesis.
\<close>

(************************************************************)
subsubsection \<open> Blinding \<close>
(************************************************************)
locale blinding_respects_hashes =
  fixes h :: "('a\<^sub>m, 'a\<^sub>h) hash"
    and bo :: "'a\<^sub>m blinding_of"
  assumes hash: "bo \<le> vimage2p h h (=)"
begin

lemma blinding_hash_eq: "bo x y \<Longrightarrow> h x = h y"
  by(drule hash[THEN predicate2D])(simp add: vimage2p_def)

end

locale blinding_of_on =
  blinding_respects_hashes h bo
    for A :: "'a\<^sub>m set"
    and h :: "('a\<^sub>m, 'a\<^sub>h) hash"
    and bo :: "'a\<^sub>m blinding_of"
  + assumes refl: "x \<in> A \<Longrightarrow> bo x x"
    and trans: "\<lbrakk> bo x y; bo y z; x \<in> A \<rbrakk> \<Longrightarrow> bo x z"
    and antisym: "\<lbrakk> bo x y; bo y x; x \<in> A \<rbrakk> \<Longrightarrow> x = y"
begin

lemma refl_pointfree: "eq_onp (\<lambda>x. x \<in> A) \<le> bo"
  by(auto elim!: eq_onpE intro: refl)

lemma blinding_respects_hashes: "blinding_respects_hashes h bo" ..
lemmas hash = hash

lemma trans_pointfree: "eq_onp (\<lambda>x. x \<in> A) OO bo OO bo \<le> bo"
  by(auto elim!: eq_onpE intro: trans)

lemma antisym_pointfree: "inf (eq_onp (\<lambda>x. x \<in> A) OO bo) bo\<inverse>\<inverse> \<le> (=)"
  by(auto elim!: eq_onpE dest: antisym)

end

(************************************************************)
subsubsection \<open> Merging \<close>
(************************************************************)

text \<open> In general, we prove the properties of blinding before the properties of merging. Thus,
  in the following definitions we assume that the blinding properties already hold on @{term UNIV}.
  The @{term Ball} restricts the argument of the merge operation on which induction will be done. \<close>

locale merge_on =
  blinding_of_on UNIV h bo
    for A :: "'a\<^sub>m set"
    and h :: "('a\<^sub>m, 'a\<^sub>h) hash"
    and bo :: "'a\<^sub>m blinding_of"
    and m :: "'a\<^sub>m merge" +
  assumes join: "\<lbrakk> h a = h b; a \<in> A \<rbrakk>
      \<Longrightarrow> \<exists>ab. m a b = Some ab \<and> bo a ab \<and> bo b ab \<and> (\<forall>u. bo a u \<longrightarrow> bo b u \<longrightarrow> bo ab u)"
    and undefined: "\<lbrakk> h a \<noteq> h b; a \<in> A \<rbrakk> \<Longrightarrow> m a b = None"
begin

lemma same: "a \<in> A \<Longrightarrow> m a a = Some a"
  using join[of a a] refl[of a] by(auto 4 3 intro: antisym)

lemma blinding_of_antisym_on: "blinding_of_on UNIV h bo" ..

lemma transp: "transp bo"
  by(auto intro: transpI trans)

lemmas hash = hash
  and refl = refl
  and antisym = antisym[OF _ _ UNIV_I]

lemma respects_hashes:
  "a \<in> A \<Longrightarrow> h a = h b \<longleftrightarrow> (\<exists>ab. m a b = Some ab)"
  using join undefined
  by fastforce

lemma join':
  "a \<in> A \<Longrightarrow> \<forall>ab. m a b = Some ab \<longleftrightarrow> bo a ab \<and> bo b ab \<and> (\<forall>u. bo a u \<longrightarrow> bo b u \<longrightarrow> bo ab u)"
  using join undefined
  by (metis (full_types) hash local.antisym option.distinct(1) option.sel predicate2D vimage2p_def)

lemma merge_on_subset:
  "B \<subseteq> A \<Longrightarrow> merge_on B h bo m"
  by unfold_locales (auto dest: same join undefined)

end

subsection \<open> Interface equality \<close>

text \<open> Here, we prove that the auxiliary definitions specify the same interface as the original ones.\<close>

lemma merkle_interface_aux: "merkle_interface h bo m = merge_on UNIV h bo m"
  (is "?lhs = ?rhs")
proof
  show ?rhs if ?lhs
  proof
    interpret merkle_interface h bo m by(fact that)
    show "bo \<le> vimage2p h h (=)" by(fact hash)
    show "bo x x" for x using reflp by(simp add: reflp_def)
    show "bo x z" if "bo x y" "bo y z" for x y z using transp that by(rule transpD)
    show "x = y" if "bo x y" "bo y x" for x y using antisymp that by(rule antisympD)
    show "\<exists>ab. m a b = Some ab \<and> bo a ab \<and> bo b ab \<and> (\<forall>u. bo a u \<longrightarrow> bo b u \<longrightarrow> bo ab u)" if "h a = h b" for a b
      using that by(simp add: merge_respects_hashes join)
    show "m a b = None" if "h a \<noteq> h b" for a b using that by(simp add: merge_respects_hashes)
  qed

  show ?lhs if ?rhs
  proof
    interpret merge_on UNIV h bo m by(fact that)
    show eq: "h a = h b \<longleftrightarrow> (\<exists>ab. m a b = Some ab)" for a b by(simp add: respects_hashes)
    show idem: "m a a = Some a" for a by(simp add: same)
    show commute: "m a b = m b a" for a b
      using join[of a b] join[of b a] undefined antisym by(cases "m a b") force+
    have undefined_partitioned: "m a c = None" if "m a b = None" "m b c = Some bc" for a b c bc
      using that eq by (metis option.distinct(1) option.exhaust)
    have merge_twice: "m a b = Some c \<Longrightarrow> m a c = Some c" for a b c by (simp add: join')
    show "m a b \<bind> m c = m b c \<bind> m a" for a b c
    proof(simp split: Option.bind_split; safe)
      show "None = m a d" if "m a b = None" "m b c = Some d" for d using that
        by(metis undefined_partitioned merge_twice)
      show "m c d = None" if "m a b = Some d" "m b c = None" for d using that
        by(metis commute merge_twice undefined_partitioned)
    next
      fix ab bc
      assume assms: "m a b = Some ab" "m b c = Some bc"
      then obtain cab and abc where cab: "m c ab = Some cab" and abc: "m a bc = Some abc"
        using eq[THEN iffD2, OF exI] eq[THEN iffD1] by (metis merge_twice)
      thus "m c ab = m a bc" using assms
        by(clarsimp simp add: join')(metis UNIV_I abc cab local.antisym local.trans)
    qed
    show "bo a b \<longleftrightarrow> m a b = Some b" for a b using idem join' by auto
  qed
qed

lemma merkle_interfaceI [locale_witness]:
  assumes "merge_on UNIV h bo m"
  shows "merkle_interface h bo m"
  using assms unfolding merkle_interface_aux by auto

lemma (in merkle_interface) merkle_interfaceD: "merge_on UNIV h bo m"
  using merkle_interface_aux[of h bo m, symmetric]
  by simp unfold_locales

subsection \<open> Parametricity rules \<close>

context includes lifting_syntax begin
parametric_constant le_fun_parametric[transfer_rule]: le_fun_def
parametric_constant vimage2p_parametric[transfer_rule]: vimage2p_def
parametric_constant blinding_respects_hashes_parametric_aux: blinding_respects_hashes_def

lemma blinding_respects_hashes_parametric [transfer_rule]:
  "((A1 ===> A2) ===> (A1 ===> A1 ===> (\<longleftrightarrow>)) ===> (\<longleftrightarrow>))
   blinding_respects_hashes blinding_respects_hashes"
  if [transfer_rule]: "bi_unique A2" "bi_total A1"
  by(rule blinding_respects_hashes_parametric_aux that le_fun_parametric | simp add: rel_fun_eq)+

parametric_constant blinding_of_on_axioms_parametric [transfer_rule]:
  blinding_of_on_axioms_def[folded Ball_def, unfolded le_fun_def le_bool_def eq_onp_def relcompp.simps, simplified]
parametric_constant blinding_of_on_parametric [transfer_rule]: blinding_of_on_def
parametric_constant antisymp_parametric[transfer_rule]: antisymp_def
parametric_constant transp_parametric[transfer_rule]: transp_def

parametric_constant merge_on_axioms_parametric [transfer_rule]: merge_on_axioms_def
parametric_constant merge_on_parametric[transfer_rule]: merge_on_def

parametric_constant merkle_interface_parametric[transfer_rule]: merkle_interface_def
end

end


theory Uniswap_Virtual_Resource
  imports UniSWP_Common
begin

no_notation inter (infixl "Int" 70)
        and union (infixl "Un" 65)
        and Nats  ("\<nat>")
        and Ints  ("\<int>")

section \<open>Semantics\<close>

subsection \<open>Models of Tick\<close>

(*We do this ugly job because prod is configured with all algebraic properties!, like ring*)

datatype tick_info = tick_info
  (growth: growth)
  (liquidityGross: int)
  (liquidityNet: int)
  (initialized: bool)

setup \<open>Sign.mandatory_path "tick_info"\<close>

definition \<open>map_growth F x = (case x of tick_info g l1 l2 i \<Rightarrow> tick_info (F g) l1 l2 i)\<close>

definition \<open>map_initialized F x = (case x of tick_info g l1 l2 i \<Rightarrow> tick_info g l1 l2 (F i))\<close>
lemma [simp]: \<open>tick_info.map_initialized F (tick_info g l1 l2 i) = (tick_info g l1 l2 (F i))\<close>
  unfolding tick_info.map_initialized_def by simp

setup \<open>Sign.parent_path\<close>

definition \<open>map_liquidityGross F x = (case x of tick_info g l1 l2 i \<Rightarrow> tick_info g (F l1) l2 i)\<close>
lemma [simp]: \<open>map_liquidityGross F (tick_info g l1 l2 i) = (tick_info g (F l1) l2 i)\<close>
  unfolding map_liquidityGross_def by simp

definition \<open>map_liquidityNet F x = (case x of tick_info g l1 l2 i \<Rightarrow> tick_info g l1 (F l2) i)\<close>
lemma [simp]: \<open>map_liquidityNet F (tick_info g l1 l2 i) = (tick_info g l1 (F l2) i)\<close>
  unfolding map_liquidityNet_def by simp

hide_const (open) growth initialized

instantiation tick_info :: zero begin
definition zero_tick_info :: tick_info where [simp]: \<open>zero_tick_info = tick_info 0 0 0 False\<close>
instance ..
end

type_synonym ticks = \<open>tick \<Rightarrow> tick_info\<close>
type_synonym ticks_resource = \<open>ticks nosep option\<close>

resource_space \<phi>uniswap_res = \<phi>empty_res +
  R_ticks :: ticks_resource

debt_axiomatization R_ticks :: \<open>ticks_resource resource_entry\<close>
  where \<phi>uniswap_res_ax: \<open>\<phi>uniswap_res R_ticks\<close>

interpretation \<phi>uniswap_res R_ticks using \<phi>uniswap_res_ax .

hide_fact \<phi>uniswap_res_ax \<phi>uniswap_res_axioms \<phi>uniswap_res_fields_axioms

debt_axiomatization
  res_valid_ticks[simp]: \<open>Resource_Validator R_ticks.name =
                           {R_ticks.inject ticks |ticks. True}\<close>

interpretation R_ticks: nonsepable_mono_resource R_ticks \<open>UNIV\<close>
  apply (standard; simp add: set_eq_iff image_iff)
  by (metis nosep.collapse not_None_eq)

subsubsection \<open>Fiction\<close>

fiction_space \<phi>uniswap_fic :: \<open>RES_N \<Rightarrow> RES\<close> =
  FIC_ticks :: \<open>R_ticks.raw_basic_fiction \<F>_it\<close>

debt_axiomatization FIC_ticks :: \<open>ticks_resource fiction_entry\<close>
  where \<phi>uniswap_fic_ax: \<open>\<phi>uniswap_fic INTERPRET FIC_ticks\<close>

interpretation \<phi>uniswap_fic INTERPRET FIC_ticks using \<phi>uniswap_fic_ax .

hide_fact \<phi>uniswap_fic_ax \<phi>uniswap_fic_axioms

interpretation FIC_ticks: identity_fiction \<open>UNIV\<close> R_ticks FIC_ticks
  by (standard; simp add: set_eq_iff image_iff)

section \<open>\<phi>-Types - Part I - Raw\<close>

subsection \<open>Tick Info Data\<close>

type_synonym opt_growths = \<open>tick \<Rightarrow> growth option\<close>

definition growth_outside :: \<open>growths \<Rightarrow> tick \<Rightarrow> growth \<Rightarrow> tick \<Rightarrow> growth\<close>
  where \<open>growth_outside abs_func tick delta current =
  (if tick \<le> current then (sum abs_func {MIN_TICK-1..<tick}) + delta
                      else (sum abs_func {tick..MAX_TICK}) - delta)\<close>

(*report: the spec of the tick_info.initialized is incorrect!
  it is not \<open>liquidity i \<noteq> 0\<close>

  abst: real (physical) growth
  delta: is some if initialized.
*)
definition Invt_A_Tick :: \<open>tick \<Rightarrow> tick \<Rightarrow> liquidity
                                \<Rightarrow> growths \<Rightarrow> growth option \<Rightarrow> tick_info \<Rightarrow> bool \<close>
  where \<open>Invt_A_Tick i current liquidity growth \<delta> ti
          \<longleftrightarrow> tick_info.liquidityGross ti = liquidity i \<and>
              tick_info.liquidityNet ti = liquidity (i + 1) - liquidity i \<and>
              pred_option (\<lambda>\<delta>. tick_info.growth ti = growth_outside growth i \<delta> current) \<delta> \<and>
              tick_info.initialized ti = (\<delta> \<noteq> None)
        \<close>

definition Invt_Ticks :: \<open>tick \<Rightarrow> liquidity \<Rightarrow> growths \<Rightarrow> opt_growths
                               \<Rightarrow> ticks \<Rightarrow> bool\<close>
  where \<open>Invt_Ticks current liquidity abst \<delta> ticks
          \<longleftrightarrow> (\<forall>i. Invt_A_Tick i current liquidity abst (\<delta> i) (ticks i))
              \<and> current \<in> {MIN_TICK-1..MAX_TICK}\<close>

abbreviation RawTicks :: \<open>(fiction, ticks) \<phi>\<close> where \<open>RawTicks \<equiv> (FIC_ticks.\<phi> (\<black_circle> (Nosep Identity)))\<close>

definition Ticks :: \<open>tick \<Rightarrow> opt_growths \<Rightarrow> (fiction, (liquidity \<times> growths)) \<phi>\<close>
  where [\<phi>defs]: \<open>Ticks current \<delta> = (\<lambda>(liquidity, growth).
                    ticks \<Ztypecolon> RawTicks \<s>\<u>\<b>\<j> ticks. Invt_Ticks current liquidity growth \<delta> ticks)\<close>

declare [[\<phi>trace_reasoning = 1]]

(*A problem of the automatic transformation rule is,
  look, the source \<open>ticks\<close> and the target \<open>liquidity, growth, \<delta>\<close> has no common term,
  meaning if there are two \<open>ticks1 \<Ztypecolon> RawTicks\<heavy_comma> ticks2 \<Ztypecolon> RawTicks\<close>, it is impossible to determine
  which one is the desired one to be transformed, or any combination of them two.

  There is no problem if there is only one \<open>ticks \<Ztypecolon> RawTicks\<close>.
*)

lemma [\<phi>reason 1200]:
  \<open> \<p>\<r>\<e>\<m>\<i>\<s>\<e> Invt_Ticks current liquidity growth \<delta> ticks
\<Longrightarrow> ticks \<Ztypecolon> RawTicks \<i>\<m>\<p>\<l>\<i>\<e>\<s> (liquidity, growth) \<Ztypecolon> Ticks current \<delta>\<close>
  \<medium_left_bracket> construct\<phi> \<open>(liquidity, growth) \<Ztypecolon> Ticks current \<delta>\<close> \<medium_right_bracket>. .

lemma [\<phi>reason 1200]:
  \<open> \<p>\<r>\<e>\<m>\<i>\<s>\<e> Invt_Ticks current liquidity growth \<delta> ticks
\<Longrightarrow> ticks \<Ztypecolon> RawTicks \<i>\<m>\<p>\<l>\<i>\<e>\<s> (liquidity, growth) \<Ztypecolon> Ticks current \<delta>
    @action to (Ticks current \<delta>)\<close> \<medium_left_bracket> \<medium_right_bracket>. .

lemma [\<phi>reason 1200]:
  \<open> (liquidity, growth) \<Ztypecolon> Ticks current \<delta> \<i>\<m>\<p>\<l>\<i>\<e>\<s> ticks \<Ztypecolon> RawTicks \<s>\<u>\<b>\<j> ticks. Invt_Ticks current liquidity growth \<delta> ticks
    @action to RawTicks\<close>
  \<medium_left_bracket> destruct\<phi> _ \<medium_right_bracket>. .

section \<open>Axiomatic Semantics of Abstract Operations\<close>

debt_axiomatization
    op_get_liquidityGross :: \<open>(VAL, VAL) proc'\<close>
and op_set_liquidityGross :: \<open>(VAL \<times> VAL, VAL) proc'\<close>
and op_get_liquidityNet :: \<open>(VAL, VAL) proc'\<close>
and op_set_liquidityNet :: \<open>(VAL \<times> VAL, VAL) proc'\<close>
and op_get_initialized :: \<open>(VAL, VAL) proc'\<close>
and op_set_initialized :: \<open>(VAL \<times> VAL, VAL) proc'\<close>
and op_get_feeGrowth0 :: \<open>(VAL, VAL) proc'\<close>
and op_set_feeGrowth0 :: \<open>(VAL \<times> VAL, VAL) proc'\<close>
and op_get_feeGrowth1 :: \<open>(VAL, VAL) proc'\<close>
and op_set_feeGrowth1 :: \<open>(VAL \<times> VAL, VAL) proc'\<close>
and op_get_tickCumulative :: \<open>(VAL, VAL) proc'\<close>
and op_set_tickCumulative :: \<open>(VAL \<times> VAL, VAL) proc'\<close>
and op_get_secondsPerLiquidity :: \<open>(VAL, VAL) proc'\<close>
and op_set_secondsPerLiquidity :: \<open>(VAL \<times> VAL, VAL) proc'\<close>
and op_get_seconds :: \<open>(VAL, VAL) proc'\<close>
and op_set_seconds :: \<open>(VAL \<times> VAL, VAL) proc'\<close>
where
    get_liquidityGross_\<phi>app[\<phi>synthesis 1200]:
      \<open> \<p>\<r>\<o>\<c> op_get_liquidityGross ri \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick
                                   \<longmapsto> f \<Ztypecolon> RawTicks\<heavy_comma> (liquidityGross o f) i \<Ztypecolon> \<v>\<a>\<l> \<int> \<rbrace>\<close>
                                                    (* to prevent higher-order unification! *)
and set_liquidityGross_\<phi>app:
      \<open> \<p>\<r>\<o>\<c> op_set_liquidityGross (rv\<^bold>, ri)
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick \<heavy_comma> v \<Ztypecolon> \<v>\<a>\<l>[rv] \<int>
                \<longmapsto> f(i := map_liquidityGross (\<lambda>_. v) (f i)) \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l> Tick \<rbrace>\<close>
and get_liquidityNet_\<phi>app[\<phi>synthesis 1200]:
      \<open> \<p>\<r>\<o>\<c> op_get_liquidityNet ri
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick
                \<longmapsto> f \<Ztypecolon> RawTicks\<heavy_comma> (liquidityNet o f) i \<Ztypecolon> \<v>\<a>\<l> \<int> \<rbrace>\<close>
and set_liquidityNet_\<phi>app:
      \<open> \<p>\<r>\<o>\<c> op_set_liquidityNet (rv\<^bold>, ri)
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick \<heavy_comma> v \<Ztypecolon> \<v>\<a>\<l>[rv] \<int>
                \<longmapsto> f(i := map_liquidityNet (\<lambda>_. v) (f i)) \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l> Tick \<rbrace>\<close>
and get_initialized_\<phi>app[\<phi>synthesis 1200]:
      \<open> \<p>\<r>\<o>\<c> op_get_initialized ri
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick
                \<longmapsto> f \<Ztypecolon> RawTicks\<heavy_comma> (tick_info.initialized o f) i \<Ztypecolon> \<v>\<a>\<l> \<bool> \<rbrace>\<close>
and set_initialized_\<phi>app:
      \<open> \<p>\<r>\<o>\<c> op_set_initialized (rv\<^bold>, ri)
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick \<heavy_comma> b \<Ztypecolon> \<v>\<a>\<l>[rv] \<bool>
                \<longmapsto> f(i := tick_info.map_initialized (\<lambda>_. b) (f i)) \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l> Tick \<rbrace>\<close>
and get_feeGrowth0_\<phi>app[\<phi>synthesis 1200]:
      \<open> \<p>\<r>\<o>\<c> op_get_feeGrowth0 ri
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick
                \<longmapsto> f \<Ztypecolon> RawTicks\<heavy_comma> (growth.fee0 o tick_info.growth o f) i \<Ztypecolon> \<v>\<a>\<l> \<real> \<rbrace>\<close>
and set_feeGrowth0_\<phi>app:
      \<open> \<p>\<r>\<o>\<c> op_set_feeGrowth0 (rv\<^bold>, ri)
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick \<heavy_comma> r \<Ztypecolon> \<v>\<a>\<l>[rv] \<real>
                \<longmapsto> f(i := tick_info.map_growth (growth.map_fee0 (\<lambda>_. r)) (f i)) \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l> Tick \<rbrace>\<close>
and get_feeGrowth1_\<phi>app[\<phi>synthesis 1200]:
      \<open> \<p>\<r>\<o>\<c> op_get_feeGrowth1 ri
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick
                \<longmapsto> f \<Ztypecolon> RawTicks\<heavy_comma> (growth.fee1 o tick_info.growth o f) i \<Ztypecolon> \<v>\<a>\<l> \<real> \<rbrace>\<close>
and set_feeGrowth1_\<phi>app:
      \<open> \<p>\<r>\<o>\<c> op_set_feeGrowth1 (rv\<^bold>, ri)
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick \<heavy_comma> r \<Ztypecolon> \<v>\<a>\<l>[rv] \<real>
                \<longmapsto> f(i := tick_info.map_growth (growth.map_fee1 (\<lambda>_. r)) (f i)) \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l> Tick \<rbrace>\<close>
and get_tickCumulative_\<phi>app[\<phi>synthesis 1200]:
      \<open> \<p>\<r>\<o>\<c> op_get_tickCumulative ri
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick
                \<longmapsto> f \<Ztypecolon> RawTicks\<heavy_comma> (growth.tickCumulative o tick_info.growth o f) i \<Ztypecolon> \<v>\<a>\<l> \<int> \<rbrace>\<close>
and set_tickCumulative_\<phi>app:
      \<open> \<p>\<r>\<o>\<c> op_set_tickCumulative (rv\<^bold>, ri)
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick \<heavy_comma> v \<Ztypecolon> \<v>\<a>\<l>[rv] \<int>
                \<longmapsto> f(i := tick_info.map_growth (growth.map_tickCumulative (\<lambda>_. v)) (f i)) \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l> Tick \<rbrace>\<close>
and get_secondsPerLiquidity_\<phi>app[\<phi>synthesis 1200]:
      \<open> \<p>\<r>\<o>\<c> op_get_secondsPerLiquidity ri
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick
                \<longmapsto> f \<Ztypecolon> RawTicks\<heavy_comma> (growth.secondsPerLiquidity o tick_info.growth o f) i \<Ztypecolon> \<v>\<a>\<l> \<real> \<rbrace>\<close>
and set_secondsPerLiquidity_\<phi>app:
      \<open> \<p>\<r>\<o>\<c> op_set_secondsPerLiquidity (rv\<^bold>, ri)
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick \<heavy_comma> r \<Ztypecolon> \<v>\<a>\<l>[rv] \<real>
                \<longmapsto> f(i := tick_info.map_growth (growth.map_secondsPerLiquidity (\<lambda>_. r)) (f i)) \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l> Tick \<rbrace>\<close>
and get_seconds_\<phi>app[\<phi>synthesis 1200]:
      \<open> \<p>\<r>\<o>\<c> op_get_seconds ri
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick
                \<longmapsto> f \<Ztypecolon> RawTicks\<heavy_comma> (growth.seconds o tick_info.growth o f) i \<Ztypecolon> \<v>\<a>\<l> \<int> \<rbrace>\<close>
and set_seconds_\<phi>app:
      \<open> \<p>\<r>\<o>\<c> op_set_seconds (rv\<^bold>, ri)
            \<lbrace> f \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l>[ri] Tick \<heavy_comma> v \<Ztypecolon> \<v>\<a>\<l>[rv] \<int>
                \<longmapsto> f(i := tick_info.map_growth (growth.map_seconds (\<lambda>_. v)) (f i)) \<Ztypecolon> RawTicks\<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l> Tick \<rbrace>\<close>

thm set_feeGrowth0_\<phi>app

section \<open>Verify\<close>

lemma interval_sub_1[simp]:
  \<open>A \<le> B \<Longrightarrow> {A..C} - {A..<B} = {B..C}\<close>
  for A :: int by auto

lemma sum_sub_1[simp]:
  \<open>A \<le> B \<and> B \<le> C \<Longrightarrow> sum f {A..C} - sum f {A..<B} = sum f {B..C}\<close>
  for f :: \<open>int \<Rightarrow> 'a::ab_group_add\<close>
  by (smt (verit, del_insts) atLeastLessThan_upto atLeastatMost_subset_iff finite_atLeastAtMost_int interval_sub_1 set_upto sum_diff)

lemma interval_sub_2[simp]:
  \<open>B \<le> C \<Longrightarrow> {A..C} - {B..C} = {A..<B}\<close> for A :: int by auto

lemma sum_sub_2[simp]:
  \<open>A \<le> B \<and> B \<le> C \<Longrightarrow> sum f {A..C} - sum f {B..C} = sum f {A..<B}\<close>
  for f :: \<open>int \<Rightarrow> 'a::ab_group_add\<close>
  using sum_diff interval_sub_2
  by (metis atLeastatMost_subset_iff dual_order.refl finite_atLeastAtMost_int)

abbreviation gSum where \<open>gSum growth \<equiv> (\<Sum>x = MIN_TICK-1..MAX_TICK. growth x)\<close>

proc getFeeGrowthInside:
  premises \<open>\<delta> lower \<noteq> None\<close> and \<open>\<delta> upper \<noteq> None\<close> (*They mean the upper tick and the lower tick is initialized*)
    and    \<open>lower < upper\<close>
  premises \<open>global_fee0 = growth.fee0 (gSum growth)\<close> (*global_fee0 is the sum of all the growth at every ticks*)
    and    \<open>global_fee1 = growth.fee1 (gSum growth)\<close>
  input \<open>(liq, growth) \<Ztypecolon> Ticks current \<delta> \<heavy_comma>
          lower \<Ztypecolon> \<v>\<a>\<l> Tick \<heavy_comma> upper \<Ztypecolon> \<v>\<a>\<l> Tick \<heavy_comma> current \<Ztypecolon> \<v>\<a>\<l> Tick \<heavy_comma> global_fee0 \<Ztypecolon> \<v>\<a>\<l> \<real> \<heavy_comma> global_fee1 \<Ztypecolon> \<v>\<a>\<l> \<real>\<close>
  output \<open>(liq, growth) \<Ztypecolon> Ticks current \<delta> \<heavy_comma>
          growth.fee0 (sum growth {lower..<upper} - the (\<delta> lower) + the (\<delta> upper)) \<Ztypecolon> \<v>\<a>\<l> \<real> \<heavy_comma>
          growth.fee1 (sum growth {lower..<upper} - the (\<delta> lower) + the (\<delta> upper)) \<Ztypecolon> \<v>\<a>\<l> \<real>\<close>
  is [routine]
  \<medium_left_bracket> to \<open>RawTicks\<close> ;;
    obtain \<delta>_lower \<delta>_upper where \<delta>_lower[simp]: \<open>\<delta> lower = Some \<delta>_lower\<close>
                            and \<delta>_upper[simp]: \<open>\<delta> upper = Some \<delta>_upper\<close>
      using the_\<phi>(1) the_\<phi>(2) by blast

    note lower_simps[simp] =
          \<open>Invt_Ticks current liq growth \<delta> ticks\<close>[unfolded Invt_Ticks_def Invt_A_Tick_def
                  growth_outside_def, THEN conjunct1, THEN spec[where x=lower], simplified]
    note upper_simps[simp] =
          \<open>Invt_Ticks current liq growth \<delta> ticks\<close>[unfolded Invt_Ticks_def Invt_A_Tick_def
                  growth_outside_def, THEN conjunct1, THEN spec[where x=upper], simplified] ;;

    if \<open>$lower \<le> $current\<close> \<medium_left_bracket>
      $lower get_feeGrowth0
      $lower get_feeGrowth1
    \<medium_right_bracket>. \<medium_left_bracket>
      $global_fee0 sub ($lower get_feeGrowth0)
      $global_fee1 sub ($lower get_feeGrowth1)
    \<medium_right_bracket>. \<rightarrow> val fee0_below, fee1_below

    if \<open>$current < $upper\<close> \<medium_left_bracket>
      have [simp]: \<open>\<not> (upper \<le> current)\<close> using \<open>current < upper\<close> by linarith ;;
      $upper get_feeGrowth0
      $upper get_feeGrowth1
    \<medium_right_bracket>. \<medium_left_bracket>
      have [simp]: \<open>(upper \<le> current)\<close> using \<open>\<not> (current < upper)\<close> by linarith ;;
      $global_fee0 sub ($upper get_feeGrowth0)
      $global_fee1 sub ($upper get_feeGrowth1)
    \<medium_right_bracket>. \<rightarrow> val fee0_above, fee1_above

    note add_diff_eq[simp] fee0_sum[simp] fee1_sum[simp] diff_diff_eq[symmetric, simp] ;;

    \<open>$global_fee0 - $fee0_below - $fee0_above\<close>
    \<open>$global_fee1 - $fee1_below - $fee1_above\<close>
  \<medium_right_bracket>. .

  thm getFeeGrowthInside_def[simplified \<phi>V_simps]

(*\<heavy_comma>
          liq i - liq current \<Ztypecolon> \<v>\<a>\<l> \<int> *)

lemma gSum_subtract1[simp]:
  \<open> MIN_TICK-1 \<le> i \<and> i \<le> j \<and> j \<le> MAX_TICK
\<Longrightarrow> gSum growth - growth_outside growth i \<delta> j = growth_outside growth i \<delta> (i-1)\<close>
  unfolding growth_outside_def by auto

lemma gSum_subtract2[simp]:
  \<open> MIN_TICK-1 \<le> j \<and> j < i \<and> i \<le> MAX_TICK
\<Longrightarrow> gSum growth - growth_outside growth i \<delta> j = growth_outside growth i \<delta> i\<close>
  unfolding growth_outside_def by auto

lemma growth_outside_shift_mono:
  \<open> i \<le> j \<and> j \<le> k   \<or>   j < i \<and> k \<le> j
\<Longrightarrow> growth_outside growth i \<delta> j = growth_outside growth i \<delta> k\<close>
  unfolding growth_outside_def by auto

abbreviation \<open>next_initialized \<delta> i j \<equiv> (\<forall>k. i < k \<and> k < j \<longrightarrow> \<delta> k = None)\<close>

proc cross:
  premises \<open>\<delta> i \<noteq> None\<close>
    and    \<open>if j < i then next_initialized \<delta> j i else next_initialized \<delta> (i-1) j\<close>
  premises \<open>fee0 = growth.fee0 (gSum growth)\<close> (*global_fee0 is the sum of all the growth at every ticks*)
    and    \<open>fee1 = growth.fee1 (gSum growth)\<close>
    and    \<open>sec_per_liq = growth.secondsPerLiquidity (gSum growth)\<close>
    and    \<open>tick_cumu = growth.tickCumulative (gSum growth)\<close>
    and    \<open>time = growth.seconds (gSum growth)\<close>
  input  \<open>(liq, growth) \<Ztypecolon> Ticks j \<delta> \<heavy_comma> i \<Ztypecolon> \<v>\<a>\<l> Tick \<heavy_comma> fee0 \<Ztypecolon> \<v>\<a>\<l> \<real> \<heavy_comma> fee1 \<Ztypecolon> \<v>\<a>\<l> \<real> \<heavy_comma>
           sec_per_liq \<Ztypecolon> \<v>\<a>\<l> \<real>\<heavy_comma> tick_cumu \<Ztypecolon> \<v>\<a>\<l> \<int> \<heavy_comma> time \<Ztypecolon> \<v>\<a>\<l> \<int>\<close>
  output \<open>(liq, growth) \<Ztypecolon> Ticks (if j < i then i else i - 1) \<delta> \<close>
  is [routine]
  \<medium_left_bracket> to \<open>RawTicks\<close>
  obtain fee0' fee1' spl' tc' time' liqG' liqN' init'
    where Tick_i[simp]: \<open>ticks i = tick_info (fee0', fee1', spl', tc', time') liqG' liqN' init'\<close>
    by (metis surj_pair tick_info.exhaust)

  ;; $i set_feeGrowth0 ($fee0 sub ($i get_feeGrowth0))
        set_feeGrowth1 ($fee1 sub ($i get_feeGrowth1))
        set_secondsPerLiquidity ($sec_per_liq sub ($i get_secondsPerLiquidity))
        set_tickCumulative ($tick_cumu sub ($i get_tickCumulative))
        set_seconds ($time sub ($i get_seconds)) ;;

  have th1[simp]:
        \<open>\<And>A. (growth.fee0 A - fee0', growth.fee1 A - fee1', growth.tickCumulative A - spl',
              growth.secondsPerLiquidity A - tc', growth.seconds A - time')
          = A - (fee0', fee1', spl', tc', time')\<close>
    by (case_tac A; simp)
  note th2 = \<open>Invt_Ticks j liq growth \<delta> ticks\<close>[unfolded Invt_Ticks_def Invt_A_Tick_def]
  note th3 = th2[THEN conjunct1]

  \<medium_right_bracket> unfolding Invt_Ticks_def Invt_A_Tick_def
    using th2 th3[THEN spec[where x=i]] Tick_i the_\<phi>(1,2) the_\<phi>lemmata(1)
    apply (auto)
    apply (smt (verit) th3 growth_outside_shift_mono option.pred_inject(1) option.pred_inject(2))
    by (smt (verit) growth_outside_def option.pred_inject(1) option.pred_inject(2) th3)
    .

end