(* Copyright 2021 (C) Mihails Milehins *)

section\<open>Finite sequences\<close>
theory CZH_Sets_FSequences
  imports CZH_Sets_Cardinality
begin

subsection\<open>Background\<close>

text\<open>
The section presents a theory of finite sequences internalized in the
type \<^typ>\<open>V\<close>. The content of this subsection
was inspired by and draws on many ideas from the content
of the theory \<open>List\<close> in the main library of Isabelle/HOL.
\<close>

subsection\<open>Definition and common properties\<close>

text\<open>
A finite sequence is defined as a single-valued binary relation whose domain
is an initial segment of the set of natural numbers.
\<close>

locale vfsequence = vsv xs for xs +
  assumes vfsequence_vdomain_in_omega: "\<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> \<omega>"

locale vfsequence_pair = r\<^sub>1: vfsequence xs\<^sub>1 + r\<^sub>2: vfsequence xs\<^sub>2 for xs\<^sub>1 xs\<^sub>2

text\<open>Rules.\<close>

lemmas [intro] = vfsequence.axioms(1)

lemma vfsequenceI[intro]:
  assumes "vsv xs" and "\<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> \<omega>"
  shows "vfsequence xs"
  using assms by (simp add: vfsequence.intro vfsequence_axioms_def)

lemma vfsequenceD[dest]:
  assumes "vfsequence xs"
  shows "\<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> \<omega>"
  using assms vfsequence.vfsequence_vdomain_in_omega by simp

lemma vfsequenceE[elim]:
  assumes "vfsequence xs" and "\<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> \<omega> \<Longrightarrow> P"
  shows P
  using assms by auto

lemma vfsequence_iff: "vfsequence xs \<longleftrightarrow> vsv xs \<and> \<D>\<^sub>\<circ> xs \<in>\<^sub>\<circ> \<omega>"
  using vfsequence_def by auto

text\<open>Elementary properties.\<close>

lemma (in vfsequence) vfsequence_vdomain: "\<D>\<^sub>\<circ> xs = vcard xs"
  unfolding vsv_vcard_vdomain[symmetric] using vfsequence_vdomain_in_omega by simp

lemma (in vfsequence) vfsequence_vcard_in_omega[simp]: "vcard xs \<in>\<^sub>\<circ> \<omega>"
  using vfsequence_vdomain_in_omega by (simp add: vfsequence_vdomain)

text\<open>Set operations.\<close>

lemma vfsequence_vempty[intro, simp]: "vfsequence 0" by (simp add: vfsequenceI)

lemma vfsequence_vsingleton[intro, simp]: "vfsequence (set {\<langle>0, a\<rangle>})"
  using vone_in_omega
  unfolding one_V_def
  by (intro vfsequenceI) (auto simp: set_vzero_eq_ord_of_nat_vone)

lemma (in vfsequence) vfsequence_vinsert:
  "vfsequence (vinsert \<langle>vcard xs, a\<rangle> xs)"
  using succ_def succ_in_omega by (auto simp: vfsequence_vdomain)

text\<open>Connections.\<close>

lemma (in vfsequence) vfsequence_vfinite[simp]: "vfinite xs"
  by (simp add: vfinite_vcard_omega_iff)

lemma (in vfsequence) vfsequence_vlrestriction[intro, simp]:
  assumes "k \<in>\<^sub>\<circ> \<omega>"
  shows "vfsequence (xs \<restriction>\<^sup>l\<^sub>\<circ> k)"
  using assms by (force simp: vfsequence_vdomain vdomain_vlrestriction)

lemma vfsequence_vproduct:
  assumes "n \<in>\<^sub>\<circ> \<omega>" and "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A i)"
  shows "vfsequence xs"
  using assms by auto

lemma vfsequence_vcpower:
  assumes "n \<in>\<^sub>\<circ> \<omega>" and "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> n"
  shows "vfsequence xs"
  using assms vfsequence_vproduct by auto

lemma vfsequence_vcomp_vsv_vfsequence:
  assumes "vsv f" and "vfsequence xs" and "\<R>\<^sub>\<circ> xs \<subseteq>\<^sub>\<circ> \<D>\<^sub>\<circ> f"
  shows "vfsequence (f \<circ>\<^sub>\<circ> xs)"
proof(intro vfsequenceI vsv_vcomp)
  interpret xs: vfsequence xs by (rule assms(2))
  show "\<D>\<^sub>\<circ> (f \<circ>\<^sub>\<circ> xs) \<in>\<^sub>\<circ> \<omega>"
    unfolding vdomain_vcomp_vsubset[OF assms(3)]
    by (force simp: xs.vfsequence_vdomain_in_omega)
qed (auto intro: assms)

text\<open>Special properties.\<close>

lemma (in vfsequence) vfsequence_vdomain_vlrestriction[intro, simp]:
  assumes "k \<in>\<^sub>\<circ> vcard xs"
  shows "\<D>\<^sub>\<circ> (xs \<restriction>\<^sup>l\<^sub>\<circ> k) = k"
  using assms
  by
    (
      simp add:
        OrdmemD
        inf_absorb2
        order.strict_implies_order
        vdomain_vlrestriction
        vfsequence_vdomain
    )

lemma (in vfsequence) vfsequence_vlrestriction_vcard[simp]:
  "xs \<restriction>\<^sup>l\<^sub>\<circ> (vcard xs) = xs"
  by (rule vlrestriction_vdomain[unfolded vfsequence_vdomain])

lemma vfsequence_vfinite_vcardI:
  assumes "vsv xs" and "vfinite xs" and "\<D>\<^sub>\<circ> xs = vcard xs"
  shows "vfsequence xs"
  using assms by (intro vfsequenceI) (auto simp: vfinite_vcard_omega)

lemma (in vfsequence) vfsequence_vrangeE:
  assumes "a \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> xs"
  obtains n where "n \<in>\<^sub>\<circ> vcard xs" and "xs\<lparr>n\<rparr> = a"
  using assms vfsequence_vdomain by auto

lemma (in vfsequence) vfsequence_vrange_vproduct:
  assumes "\<And>i. i \<in>\<^sub>\<circ> vcard xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
  shows "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A i)"
  using vfsequence_vdomain vsv_axioms assms
  by
    (
      intro vproductI;
      (intro vsv.vsv_vrange_vsubset_vifunion_app | tactic\<open>all_tac\<close>)
    ) auto

lemma (in vfsequence) vfsequence_vrange_vcpower:
  assumes "\<R>\<^sub>\<circ> xs \<subseteq>\<^sub>\<circ> A"
  shows "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> (vcard xs)"
  using assms
proof(elim vsubsetE; intro vcpowerI)
  assume hyp: "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> xs \<Longrightarrow> x \<in>\<^sub>\<circ> A" for x
  from vfsequence_vdomain show "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A)"
    by (intro vproductI) (blast intro: hyp elim: vdomain_atE)+
qed

text\<open>Alternative forms of existing results.\<close>

lemmas [intro, simp] = vfsequence.vfsequence_vcard_in_omega
  and [intro, simp] = vfsequence.vfsequence_vfinite
  and [intro, simp] = vfsequence.vfsequence_vlrestriction
  and [intro, simp] = vfsequence.vfsequence_vdomain_vlrestriction
  and [intro, simp] = vfsequence.vfsequence_vlrestriction_vcard

subsection\<open>Appending an element to a finite sequence: \<open>vcons\<close>\<close>

subsubsection\<open>Definition and common properties\<close>

definition vcons :: "V \<Rightarrow> V \<Rightarrow> V"  (infixr \<open>#\<^sub>\<circ>\<close> 65)
  where "xs #\<^sub>\<circ> x = vinsert \<langle>vcard xs, x\<rangle> xs"

text\<open>Syntax.\<close>

abbreviation vempty_vfsequence (\<open>[]\<^sub>\<circ>\<close>) where
  "vempty_vfsequence \<equiv> 0::V"

notation vempty_vfsequence (\<open>[]\<^sub>\<circ>\<close>)

nonterminal fsfields
nonterminal vlist

syntax
  "" :: "V \<Rightarrow> fsfields" ("_")
  "_fsfields" :: "fsfields \<Rightarrow> V \<Rightarrow> fsfields" ("_,/ _")
  "_vlist" :: "fsfields \<Rightarrow> V" ("[(_)]\<^sub>\<circ>")
  "_vapp" :: "V \<Rightarrow> fsfields \<Rightarrow> V" ("_ \<lparr>(_)\<rparr>\<^sub>\<bullet>" [100, 100] 100)

translations
  "[xs, x]\<^sub>\<circ>" == "[xs]\<^sub>\<circ> #\<^sub>\<circ> x"
  "[x]\<^sub>\<circ>" == "[]\<^sub>\<circ> #\<^sub>\<circ> x"

translations
  "f\<lparr>xs, x\<rparr>\<^sub>\<bullet>" == "f\<lparr>[xs, x]\<^sub>\<circ>\<rparr>"
  "f\<lparr>x\<rparr>\<^sub>\<bullet>" == "f\<lparr>[x]\<^sub>\<circ>\<rparr>"

text\<open>Rules.\<close>

lemma vconsI[intro!]:
  assumes "a \<in>\<^sub>\<circ> vinsert \<langle>vcard xs, x\<rangle> xs"
  shows "a \<in>\<^sub>\<circ> xs #\<^sub>\<circ> x"
  using assms unfolding vcons_def by clarsimp

lemma vconsD[dest!]:
  assumes "a \<in>\<^sub>\<circ> xs #\<^sub>\<circ> x"
  shows "a \<in>\<^sub>\<circ> vinsert \<langle>vcard xs, x\<rangle> xs"
  using assms unfolding vcons_def by clarsimp

lemma vconsE[elim!]:
  assumes "a \<in>\<^sub>\<circ> xs #\<^sub>\<circ> x"
  obtains a where "a \<in>\<^sub>\<circ> vinsert \<langle>vcard xs, x\<rangle> xs"
  using assms unfolding vcons_def by clarsimp

text\<open>Elementary properties.\<close>

lemma vcons_neq_vempty[simp]: "ys #\<^sub>\<circ> y \<noteq> []\<^sub>\<circ>" by auto

text\<open>Set operations.\<close>

lemma vcons_vsingleton: "[a]\<^sub>\<circ> = set {\<langle>0\<^sub>\<nat>, a\<rangle>}" unfolding vcons_def by simp

lemma vcons_vdoubleton: "[a, b]\<^sub>\<circ> = set {\<langle>0\<^sub>\<nat>, a\<rangle>, \<langle>1\<^sub>\<nat>, b\<rangle>}"
  unfolding vcons_def
  using vinsert_vsingleton
  by (force simp: vinsert_set_insert_eq)

lemma vcons_vsubset: "xs \<subseteq>\<^sub>\<circ> xs #\<^sub>\<circ> x" by clarsimp

lemma vcons_vsubset':
  assumes "vcons xs x \<subseteq>\<^sub>\<circ> ys"
  shows "vcons xs x \<subseteq>\<^sub>\<circ> vcons ys y"
  using assms unfolding vcons_def by auto

text\<open>Connections.\<close>

lemma (in vfsequence) vfsequence_vcons[intro, simp]: "vfsequence (xs #\<^sub>\<circ> x)"
proof(intro vfsequenceI)
  from vfsequence_vdomain_in_omega vsv_vcard_vdomain have "vcard xs = \<D>\<^sub>\<circ> xs"
    by (simp add: vcard_veqpoll)
  show "vsv (xs #\<^sub>\<circ> x)"
  proof(intro vsvI)
    fix a b c assume ab: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> xs #\<^sub>\<circ> x" and ac: "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> xs #\<^sub>\<circ> x"
    then consider (dom) "a \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" | (ndom) "a = vcard xs"
      unfolding vcons_def by auto
    then show "b = c"
    proof cases
      case dom
      with ab have "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> xs"
        unfolding vcons_def by (auto simp: \<open>vcard xs = \<D>\<^sub>\<circ> xs\<close>)
      moreover from dom ac have "\<langle>a, c\<rangle> \<in>\<^sub>\<circ> xs"
        unfolding vcons_def by (auto simp: \<open>vcard xs = \<D>\<^sub>\<circ> xs\<close>)
      ultimately show ?thesis using vsv by simp
    next
      case ndom
      from ab have "\<langle>a, b\<rangle> = \<langle>vcard xs, x\<rangle>"
        unfolding ndom vcons_def using \<open>vcard xs = \<D>\<^sub>\<circ> xs\<close> mem_not_refl by blast
      moreover from ac have "\<langle>a, c\<rangle> = \<langle>vcard xs, x\<rangle>"
        unfolding ndom vcons_def using \<open>vcard xs = \<D>\<^sub>\<circ> xs\<close> mem_not_refl by blast
      ultimately show ?thesis by simp
    qed
  next
    show "vbrelation (xs #\<^sub>\<circ> x)" unfolding vcons_def
      using vbrelation_vinsertI by auto
  qed
  show "\<D>\<^sub>\<circ> (xs #\<^sub>\<circ> x) \<in>\<^sub>\<circ> \<omega>"
    unfolding vcons_def
    using succ_in_omega
    by (auto simp: vfsequence_vdomain_in_omega succ_def \<open>vcard xs = \<D>\<^sub>\<circ> xs\<close>)
qed

lemma (in vfsequence) vfsequence_vcons_vdomain[simp]:
  "\<D>\<^sub>\<circ> (xs #\<^sub>\<circ> x) = succ (vcard xs)"
  by (simp add: succ_def vcons_def vfsequence_vdomain)

lemma (in vfsequence) vfsequence_vcons_vrange[simp]:
  "\<R>\<^sub>\<circ> (xs #\<^sub>\<circ> x) = vinsert x (\<R>\<^sub>\<circ> xs)"
  by (simp add: vcons_def)

lemma (in vfsequence) vfsequence_vrange_vconsI:
  assumes "\<R>\<^sub>\<circ> xs \<subseteq>\<^sub>\<circ> X" and "x \<in>\<^sub>\<circ> X"
  shows "\<R>\<^sub>\<circ> (xs #\<^sub>\<circ> x) \<subseteq>\<^sub>\<circ> X"
  using assms unfolding vcons_def by auto

lemmas vfsequence_vrange_vconsI = vfsequence.vfsequence_vrange_vconsI[rotated 1]

text\<open>Special properties.\<close>

lemma vcons_vrange_mono:
  assumes "xs \<subseteq>\<^sub>\<circ> ys"
  shows "\<R>\<^sub>\<circ> (xs #\<^sub>\<circ> x) \<subseteq>\<^sub>\<circ> \<R>\<^sub>\<circ> (ys #\<^sub>\<circ> x)"
  using assms
  unfolding vcons_def
  by (simp add: vrange_mono vsubset_vinsert_leftI vsubset_vinsert_rightI)

lemma (in vfsequence) vfsequence_vlrestriction_succ:
  assumes [simp]: "k \<in>\<^sub>\<circ> vcard xs"
  shows "xs \<restriction>\<^sup>l\<^sub>\<circ> succ k = xs \<restriction>\<^sup>l\<^sub>\<circ> k #\<^sub>\<circ> (xs\<lparr>k\<rparr>)"
proof-
  interpret vlr: vfsequence \<open>xs \<restriction>\<^sup>l\<^sub>\<circ> k\<close>
    using assms by (blast intro: vfsequence_vcard_in_omega Ord_trans)
  from vlr.vfsequence_vdomain[symmetric, simplified] show ?thesis
    by
      (
        simp add:
          vcons_def succ_def vfsequence_vdomain vsv_vlrestriction_vinsert
      )
qed

lemma (in vfsequence) vfsequence_vremove_vcons_vfsequence:
  assumes "xs = xs' #\<^sub>\<circ> x"
  shows "vfsequence xs'"
proof(cases\<open>\<langle>vcard xs', x\<rangle> \<in>\<^sub>\<circ> xs'\<close>)
  case True
  with assms[unfolded vcons_def] have "xs = xs'" by auto
  then show ?thesis using vfsequence_axioms by simp
next
  case False
  note x_def[simp] = assms[unfolded vcons_def]
  interpret xs': vsv xs' using vsv_axioms by (auto intro: vsv_vinsertD)
  have fin: "vfinite xs'" using vfsequence_vfinite by auto
  have vcard_xs: "vcard xs = succ (vcard xs')" by (simp add: fin False)
  have [simp]: "vcard xs' \<notin>\<^sub>\<circ> \<D>\<^sub>\<circ> xs'" using False vsv_axioms by auto
  have "vcard xs' \<in>\<^sub>\<circ> \<omega>" using fin vfinite_vcard_omega by auto
  have xs'_def: "xs' = xs \<restriction>\<^sup>l\<^sub>\<circ> (vcard xs')"
    using vcard_xs fin vfsequence_vdomain
    by (auto simp: vinsert_ident succ_def)
  from vfsequence_vlrestriction[OF \<open>vcard xs' \<in>\<^sub>\<circ> \<omega>\<close>] show ?thesis
    unfolding xs'_def[symmetric] .
qed

lemma (in vfsequence) vfsequence_vcons_ex:
  assumes "xs \<noteq> []\<^sub>\<circ>"
  obtains xs' x where "xs = xs' #\<^sub>\<circ> x" and "vfsequence xs'"
proof-
  from vcard_vempty have "0 \<in>\<^sub>\<circ> vcard xs" by (simp add: assms mem_0_Ord)
  then obtain k where succk: "succ k = vcard xs"
    by (metis omega_prev vfsequence_vcard_in_omega)
  then have "k \<in>\<^sub>\<circ> vcard xs" using elts_succ by blast
  from vfsequence_vlrestriction_succ[OF this, unfolded succk] show ?thesis
    by (simp add: vfsequence_vremove_vcons_vfsequence that)
qed

subsubsection\<open>Induction and case analysis\<close>

lemma vfsequence_induct[consumes 1, case_names 0 vcons]:
  assumes "vfsequence xs"
    and "P []\<^sub>\<circ>"
    and "\<And>xs x. \<lbrakk>vfsequence xs; P xs\<rbrakk> \<Longrightarrow> P (xs #\<^sub>\<circ> x)"
  shows "P xs"
proof-
  interpret vfsequence xs by (rule assms(1))
  from assms(1) obtain n where "n \<in>\<^sub>\<circ> \<omega>" and "\<D>\<^sub>\<circ> xs = n" by auto
  then have "n \<le> \<D>\<^sub>\<circ> xs" by auto
  define P' where "P' k = P (xs \<restriction>\<^sup>l\<^sub>\<circ> k)" for k
  from \<open>n \<in>\<^sub>\<circ> \<omega>\<close> and \<open>n \<le> \<D>\<^sub>\<circ> xs\<close> have "P' n"
  proof(induction rule: omega_induct)
    case (succ n') then show ?case
    proof-
      interpret vlr: vfsequence \<open>xs \<restriction>\<^sup>l\<^sub>\<circ> n'\<close> by (simp add: succ.hyps)
      have "P' n'" using succ.prems by (force intro: succ.IH)
      then have "P (xs \<restriction>\<^sup>l\<^sub>\<circ> n')" unfolding P'_def by assumption
      have "n' \<in>\<^sub>\<circ> vcard xs"
        using succ.prems by (auto simp: vsubset_iff vfsequence_vdomain)
      from vfsequence_vlrestriction_succ[OF \<open>n' \<in>\<^sub>\<circ> vcard xs\<close>]
      show "P' (succ n')"
        by (simp add: P'_def \<open>P (xs \<restriction>\<^sup>l\<^sub>\<circ> n')\<close> assms(3) vlr.vfsequence_axioms)
    qed
  qed (simp add: P'_def assms(2))
  then show ?thesis unfolding P'_def \<open>\<D>\<^sub>\<circ> xs = n\<close>[symmetric] by simp
qed

lemma vfsequence_cases[consumes 1, case_names 0 vcons]:
  assumes "vfsequence xs"
    and "xs = []\<^sub>\<circ> \<Longrightarrow> P"
    and "\<And>xs' x. \<lbrakk>xs = xs' #\<^sub>\<circ> x; vfsequence xs'\<rbrakk> \<Longrightarrow> P"
  shows P
proof-
  interpret vfsequence xs by (rule assms(1))
  show ?thesis
  proof(cases \<open>xs = 0\<close>)
    case False
    then obtain xs' x where "xs = xs' #\<^sub>\<circ> x"
      by (blast intro: vfsequence_vcons_ex)
    then show ?thesis by (auto simp: assms(3) intro: vfsequence_vcons_ex)
  qed (use assms(2) in auto)
qed

subsubsection\<open>Evaluation\<close>

lemma (in vfsequence) vfsequence_vcard_vcons[simp]:
  "vcard (xs #\<^sub>\<circ> x) = succ (vcard xs)"
proof-
  interpret xsx: vfsequence \<open>xs #\<^sub>\<circ> x\<close> by simp
  have "vcard (xs #\<^sub>\<circ> x) = \<D>\<^sub>\<circ> (xs #\<^sub>\<circ> x)"
    by (rule xsx.vfsequence_vdomain[symmetric])
  then show ?thesis
    by (subst vcons_def) (simp add: succ_def vcons_def vfsequence_vdomain)
qed

lemma (in vfsequence) vfsequence_at_last[intro, simp]:
  assumes "i = vcard xs"
  shows "(xs #\<^sub>\<circ> x)\<lparr>i\<rparr> = x"
  by (simp add: vfsequence_vdomain vcons_def assms)

lemma (in vfsequence) vfsequence_at_not_last[intro, simp]:
  assumes "i \<in>\<^sub>\<circ> vcard xs"
  shows "(xs #\<^sub>\<circ> x)\<lparr>i\<rparr> = xs\<lparr>i\<rparr>"
proof-
  from assms have [simp]: "\<D>\<^sub>\<circ> xs = vcard xs" by (auto simp: vfsequence_vdomain)
  from assms have "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" by simp
  moreover have "i \<noteq> vcard xs" using assms mem_not_refl by blast
  ultimately show ?thesis
    unfolding vcons_def using vsv.vsv_vinsert vsvE vsv_axioms by auto
qed

text\<open>Alternative forms of existing results.\<close>

lemmas [intro, simp] = vfsequence.vfsequence_vcons
  and [intro, simp] = vfsequence.vfsequence_vcard_vcons
  and [intro, simp] = vfsequence.vfsequence_at_last
  and [intro, simp] = vfsequence.vfsequence_at_not_last
  and [intro, simp] = vfsequence.vfsequence_vcons_vdomain
  and [intro, simp] = vfsequence.vfsequence_vcons_vrange

subsubsection\<open>Congruence-like properties\<close>

context vfsequence_pair
begin

lemma vcons_eq_vcard_eq:
  assumes "xs\<^sub>1 #\<^sub>\<circ> x\<^sub>1 = xs\<^sub>2 #\<^sub>\<circ> x\<^sub>2"
  shows "vcard xs\<^sub>1 = vcard xs\<^sub>2"
  by
    (
      metis
        assms
        succ_inject_iff
        vfsequence.vfsequence_vcons_vdomain
        r\<^sub>1.vfsequence_axioms
        r\<^sub>2.vfsequence_axioms
    )

lemma vcons_eqD[dest]:
  assumes "xs\<^sub>1 #\<^sub>\<circ> x\<^sub>1 = xs\<^sub>2 #\<^sub>\<circ> x\<^sub>2"
  shows "xs\<^sub>1 = xs\<^sub>2" and "x\<^sub>1 = x\<^sub>2"
proof-

  have xsx1_last: "(xs\<^sub>1 #\<^sub>\<circ> x\<^sub>1)\<lparr>vcard xs\<^sub>1\<rparr> = x\<^sub>1" by simp
  have xsx2_last: "(xs\<^sub>2 #\<^sub>\<circ> x\<^sub>2)\<lparr>vcard xs\<^sub>2\<rparr> = x\<^sub>2" by simp

  from assms have vcard: "vcard xs\<^sub>1 = vcard xs\<^sub>2" by (rule vcons_eq_vcard_eq)
  from trans[OF xsx1_last xsx1_last[unfolded vcard assms, symmetric]]

  show "x\<^sub>1 = x\<^sub>2" unfolding xsx1_last xsx2_last .

  have nxs1: "\<langle>vcard xs\<^sub>1, x\<^sub>1\<rangle> \<notin>\<^sub>\<circ> xs\<^sub>1"
    using mem_not_refl r\<^sub>1.vfsequence_vdomain by blast
  have nxs2: "\<langle>vcard xs\<^sub>2, x\<^sub>2\<rangle> \<notin>\<^sub>\<circ> xs\<^sub>2"
    using mem_not_refl r\<^sub>2.vfsequence_vdomain by blast
  have xsx1_xsx2: "\<langle>vcard xs\<^sub>1, x\<^sub>1\<rangle> = \<langle>vcard xs\<^sub>2, x\<^sub>2\<rangle>"
    unfolding vcons_eq_vcard_eq[OF assms(1)] \<open>x\<^sub>1 = x\<^sub>2\<close> by simp

  show "xs\<^sub>1 = xs\<^sub>2"
  proof(rule vinsert_identD[OF _ nxs1])
    from assms(1)[unfolded vcons_def] show
      "vinsert \<langle>vcard xs\<^sub>1, x\<^sub>1\<rangle> xs\<^sub>1 = vinsert \<langle>vcard xs\<^sub>1, x\<^sub>1\<rangle> xs\<^sub>2"
      by (auto simp: xsx1_xsx2)
    show "\<langle>vcard xs\<^sub>1, x\<^sub>1\<rangle> \<notin>\<^sub>\<circ> xs\<^sub>2"
      by (rule nxs2[folded \<open>x\<^sub>1 = x\<^sub>2\<close> vcons_eq_vcard_eq[OF assms(1)]])
  qed

qed

lemma vcons_eqI:
  assumes "xs\<^sub>1 = xs\<^sub>2" and "x\<^sub>1 = x\<^sub>2"
  shows "xs\<^sub>1 #\<^sub>\<circ> x\<^sub>1 = xs\<^sub>2 #\<^sub>\<circ> x\<^sub>2"
  using assms by (rule arg_cong2)

lemma vcons_eq_iff[simp]: "(xs\<^sub>1 #\<^sub>\<circ> x\<^sub>1 = xs\<^sub>2 #\<^sub>\<circ> x\<^sub>2) \<longleftrightarrow> (xs\<^sub>1 = xs\<^sub>2 \<and> x\<^sub>1 = x\<^sub>2)"
  by auto

end

text\<open>Alternative forms of existing results.\<close>

context
  fixes xs\<^sub>1 xs\<^sub>2
  assumes xs\<^sub>1: "vfsequence xs\<^sub>1"
    and xs\<^sub>2: "vfsequence xs\<^sub>2"
begin

lemmas_with[OF vfsequence_pair.intro[OF xs\<^sub>1 xs\<^sub>2]]:
  vcons_eqD' = vfsequence_pair.vcons_eqD
  and vcons_eq_iff[intro, simp] = vfsequence_pair.vcons_eq_iff

end

lemmas vcons_eqD[dest] = vcons_eqD'[rotated -1]

subsection\<open>Transfer between the type \<^typ>\<open>V list\<close> and finite sequences\<close>

subsubsection\<open>Initialization\<close>

primrec vfsequence_of_vlist :: "V list \<Rightarrow> V"
  where
    "vfsequence_of_vlist [] = 0"
  | "vfsequence_of_vlist (x # xs) = vfsequence_of_vlist xs #\<^sub>\<circ> x"

definition vlist_of_vfsequence :: "V \<Rightarrow> V list"
  where "vlist_of_vfsequence = inv_into UNIV vfsequence_of_vlist"

lemma vfsequence_vfsequence_of_vlist: "vfsequence (vfsequence_of_vlist xs)"
  by (induction xs) auto

lemma inj_vfsequence_of_vlist: "inj vfsequence_of_vlist"
proof
  show "vfsequence_of_vlist x = vfsequence_of_vlist y \<Longrightarrow> x = y"
    for x y
  proof(induction y arbitrary: x)
    case Nil then show ?case by (cases x) auto
  next
    case (Cons a ys)
    note Cons' = Cons
    show ?case
    proof(cases x)
      case Nil with Cons show ?thesis by auto
    next
      case (Cons b zs)
      from Cons'[unfolded Cons vfsequence_of_vlist.simps] have
        "vfsequence_of_vlist zs #\<^sub>\<circ> b = vfsequence_of_vlist ys #\<^sub>\<circ> a"
        by simp
      then have "vfsequence_of_vlist zs = vfsequence_of_vlist ys" and "b = a"
        by (auto simp: vfsequence_vfsequence_of_vlist)
      from Cons'(1)[OF this(1)] this(2) show ?thesis unfolding Cons by auto
    qed
  qed
qed

lemma range_vfsequence_of_vlist:
  "range vfsequence_of_vlist = {xs. vfsequence xs}"
proof(intro subset_antisym subsetI; unfold mem_Collect_eq)
  show "xs \<in> range vfsequence_of_vlist \<Longrightarrow> vfsequence xs" for xs
    by (clarsimp simp: vfsequence_vfsequence_of_vlist)
  fix xs assume "vfsequence xs"
  then show "xs \<in> range vfsequence_of_vlist"
  proof(induction rule: vfsequence_induct)
    case 0 then show ?case
      by (metis image_iff iso_tuple_UNIV_I vfsequence_of_vlist.simps(1))
  next
    case (vcons xs x) then show ?case
      by (metis rangeE rangeI vfsequence_of_vlist.simps(2))
  qed
qed

lemma vlist_of_vfsequence_vfsequence_of_vlist[simp]:
  "vlist_of_vfsequence (vfsequence_of_vlist xs) = xs"
  by (simp add: inj_vfsequence_of_vlist vlist_of_vfsequence_def)

lemma (in vfsequence) vfsequence_of_vlist_vlist_of_vfsequence[simp]:
  "vfsequence_of_vlist (vlist_of_vfsequence xs) = xs"
  using vfsequence_axioms range_vfsequence_of_vlist inj_vfsequence_of_vlist
  by (simp add: f_inv_into_f vlist_of_vfsequence_def)

lemmas vfsequence_of_vlist_vlist_of_vfsequence[intro, simp] =
  vfsequence.vfsequence_of_vlist_vlist_of_vfsequence

lemma vlist_of_vfsequence_vempty[simp]: "vlist_of_vfsequence []\<^sub>\<circ> = []"
  by
    (
      metis
        vfsequence_of_vlist.simps(1)
        vlist_of_vfsequence_vfsequence_of_vlist
    )

text\<open>Transfer relation 1.\<close>

definition cr_vfsequence :: "V \<Rightarrow> V list \<Rightarrow> bool"
  where "cr_vfsequence a b \<longleftrightarrow> (a = vfsequence_of_vlist b)"

lemma cr_vfsequence_right_total[transfer_rule]: "right_total cr_vfsequence"
  unfolding cr_vfsequence_def right_total_def by simp

lemma cr_vfsequence_bi_unqie[transfer_rule]: "bi_unique cr_vfsequence"
  unfolding cr_vfsequence_def bi_unique_def
  by (simp add: inj_eq inj_vfsequence_of_vlist)

lemma cr_vfsequence_transfer_domain_rule[transfer_domain_rule]:
  "Domainp cr_vfsequence = (\<lambda>xs. vfsequence xs)"
  unfolding cr_vfsequence_def
proof(intro HOL.ext, rule iffI)
  fix xs assume prems: "vfsequence xs"
  interpret vfsequence xs by (rule prems)
  have "\<exists>ys. xs = vfsequence_of_vlist ys"
    using prems
  proof(induction rule: vfsequence_induct)
    show "\<lbrakk> vfsequence xs; \<exists>ys. xs = vfsequence_of_vlist ys \<rbrakk> \<Longrightarrow>
      \<exists>ys. xs #\<^sub>\<circ> x = vfsequence_of_vlist ys"
      for xs x
      unfolding vfsequence_of_vlist_def by (metis list.simps(7))
  qed auto
  then show "Domainp (\<lambda>a b. a = vfsequence_of_vlist b) xs" by auto
qed (clarsimp simp: vfsequence_vfsequence_of_vlist)

lemma cr_vfsequence_vconsD:
  assumes "cr_vfsequence (xs #\<^sub>\<circ> x) (y # ys)"
  shows "cr_vfsequence xs ys" and "x = y"
proof-
  from assms[unfolded cr_vfsequence_def] have xs_x_def:
    "xs #\<^sub>\<circ> x = vfsequence_of_vlist (y # ys)" .
  then have xs_x: "vfsequence (xs #\<^sub>\<circ> x)"
    by (simp add: vfsequence_vfsequence_of_vlist)
  interpret vfsequence xs
    by (blast intro: vfsequence.vfsequence_vremove_vcons_vfsequence xs_x)
  from
    assms[unfolded cr_vfsequence_def vfsequence_of_vlist.simps(2)]
    vfsequence_axioms
  show "cr_vfsequence xs ys" and "x = y"
    unfolding cr_vfsequence_def by (auto simp: vfsequence_vfsequence_of_vlist)
qed

text\<open>Transfer relation 2.\<close>

definition cr_cr_vfsequence :: "V \<Rightarrow> V list list \<Rightarrow> bool"
  where "cr_cr_vfsequence a b \<longleftrightarrow>
    (a = vfsequence_of_vlist (map vfsequence_of_vlist b))"

lemma cr_cr_vfsequence_right_total[transfer_rule]:
  "right_total cr_cr_vfsequence"
  unfolding cr_cr_vfsequence_def right_total_def by simp

lemma cr_cr_vfsequence_bi_unqie[transfer_rule]: "bi_unique cr_cr_vfsequence"
  unfolding cr_cr_vfsequence_def bi_unique_def
  by (simp add: inj_eq inj_vfsequence_of_vlist)

text\<open>Transfer relation for scalars.\<close>

definition cr_scalar :: "(V \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> V \<Rightarrow> 'a \<Rightarrow> bool"
  where "cr_scalar R x y = (\<exists>a. x = [a]\<^sub>\<circ> \<and> R a y)"

lemma cr_scalar_bi_unique[transfer_rule]:
  assumes "bi_unique R"
  shows "bi_unique (cr_scalar R)"
  using assms unfolding cr_scalar_def bi_unique_def by auto

lemma cr_scalar_right_total[transfer_rule]:
  assumes "right_total R"
  shows "right_total (cr_scalar R)"
  using assms unfolding cr_scalar_def right_total_def by simp

lemma cr_scalar_transfer_domain_rule[transfer_domain_rule]:
  "Domainp (cr_scalar R) = (\<lambda>x. \<exists>a. x = [a]\<^sub>\<circ> \<and> Domainp R a)"
  unfolding cr_scalar_def by auto

subsubsection\<open>Transfer rules for previously defined entities\<close>

context
  includes lifting_syntax
begin

lemma vfsequence_vempty_transfer[transfer_rule]: "cr_vfsequence []\<^sub>\<circ> []"
  unfolding cr_vfsequence_def by simp

lemma vfsequence_vempty_ll_transfer[transfer_rule]:
  "cr_cr_vfsequence [[]\<^sub>\<circ>]\<^sub>\<circ> [[]]"
  unfolding cr_cr_vfsequence_def by simp

lemma vcons_transfer[transfer_rule]:
  "((=) ===> cr_vfsequence ===> cr_vfsequence) (\<lambda>x xs. xs #\<^sub>\<circ> x) (\<lambda>x xs. x # xs)"
  by (intro rel_funI) (simp add: cr_vfsequence_def)

lemma vcons_ll_transfer[transfer_rule]:
  "(cr_vfsequence ===> cr_cr_vfsequence ===> cr_cr_vfsequence)
    (\<lambda>x xs. xs #\<^sub>\<circ> x) (\<lambda>x xs. x # xs)"
  by (intro rel_funI) (simp add: cr_vfsequence_def cr_cr_vfsequence_def)

lemma vfsequence_vrange_transfer[transfer_rule]:
  "(cr_vfsequence ===> (=)) (\<lambda>xs. elts (\<R>\<^sub>\<circ> xs)) list.set"
proof(intro rel_funI)
  fix xs ys assume prems: "cr_vfsequence xs ys"
  then have "xs = vfsequence_of_vlist ys" unfolding cr_vfsequence_def by simp
  then have "vfsequence xs" by (simp add: vfsequence_vfsequence_of_vlist)
  from this prems show "elts (\<R>\<^sub>\<circ> xs) = list.set ys"
  proof(induction ys arbitrary: xs)
    case (Cons a ys)
    from Cons(2) show ?case
    proof(cases xs rule: vfsequence_cases)
      case 0 with Cons show ?thesis by (simp add: Cons.IH cr_vfsequence_def)
    next
      case (vcons xs' x)
      interpret vfsequence xs' by (rule vcons(2))
      note vcons_transfer = cr_vfsequence_vconsD[OF Cons(3)[unfolded vcons(1)]]
      have a_ys: "list.set (a # ys) = insert a (list.set ys)" by simp
      from vcons(2) have R_xs'x: "\<R>\<^sub>\<circ> (xs' #\<^sub>\<circ> x) = vinsert x (\<R>\<^sub>\<circ> xs')" by simp
      show "elts (\<R>\<^sub>\<circ> xs) = (list.set (a # ys))"
        unfolding vcons(1) R_xs'x a_ys
        by
          (
            auto simp:
              vcons_transfer(2) Cons(1)[OF vfsequence_axioms vcons_transfer(1)]
          )
    qed
  qed (auto simp: cr_vfsequence_def)
qed

lemma vcard_transfer[transfer_rule]:
  "(cr_vfsequence ===> cr_omega) vcard length"
proof(intro rel_funI)
  fix xs ys assume prems: "cr_vfsequence xs ys"
  then have "xs = vfsequence_of_vlist ys" unfolding cr_vfsequence_def by simp
  then have "vfsequence xs" by (simp add: vfsequence_vfsequence_of_vlist)
  from this prems show "cr_omega (vcard xs) (length ys)"
  proof(induction ys arbitrary: xs)
    case (Cons y ys)
    from Cons(2) show ?case
    proof(cases xs rule: vfsequence_cases)
      case 0 with Cons show ?thesis by (simp add: Cons.IH cr_vfsequence_def)
    next
      case (vcons xs' x)
      interpret vfsequence xs' by (rule vcons(2))
      note vcons_transfer = cr_vfsequence_vconsD[OF Cons(3)[unfolded vcons(1)]]
      have vcard_xs_x: "vcard (xs' #\<^sub>\<circ> x) = succ (vcard xs')" by simp
      have vcard_y_ys: "length (y # ys) = Suc (length ys)" by simp
      from vfsequence_axioms have [transfer_rule]:
        "cr_omega (vcard xs') (length ys)"
        by (simp add: vcons_transfer(1) Cons.IH)
      show ?thesis unfolding vcons(1) vcard_xs_x vcard_y_ys by transfer_prover
    qed
  qed (auto simp: cr_omega_def cr_vfsequence_def)
qed

lemma vcard_ll_transfer[transfer_rule]:
  "(cr_cr_vfsequence ===> cr_omega) vcard length"
  unfolding cr_cr_vfsequence_def
  by (intro rel_funI)
    (metis cr_vfsequence_def length_map rel_funD vcard_transfer)

end

text\<open>Corollaries.\<close>

lemma vdomain_vfsequence_of_vlist: "\<D>\<^sub>\<circ> (vfsequence_of_vlist xs) = length xs"
proof-
  define ys where "ys = vfsequence_of_vlist xs"
  interpret vfsequence ys
    unfolding ys_def by (rule vfsequence_vfsequence_of_vlist)
  have [transfer_rule]: "cr_vfsequence ys xs"
    unfolding ys_def cr_vfsequence_def by simp_all
  show ?thesis
    by (fold ys_def, unfold vfsequence_vdomain, transfer) simp
qed

lemma vrange_vfsequence_of_vlist:
  "\<R>\<^sub>\<circ> (vfsequence_of_vlist xs) = set (list.set xs)"
proof(intro vsubset_antisym vsubsetI)
  fix x assume prems: "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (vfsequence_of_vlist xs)"
  define ys where "ys = vfsequence_of_vlist xs"
  have [transfer_rule]: "cr_vfsequence ys xs" "x = x"
    unfolding ys_def cr_vfsequence_def by simp_all
  show "x \<in>\<^sub>\<circ> set (list.set xs)" by transfer (simp add: prems[folded ys_def])
next
  fix x assume prems: "x \<in>\<^sub>\<circ> set (list.set xs)"
  define ys where "ys = vfsequence_of_vlist xs"
  have [transfer_rule]: "cr_vfsequence ys xs" "x = x"
    unfolding ys_def cr_vfsequence_def by simp_all
  from prems[untransferred] show "x \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> (vfsequence_of_vlist xs)"
    unfolding ys_def by simp
qed

lemma cr_cr_vfsequence_transfer_domain_rule[transfer_domain_rule]:
  "Domainp cr_cr_vfsequence =
    (\<lambda>xss. vfsequence xss \<and> (\<forall>xs\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> xss. vfsequence xs))"
proof(intro HOL.ext, rule iffI; (elim conjE | intro conjI ballI))
  fix xss assume prems: "Domainp cr_cr_vfsequence xss"
  with vfsequence_vfsequence_of_vlist show xss: "vfsequence xss"
    unfolding cr_cr_vfsequence_def by clarsimp
  interpret vfsequence xss by (rule xss)
  fix xs assume prems': "xs \<in>\<^sub>\<circ> \<R>\<^sub>\<circ> xss"
  from prems obtain yss where xss_def:
    "xss = vfsequence_of_vlist (map vfsequence_of_vlist yss)"
    unfolding cr_cr_vfsequence_def by clarsimp
  from prems' have "xs \<in>\<^sub>\<circ> set (list.set (map vfsequence_of_vlist yss))"
    unfolding xss_def vrange_vfsequence_of_vlist by simp
  then obtain ys where xs_def: "xs = vfsequence_of_vlist ys" by clarsimp
  show "vfsequence xs"
    unfolding xs_def by (simp add: vfsequence_vfsequence_of_vlist)
next
  fix xss assume prems: "vfsequence xss" "\<forall>xs\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> xss. vfsequence xs"
  have "\<exists>yss. xss = vfsequence_of_vlist (map vfsequence_of_vlist yss)"
    using prems
  proof(induction rule: vfsequence_induct)
    case (vcons xss x)
    let ?y = \<open>vlist_of_vfsequence x\<close>
    from vcons(2,3) obtain yss where xss_def:
      "xss = vfsequence_of_vlist (map vfsequence_of_vlist yss)"
      by auto
    from vcons(3) have "vfsequence x" by auto
    then have x_def: "x = vfsequence_of_vlist (vlist_of_vfsequence x)" by simp
    then have
      "xss #\<^sub>\<circ> x = vfsequence_of_vlist (map vfsequence_of_vlist (?y # yss))"
      unfolding xss_def by simp
    then show ?case by blast
  qed (auto intro: exI[of _ \<open>[]\<close>])
  then show "Domainp cr_cr_vfsequence xss"
    unfolding cr_cr_vfsequence_def by blast
qed

subsubsection\<open>Appending elements\<close>

definition vappend :: "V \<Rightarrow> V \<Rightarrow> V" (infixr "@\<^sub>\<circ>" 65)
  where "xs @\<^sub>\<circ> ys =
    vfsequence_of_vlist (vlist_of_vfsequence ys @ vlist_of_vfsequence xs)"

text\<open>Transfer.\<close>

lemma vappend_transfer[transfer_rule]:
  includes lifting_syntax
  shows "(cr_vfsequence ===> cr_vfsequence ===> cr_vfsequence)
    (\<lambda>xs ys. vappend ys xs) append"
  by (intro rel_funI, unfold cr_vfsequence_def) (simp add: vappend_def)

lemma vappend_ll_transfer[transfer_rule]:
  includes lifting_syntax
  shows "(cr_cr_vfsequence ===> cr_cr_vfsequence ===> cr_cr_vfsequence)
    (\<lambda>xs ys. vappend ys xs) append"
  by (intro rel_funI, unfold cr_cr_vfsequence_def) (simp add: vappend_def)

text\<open>Elementary properties.\<close>

lemma (in vfsequence) vfsequence_vappend_vempty_vfsequence[simp]:
  "[]\<^sub>\<circ> @\<^sub>\<circ> xs = xs"
  unfolding vappend_def by auto

lemmas vfsequence_vappend_vempty_vfsequence[simp] =
  vfsequence.vfsequence_vappend_vempty_vfsequence

lemma (in vfsequence) vfsequence_vappend_vfsequence_vempty[simp]:
  "xs @\<^sub>\<circ> []\<^sub>\<circ> = xs"
  unfolding vappend_def by auto

lemmas vfsequence_vappend_vfsequence_vempty[simp] =
  vfsequence.vfsequence_vappend_vfsequence_vempty

lemma vappend_vcons[simp]:
  assumes "vfsequence xs" and "vfsequence ys"
  shows "xs @\<^sub>\<circ> (ys #\<^sub>\<circ> y) = (xs @\<^sub>\<circ> ys) #\<^sub>\<circ> y"
  using append_Cons[where 'a=V, untransferred, OF assms(2,1)] by simp

subsubsection\<open>Distinct elements\<close>

definition vdistinct :: "V \<Rightarrow> bool"
  where "vdistinct xs = distinct (vlist_of_vfsequence xs)"

text\<open>Transfer.\<close>

lemma vdistinct_transfer[transfer_rule]:
  includes lifting_syntax
  shows "(cr_vfsequence ===> (=)) vdistinct distinct"
  by (intro rel_funI, unfold cr_vfsequence_def) (simp add: vdistinct_def)

lemma vdistinct_ll_transfer[transfer_rule]:
  includes lifting_syntax
  shows "(cr_cr_vfsequence ===> (=)) vdistinct distinct"
  by (intro rel_funI, unfold cr_cr_vfsequence_def)
    (
      metis
        vdistinct_def
        distinct_map
        inj_onI
        vlist_of_vfsequence_vfsequence_of_vlist
    )

text\<open>Elementary properties.\<close>

lemma (in vfsequence) vfsequence_vdistinct_if_vcard_vrange_eq_vcard:
  assumes "vcard (\<R>\<^sub>\<circ> xs) = vcard xs"
  shows "vdistinct xs"
proof-
  have "finite (elts (\<R>\<^sub>\<circ> xs))" by (simp add: assms vcard_vfinite_omega)
  from vcard_finite_set[OF this] assms have "card (elts (\<R>\<^sub>\<circ> xs))\<^sub>\<nat> = vcard xs"
    by simp
  from card_distinct[where ?'a=V, untransferred, OF vfsequence_axioms this]
  show ?thesis.
qed

lemma vdistinct_vempty[intro, simp]: "vdistinct []\<^sub>\<circ>"
proof-
  have t: "distinct ([]::V list)" by simp
  show ?thesis by (rule t[untransferred])
qed

lemma (in vfsequence) vfsequence_vcons_vdistinct:
  assumes "vdistinct (xs #\<^sub>\<circ> x)"
  shows "vdistinct xs"
proof-
  from distinct.simps(2)[where 'a=V, THEN iffD1, THEN conjunct2, untransferred]
  show ?thesis
    using vfsequence_axioms assms by simp
qed

lemma (in vfsequence) vfsequence_vcons_nin_vrange:
  assumes "vdistinct (xs #\<^sub>\<circ> x)"
  shows "x \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> xs"
proof-
  from distinct.simps(2)[where 'a=V, THEN iffD1, THEN conjunct1, untransferred]
  show ?thesis
    using vfsequence_axioms assms by simp
qed

lemma (in vfsequence) vfsequence_v11I[intro]:
  assumes "vdistinct xs"
  shows "v11 xs"
  using vfsequence_axioms assms
proof(induction xs rule: vfsequence_induct)
  case (vcons xs x)
  interpret vfsequence xs by (rule vcons(1))
  from vcons(3) have dxs: "vdistinct xs" by (rule vfsequence_vcons_vdistinct)
  interpret v11 xs using dxs by (rule vcons(2))
  from vfsequence_vcons_nin_vrange[OF vcons(3)] have "x \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> xs" .
  show "v11 (xs #\<^sub>\<circ> x)"
    by
      (
        simp_all add:
          vcons_def vfsequence_vdomain vfsequence_vcons_nin_vrange[OF vcons(3)]
      )
qed simp

lemma (in vfsequence) vfsequence_vcons_vdistinctI:
  assumes "vdistinct xs" and "x \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> xs"
  shows "vdistinct (xs #\<^sub>\<circ> x)"
proof-
  have t: "distinct xs \<Longrightarrow> x \<notin> list.set xs \<Longrightarrow> distinct (x # xs)"
    for x ::V and xs
    by simp
  from vfsequence_axioms assms show ?thesis by (rule t[untransferred])
qed

lemmas vfsequence_vcons_vdistinctI[intro] =
  vfsequence.vfsequence_vcons_vdistinctI

lemma (in vfsequence) vfsequence_nin_vrange_vcons:
  assumes "y \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> xs" and "y \<noteq> x"
  shows "y \<notin>\<^sub>\<circ> \<R>\<^sub>\<circ> (xs #\<^sub>\<circ> x)"
proof-
  have t: "y \<notin> list.set xs \<Longrightarrow> y \<noteq> x \<Longrightarrow> y \<notin> list.set (x # xs)"
    for x y :: V and xs
    by simp
  from vfsequence_axioms assms show ?thesis by (rule t[untransferred])
qed

lemmas vfsequence_nin_vrange_vcons[intro] =
  vfsequence.vfsequence_nin_vrange_vcons

subsubsection\<open>Concatenation of sequences\<close>

definition vconcat :: "V \<Rightarrow> V"
  where "vconcat xss =
    vfsequence_of_vlist(
      concat (map vlist_of_vfsequence (vlist_of_vfsequence xss))
    )"

text\<open>Transfer.\<close>

lemma vconcat_transfer[transfer_rule]:
  includes lifting_syntax
  shows "(cr_cr_vfsequence ===> cr_vfsequence) vconcat concat"
proof(intro rel_funI)
  fix xs ys assume "cr_cr_vfsequence xs ys"
  then have xs_def: "xs = vfsequence_of_vlist (map vfsequence_of_vlist ys)"
    unfolding cr_cr_vfsequence_def by simp
  have main_eq: "map vlist_of_vfsequence (vlist_of_vfsequence xs) = ys"
    unfolding xs_def by (simp add: map_idI)
  show "cr_vfsequence (vconcat xs) (concat ys)"
    unfolding cr_vfsequence_def vconcat_def main_eq ..
qed

text\<open>Elementary properties.\<close>

lemma vconcat_vempty[simp]: "vconcat []\<^sub>\<circ> = []\<^sub>\<circ>"
  unfolding vconcat_def by simp

lemma vconcat_append[simp]:
  assumes "vfsequence xss"
    and "\<forall>xs\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> xss. vfsequence xs"
    and "vfsequence yss"
    and "\<forall>xs\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> yss. vfsequence xs"
  shows "vconcat (xss @\<^sub>\<circ> yss) = vconcat xss @\<^sub>\<circ> vconcat yss"
  using assms concat_append[where 'a=V, untransferred] by simp

lemma vconcat_vcons[simp]:
  assumes "vfsequence xs" and "vfsequence xss" and "\<forall>xs\<in>\<^sub>\<circ>\<R>\<^sub>\<circ> xss. vfsequence xs"
  shows "vconcat (xss #\<^sub>\<circ> xs) = vconcat xss @\<^sub>\<circ> xs"
  using assms concat.simps(2)[where 'a=V, untransferred] by simp

lemma (in vfsequence) vfsequence_vconcat_fsingleton[simp]: "vconcat [xs]\<^sub>\<circ> = xs"
  using vfsequence_axioms
  by
    (
      metis
        vfsequence_vappend_vempty_vfsequence
        vconcat_vcons
        vconcat_vempty
        vempty_nin
        vfsequence_vempty
        vrange_vempty
    )

lemmas vfsequence_vconcat_fsingleton[simp] =
  vfsequence.vfsequence_vconcat_fsingleton

subsection\<open>Finite sequences and the Cartesian product\<close>

lemma vfsequence_vcons_vproductI[intro!]:
  assumes "n \<in>\<^sub>\<circ> \<omega>"
    and "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A i)"
    and "x \<in>\<^sub>\<circ> A (vcard xs)"
    and "n = vcard (xs #\<^sub>\<circ> x)"
  shows "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A i)"
proof
  interpret xs: vfsequence xs
    using assms
    apply(intro vfsequenceI)
    subgoal by auto
    subgoal
      by
        (
          metis
            vcard_vfinite_omega
            vcons_vsubset
            vfinite_vcard_omega
            vfinite_vsubset vproductD(2)
        )
    done
  interpret xsx: vfsequence \<open>xs #\<^sub>\<circ> x\<close> by auto
  show "vsv (xs #\<^sub>\<circ> x)" by (simp add: xsx.vsv_axioms)
  show D: "\<D>\<^sub>\<circ> (xs #\<^sub>\<circ> x) = n" unfolding assms(4) xsx.vfsequence_vdomain by auto
  from vproductD[OF assms(2)] have elem: "i \<in>\<^sub>\<circ> vcard xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i" for i
    by auto
  show "\<forall>i\<in>\<^sub>\<circ>n. (xs #\<^sub>\<circ> x)\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i" by (auto simp: elem assms(3,4))
qed

lemma vfsequence_vcons_vproductD[dest]:
  assumes "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A i)" and "n \<in>\<^sub>\<circ> \<omega>"
  shows "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A i)"
    and "x \<in>\<^sub>\<circ> A (vcard xs)"
    and "n = vcard (xs #\<^sub>\<circ> x)"
proof-

  interpret xsx: vfsequence \<open>xs #\<^sub>\<circ> x\<close>
    by (meson assms succ_in_omega vfsequence_vproduct)
  interpret xs: vfsequence xs
    by (blast intro: xsx.vfsequence_vremove_vcons_vfsequence)

  show n_def: "n = vcard (xs #\<^sub>\<circ> x)"
    using assms using xsx.vfsequence_vdomain by blast
  from vproductD[OF assms(1), unfolded n_def]
  have elem_xs_x: "i \<in>\<^sub>\<circ> vcard (xs #\<^sub>\<circ> x) \<Longrightarrow> (xs #\<^sub>\<circ> x)\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i"
    for i
    by auto
  then have elem_xs[simp]: "i \<in>\<^sub>\<circ> vcard xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A i" for i
    by (metis rev_vsubsetD vcard_mono vcons_vsubset xs.vfsequence_at_not_last)
  show "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A i)"
    by (auto simp: xs.vsv_axioms xs.vfsequence_vdomain)
  from elem_xs_x show "x \<in>\<^sub>\<circ> A (vcard xs)" by fastforce

qed

lemma vfsequence_vcons_vproductE[elim!]:
  assumes "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>n. A i)" and "n \<in>\<^sub>\<circ> \<omega>"
  obtains "xs \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>vcard xs. A i)"
    and "x \<in>\<^sub>\<circ> A (vcard xs)"
    and "n = vcard (xs #\<^sub>\<circ> x)"
  using assms by (auto simp: vfsequence_vcons_vproductD)

subsection\<open>Binary Cartesian product based on finite sequences: \<open>ftimes\<close>\<close>

definition ftimes :: "V \<Rightarrow> V \<Rightarrow> V" (infixr \<open>\<times>\<^sub>\<bullet>\<close> 80)
  where "ftimes a b \<equiv> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. if i = 0 then a else b)"

lemma small_fpairs[simp]: "small {[a, b]\<^sub>\<circ> | a b. [a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> r}"
  by (rule down[of _ r]) clarsimp

text\<open>Rules.\<close>

lemma ftimesI1[intro]:
  assumes "x = [a, b]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B"
  shows "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
  unfolding ftimes_def
proof
  show vsv: "vsv x" by (simp add: assms(1) vfsequence.axioms(1))
  then interpret vsv x .
  from assms show D: "\<D>\<^sub>\<circ> x = 2\<^sub>\<nat>"
    unfolding nat_omega_simps two One_nat_def by auto
  from assms(2,3) have i: "i \<in>\<^sub>\<circ> 2\<^sub>\<nat> \<Longrightarrow> x\<lparr>i\<rparr> \<in>\<^sub>\<circ> (if i = 0\<^sub>\<nat> then A else B)"
    for i
    unfolding assms(1) two nat_omega_simps One_nat_def by auto
  from i show "\<forall>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. x\<lparr>i\<rparr> \<in>\<^sub>\<circ> (if i = 0 then A else B)" by auto
qed

lemma ftimesI2[intro!]:
  assumes "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B"
  shows "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
  using assms ftimesI1 by auto

lemma fproductE1[elim!]:
  assumes "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B"
  obtains a b where "x = [a, b]\<^sub>\<circ>" and "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B"
proof-
  from vproduct_vdoubletonD[OF assms[unfolded two ftimes_def]]
  have x_def: "x = set {\<langle>0\<^sub>\<nat>, x\<lparr>0\<^sub>\<nat>\<rparr>\<rangle>, \<langle>1\<^sub>\<nat>, x\<lparr>1\<^sub>\<nat>\<rparr>\<rangle>}"
    and "x\<lparr>0\<^sub>\<nat>\<rparr> \<in>\<^sub>\<circ> A"
    and "x\<lparr>1\<^sub>\<nat>\<rparr> \<in>\<^sub>\<circ> B"
    by auto
  then show ?thesis using that using vcons_vdoubleton by simp
qed

lemma fproductE2[elim!]:
  assumes "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> B" obtains "a \<in>\<^sub>\<circ> A" and "b \<in>\<^sub>\<circ> B"
  using assms by blast

text\<open>Set operations.\<close>

lemma vfinite_0_left[simp]: "0 \<times>\<^sub>\<bullet> b = 0"
  by (meson eq0_iff fproductE1)

lemma vfinite_0_right[simp]: "a \<times>\<^sub>\<bullet> 0 = 0"
  by (meson eq0_iff fproductE1)

lemma fproduct_vintersection: "(a \<inter>\<^sub>\<circ> b) \<times>\<^sub>\<bullet> (c \<inter>\<^sub>\<circ> d) = (a \<times>\<^sub>\<bullet> c) \<inter>\<^sub>\<circ> (b \<times>\<^sub>\<bullet> d)"
  by auto

lemma fproduct_vdiff: "a \<times>\<^sub>\<bullet> (b -\<^sub>\<circ> c) = (a \<times>\<^sub>\<bullet> b) -\<^sub>\<circ> (a \<times>\<^sub>\<bullet> c)" by auto

lemma vfinite_ftimesI[intro!]:
  assumes "vfinite a" and "vfinite b"
  shows "vfinite (a \<times>\<^sub>\<bullet> b)"
  using assms(1,2)
proof(induction arbitrary: b rule: vfinite_induct)
  case (vinsert x a')
  from vinsert(4) have "vfinite (set {x} \<times>\<^sub>\<bullet> b)"
  proof(induction rule: vfinite_induct)
    case (vinsert y b')
    have "set {x} \<times>\<^sub>\<bullet> vinsert y b' = vinsert [x, y]\<^sub>\<circ> (set {x} \<times>\<^sub>\<bullet> b')" by auto
    with vinsert(3) show ?case by simp
  qed simp
  moreover have "vinsert x a' \<times>\<^sub>\<bullet> b = (set {x} \<times>\<^sub>\<bullet> b) \<union>\<^sub>\<circ> (a' \<times>\<^sub>\<bullet> b)" by auto
  ultimately show ?case using vinsert by (auto simp: vfinite_vunionI)
qed simp

text\<open>\<open>ftimes\<close> and \<open>vcpower\<close>\<close>

lemma vproduct_vpair: "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. f i) \<longleftrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> f (0\<^sub>\<nat>) \<times>\<^sub>\<circ> f (1\<^sub>\<nat>)"
proof
  interpret vfsequence \<open>[a, b]\<^sub>\<circ>\<close> by simp
  show "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. f i) \<Longrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> f (0\<^sub>\<nat>) \<times>\<^sub>\<circ> f (1\<^sub>\<nat>)"
    unfolding vcons_vdoubleton two by (elim vproduct_vdoubletonE) auto
  assume hyp: "\<langle>a, b\<rangle> \<in>\<^sub>\<circ> f (0\<^sub>\<nat>) \<times>\<^sub>\<circ> f (1\<^sub>\<nat>)"
  then have af: "a \<in>\<^sub>\<circ> f (0\<^sub>\<nat>)" and bf: "b \<in>\<^sub>\<circ> f (1\<^sub>\<nat>)" by auto
  have dom: "\<D>\<^sub>\<circ> [a, b]\<^sub>\<circ> = set {0\<^sub>\<nat>, 1\<^sub>\<nat>}" by (auto intro!: vsubset_antisym)
  have ran: "\<R>\<^sub>\<circ> [a, b]\<^sub>\<circ> \<subseteq>\<^sub>\<circ> (\<Union>\<^sub>\<circ>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. f i)"
    unfolding two using af bf vifunion_vdoubleton by auto
  show "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> (\<Prod>\<^sub>\<circ>i\<in>\<^sub>\<circ>2\<^sub>\<nat>. f i)"
    apply(intro vproductI)
    subgoal using dom ran vsv_axioms unfolding two by auto
    subgoal using af bf unfolding two by (auto intro!: vsubset_antisym)
    subgoal
      unfolding two
      using hyp VSigmaE2 small_empty vcons_vdoubleton
      by (auto simp: vinsert_set_insert_eq)
    done
qed

text\<open>Connections.\<close>

lemma vcpower_two_ftimes: "A ^\<^sub>\<times> 2\<^sub>\<nat> = A \<times>\<^sub>\<bullet> A"
  unfolding vcpower_def ftimes_def two by simp

lemma vcpower_two_ftimesI[intro]:
  assumes "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> A"
  shows "x \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>"
  using assms unfolding ftimes_def two by auto

lemma vcpower_two_ftimesD[dest]:
  assumes "x \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>"
  shows "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> A"
  using assms unfolding vcpower_def ftimes_def two by simp

lemma vcpower_two_ftimesE[elim]:
  assumes "x \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat>" and "x \<in>\<^sub>\<circ> A \<times>\<^sub>\<bullet> A \<Longrightarrow> P"
  shows P
  using assms unfolding vcpower_def ftimes_def two by simp

lemma vfsequence_vcpower_two_vpair: "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat> \<longleftrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> A"
proof(rule iffI)
  show "[a, b]\<^sub>\<circ> \<in>\<^sub>\<circ> A ^\<^sub>\<times> 2\<^sub>\<nat> \<Longrightarrow> \<langle>a, b\<rangle> \<in>\<^sub>\<circ> A \<times>\<^sub>\<circ> A"
    by (elim vcpowerE, unfold vproduct_vpair)
qed (intro vcpowerI, unfold vproduct_vpair)

lemma vsv_vfsequence_two:
  assumes "vsv gf" and "\<D>\<^sub>\<circ> gf = 2\<^sub>\<nat>"
  shows "[vpfst gf, vpsnd gf]\<^sub>\<circ> = gf"
proof-
  interpret gf: vsv gf by (auto intro: assms(1))
  show ?thesis
    by
      (
        rule sym,
        rule vsv_eqI,
        blast,
        blast,
        simp add: assms(2) nat_omega_simps,
        unfold assms(2),
        elim_in_numeral,
        all\<open>simp add: nat_omega_simps\<close>
      )
qed

lemma vsv_vfsequence_three:
  assumes "vsv hgf" and "\<D>\<^sub>\<circ> hgf = 3\<^sub>\<nat>"
  shows "[vpfst hgf, vpsnd hgf, vpthrd hgf]\<^sub>\<circ> = hgf"
proof-
  interpret hgf: vsv hgf by (auto intro: assms(1))
  show ?thesis
    by
      (
        rule sym,
        rule vsv_eqI,
        blast,
        blast,
        simp add: assms(2) nat_omega_simps,
        unfold assms(2),
        elim_in_numeral,
        all\<open>simp add: nat_omega_simps\<close>
      )
qed

subsection\<open>Sequence as an element of a Cartesian power of a set\<close>

lemma vcons_in_vcpowerI[intro!]:
  assumes "n \<in>\<^sub>\<circ> \<omega>"
    and "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs"
    and "x \<in>\<^sub>\<circ> A"
    and "n = vcard (xs #\<^sub>\<circ> x)"
  shows "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> A ^\<^sub>\<times> n"
proof-
  interpret vfsequence xs
    using assms
    by
      (
        meson
          vcons_vsubset
          vfinite_vcard_omega_iff
          vfinite_vsubset
          vfsequence_vcpower
      )
  show ?thesis
    by
      (
        metis
          assms(2,3,4)
          vcpower_vrange
          vfsequence_vcons
          vfsequence_vcons_vrange
          vfsequence.vfsequence_vrange_vcpower
          vsubset_vinsert_leftI
      )
qed

lemma vcons_in_vcpowerD[dest]:
  assumes "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> A ^\<^sub>\<times> n" and "n \<in>\<^sub>\<circ> \<omega>"
  shows "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs"
    and "x \<in>\<^sub>\<circ> A"
    and "n = vcard (xs #\<^sub>\<circ> x)"
proof-
  interpret vfsequence xs
    by
      (
        meson
          assms
          vfsequence.vfsequence_vremove_vcons_vfsequence
          vfsequence_vcpower
      )
  from assms vfsequence_vcard_vcons show "n = vcard (xs #\<^sub>\<circ> x)" by auto
  then show "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs"
    by
      (
        metis
          assms(1)
          vcpower_vrange
          vfsequence_vcons_vrange
          vfsequence_vrange_vcpower
          vsubset_vinsert_leftD
      )
  show "x \<in>\<^sub>\<circ> A"
    by
      (
        metis
          assms(1)
          vcpower_vrange
          vfsequence.vfsequence_vcons_vrange
          vfsequence_axioms
          vinsertI1
          vsubsetE
      )
qed

lemma vcons_in_vcpowerE1[elim!]:
  assumes "xs #\<^sub>\<circ> x \<in>\<^sub>\<circ> A ^\<^sub>\<times> n" and "n \<in>\<^sub>\<circ> \<omega>"
  obtains "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs" and "x \<in>\<^sub>\<circ> A" and "n = vcard (xs #\<^sub>\<circ> x)"
  using assms by blast

lemma vcons_in_vcpowerE2:
  assumes "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> n" and "n \<in>\<^sub>\<circ> \<omega>" and "0 \<in>\<^sub>\<circ> n"
  obtains x xs' where "xs = xs' #\<^sub>\<circ> x"
    and "xs' \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs'"
    and "x \<in>\<^sub>\<circ> A"
    and "n = vcard (xs' #\<^sub>\<circ> x)"
proof-
  interpret vfsequence xs using assms(1,2) by auto
  from assms obtain x xs' where xs_def: "xs = xs' #\<^sub>\<circ> x"
    by
      (
        metis
          eq0_iff vcard_0 vcpower_vdomain vfsequence_vcons_ex vfsequence_vdomain
      )
  from vcons_in_vcpowerE1[OF assms(1)[unfolded xs_def] assms(2)] have
    "xs' \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs'" and "x \<in>\<^sub>\<circ> A" and "n = vcard (xs' #\<^sub>\<circ> x)"
    by blast+
  from xs_def this show ?thesis by (clarsimp simp: that)
qed

lemma vcons_vcpower1E: (*TODO: generalize*)
  assumes "xs \<in>\<^sub>\<circ> A ^\<^sub>\<times> 1\<^sub>\<nat>"
  obtains x where "xs = [x]\<^sub>\<circ>" and "x \<in>\<^sub>\<circ> A"
proof-
  have 01: "0 \<in>\<^sub>\<circ> 1\<^sub>\<nat>" by simp
  from vcons_in_vcpowerE2[OF assms ord_of_nat_\<omega> 01] obtain x xs'
    where xs_def: "xs = xs' #\<^sub>\<circ> x"
      and xs': "xs' \<in>\<^sub>\<circ> A ^\<^sub>\<times> vcard xs'"
      and x: "x \<in>\<^sub>\<circ> A"
      and one: "1\<^sub>\<nat> = vcard (xs' #\<^sub>\<circ> x)"
    by metis
  interpret xs: vfsequence xs using assms by (auto intro: vfsequence_vcpower)
  interpret xs': vfsequence xs'
    using xs' xs_def xs.vfsequence_vremove_vcons_vfsequence by blast
  from one have "vcard xs' = 0"
    by (metis ord_of_nat_succ_vempty succ_inject_iff xs'.vfsequence_vcard_vcons)
  then have "xs = [x]\<^sub>\<circ>" unfolding xs_def by (simp add: vcard_vempty)
  with x that show ?thesis by simp
qed

subsection\<open>The set of all finite sequences on a set\<close>

subsubsection\<open>Definition and elementary properties\<close>

definition vfsequences_on :: "V \<Rightarrow> V"
  where "vfsequences_on X = set {x. vfsequence x \<and> (\<forall>i\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> x. x\<lparr>i\<rparr> \<in>\<^sub>\<circ> X)}"

lemma vfsequences_on_subset_\<omega>_set:
  "{x. vfsequence x \<and> (\<forall>i\<in>elts (\<D>\<^sub>\<circ> x). x\<lparr>i\<rparr> \<in>\<^sub>\<circ> X)} \<subseteq> elts (VPow (\<omega> \<times>\<^sub>\<circ> X))"
proof
  (
    intro subsetI,
    unfold mem_Collect_eq VPow_iff,
    elim conjE,
    intro vsubsetI
  )
  fix xs nx
  assume prems[rule_format]:
    "vfsequence xs"
    "\<forall>i\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> xs. xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> X"
    "nx \<in>\<^sub>\<circ> xs"
  interpret vfsequence xs by (rule prems(1))
  from prems(3) vbrelation obtain n x where nx_def: "nx = \<langle>n, x\<rangle>" by auto
  from vsv_appI[OF prems(3)[unfolded this]] have xsn: "xs\<lparr>n\<rparr> = x" .
  from prems(3) nx_def have "n \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" by auto
  with prems(2) show "nx \<in>\<^sub>\<circ> \<omega> \<times>\<^sub>\<circ> X"
    by (auto simp: nx_def xsn[symmetric] Ord_trans vfsequence_vdomain_in_omega)
qed

lemma small_vfsequences_on[simp]:
  "small {x. vfsequence x \<and> (\<forall>i\<in>\<^sub>\<circ>\<D>\<^sub>\<circ> x. x\<lparr>i\<rparr> \<in>\<^sub>\<circ> X)}"
  by (rule down, rule vfsequences_on_subset_\<omega>_set)

text\<open>Rules.\<close>

lemma vfsequences_onI:
  assumes "vfsequence xs" and "\<And>i. i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> X"
  shows "xs \<in>\<^sub>\<circ> vfsequences_on X"
  using assms unfolding vfsequences_on_def by simp

lemma vfsequences_onD[dest]:
  assumes "xs \<in>\<^sub>\<circ> vfsequences_on X"
  shows "vfsequence xs" and "\<And>i. i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> X"
  using assms unfolding vfsequences_on_def by auto

lemma vfsequences_onE[elim]:
  assumes "xs \<in>\<^sub>\<circ> vfsequences_on X"
  obtains "vfsequence xs" and "\<And>i. i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> X"
  using assms unfolding vfsequences_on_def by auto

subsubsection\<open>Further properties\<close>

lemma vfsequences_on_vsubset_mono:
  assumes "A \<subseteq>\<^sub>\<circ> B "
  shows "vfsequences_on A \<subseteq>\<^sub>\<circ> vfsequences_on B"
proof(intro vsubsetI vfsequences_onI; elim vfsequences_onE)
  fix i xs assume prems: "i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs" "\<And>i. i \<in>\<^sub>\<circ> \<D>\<^sub>\<circ> xs \<Longrightarrow> xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> A"
  from assms prems(2)[OF prems(1)] show "xs\<lparr>i\<rparr> \<in>\<^sub>\<circ> B" by auto
qed

text\<open>\newpage\<close>

end


(*  Title:      HOL/Hoare/Pointer_Examples.thy
    Author:     Tobias Nipkow
    Copyright   2002 TUM
*)

section \<open>Examples of verifications of pointer programs\<close>

theory Pointer_Examples
  imports HeapSyntax
begin

axiomatization where unproven: "PROP A"

subsection "Verifications"

subsubsection "List reversal"

text "A short but unreadable proof:"

lemma "VARS tl p q r
  {List tl p Ps \<and> List tl q Qs \<and> set Ps \<inter> set Qs = {}}
  WHILE p \<noteq> Null
  INV {\<exists>ps qs. List tl p ps \<and> List tl q qs \<and> set ps \<inter> set qs = {} \<and>
                 rev ps @ qs = rev Ps @ Qs}
  DO r := p; p := p^.tl; r^.tl := q; q := r OD
  {List tl q (rev Ps @ Qs)}"
apply vcg_simp
  apply fastforce
  apply(fastforce intro:notin_List_update[THEN iffD2])
  \<comment> \<open>explicit:\<close>
  \<^cancel>\<open>apply clarify\<close>
  \<^cancel>\<open>apply(rename_tac ps b qs)\<close>
  \<^cancel>\<open>apply clarsimp\<close>
  \<^cancel>\<open>apply(rename_tac ps')\<close>
  \<^cancel>\<open>apply(fastforce intro:notin_List_update[THEN iffD2])\<close>
  done

text\<open>And now with ghost variables \<^term>\<open>ps\<close> and \<^term>\<open>qs\<close>. Even
``more automatic''.\<close>

lemma "VARS next p ps q qs r
  {List next p Ps \<and> List next q Qs \<and> set Ps \<inter> set Qs = {} \<and>
   ps = Ps \<and> qs = Qs}
  WHILE p \<noteq> Null
  INV {List next p ps \<and> List next q qs \<and> set ps \<inter> set qs = {} \<and>
       rev ps @ qs = rev Ps @ Qs}
  DO r := p; p := p^.next; r^.next := q; q := r;
     qs := (hd ps) # qs; ps := tl ps OD
  {List next q (rev Ps @ Qs)}"
apply vcg_simp
 apply fastforce
done

text "A longer readable version:"

lemma "VARS tl p q r
  {List tl p Ps \<and> List tl q Qs \<and> set Ps \<inter> set Qs = {}}
  WHILE p \<noteq> Null
  INV {\<exists>ps qs. List tl p ps \<and> List tl q qs \<and> set ps \<inter> set qs = {} \<and>
               rev ps @ qs = rev Ps @ Qs}
  DO r := p; p := p^.tl; r^.tl := q; q := r OD
  {List tl q (rev Ps @ Qs)}"
proof vcg
  fix tl p q r
  assume "List tl p Ps \<and> List tl q Qs \<and> set Ps \<inter> set Qs = {}"
  thus "\<exists>ps qs. List tl p ps \<and> List tl q qs \<and> set ps \<inter> set qs = {} \<and>
                rev ps @ qs = rev Ps @ Qs" by fastforce
next
  fix tl p q r
  assume "(\<exists>ps qs. List tl p ps \<and> List tl q qs \<and> set ps \<inter> set qs = {} \<and>
                   rev ps @ qs = rev Ps @ Qs) \<and> p \<noteq> Null"
         (is "(\<exists>ps qs. ?I ps qs) \<and> _")
  then obtain ps qs a where I: "?I ps qs \<and> p = Ref a"
    by fast
  then obtain ps' where "ps = a # ps'" by fastforce
  hence "List (tl(p \<rightarrow> q)) (p^.tl) ps' \<and>
         List (tl(p \<rightarrow> q)) p       (a#qs) \<and>
         set ps' \<inter> set (a#qs) = {} \<and>
         rev ps' @ (a#qs) = rev Ps @ Qs"
    using I by fastforce
  thus "\<exists>ps' qs'. List (tl(p \<rightarrow> q)) (p^.tl) ps' \<and>
                  List (tl(p \<rightarrow> q)) p       qs' \<and>
                  set ps' \<inter> set qs' = {} \<and>
                  rev ps' @ qs' = rev Ps @ Qs" by fast
next
  fix tl p q r
  assume "(\<exists>ps qs. List tl p ps \<and> List tl q qs \<and> set ps \<inter> set qs = {} \<and>
                   rev ps @ qs = rev Ps @ Qs) \<and> \<not> p \<noteq> Null"
  thus "List tl q (rev Ps @ Qs)" by fastforce
qed

text\<open>Finaly, the functional version. A bit more verbose, but automatic!\<close>

lemma "VARS tl p q r
  {islist tl p \<and> islist tl q \<and>
   Ps = list tl p \<and> Qs = list tl q \<and> set Ps \<inter> set Qs = {}}
  WHILE p \<noteq> Null
  INV {islist tl p \<and> islist tl q \<and>
       set(list tl p) \<inter> set(list tl q) = {} \<and>
       rev(list tl p) @ (list tl q) = rev Ps @ Qs}
  DO r := p; p := p^.tl; r^.tl := q; q := r OD
  {islist tl q \<and> list tl q = rev Ps @ Qs}"
apply vcg_simp
  apply clarsimp
 apply clarsimp
done

subsubsection "Searching in a list"

text\<open>What follows is a sequence of successively more intelligent proofs that
a simple loop finds an element in a linked list.

We start with a proof based on the \<^term>\<open>List\<close> predicate. This means it only
works for acyclic lists.\<close>

lemma "VARS tl p
  {List tl p Ps \<and> X \<in> set Ps}
  WHILE p \<noteq> Null \<and> p \<noteq> Ref X
  INV {\<exists>ps. List tl p ps \<and> X \<in> set ps}
  DO p := p^.tl OD
  {p = Ref X}"
apply vcg_simp
  apply blast
 apply clarsimp
apply clarsimp
done

text\<open>Using \<^term>\<open>Path\<close> instead of \<^term>\<open>List\<close> generalizes the correctness
statement to cyclic lists as well:\<close>

lemma "VARS tl p
  {Path tl p Ps X}
  WHILE p \<noteq> Null \<and> p \<noteq> X
  INV {\<exists>ps. Path tl p ps X}
  DO p := p^.tl OD
  {p = X}"
apply vcg_simp
  apply blast
 apply fastforce
apply clarsimp
done

text\<open>Now it dawns on us that we do not need the list witness at all --- it
suffices to talk about reachability, i.e.\ we can use relations directly. The
first version uses a relation on \<^typ>\<open>'a ref\<close>:\<close>

lemma "VARS tl p
  {(p,X) \<in> {(Ref x,tl x) |x. True}\<^sup>*}
  WHILE p \<noteq> Null \<and> p \<noteq> X
  INV {(p,X) \<in> {(Ref x,tl x) |x. True}\<^sup>*}
  DO p := p^.tl OD
  {p = X}"
apply vcg_simp
 apply clarsimp
 apply(erule converse_rtranclE)
  apply simp
 apply(clarsimp elim:converse_rtranclE)
apply(fast elim:converse_rtranclE)
done

text\<open>Finally, a version based on a relation on type \<^typ>\<open>'a\<close>:\<close>

lemma "VARS tl p
  {p \<noteq> Null \<and> (addr p,X) \<in> {(x,y). tl x = Ref y}\<^sup>*}
  WHILE p \<noteq> Null \<and> p \<noteq> Ref X
  INV {p \<noteq> Null \<and> (addr p,X) \<in> {(x,y). tl x = Ref y}\<^sup>*}
  DO p := p^.tl OD
  {p = Ref X}"
apply vcg_simp
 apply clarsimp
 apply(erule converse_rtranclE)
  apply simp
 apply clarsimp
apply clarsimp
done

subsubsection "Splicing two lists"

lemma "VARS tl p q pp qq
  {List tl p Ps \<and> List tl q Qs \<and> set Ps \<inter> set Qs = {} \<and> size Qs \<le> size Ps}
  pp := p;
  WHILE q \<noteq> Null
  INV {\<exists>as bs qs.
    distinct as \<and> Path tl p as pp \<and> List tl pp bs \<and> List tl q qs \<and>
    set bs \<inter> set qs = {} \<and> set as \<inter> (set bs \<union> set qs) = {} \<and>
    size qs \<le> size bs \<and> splice Ps Qs = as @ splice bs qs}
  DO qq := q^.tl; q^.tl := pp^.tl; pp^.tl := q; pp := q^.tl; q := qq OD
  {List tl p (splice Ps Qs)}"
apply vcg_simp
  apply(rule_tac x = "[]" in exI)
  apply fastforce
 apply clarsimp
 apply(rename_tac y bs qqs)
 apply(case_tac bs) apply simp
 apply clarsimp
 apply(rename_tac x bbs)
 apply(rule_tac x = "as @ [x,y]" in exI)
 apply simp
 apply(rule_tac x = "bbs" in exI)
 apply simp
 apply(rule_tac x = "qqs" in exI)
 apply simp
apply (fastforce simp:List_app)
done

subsubsection "Merging two lists"

text"This is still a bit rough, especially the proof."

definition cor :: "bool \<Rightarrow> bool \<Rightarrow> bool"
  where "cor P Q \<longleftrightarrow> (if P then True else Q)"

definition cand :: "bool \<Rightarrow> bool \<Rightarrow> bool"
  where "cand P Q \<longleftrightarrow> (if P then Q else False)"

fun merge :: "'a list * 'a list * ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list"
where
  "merge(x#xs,y#ys,f) = (if f x y then x # merge(xs,y#ys,f)
                                  else y # merge(x#xs,ys,f))"
| "merge(x#xs,[],f) = x # merge(xs,[],f)"
| "merge([],y#ys,f) = y # merge([],ys,f)"
| "merge([],[],f) = []"

text\<open>Simplifies the proof a little:\<close>

lemma "VARS hd tl p q r s
 {List tl p Ps \<and> List tl q Qs \<and> set Ps \<inter> set Qs = {} \<and>
  (p \<noteq> Null \<or> q \<noteq> Null)}
 IF cor (q = Null) (cand (p \<noteq> Null) (p^.hd \<le> q^.hd))
 THEN r := p; p := p^.tl ELSE r := q; q := q^.tl FI;
 s := r;
 WHILE p \<noteq> Null \<or> q \<noteq> Null
 INV {\<exists>rs ps qs a. Path tl r rs s \<and> List tl p ps \<and> List tl q qs \<and>
      distinct(a # ps @ qs @ rs) \<and> s = Ref a \<and>
      merge(Ps,Qs,\<lambda>x y. hd x \<le> hd y) =
      rs @ a # merge(ps,qs,\<lambda>x y. hd x \<le> hd y) \<and>
      (tl a = p \<or> tl a = q)}
 DO IF cor (q = Null) (cand (p \<noteq> Null) (p^.hd \<le> q^.hd))
    THEN s^.tl := p; p := p^.tl ELSE s^.tl := q; q := q^.tl FI;
    s := s^.tl
 OD
 {List tl r (merge(Ps,Qs,\<lambda>x y. hd x \<le> hd y))}"
apply vcg_simp
apply (simp_all add: cand_def cor_def)

apply (fastforce)

apply clarsimp
apply(rule conjI)
apply clarsimp
apply(rule conjI)
apply (fastforce intro!:Path_snoc intro:Path_upd[THEN iffD2] notin_List_update[THEN iffD2] simp:eq_sym_conv)
apply clarsimp
apply(rule conjI)
apply (clarsimp)
apply(rule_tac x = "rs @ [a]" in exI)
apply(clarsimp simp:eq_sym_conv)
apply(rule_tac x = "bs" in exI)
apply(clarsimp simp:eq_sym_conv)
apply(rule_tac x = "ya#bsa" in exI)
apply(simp)
apply(clarsimp simp:eq_sym_conv)
apply(rule_tac x = "rs @ [a]" in exI)
apply(clarsimp simp:eq_sym_conv)
apply(rule_tac x = "y#bs" in exI)
apply(clarsimp simp:eq_sym_conv)
apply(rule_tac x = "bsa" in exI)
apply(simp)
apply (fastforce intro!:Path_snoc intro:Path_upd[THEN iffD2] notin_List_update[THEN iffD2] simp:eq_sym_conv)

apply(clarsimp simp add:List_app)
done

text\<open>And now with ghost variables:\<close>

lemma "VARS elem next p q r s ps qs rs a
 {List next p Ps \<and> List next q Qs \<and> set Ps \<inter> set Qs = {} \<and>
  (p \<noteq> Null \<or> q \<noteq> Null) \<and> ps = Ps \<and> qs = Qs}
 IF cor (q = Null) (cand (p \<noteq> Null) (p^.elem \<le> q^.elem))
 THEN r := p; p := p^.next; ps := tl ps
 ELSE r := q; q := q^.next; qs := tl qs FI;
 s := r; rs := []; a := addr s;
 WHILE p \<noteq> Null \<or> q \<noteq> Null
 INV {Path next r rs s \<and> List next p ps \<and> List next q qs \<and>
      distinct(a # ps @ qs @ rs) \<and> s = Ref a \<and>
      merge(Ps,Qs,\<lambda>x y. elem x \<le> elem y) =
      rs @ a # merge(ps,qs,\<lambda>x y. elem x \<le> elem y) \<and>
      (next a = p \<or> next a = q)}
 DO IF cor (q = Null) (cand (p \<noteq> Null) (p^.elem \<le> q^.elem))
    THEN s^.next := p; p := p^.next; ps := tl ps
    ELSE s^.next := q; q := q^.next; qs := tl qs FI;
    rs := rs @ [a]; s := s^.next; a := addr s
 OD
 {List next r (merge(Ps,Qs,\<lambda>x y. elem x \<le> elem y))}"
apply vcg_simp
apply (simp_all add: cand_def cor_def)

apply (fastforce)

apply clarsimp
apply(rule conjI)
apply(clarsimp)
apply(rule conjI)
apply(clarsimp simp:neq_commute)
apply(clarsimp simp:neq_commute)
apply(clarsimp simp:neq_commute)

apply(clarsimp simp add:List_app)
done

text\<open>The proof is a LOT simpler because it does not need
instantiations anymore, but it is still not quite automatic, probably
because of this wrong orientation business.\<close>

text\<open>More of the previous proof without ghost variables can be
automated, but the runtime goes up drastically. In general it is
usually more efficient to give the witness directly than to have it
found by proof.

Now we try a functional version of the abstraction relation \<^term>\<open>Path\<close>. Since the result is not that convincing, we do not prove any of
the lemmas.\<close>

axiomatization
  ispath :: "('a \<Rightarrow> 'a ref) \<Rightarrow> 'a ref \<Rightarrow> 'a ref \<Rightarrow> bool" and
  path :: "('a \<Rightarrow> 'a ref) \<Rightarrow> 'a ref \<Rightarrow> 'a ref \<Rightarrow> 'a list"

text"First some basic lemmas:"

lemma [simp]: "ispath f p p"
by (rule unproven)
lemma [simp]: "path f p p = []"
by (rule unproven)
lemma [simp]: "ispath f p q \<Longrightarrow> a \<notin> set(path f p q) \<Longrightarrow> ispath (f(a := r)) p q"
by (rule unproven)
lemma [simp]: "ispath f p q \<Longrightarrow> a \<notin> set(path f p q) \<Longrightarrow>
 path (f(a := r)) p q = path f p q"
by (rule unproven)

text"Some more specific lemmas needed by the example:"

lemma [simp]: "ispath (f(a := q)) p (Ref a) \<Longrightarrow> ispath (f(a := q)) p q"
by (rule unproven)
lemma [simp]: "ispath (f(a := q)) p (Ref a) \<Longrightarrow>
 path (f(a := q)) p q = path (f(a := q)) p (Ref a) @ [a]"
by (rule unproven)
lemma [simp]: "ispath f p (Ref a) \<Longrightarrow> f a = Ref b \<Longrightarrow>
 b \<notin> set (path f p (Ref a))"
by (rule unproven)
lemma [simp]: "ispath f p (Ref a) \<Longrightarrow> f a = Null \<Longrightarrow> islist f p"
by (rule unproven)
lemma [simp]: "ispath f p (Ref a) \<Longrightarrow> f a = Null \<Longrightarrow> list f p = path f p (Ref a) @ [a]"
by (rule unproven)

lemma [simp]: "islist f p \<Longrightarrow> distinct (list f p)"
by (rule unproven)

lemma "VARS hd tl p q r s
 {islist tl p \<and> Ps = list tl p \<and> islist tl q \<and> Qs = list tl q \<and>
  set Ps \<inter> set Qs = {} \<and>
  (p \<noteq> Null \<or> q \<noteq> Null)}
 IF cor (q = Null) (cand (p \<noteq> Null) (p^.hd \<le> q^.hd))
 THEN r := p; p := p^.tl ELSE r := q; q := q^.tl FI;
 s := r;
 WHILE p \<noteq> Null \<or> q \<noteq> Null
 INV {\<exists>rs ps qs a. ispath tl r s \<and> rs = path tl r s \<and>
      islist tl p \<and> ps = list tl p \<and> islist tl q \<and> qs = list tl q \<and>
      distinct(a # ps @ qs @ rs) \<and> s = Ref a \<and>
      merge(Ps,Qs,\<lambda>x y. hd x \<le> hd y) =
      rs @ a # merge(ps,qs,\<lambda>x y. hd x \<le> hd y) \<and>
      (tl a = p \<or> tl a = q)}
 DO IF cor (q = Null) (cand (p \<noteq> Null) (p^.hd \<le> q^.hd))
    THEN s^.tl := p; p := p^.tl ELSE s^.tl := q; q := q^.tl FI;
    s := s^.tl
 OD
 {islist tl r & list tl r = (merge(Ps,Qs,\<lambda>x y. hd x \<le> hd y))}"
apply vcg_simp

apply (simp_all add: cand_def cor_def)
  apply (fastforce)
 apply (fastforce simp: eq_sym_conv)
apply(clarsimp)
done

text"The proof is automatic, but requires a numbet of special lemmas."

subsubsection "Cyclic list reversal"

text\<open>We consider two algorithms for the reversal of circular lists.
\<close>

lemma circular_list_rev_I:
  "VARS next root p q tmp
  {root = Ref r \<and> distPath next root (r#Ps) root}
  p := root; q := root^.next;
  WHILE q \<noteq> root
  INV {\<exists> ps qs. distPath next p ps root \<and> distPath next q qs root \<and>
             root = Ref r \<and> r \<notin> set Ps  \<and> set ps \<inter> set qs = {} \<and>
             Ps = (rev ps) @ qs  }
  DO tmp := q; q := q^.next; tmp^.next := p; p:=tmp OD;
  root^.next := p
  { root = Ref r \<and> distPath next root (r#rev Ps) root}"
apply (simp only:distPath_def)
apply vcg_simp
  apply (rule_tac x="[]" in exI)
  apply auto
 apply (drule (2) neq_dP)
 apply clarsimp
 apply(rule_tac x="a # ps" in exI)
apply clarsimp
done

text\<open>In the beginning, we are able to assert \<^term>\<open>distPath next
root as root\<close>, with \<^term>\<open>as\<close> set to \<^term>\<open>[]\<close> or
\<^term>\<open>[r,a,b,c]\<close>. Note that \<^term>\<open>Path next root as root\<close> would
additionally give us an infinite number of lists with the recurring
sequence \<^term>\<open>[r,a,b,c]\<close>.

The precondition states that there exists a non-empty non-repeating
path \mbox{\<^term>\<open>r # Ps\<close>} from pointer \<^term>\<open>root\<close> to itself, given that
\<^term>\<open>root\<close> points to location \<^term>\<open>r\<close>. Pointers \<^term>\<open>p\<close> and
\<^term>\<open>q\<close> are then set to \<^term>\<open>root\<close> and the successor of \<^term>\<open>root\<close> respectively. If \<^term>\<open>q = root\<close>, we have circled the loop,
otherwise we set the \<^term>\<open>next\<close> pointer field of \<^term>\<open>q\<close> to point
to \<^term>\<open>p\<close>, and shift \<^term>\<open>p\<close> and \<^term>\<open>q\<close> one step forward. The
invariant thus states that \<^term>\<open>p\<close> and \<^term>\<open>q\<close> point to two
disjoint lists \<^term>\<open>ps\<close> and \<^term>\<open>qs\<close>, such that \<^term>\<open>Ps = rev ps
@ qs\<close>. After the loop terminates, one
extra step is needed to close the loop. As expected, the postcondition
states that the \<^term>\<open>distPath\<close> from \<^term>\<open>root\<close> to itself is now
\<^term>\<open>r # (rev Ps)\<close>.

It may come as a surprise to the reader that the simple algorithm for
acyclic list reversal, with modified annotations, works for cyclic
lists as well:\<close>

lemma circular_list_rev_II:
"VARS next p q tmp
{p = Ref r \<and> distPath next p (r#Ps) p}
q:=Null;
WHILE p \<noteq> Null
INV
{ ((q = Null) \<longrightarrow> (\<exists>ps. distPath next p (ps) (Ref r) \<and> ps = r#Ps)) \<and>
  ((q \<noteq> Null) \<longrightarrow> (\<exists>ps qs. distPath next q (qs) (Ref r) \<and> List next p ps  \<and>
                   set ps \<inter> set qs = {} \<and> rev qs @ ps = Ps@[r])) \<and>
  \<not> (p = Null \<and> q = Null) }
DO tmp := p; p := p^.next; tmp^.next := q; q:=tmp OD
{q = Ref r \<and> distPath next q (r # rev Ps) q}"
apply (simp only:distPath_def)
apply vcg_simp
  apply clarsimp
 apply (case_tac "(q = Null)")
  apply (fastforce intro: Path_is_List)
 apply clarsimp
 apply (rule_tac x= "bs" in exI)
 apply (rule_tac x= "y # qs" in exI)
 apply clarsimp
apply (auto simp:fun_upd_apply)
done

subsubsection "Storage allocation"

definition new :: "'a set \<Rightarrow> 'a"
  where "new A = (SOME a. a \<notin> A)"

lemma new_notin:
 "\<lbrakk> ~finite(UNIV::'a set); finite(A::'a set); B \<subseteq> A \<rbrakk> \<Longrightarrow> new (A) \<notin> B"
apply(unfold new_def)
apply(rule someI2_ex)
 apply (fast intro:ex_new_if_finite)
apply (fast)
done

lemma "~finite(UNIV::'a set) \<Longrightarrow>
  VARS xs elem next alloc p q
  {Xs = xs \<and> p = (Null::'a ref)}
  WHILE xs \<noteq> []
  INV {islist next p \<and> set(list next p) \<subseteq> set alloc \<and>
       map elem (rev(list next p)) @ xs = Xs}
  DO q := Ref(new(set alloc)); alloc := (addr q)#alloc;
     q^.next := p; q^.elem := hd xs; xs := tl xs; p := q
  OD
  {islist next p \<and> map elem (rev(list next p)) = Xs}"
apply vcg_simp
 apply (clarsimp simp: subset_insert_iff neq_Nil_conv fun_upd_apply new_notin)
done

end


(*  Title:      HOL/UNITY/UNITY.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1998  University of Cambridge

The basic UNITY theory (revised version, based upon the "co"
operator).

From Misra, "A Logic for Concurrent Programming", 1994.
*)

section \<open>The Basic UNITY Theory\<close>

theory UNITY imports MainRLT begin

definition
  "Program =
    {(init:: 'a set, acts :: ('a * 'a)set set,
      allowed :: ('a * 'a)set set). Id \<in> acts & Id \<in> allowed}"

typedef 'a program = "Program :: ('a set * ('a * 'a) set set * ('a * 'a) set set) set"
  morphisms Rep_Program Abs_Program
  unfolding Program_def by blast

definition Acts :: "'a program => ('a * 'a)set set" where
    "Acts F == (%(init, acts, allowed). acts) (Rep_Program F)"

definition "constrains" :: "['a set, 'a set] => 'a program set"  (infixl "co"     60) where
    "A co B == {F. \<forall>act \<in> Acts F. act``A \<subseteq> B}"

definition unless  :: "['a set, 'a set] => 'a program set"  (infixl "unless" 60)  where
    "A unless B == (A-B) co (A \<union> B)"

definition mk_program :: "('a set * ('a * 'a)set set * ('a * 'a)set set)
                   => 'a program" where
    "mk_program == %(init, acts, allowed).
                      Abs_Program (init, insert Id acts, insert Id allowed)"

definition Init :: "'a program => 'a set" where
    "Init F == (%(init, acts, allowed). init) (Rep_Program F)"

definition AllowedActs :: "'a program => ('a * 'a)set set" where
    "AllowedActs F == (%(init, acts, allowed). allowed) (Rep_Program F)"

definition Allowed :: "'a program => 'a program set" where
    "Allowed F == {G. Acts G \<subseteq> AllowedActs F}"

definition stable     :: "'a set => 'a program set" where
    "stable A == A co A"

definition strongest_rhs :: "['a program, 'a set] => 'a set" where
    "strongest_rhs F A == \<Inter>{B. F \<in> A co B}"

definition invariant :: "'a set => 'a program set" where
    "invariant A == {F. Init F \<subseteq> A} \<inter> stable A"

definition increasing :: "['a => 'b::{order}] => 'a program set" where
    \<comment> \<open>Polymorphic in both states and the meaning of \<open>\<le>\<close>\<close>
    "increasing f == \<Inter>z. stable {s. z \<le> f s}"

subsubsection\<open>The abstract type of programs\<close>

lemmas program_typedef =
     Rep_Program Rep_Program_inverse Abs_Program_inverse
     Program_def Init_def Acts_def AllowedActs_def mk_program_def

lemma Id_in_Acts [iff]: "Id \<in> Acts F"
apply (cut_tac x = F in Rep_Program)
apply (auto simp add: program_typedef)
done

lemma insert_Id_Acts [iff]: "insert Id (Acts F) = Acts F"
by (simp add: insert_absorb)

lemma Acts_nonempty [simp]: "Acts F \<noteq> {}"
by auto

lemma Id_in_AllowedActs [iff]: "Id \<in> AllowedActs F"
apply (cut_tac x = F in Rep_Program)
apply (auto simp add: program_typedef)
done

lemma insert_Id_AllowedActs [iff]: "insert Id (AllowedActs F) = AllowedActs F"
by (simp add: insert_absorb)

subsubsection\<open>Inspectors for type "program"\<close>

lemma Init_eq [simp]: "Init (mk_program (init,acts,allowed)) = init"
by (simp add: program_typedef)

lemma Acts_eq [simp]: "Acts (mk_program (init,acts,allowed)) = insert Id acts"
by (simp add: program_typedef)

lemma AllowedActs_eq [simp]:
     "AllowedActs (mk_program (init,acts,allowed)) = insert Id allowed"
by (simp add: program_typedef)

subsubsection\<open>Equality for UNITY programs\<close>

lemma surjective_mk_program [simp]:
     "mk_program (Init F, Acts F, AllowedActs F) = F"
apply (cut_tac x = F in Rep_Program)
apply (auto simp add: program_typedef)
apply (drule_tac f = Abs_Program in arg_cong)+
apply (simp add: program_typedef insert_absorb)
done

lemma program_equalityI:
     "[| Init F = Init G; Acts F = Acts G; AllowedActs F = AllowedActs G |]
      ==> F = G"
apply (rule_tac t = F in surjective_mk_program [THEN subst])
apply (rule_tac t = G in surjective_mk_program [THEN subst], simp)
done

lemma program_equalityE:
     "[| F = G;
         [| Init F = Init G; Acts F = Acts G; AllowedActs F = AllowedActs G |]
         ==> P |] ==> P"
by simp

lemma program_equality_iff:
     "(F=G) =
      (Init F = Init G & Acts F = Acts G &AllowedActs F = AllowedActs G)"
by (blast intro: program_equalityI program_equalityE)

subsubsection\<open>co\<close>

lemma constrainsI:
    "(!!act s s'. [| act \<in> Acts F;  (s,s') \<in> act;  s \<in> A |] ==> s' \<in> A')
     ==> F \<in> A co A'"
by (simp add: constrains_def, blast)

lemma constrainsD:
    "[| F \<in> A co A'; act \<in> Acts F;  (s,s') \<in> act;  s \<in> A |] ==> s' \<in> A'"
by (unfold constrains_def, blast)

lemma constrains_empty [iff]: "F \<in> {} co B"
by (unfold constrains_def, blast)

lemma constrains_empty2 [iff]: "(F \<in> A co {}) = (A={})"
by (unfold constrains_def, blast)

lemma constrains_UNIV [iff]: "(F \<in> UNIV co B) = (B = UNIV)"
by (unfold constrains_def, blast)

lemma constrains_UNIV2 [iff]: "F \<in> A co UNIV"
by (unfold constrains_def, blast)

text\<open>monotonic in 2nd argument\<close>
lemma constrains_weaken_R:
    "[| F \<in> A co A'; A'<=B' |] ==> F \<in> A co B'"
by (unfold constrains_def, blast)

text\<open>anti-monotonic in 1st argument\<close>
lemma constrains_weaken_L:
    "[| F \<in> A co A'; B \<subseteq> A |] ==> F \<in> B co A'"
by (unfold constrains_def, blast)

lemma constrains_weaken:
   "[| F \<in> A co A'; B \<subseteq> A; A'<=B' |] ==> F \<in> B co B'"
by (unfold constrains_def, blast)

subsubsection\<open>Union\<close>

lemma constrains_Un:
    "[| F \<in> A co A'; F \<in> B co B' |] ==> F \<in> (A \<union> B) co (A' \<union> B')"
by (unfold constrains_def, blast)

lemma constrains_UN:
    "(!!i. i \<in> I ==> F \<in> (A i) co (A' i))
     ==> F \<in> (\<Union>i \<in> I. A i) co (\<Union>i \<in> I. A' i)"
by (unfold constrains_def, blast)

lemma constrains_Un_distrib: "(A \<union> B) co C = (A co C) \<inter> (B co C)"
by (unfold constrains_def, blast)

lemma constrains_UN_distrib: "(\<Union>i \<in> I. A i) co B = (\<Inter>i \<in> I. A i co B)"
by (unfold constrains_def, blast)

lemma constrains_Int_distrib: "C co (A \<inter> B) = (C co A) \<inter> (C co B)"
by (unfold constrains_def, blast)

lemma constrains_INT_distrib: "A co (\<Inter>i \<in> I. B i) = (\<Inter>i \<in> I. A co B i)"
by (unfold constrains_def, blast)

subsubsection\<open>Intersection\<close>

lemma constrains_Int:
    "[| F \<in> A co A'; F \<in> B co B' |] ==> F \<in> (A \<inter> B) co (A' \<inter> B')"
by (unfold constrains_def, blast)

lemma constrains_INT:
    "(!!i. i \<in> I ==> F \<in> (A i) co (A' i))
     ==> F \<in> (\<Inter>i \<in> I. A i) co (\<Inter>i \<in> I. A' i)"
by (unfold constrains_def, blast)

lemma constrains_imp_subset: "F \<in> A co A' ==> A \<subseteq> A'"
by (unfold constrains_def, auto)

text\<open>The reasoning is by subsets since "co" refers to single actions
  only.  So this rule isn't that useful.\<close>
lemma constrains_trans:
    "[| F \<in> A co B; F \<in> B co C |] ==> F \<in> A co C"
by (unfold constrains_def, blast)

lemma constrains_cancel:
   "[| F \<in> A co (A' \<union> B); F \<in> B co B' |] ==> F \<in> A co (A' \<union> B')"
by (unfold constrains_def, clarify, blast)

subsubsection\<open>unless\<close>

lemma unlessI: "F \<in> (A-B) co (A \<union> B) ==> F \<in> A unless B"
by (unfold unless_def, assumption)

lemma unlessD: "F \<in> A unless B ==> F \<in> (A-B) co (A \<union> B)"
by (unfold unless_def, assumption)

subsubsection\<open>stable\<close>

lemma stableI: "F \<in> A co A ==> F \<in> stable A"
by (unfold stable_def, assumption)

lemma stableD: "F \<in> stable A ==> F \<in> A co A"
by (unfold stable_def, assumption)

lemma stable_UNIV [simp]: "stable UNIV = UNIV"
by (unfold stable_def constrains_def, auto)

subsubsection\<open>Union\<close>

lemma stable_Un:
    "[| F \<in> stable A; F \<in> stable A' |] ==> F \<in> stable (A \<union> A')"

apply (unfold stable_def)
apply (blast intro: constrains_Un)
done

lemma stable_UN:
    "(!!i. i \<in> I ==> F \<in> stable (A i)) ==> F \<in> stable (\<Union>i \<in> I. A i)"
apply (unfold stable_def)
apply (blast intro: constrains_UN)
done

lemma stable_Union:
    "(!!A. A \<in> X ==> F \<in> stable A) ==> F \<in> stable (\<Union>X)"
by (unfold stable_def constrains_def, blast)

subsubsection\<open>Intersection\<close>

lemma stable_Int:
    "[| F \<in> stable A;  F \<in> stable A' |] ==> F \<in> stable (A \<inter> A')"
apply (unfold stable_def)
apply (blast intro: constrains_Int)
done

lemma stable_INT:
    "(!!i. i \<in> I ==> F \<in> stable (A i)) ==> F \<in> stable (\<Inter>i \<in> I. A i)"
apply (unfold stable_def)
apply (blast intro: constrains_INT)
done

lemma stable_Inter:
    "(!!A. A \<in> X ==> F \<in> stable A) ==> F \<in> stable (\<Inter>X)"
by (unfold stable_def constrains_def, blast)

lemma stable_constrains_Un:
    "[| F \<in> stable C; F \<in> A co (C \<union> A') |] ==> F \<in> (C \<union> A) co (C \<union> A')"
by (unfold stable_def constrains_def, blast)

lemma stable_constrains_Int:
  "[| F \<in> stable C; F \<in>  (C \<inter> A) co A' |] ==> F \<in> (C \<inter> A) co (C \<inter> A')"
by (unfold stable_def constrains_def, blast)

(*[| F \<in> stable C; F \<in>  (C \<inter> A) co A |] ==> F \<in> stable (C \<inter> A) *)
lemmas stable_constrains_stable = stable_constrains_Int[THEN stableI]

subsubsection\<open>invariant\<close>

lemma invariantI: "[| Init F \<subseteq> A;  F \<in> stable A |] ==> F \<in> invariant A"
by (simp add: invariant_def)

text\<open>Could also say \<^term>\<open>invariant A \<inter> invariant B \<subseteq> invariant(A \<inter> B)\<close>\<close>
lemma invariant_Int:
     "[| F \<in> invariant A;  F \<in> invariant B |] ==> F \<in> invariant (A \<inter> B)"
by (auto simp add: invariant_def stable_Int)

subsubsection\<open>increasing\<close>

lemma increasingD:
     "F \<in> increasing f ==> F \<in> stable {s. z \<subseteq> f s}"
by (unfold increasing_def, blast)

lemma increasing_constant [iff]: "F \<in> increasing (%s. c)"
by (unfold increasing_def stable_def, auto)

lemma mono_increasing_o:
     "mono g ==> increasing f \<subseteq> increasing (g o f)"
apply (unfold increasing_def stable_def constrains_def, auto)
apply (blast intro: monoD order_trans)
done

(*Holds by the theorem (Suc m \<subseteq> n) = (m < n) *)
lemma strict_increasingD:
     "!!z::nat. F \<in> increasing f ==> F \<in> stable {s. z < f s}"
by (simp add: increasing_def Suc_le_eq [symmetric])

(** The Elimination Theorem.  The "free" m has become universally quantified!
    Should the premise be !!m instead of \<forall>m ?  Would make it harder to use
    in forward proof. **)

lemma elimination:
    "[| \<forall>m \<in> M. F \<in> {s. s x = m} co (B m) |]
     ==> F \<in> {s. s x \<in> M} co (\<Union>m \<in> M. B m)"
by (unfold constrains_def, blast)

text\<open>As above, but for the trivial case of a one-variable state, in which the
  state is identified with its one variable.\<close>
lemma elimination_sing:
    "(\<forall>m \<in> M. F \<in> {m} co (B m)) ==> F \<in> M co (\<Union>m \<in> M. B m)"
by (unfold constrains_def, blast)

subsubsection\<open>Theoretical Results from Section 6\<close>

lemma constrains_strongest_rhs:
    "F \<in> A co (strongest_rhs F A )"
by (unfold constrains_def strongest_rhs_def, blast)

lemma strongest_rhs_is_strongest:
    "F \<in> A co B ==> strongest_rhs F A \<subseteq> B"
by (unfold constrains_def strongest_rhs_def, blast)

subsubsection\<open>Ad-hoc set-theory rules\<close>

lemma Un_Diff_Diff [simp]: "A \<union> B - (A - B) = B"
by blast

lemma Int_Union_Union: "\<Union>B \<inter> A = \<Union>((%C. C \<inter> A)`B)"
by blast

text\<open>Needed for WF reasoning in WFair.thy\<close>

lemma Image_less_than [simp]: "less_than `` {k} = greaterThan k"
by blast

lemma Image_inverse_less_than [simp]: "less_than\<inverse> `` {k} = lessThan k"
by blast

subsection\<open>Partial versus Total Transitions\<close>

definition totalize_act :: "('a * 'a)set => ('a * 'a)set" where
    "totalize_act act == act \<union> Id_on (-(Domain act))"

definition totalize :: "'a program => 'a program" where
    "totalize F == mk_program (Init F,
                               totalize_act ` Acts F,
                               AllowedActs F)"

definition mk_total_program :: "('a set * ('a * 'a)set set * ('a * 'a)set set)
                   => 'a program" where
    "mk_total_program args == totalize (mk_program args)"

definition all_total :: "'a program => bool" where
    "all_total F == \<forall>act \<in> Acts F. Domain act = UNIV"

lemma insert_Id_image_Acts: "f Id = Id ==> insert Id (f`Acts F) = f ` Acts F"
by (blast intro: sym [THEN image_eqI])

subsubsection\<open>Basic properties\<close>

lemma totalize_act_Id [simp]: "totalize_act Id = Id"
by (simp add: totalize_act_def)

lemma Domain_totalize_act [simp]: "Domain (totalize_act act) = UNIV"
by (auto simp add: totalize_act_def)

lemma Init_totalize [simp]: "Init (totalize F) = Init F"
by (unfold totalize_def, auto)

lemma Acts_totalize [simp]: "Acts (totalize F) = (totalize_act ` Acts F)"
by (simp add: totalize_def insert_Id_image_Acts)

lemma AllowedActs_totalize [simp]: "AllowedActs (totalize F) = AllowedActs F"
by (simp add: totalize_def)

lemma totalize_constrains_iff [simp]: "(totalize F \<in> A co B) = (F \<in> A co B)"
by (simp add: totalize_def totalize_act_def constrains_def, blast)

lemma totalize_stable_iff [simp]: "(totalize F \<in> stable A) = (F \<in> stable A)"
by (simp add: stable_def)

lemma totalize_invariant_iff [simp]:
     "(totalize F \<in> invariant A) = (F \<in> invariant A)"
by (simp add: invariant_def)

lemma all_total_totalize: "all_total (totalize F)"
by (simp add: totalize_def all_total_def)

lemma Domain_iff_totalize_act: "(Domain act = UNIV) = (totalize_act act = act)"
by (force simp add: totalize_act_def)

lemma all_total_imp_totalize: "all_total F ==> (totalize F = F)"
apply (simp add: all_total_def totalize_def)
apply (rule program_equalityI)
  apply (simp_all add: Domain_iff_totalize_act image_def)
done

lemma all_total_iff_totalize: "all_total F = (totalize F = F)"
apply (rule iffI)
 apply (erule all_total_imp_totalize)
apply (erule subst)
apply (rule all_total_totalize)
done

lemma mk_total_program_constrains_iff [simp]:
     "(mk_total_program args \<in> A co B) = (mk_program args \<in> A co B)"
by (simp add: mk_total_program_def)

subsection\<open>Rules for Lazy Definition Expansion\<close>

text\<open>They avoid expanding the full program, which is a large expression\<close>

lemma def_prg_Init:
     "F = mk_total_program (init,acts,allowed) ==> Init F = init"
by (simp add: mk_total_program_def)

lemma def_prg_Acts:
     "F = mk_total_program (init,acts,allowed)
      ==> Acts F = insert Id (totalize_act ` acts)"
by (simp add: mk_total_program_def)

lemma def_prg_AllowedActs:
     "F = mk_total_program (init,acts,allowed)
      ==> AllowedActs F = insert Id allowed"
by (simp add: mk_total_program_def)

text\<open>An action is expanded if a pair of states is being tested against it\<close>
lemma def_act_simp:
     "act = {(s,s'). P s s'} ==> ((s,s') \<in> act) = P s s'"
by (simp add: mk_total_program_def)

text\<open>A set is expanded only if an element is being tested against it\<close>
lemma def_set_simp: "A = B ==> (x \<in> A) = (x \<in> B)"
by (simp add: mk_total_program_def)

subsubsection\<open>Inspectors for type "program"\<close>

lemma Init_total_eq [simp]:
     "Init (mk_total_program (init,acts,allowed)) = init"
by (simp add: mk_total_program_def)

lemma Acts_total_eq [simp]:
    "Acts(mk_total_program(init,acts,allowed)) = insert Id (totalize_act`acts)"
by (simp add: mk_total_program_def)

lemma AllowedActs_total_eq [simp]:
     "AllowedActs (mk_total_program (init,acts,allowed)) = insert Id allowed"
by (auto simp add: mk_total_program_def)

end


(*
    Title:      Examples_Echelon_Form_Abstract.thy
    Author:     Jose Divasón <jose.divasonm at unirioja.es>
    Author:     Jesús Aransay <jesus-maria.aransay at unirioja.es>
*)

section\<open>Examples of execution over matrices represented as functions\<close>

theory Examples_Echelon_Form_Abstract
imports
  Code_Cayley_Hamilton
  Gauss_Jordan.Examples_Gauss_Jordan_Abstract
  Echelon_Form_Inverse
  "HOL-Computational_Algebra.Field_as_Ring"
begin

text\<open>The definitions introduced in this file will be also used in
  the computations presented in file @{file \<open>Examples_Echelon_Form_IArrays.thy\<close>}.
  Some of these definitions are not even used in this file since they are quite
  time consuming.\<close>

definition test_real_6x4 :: "real^6^4"
  where "test_real_6x4 = list_of_list_to_matrix
        [[0,0,0,0,0,0],
         [0,1,0,0,0,0],
         [0,0,0,0,0,0],
         [0,0,0,0,8,2]]"

value "matrix_to_list_of_list (minorM test_real_6x4 0 0)"

value "cofactor (mat 1::rat^3^3) 0 0"

value "vec_to_list (cofactorM_row  (mat 1::int^3^3) 1)"

value "matrix_to_list_of_list (cofactorM  (mat 1::int^3^3))"

definition test_rat_3x3 :: "rat^3^3"
  where "test_rat_3x3 = list_of_list_to_matrix [[3,5,1],[2,1,3],[1,2,1]]"

value "matrix_to_list_of_list (matpow test_rat_3x3 5)"

definition test_int_3x3 :: "int^3^3"
  where "test_int_3x3 = list_of_list_to_matrix [[3,2,8], [0,3,9], [8,7,9]]"

value "det test_int_3x3"

definition test_real_3x3 :: "real^3^3"
  where "test_real_3x3 = list_of_list_to_matrix [[3,5,1],[2,1,3],[1,2,1]]"

value "charpoly test_real_3x3"

text\<open>We check that the Cayley-Hamilton theorem holds for this particular case:\<close>

value "matrix_to_list_of_list (evalmat (charpoly test_real_3x3) test_real_3x3)"

definition test_int_3x3_02 :: "int^3^3"
  where "test_int_3x3_02 = list_of_list_to_matrix [[3,5,1],[2,1,3],[1,2,1]]"

value "matrix_to_list_of_list (adjugate test_int_3x3_02)"

text\<open>The following integer matrix is not invertible, so the result is \<open>None\<close>\<close>

value "inverse_matrix test_int_3x3_02"

definition test_int_3x3_03 :: "int^3^3"
  where "test_int_3x3_03 = list_of_list_to_matrix [[1,-2,4],[1,-1,1],[0,1,-2]]"

value "matrix_to_list_of_list (the (inverse_matrix test_int_3x3_03))"

text\<open>We check that the previous inverse has been correctly computed:\<close>

value "test_int_3x3_03 ** (the (inverse_matrix test_int_3x3_03)) = (mat 1::int^3^3)"

definition test_int_8x8 :: "int^8^8"
  where "test_int_8x8 = list_of_list_to_matrix
       [[ 3, 2, 3, 6, 2, 8, 5, 6],
        [ 0, 5, 5, 2, 3, 9, 4, 7],
        [ 8, 7, 9, 1, 4,-2, 2, 0],
        [ 0, 1, 5, 6, 5, 1, 1, 4],
        [ 0, 3, 4, 5, 2,-4, 2, 1],
        [ 6, 8, 6, 2, 2,-3, 3, 5],
        [-2, 4,-2, 6, 7, 8, 0, 3],
        [ 7, 1, 3, 0,-9,-3, 4,-5]]"

text\<open>SLOW; several minutes.\<close>

(*value "det test_int_8x8"

value "matrix_to_list_of_list (echelon_form_of test_int_8x8 euclid_ext2)"*)

text\<open>The following definitions will be used in
  file @{file \<open>Examples_Echelon_Form_IArrays.thy\<close>}.
  Using the abstract version of matrices would produce lengthy computations.\<close>

definition test_int_6x6 :: "int^6^6"
  where "test_int_6x6 = list_of_list_to_matrix
    [[ 3, 2, 3, 6, 2, 8],
     [ 0, 5, 5, 2, 3, 9],
     [ 8, 7, 9, 1, 4,-2],
     [ 0, 1, 5, 6, 5, 1],
     [ 0, 3, 4, 5, 2,-4],
     [ 6, 8, 6, 2, 2,-3]]"

definition test_real_6x6 :: "real^6^6"
  where "test_real_6x6 = list_of_list_to_matrix
    [[ 3, 2, 3, 6, 2, 8],
     [ 0, 5, 5, 2, 3, 9],
     [ 8, 7, 9, 1, 4,-2],
     [ 0, 1, 5, 6, 5, 1],
     [ 0, 3, 4, 5, 2,-4],
     [ 6, 8, 6, 2, 2,-3]]"

definition test_int_20x20 :: "int^20^20"
  where "test_int_20x20 =  list_of_list_to_matrix
    [[3,2,3,6,2,8,5,9,8,7,5,4,7,8,9,8,7,4,5,2],
     [0,5,5,2,3,9,1,2,4,6,1,2,3,6,5,4,5,8,7,1],
     [8,7,9,1,4,-2,8,7,1,4,1,4,5,8,7,4,1,0,0,2],
     [0,1,5,6,5,1,3,5,4,9,3,2,1,4,5,6,9,8,7,4],
     [0,3,4,5,2,-4,0,2,1,0,0,0,1,2,4,5,1,1,2,0],
     [6,8,6,2,2,-3,2,4,7,9,1,2,3,6,5,4,1,2,8,7],
     [3,8,3,6,2,8,8,9,6,7,8,9,7,8,9,5,4,1,2,3,0],
     [0,8,5,2,8,9,1,2,4,6,4,6,5,8,7,9,8,7,4,5],
     [8,8,8,1,4,-2,8,7,1,4,5,5,5,6,4,5,1,2,3,6],
     [0,8,5,6,5,1,3,5,4,9::int,1,2,3,5,4,7,8,9,6,4],
     [3,2,3,6,2,8,5,9,8,7,5,4,7,3,9,8,7,4,5,2],
     [0,5,5,2,3,9,1,2,4,3,1,2,3,6,5,4,5,8,7,1],
     [1,7,9,1,4,-2,8,7,1,4,1,4,5,8,7,4,1,0,0,2],
     [1,1,5,6,5,1,3,5,4,9,3,4,5,6,9,8,7,4,5,4],
     [3,3,4,5,2,-4,0,2,1,0,0,3,1,2,4,5,1,1,2,0],
     [4,8,6,5,2,-3,2,4,2,9,1,2,3,2,5,4,1,2,8,7],
     [5,8,3,6,2,2,9,9,6,7,2,7,7,2,9,5,4,1,2,3,0],
     [2,8,5,2,8,9,5,2,4,6,4,6,5,2,7,1,8,7,4,5],
     [2,1,8,1,4,-2,8,3,1,4,5,5,5,6,4,5,1,2,3,6],
     [0,2,5,6,5,1,3,5,4,9::int,1,2,3,5,4,7,8,9,6,4]]"

definition test_int_20x20_2 :: "int^20^20"
where "test_int_20x20_2 = list_of_list_to_matrix
      [[58,18,18,41,68,62,6,21,19,78,34,22,108,63,71,38,43,52,37,24],
      [18,51,29,91,76,98,56,37,47,61,88,99,88,78,210,57,27,87,72,79],
      [49,19,81,107,43,34,69,28,101,39,21,910,27,53,15,38,5,34,47,23],
      [97,102,68,27,56,56,102,210,68,56,24,33,88,110,71,23,35,36,72,1],
      [63,11,39,16,32,81,16,98,94,26,53,23,11,51,98,51,81,57,610,85],
      [46,61,68,710,11,105,3,5,61,210,67,34,108,10,44,71,36,66,38,42],
      [39,75,106,42,36,92,110,42,89,105,11,108,22,61,65,101,410,1,1,31],
      [106,94,24,63,16,75,47,82,62,210,52,57,810,41,55,93,73,58,41,82],
      [55,49,102,9,8,41,12,110,109,310,95,51,103,71,92,85,910,410,17,21],
      [31,2,77,93,8,98,510,94,56,5,12,91,69,31,62,4,11,5,92,65],
      [22,29,103,34,64,11,9,610,1,19,35,24,21,49,31,43,81,102,14,11],
      [75,81,5,109,61,110,19,46,55,23,31,1,98,28,56,2,83,81,91,41],
      [4,510,58,41,38,106,99,103,31,84,110,63,17,105,210,61,95,103,63,51],
      [38,32,510,62,410,14,86,310,59,69,107,13,29,610,38,103,43,98,98,1],
      [101,11,3,101,99,810,10,3,510,8,35,62,45,49,34,86,63,66,71,9],
      [16,5,77,110,109,13,63,54,310,102,92,103,310,26,15,22,66,106,210,91],
      [13,810,66,51,91,84,19,25,110,41,51,87,27,79,18,69,99,95,11,46],
      [410,910,62,89,43,23,108,52,33,67,31,105,26,106,108,85,87,68,56,23],
      [310,68,21,91,107,85,94,28,101,34,109,27,63,84,25,106,65,81,7,310],
      [42,63,27,24,1010,11,107,69,910,810,31,15,97,3,56,77,51,108,31,26::int]]"
end