(*  Title:      HOL/MicroJava/DFA/LBVSpec.thy
    Author:     Gerwin Klein
    Copyright   1999 Technische Universitaet Muenchen
*)

section \<open>The Lightweight Bytecode Verifier\<close>

theory LBVSpec
imports SemilatAlg Opt
begin

type_synonym 's certificate = "'s list"

primrec merge :: "'s certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow> nat \<Rightarrow> (nat \<times> 's) list \<Rightarrow> 's \<Rightarrow> 's" where
  "merge cert f r T pc []     x = x"
| "merge cert f r T pc (s#ss) x = merge cert f r T pc ss (let (pc',s') = s in
                                  if pc'=pc+1 then s' +_f x
                                  else if s' <=_r (cert!pc') then x
                                  else T)"

definition wtl_inst :: "'s certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow>
             's step_type \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's" where
"wtl_inst cert f r T step pc s \<equiv> merge cert f r T pc (step pc s) (cert!(pc+1))"

definition wtl_cert :: "'s certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow>
             's step_type \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's" where
"wtl_cert cert f r T B step pc s \<equiv>
  if cert!pc = B then
    wtl_inst cert f r T step pc s
  else
    if s <=_r (cert!pc) then wtl_inst cert f r T step pc (cert!pc) else T"

primrec wtl_inst_list :: "'a list \<Rightarrow> 's certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow>
                  's step_type \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's" where
  "wtl_inst_list []     cert f r T B step pc s = s"
| "wtl_inst_list (i#is) cert f r T B step pc s =
    (let s' = wtl_cert cert f r T B step pc s in
      if s' = T \<or> s = T then T else wtl_inst_list is cert f r T B step (pc+1) s')"

definition cert_ok :: "'s certificate \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow> 's set \<Rightarrow> bool" where
  "cert_ok cert n T B A \<equiv> (\<forall>i < n. cert!i \<in> A \<and> cert!i \<noteq> T) \<and> (cert!n = B)"

definition bottom :: "'a ord \<Rightarrow> 'a \<Rightarrow> bool" where
  "bottom r B \<equiv> \<forall>x. B <=_r x"

locale lbv = Semilat +
  fixes T :: "'a" ("\<top>")
  fixes B :: "'a" ("\<bottom>")
  fixes step :: "'a step_type"
  assumes top: "top r \<top>"
  assumes T_A: "\<top> \<in> A"
  assumes bot: "bottom r \<bottom>"
  assumes B_A: "\<bottom> \<in> A"

  fixes merge :: "'a certificate \<Rightarrow> nat \<Rightarrow> (nat \<times> 'a) list \<Rightarrow> 'a \<Rightarrow> 'a"
  defines mrg_def: "merge cert \<equiv> LBVSpec.merge cert f r \<top>"

  fixes wti :: "'a certificate \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
  defines wti_def: "wti cert \<equiv> wtl_inst cert f r \<top> step"

  fixes wtc :: "'a certificate \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
  defines wtc_def: "wtc cert \<equiv> wtl_cert cert f r \<top> \<bottom> step"

  fixes wtl :: "'b list \<Rightarrow> 'a certificate \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
  defines wtl_def: "wtl ins cert \<equiv> wtl_inst_list ins cert f r \<top> \<bottom> step"

lemma (in lbv) wti:
  "wti c pc s \<equiv> merge c pc (step pc s) (c!(pc+1))"
  by (simp add: wti_def mrg_def wtl_inst_def)

lemma (in lbv) wtc:
  "wtc c pc s \<equiv> if c!pc = \<bottom> then wti c pc s else if s <=_r c!pc then wti c pc (c!pc) else \<top>"
  by (unfold wtc_def wti_def wtl_cert_def)

lemma cert_okD1 [intro?]:
  "cert_ok c n T B A \<Longrightarrow> pc < n \<Longrightarrow> c!pc \<in> A"
  by (unfold cert_ok_def) fast

lemma cert_okD2 [intro?]:
  "cert_ok c n T B A \<Longrightarrow> c!n = B"
  by (simp add: cert_ok_def)

lemma cert_okD3 [intro?]:
  "cert_ok c n T B A \<Longrightarrow> B \<in> A \<Longrightarrow> pc < n \<Longrightarrow> c!Suc pc \<in> A"
  by (drule Suc_leI) (auto simp add: le_eq_less_or_eq dest: cert_okD1 cert_okD2)

declare Let_def [simp]

subsection "more semilattice lemmas"

lemma (in lbv) sup_top [simp, elim]:
  assumes x: "x \<in> A"
  shows "x +_f \<top> = \<top>"
proof -
  from top have "x +_f \<top> <=_r \<top>" ..
  moreover from x T_A have "\<top> <=_r x +_f \<top>" ..
  ultimately show ?thesis ..
qed

lemma (in lbv) plusplussup_top [simp, elim]:
  "set xs \<subseteq> A \<Longrightarrow> xs ++_f \<top> = \<top>"
  by (induct xs) auto

lemma (in Semilat) pp_ub1':
  assumes S: "snd`set S \<subseteq> A"
  assumes y: "y \<in> A" and ab: "(a, b) \<in> set S"
  shows "b <=_r map snd [(p', t') \<leftarrow> S . p' = a] ++_f y"
proof -
  from S have "\<forall>(x,y) \<in> set S. y \<in> A" by auto
  with semilat y ab show ?thesis by - (rule ub1')
qed

lemma (in lbv) bottom_le [simp, intro]:
  "\<bottom> <=_r x"
  using bot by (simp add: bottom_def)

lemma (in lbv) le_bottom [simp]:
  "x <=_r \<bottom> = (x = \<bottom>)"
  by (blast intro: antisym_r)

subsection "merge"

lemma (in lbv) merge_Nil [simp]:
  "merge c pc [] x = x" by (simp add: mrg_def)

lemma (in lbv) merge_Cons [simp]:
  "merge c pc (l#ls) x = merge c pc ls (if fst l=pc+1 then snd l +_f x
                                        else if snd l <=_r (c!fst l) then x
                                        else \<top>)"
  by (simp add: mrg_def split_beta)

lemma (in lbv) merge_Err [simp]:
  "snd`set ss \<subseteq> A \<Longrightarrow> merge c pc ss \<top> = \<top>"
  by (induct ss) auto

lemma (in lbv) merge_not_top:
  "\<And>x. snd`set ss \<subseteq> A \<Longrightarrow> merge c pc ss x \<noteq> \<top> \<Longrightarrow>
  \<forall>(pc',s') \<in> set ss. (pc' \<noteq> pc+1 \<longrightarrow> s' <=_r (c!pc'))"
  (is "\<And>x. ?set ss \<Longrightarrow> ?merge ss x \<Longrightarrow> ?P ss")
proof (induct ss)
  show "?P []" by simp
next
  fix x ls l
  assume "?set (l#ls)" then obtain set: "snd`set ls \<subseteq> A" by simp
  assume merge: "?merge (l#ls) x"
  moreover
  obtain pc' s' where l: "l = (pc',s')" by (cases l)
  ultimately
  obtain x' where merge': "?merge ls x'" by simp
  assume "\<And>x. ?set ls \<Longrightarrow> ?merge ls x \<Longrightarrow> ?P ls" hence "?P ls" using set merge' .
  moreover
  from merge set
  have "pc' \<noteq> pc+1 \<longrightarrow> s' <=_r (c!pc')" by (simp add: l split: if_split_asm)
  ultimately
  show "?P (l#ls)" by (simp add: l)
qed

lemma (in lbv) merge_def:
  shows
  "\<And>x. x \<in> A \<Longrightarrow> snd`set ss \<subseteq> A \<Longrightarrow>
  merge c pc ss x =
  (if \<forall>(pc',s') \<in> set ss. pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc' then
    map snd [(p',t') \<leftarrow> ss. p'=pc+1] ++_f x
  else \<top>)"
  (is "\<And>x. _ \<Longrightarrow> _ \<Longrightarrow> ?merge ss x = ?if ss x" is "\<And>x. _ \<Longrightarrow> _ \<Longrightarrow> ?P ss x")
proof (induct ss)
  fix x show "?P [] x" by simp
next
  fix x assume x: "x \<in> A"
  fix l::"nat \<times> 'a" and ls
  assume "snd`set (l#ls) \<subseteq> A"
  then obtain l: "snd l \<in> A" and ls: "snd`set ls \<subseteq> A" by auto
  assume "\<And>x. x \<in> A \<Longrightarrow> snd`set ls \<subseteq> A \<Longrightarrow> ?P ls x"
  hence IH: "\<And>x. x \<in> A \<Longrightarrow> ?P ls x" using ls by iprover
  obtain pc' s' where [simp]: "l = (pc',s')" by (cases l)
  hence "?merge (l#ls) x = ?merge ls
    (if pc'=pc+1 then s' +_f x else if s' <=_r c!pc' then x else \<top>)"
    (is "?merge (l#ls) x = ?merge ls ?if'")
    by simp
  also have "\<dots> = ?if ls ?if'"
  proof -
    from l have "s' \<in> A" by simp
    with x have "s' +_f x \<in> A" by simp
    with x T_A have "?if' \<in> A" by auto
    hence "?P ls ?if'" by (rule IH) thus ?thesis by simp
  qed
  also have "\<dots> = ?if (l#ls) x"
    proof (cases "\<forall>(pc', s')\<in>set (l#ls). pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'")
      case True
      hence "\<forall>(pc', s')\<in>set ls. pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'" by auto
      moreover
      from True have
        "map snd [(p',t')\<leftarrow>ls . p'=pc+1] ++_f ?if' =
        (map snd [(p',t')\<leftarrow>l#ls . p'=pc+1] ++_f x)"
        by simp
      ultimately
      show ?thesis using True by simp
    next
      case False
      moreover
      from ls have "set (map snd [(p', t')\<leftarrow>ls . p' = Suc pc]) \<subseteq> A" by auto
      ultimately show ?thesis by auto
    qed
  finally show "?P (l#ls) x" .
qed

lemma (in lbv) merge_not_top_s:
  assumes x:  "x \<in> A" and ss: "snd`set ss \<subseteq> A"
  assumes m:  "merge c pc ss x \<noteq> \<top>"
  shows "merge c pc ss x = (map snd [(p',t') \<leftarrow> ss. p'=pc+1] ++_f x)"
proof -
  from ss m have "\<forall>(pc',s') \<in> set ss. (pc' \<noteq> pc+1 \<longrightarrow> s' <=_r c!pc')"
    by (rule merge_not_top)
  with x ss m show ?thesis by - (drule merge_def, auto split: if_split_asm)
qed

subsection "wtl-inst-list"

lemmas [iff] = not_Err_eq

lemma (in lbv) wtl_Nil [simp]: "wtl [] c pc s = s"
  by (simp add: wtl_def)

lemma (in lbv) wtl_Cons [simp]:
  "wtl (i#is) c pc s =
  (let s' = wtc c pc s in if s' = \<top> \<or> s = \<top> then \<top> else wtl is c (pc+1) s')"
  by (simp add: wtl_def wtc_def)

lemma (in lbv) wtl_Cons_not_top:
  "wtl (i#is) c pc s \<noteq> \<top> =
  (wtc c pc s \<noteq> \<top> \<and> s \<noteq> T \<and> wtl is c (pc+1) (wtc c pc s) \<noteq> \<top>)"
  by (auto simp del: split_paired_Ex)

lemma (in lbv) wtl_top [simp]:  "wtl ls c pc \<top> = \<top>"
  by (cases ls) auto

lemma (in lbv) wtl_not_top:
  "wtl ls c pc s \<noteq> \<top> \<Longrightarrow> s \<noteq> \<top>"
  by (cases "s=\<top>") auto

lemma (in lbv) wtl_append [simp]:
  "\<And>pc s. wtl (a@b) c pc s = wtl b c (pc+length a) (wtl a c pc s)"
  by (induct a) auto

lemma (in lbv) wtl_take:
  "wtl is c pc s \<noteq> \<top> \<Longrightarrow> wtl (take pc' is) c pc s \<noteq> \<top>"
  (is "?wtl is \<noteq> _ \<Longrightarrow> _")
proof -
  assume "?wtl is \<noteq> \<top>"
  hence "?wtl (take pc' is @ drop pc' is) \<noteq> \<top>" by simp
  thus ?thesis by (auto dest!: wtl_not_top simp del: append_take_drop_id)
qed

lemma take_Suc:
  "\<forall>n. n < length l \<longrightarrow> take (Suc n) l = (take n l)@[l!n]" (is "?P l")
proof (induct l)
  show "?P []" by simp
next
  fix x xs assume IH: "?P xs"
  show "?P (x#xs)"
  proof (intro strip)
    fix n assume "n < length (x#xs)"
    with IH show "take (Suc n) (x # xs) = take n (x # xs) @ [(x # xs) ! n]"
      by (cases n, auto)
  qed
qed

lemma (in lbv) wtl_Suc:
  assumes suc: "pc+1 < length is"
  assumes wtl: "wtl (take pc is) c 0 s \<noteq> \<top>"
  shows "wtl (take (pc+1) is) c 0 s = wtc c pc (wtl (take pc is) c 0 s)"
proof -
  from suc have "take (pc+1) is=(take pc is)@[is!pc]" by (simp add: take_Suc)
  with suc wtl show ?thesis by (simp add: min.absorb2)
qed

lemma (in lbv) wtl_all:
  assumes all: "wtl is c 0 s \<noteq> \<top>" (is "?wtl is \<noteq> _")
  assumes pc:  "pc < length is"
  shows  "wtc c pc (wtl (take pc is) c 0 s) \<noteq> \<top>"
proof -
  from pc have "0 < length (drop pc is)" by simp
  then  obtain i r where Cons: "drop pc is = i#r"
    by (auto simp add: neq_Nil_conv simp del: length_drop drop_eq_Nil)
  hence "i#r = drop pc is" ..
  with all have take: "?wtl (take pc is@i#r) \<noteq> \<top>" by simp
  from pc have "is!pc = drop pc is ! 0" by simp
  with Cons have "is!pc = i" by simp
  with take pc show ?thesis by (auto simp add: min.absorb2)
qed

subsection "preserves-type"

lemma (in lbv) merge_pres:
  assumes s0: "snd`set ss \<subseteq> A" and x: "x \<in> A"
  shows "merge c pc ss x \<in> A"
proof -
  from s0 have "set (map snd [(p', t')\<leftarrow>ss . p'=pc+1]) \<subseteq> A" by auto
  with x  have "(map snd [(p', t')\<leftarrow>ss . p'=pc+1] ++_f x) \<in> A"
    by (auto intro!: plusplus_closed semilat)
  with s0 x show ?thesis by (simp add: merge_def T_A)
qed

lemma pres_typeD2:
  "pres_type step n A \<Longrightarrow> s \<in> A \<Longrightarrow> p < n \<Longrightarrow> snd`set (step p s) \<subseteq> A"
  by auto (drule pres_typeD)

lemma (in lbv) wti_pres [intro?]:
  assumes pres: "pres_type step n A"
  assumes cert: "c!(pc+1) \<in> A"
  assumes s_pc: "s \<in> A" "pc < n"
  shows "wti c pc s \<in> A"
proof -
  from pres s_pc have "snd`set (step pc s) \<subseteq> A" by (rule pres_typeD2)
  with cert show ?thesis by (simp add: wti merge_pres)
qed

lemma (in lbv) wtc_pres:
  assumes pres: "pres_type step n A"
  assumes cert: "c!pc \<in> A" and cert': "c!(pc+1) \<in> A"
  assumes s: "s \<in> A" and pc: "pc < n"
  shows "wtc c pc s \<in> A"
proof -
  have "wti c pc s \<in> A" using pres cert' s pc ..
  moreover have "wti c pc (c!pc) \<in> A" using pres cert' cert pc ..
  ultimately show ?thesis using T_A by (simp add: wtc)
qed

lemma (in lbv) wtl_pres:
  assumes pres: "pres_type step (length is) A"
  assumes cert: "cert_ok c (length is) \<top> \<bottom> A"
  assumes s:    "s \<in> A"
  assumes all:  "wtl is c 0 s \<noteq> \<top>"
  shows "pc < length is \<Longrightarrow> wtl (take pc is) c 0 s \<in> A"
  (is "?len pc \<Longrightarrow> ?wtl pc \<in> A")
proof (induct pc)
  from s show "?wtl 0 \<in> A" by simp
next
  fix n assume IH: "Suc n < length is"
  then have n: "n < length is" by simp
  from IH have n1: "n+1 < length is" by simp
  assume prem: "n < length is \<Longrightarrow> ?wtl n \<in> A"
  have "wtc c n (?wtl n) \<in> A"
  using pres _ _ _ n
  proof (rule wtc_pres)
    from prem n show "?wtl n \<in> A" .
    from cert n show "c!n \<in> A" by (rule cert_okD1)
    from cert n1 show "c!(n+1) \<in> A" by (rule cert_okD1)
  qed
  also
  from all n have "?wtl n \<noteq> \<top>" by - (rule wtl_take)
  with n1 have "wtc c n (?wtl n) = ?wtl (n+1)" by (rule wtl_Suc [symmetric])
  finally  show "?wtl (Suc n) \<in> A" by simp
qed

end


(*
  File:    Puiseux_Laurent_Library.thy
  Author:  Manuel Eberl, TU München
*)
subsection \<open>Facts about Laurent series\<close>
theory Puiseux_Laurent_Library
  imports "HOL-Computational_Algebra.Computational_Algebra"
begin

lemma filterlim_at_top_div_const_nat:
  assumes "c > 0"
  shows   "filterlim (\<lambda>x::nat. x div c) at_top at_top"
  unfolding filterlim_at_top
proof
  fix C :: nat
  have *: "n div c \<ge> C" if "n \<ge> C * c" for n
    using assms that by (metis div_le_mono div_mult_self_is_m)
  have "eventually (\<lambda>n. n \<ge> C * c) at_top"
    by (rule eventually_ge_at_top)
  thus "eventually (\<lambda>n. n div c \<ge> C) at_top"
    by eventually_elim (use * in auto)
qed

lemma fls_eq_iff: "f = g \<longleftrightarrow> (\<forall>n. fls_nth f n = fls_nth g n)"
  by transfer auto

lemma fls_shift_eq_1_iff: "fls_shift n f = 1 \<longleftrightarrow> f = fls_shift (-n) 1"
proof -
  have "fls_shift n f = 1 \<longleftrightarrow> fls_shift n f = fls_shift n (fls_shift (-n) 1)"
    by (simp del: fls_shift_eq_iff)
  also have "\<dots> \<longleftrightarrow> f = fls_shift (-n) 1"
    by (subst fls_shift_eq_iff) auto
  finally show ?thesis .
qed

lemma fps_to_fls_eq_iff [simp]: "fps_to_fls f = fps_to_fls g \<longleftrightarrow> f = g"
proof safe
  assume "fps_to_fls f = fps_to_fls g"
  hence *: "n < 0 \<or> f $ nat n = g $ nat n" for n
    by (force simp: fls_eq_iff split: if_splits)
  have "f $ n = g $ n" for n
    using *[of "int n"] by auto
  thus "f = g"
    by (auto simp: fps_eq_iff)
qed

lemma fps_to_fls_eq_0_iff [simp]: "fps_to_fls f = 0 \<longleftrightarrow> f = 0"
  using fps_to_fls_eq_iff[of f 0] by (simp del: fps_to_fls_eq_iff)

lemma fps_to_fls_eq_1_iff [simp]: "fps_to_fls f = 1 \<longleftrightarrow> f = 1"
  using fps_to_fls_eq_iff[of f 1] by (simp del: fps_to_fls_eq_iff)

lemma fps_to_fls_power: "fps_to_fls (f ^ n) = fps_to_fls f ^ n"
  by (induction n) (auto simp: fls_times_fps_to_fls)

lemma fls_as_fps:
  fixes f :: "'a :: zero fls" and n :: int
  assumes n: "n \<ge> -fls_subdegree f"
  obtains f' where "f = fls_shift n (fps_to_fls f')"
proof -
  have "fls_subdegree (fls_shift (- n) f) \<ge> 0"
    by (rule fls_shift_nonneg_subdegree) (use n in simp)
  hence "f = fls_shift n (fps_to_fls (fls_regpart (fls_shift (-n) f)))"
    by (subst fls_regpart_to_fls_trivial) simp_all
  thus ?thesis
    by (rule that)
qed

lemma fls_as_fps':
  fixes f :: "'a :: zero fls" and n :: int
  assumes n: "n \<ge> -fls_subdegree f"
  shows "\<exists>f'. f = fls_shift n (fps_to_fls f')"
  using fls_as_fps[OF assms] by metis

definition fls_compose_fps :: "'a :: field fls \<Rightarrow> 'a fps \<Rightarrow> 'a fls" where
  "fls_compose_fps f g =
     (if f = 0 then 0
      else if fls_subdegree f \<ge> 0 then fps_to_fls (fps_compose (fls_regpart f) g)
      else fps_to_fls (fps_compose (fls_base_factor_to_fps f) g) /
             fps_to_fls g ^ nat (-fls_subdegree f))"

lemma fls_compose_fps_fps [simp]:
  "fls_compose_fps (fps_to_fls f) g = fps_to_fls (fps_compose f g)"
  by (auto simp: fls_compose_fps_def fls_subdegree_fls_to_fps)

lemma fls_const_transfer [transfer_rule]:
  "rel_fun (=) (pcr_fls (=))
     (\<lambda>c n. if n = 0 then c else 0) fls_const"
  by (auto simp: fls_const_def rel_fun_def pcr_fls_def OO_def cr_fls_def)

lemma fls_shift_transfer [transfer_rule]:
  "rel_fun (=) (rel_fun (pcr_fls (=)) (pcr_fls (=)))
     (\<lambda>n f k. f (k+n)) fls_shift"
  by (auto simp: fls_const_def rel_fun_def pcr_fls_def OO_def cr_fls_def)

lift_definition fls_compose_power :: "'a :: zero fls \<Rightarrow> nat \<Rightarrow> 'a fls" is
  "\<lambda>f d n. if d > 0 \<and> int d dvd n then f (n div int d) else 0"
proof -
  fix f :: "int \<Rightarrow> 'a" and d :: nat
  assume *: "eventually (\<lambda>n. f (-int n) = 0) cofinite"
  show "eventually (\<lambda>n. (if d > 0 \<and> int d dvd -int n then f (-int n div int d) else 0) = 0) cofinite"
  proof (cases "d = 0")
    case False
    from * have "eventually (\<lambda>n. f (-int n) = 0) at_top"
      by (simp add: cofinite_eq_sequentially)
    hence "eventually (\<lambda>n. f (-int (n div d)) = 0) at_top"
      by (rule eventually_compose_filterlim[OF _ filterlim_at_top_div_const_nat]) (use False in auto)
    hence "eventually (\<lambda>n. (if d > 0 \<and> int d dvd -int n then f (-int n div int d) else 0) = 0) at_top"
      by eventually_elim (auto simp: zdiv_int dvd_neg_div)
    thus ?thesis
      by (simp add: cofinite_eq_sequentially)
  qed auto
qed

lemma fls_nth_compose_power:
  assumes "d > 0"
  shows   "fls_nth (fls_compose_power f d) n = (if int d dvd n then fls_nth f (n div int d) else 0)"
  using assms by transfer auto

lemma fls_compose_power_0_left [simp]: "fls_compose_power 0 d = 0"
  by transfer auto

lemma fls_compose_power_1_left [simp]: "d > 0 \<Longrightarrow> fls_compose_power 1 d = 1"
  by transfer (auto simp: fun_eq_iff)

lemma fls_compose_power_const_left [simp]:
  "d > 0 \<Longrightarrow> fls_compose_power (fls_const c) d = fls_const c"
  by transfer (auto simp: fun_eq_iff)

lemma fls_compose_power_shift [simp]:
  "d > 0 \<Longrightarrow> fls_compose_power (fls_shift n f) d = fls_shift (d * n) (fls_compose_power f d)"
  by transfer (auto simp: fun_eq_iff add_ac mult_ac)

lemma fls_compose_power_X_intpow [simp]:
  "d > 0 \<Longrightarrow> fls_compose_power (fls_X_intpow n) d = fls_X_intpow (int d * n)"
  by simp

lemma fls_compose_power_X [simp]:
  "d > 0 \<Longrightarrow> fls_compose_power fls_X d = fls_X_intpow (int d)"
  by transfer (auto simp: fun_eq_iff)

lemma fls_compose_power_X_inv [simp]:
  "d > 0 \<Longrightarrow> fls_compose_power fls_X_inv d = fls_X_intpow (-int d)"
  by (simp add: fls_X_inv_conv_shift_1)

lemma fls_compose_power_0_right [simp]: "fls_compose_power f 0 = 0"
  by transfer auto

lemma fls_compose_power_add [simp]:
  "fls_compose_power (f + g) d = fls_compose_power f d + fls_compose_power g d"
  by transfer auto

lemma fls_compose_power_diff [simp]:
  "fls_compose_power (f - g) d = fls_compose_power f d - fls_compose_power g d"
  by transfer auto

lemma fls_compose_power_uminus [simp]:
  "fls_compose_power (-f) d = -fls_compose_power f d"
  by transfer auto

lemma fps_nth_compose_X_power:
  "fps_nth (f oo (fps_X ^ d)) n = (if d dvd n then fps_nth f (n div d) else 0)"
proof -
  have "fps_nth (f oo (fps_X ^ d)) n = (\<Sum>i = 0..n. f $ i * (fps_X ^ (d * i)) $ n)"
    unfolding fps_compose_def by (simp add: power_mult)
  also have "\<dots> = (\<Sum>i\<in>(if d dvd n then {n div d} else {}). f $ i * (fps_X ^ (d * i)) $ n)"
    by (intro sum.mono_neutral_right) auto
  also have "\<dots> = (if d dvd n then fps_nth f (n div d) else 0)"
    by auto
  finally show ?thesis .
qed

lemma fls_compose_power_fps_to_fls:
  assumes "d > 0"
  shows   "fls_compose_power (fps_to_fls f) d = fps_to_fls (fps_compose f (fps_X ^ d))"
  using assms
  by (intro fls_eqI) (auto simp: fls_nth_compose_power fps_nth_compose_X_power
                                 pos_imp_zdiv_neg_iff div_neg_pos_less0 nat_div_distrib
                           simp flip: int_dvd_int_iff)

lemma fls_compose_power_mult [simp]:
  "fls_compose_power (f * g :: 'a :: idom fls) d = fls_compose_power f d * fls_compose_power g d"
proof (cases "d > 0")
  case True
  define n where "n = nat (max 0 (max (- fls_subdegree f) (- fls_subdegree g)))"
  have n_ge: "-fls_subdegree f \<le> int n" "-fls_subdegree g \<le> int n"
    unfolding n_def by auto
  obtain f' where f': "f = fls_shift n (fps_to_fls f')"
    using fls_as_fps[OF n_ge(1)] by (auto simp: n_def)
  obtain g' where g': "g = fls_shift n (fps_to_fls g')"
    using fls_as_fps[OF n_ge(2)] by (auto simp: n_def)
  show ?thesis using \<open>d > 0\<close>
    by (simp add: f' g' fls_shifted_times_simps mult_ac fls_compose_power_fps_to_fls
                  fps_compose_mult_distrib flip: fls_times_fps_to_fls)
qed auto

lemma fls_compose_power_power [simp]:
  assumes "d > 0 \<or> n > 0"
  shows   "fls_compose_power (f ^ n :: 'a :: idom fls) d = fls_compose_power f d ^ n"
proof (cases "d > 0")
  case True
  thus ?thesis by (induction n) auto
qed (use assms in auto)

lemma fls_nth_compose_power' [simp]:
  "d = 0 \<or> \<not>d dvd n \<Longrightarrow> fls_nth (fls_compose_power f d) n = 0"
  "d dvd n \<Longrightarrow> d > 0 \<Longrightarrow> fls_nth (fls_compose_power f d) n = fls_nth f (n div d)"
  by (transfer; force; fail)+

end


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

(* Author: Gerwin Klein, 2012
   Maintainers: Gerwin Klein <kleing at cse.unsw.edu.au>
                Rafal Kolanski <rafal.kolanski at nicta.com.au>
*)

chapter "Standard Heaps as an Instance of Separation Algebra"

theory Sep_Heap_Instance
imports Separation_Algebra
begin

text \<open>
  Example instantiation of a the separation algebra to a map, i.e.\ a
  function from any type to @{typ "'a option"}.
\<close>

class opt =
  fixes none :: 'a
begin
  definition "domain f \<equiv> {x. f x \<noteq> none}"
end

instantiation option :: (type) opt
begin
  definition none_def [simp]: "none \<equiv> None"
  instance ..
end

instantiation "fun" :: (type, opt) zero
begin
  definition zero_fun_def: "0 \<equiv> \<lambda>s. none"
  instance ..
end

instantiation "fun" :: (type, opt) sep_algebra
begin

definition
  plus_fun_def: "m1 + m2 \<equiv> \<lambda>x. if m2 x = none then m1 x else m2 x"

definition
  sep_disj_fun_def: "sep_disj m1 m2 \<equiv> domain m1 \<inter> domain m2 = {}"

instance
  apply intro_classes
        apply (simp add: sep_disj_fun_def domain_def zero_fun_def)
       apply (fastforce simp: sep_disj_fun_def)
      apply (simp add: plus_fun_def zero_fun_def)
     apply (simp add: plus_fun_def sep_disj_fun_def domain_def)
     apply (rule ext)
     apply fastforce
    apply (rule ext)
    apply (simp add: plus_fun_def)
   apply (simp add: sep_disj_fun_def domain_def plus_fun_def)
   apply fastforce
  apply (simp add: sep_disj_fun_def domain_def plus_fun_def)
  apply fastforce
  done

end

text \<open>
  For the actual option type @{const domain} and @{text "+"} are
  just @{const dom} and @{text "++"}:
\<close>

lemma domain_conv: "domain = dom"
  by (rule ext) (simp add: domain_def dom_def)

lemma plus_fun_conv: "a + b = a ++ b"
  by (auto simp: plus_fun_def map_add_def split: option.splits)

lemmas map_convs = domain_conv plus_fun_conv

text \<open>
  Any map can now act as a separation heap without further work:
\<close>
lemma
  fixes h :: "(nat => nat) => 'foo option"
  shows "(P ** Q ** H) h = (Q ** H ** P) h"
  by (simp add: sep_conj_ac)

section \<open>@{typ unit} Instantiation\<close>

text \<open>
  The @{typ unit} type also forms a separation algebra. Although
  typically not useful as a state space by itself, it may be
  a type parameter to more complex state space.
\<close>

instantiation "unit" :: stronger_sep_algebra
begin
  definition "plus_unit (a :: unit) (b :: unit) \<equiv> ()"
  definition "sep_disj_unit  (a :: unit) (b :: unit) \<equiv> True"
  instance
    apply intro_classes
    apply (simp add: plus_unit_def sep_disj_unit_def)+
    done
end

lemma unit_disj_sep_unit [simp]: "(a :: unit) ## b"
  by (clarsimp simp: sep_disj_unit_def)

lemma unit_plus_unit [simp]: "(a :: unit) + b = ()"
  by (rule unit_eq)

section \<open>@{typ "'a option"} Instantiation\<close>

text \<open>
  The @{typ "'a option"} is a seperation algebra, with @{term None}
  indicating emptyness.
\<close>

instantiation option :: (type) stronger_sep_algebra
begin
  definition
    "zero_option \<equiv> None"
  definition
    "plus_option (a :: 'a option) (b :: 'a option) \<equiv> (case b of None \<Rightarrow> a | Some x \<Rightarrow> b)"
  definition
    "sep_disj_option  (a :: 'a option) (b :: 'a option) \<equiv> a = None \<or> b = None"

  instance
    by intro_classes
       (auto simp: zero_option_def sep_disj_option_def plus_option_def split: option.splits)
end

lemma disj_sep_None [simp]:
  "a ## None"
  "None ## a"
  by (auto simp: sep_disj_option_def)

lemma disj_sep_Some_Some [simp]:
  "\<not> (Some a ## Some b)"
  by (auto simp: sep_disj_option_def)

lemma None_plus [simp]:
  "a + None = a"
  "None + a = a"
  by (auto simp: plus_option_def split: option.splits)

lemma None_plus_distrib:
  "(a :: 'a option) + (b + c) = (a + b) + c"
  by (clarsimp simp: plus_option_def split: option.splits)

end


(*  Title:      FOLP/ex/Foundation.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1991  University of Cambridge
*)

section "Intuitionistic FOL: Examples from The Foundation of a Generic Theorem Prover"

theory Foundation
imports IFOLP
begin

schematic_lemma "?p : A&B  --> (C-->A&C)"
apply (rule impI)
apply (rule impI)
apply (rule conjI)
prefer 2 apply assumption
apply (rule conjunct1)
apply assumption
done

text {*A form of conj-elimination*}
schematic_lemma
  assumes "p : A & B"
    and "!!x y. x : A ==> y : B ==> f(x, y) : C"
  shows "?p : C"
apply (rule assms)
apply (rule conjunct1)
apply (rule assms)
apply (rule conjunct2)
apply (rule assms)
done

schematic_lemma
  assumes "!!A x. x : ~ ~A ==> cla(x) : A"
  shows "?p : B | ~B"
apply (rule assms)
apply (rule notI)
apply (rule_tac P = "~B" in notE)
apply (rule_tac [2] notI)
apply (rule_tac [2] P = "B | ~B" in notE)
prefer 2 apply assumption
apply (rule_tac [2] disjI1)
prefer 2 apply assumption
apply (rule notI)
apply (rule_tac P = "B | ~B" in notE)
apply assumption
apply (rule disjI2)
apply assumption
done

schematic_lemma
  assumes "!!A x. x : ~ ~A ==> cla(x) : A"
  shows "?p : B | ~B"
apply (rule assms)
apply (rule notI)
apply (rule notE)
apply (rule_tac [2] notI)
apply (erule_tac [2] notE)
apply (erule_tac [2] disjI1)
apply (rule notI)
apply (erule notE)
apply (erule disjI2)
done

schematic_lemma
  assumes "p : A | ~A"
    and "q : ~ ~A"
  shows "?p : A"
apply (rule disjE)
apply (rule assms)
apply assumption
apply (rule FalseE)
apply (rule_tac P = "~A" in notE)
apply (rule assms)
apply assumption
done

subsection "Examples with quantifiers"

schematic_lemma
  assumes "p : ALL z. G(z)"
  shows "?p : ALL z. G(z)|H(z)"
apply (rule allI)
apply (rule disjI1)
apply (rule assms [THEN spec])
done

schematic_lemma "?p : ALL x. EX y. x=y"
apply (rule allI)
apply (rule exI)
apply (rule refl)
done

schematic_lemma "?p : EX y. ALL x. x=y"
apply (rule exI)
apply (rule allI)
apply (rule refl)?
oops

text {* Parallel lifting example. *}
schematic_lemma "?p : EX u. ALL x. EX v. ALL y. EX w. P(u,x,v,y,w)"
apply (rule exI allI)
apply (rule exI allI)
apply (rule exI allI)
apply (rule exI allI)
apply (rule exI allI)
oops

schematic_lemma
  assumes "p : (EX z. F(z)) & B"
  shows "?p : EX z. F(z) & B"
apply (rule conjE)
apply (rule assms)
apply (rule exE)
apply assumption
apply (rule exI)
apply (rule conjI)
apply assumption
apply assumption
done

text {* A bigger demonstration of quantifiers -- not in the paper. *}
schematic_lemma "?p : (EX y. ALL x. Q(x,y)) -->  (ALL x. EX y. Q(x,y))"
apply (rule impI)
apply (rule allI)
apply (rule exE, assumption)
apply (rule exI)
apply (rule allE, assumption)
apply assumption
done

end


theory IBDD_basic
  imports Main
begin

datatype 'b PreBDD = Nothing | Top | Select nat 'b 'b

datatype BDD = BDD "BDD PreBDD"

inductive contains :: "BDD \<Rightarrow> nat set \<Rightarrow> bool" where
  contains_top [simp, intro]: "contains Top f" |
  contains_sel_t: "v \<in> f \<Longrightarrow> contains t f \<Longrightarrow> contains (Select v t e) f" |
  contains_sel_e: "v \<notin> f \<Longrightarrow> contains e f \<Longrightarrow> contains (Select v t e) f"

fun contains_p :: "BDD \<Rightarrow> nat set \<Rightarrow> bool" where
  "contains_p Top _ = True" |
  "contains_p Nothing _ = False" |
  "contains_p (Select v t e) f = (if v \<in> f then contains_p t f else contains_p e f)"

theorem contains_p_correct: "contains a f = contains_p a f"
  apply (rule iffI)
  apply (induction rule: contains.induct)
  apply auto
  apply (induction a f rule: contains_p.induct)
  apply auto
  by (metis contains.simps)

lemma not_contains_nothing [simp]: "contains Nothing f = False"
  by (simp add: contains_p_correct)

lemma contains_sel: "(if v \<in> f then contains t f else contains e f) \<Longrightarrow> contains (Select v t e) f"
  by (metis contains.simps)

inductive ordered :: "nat \<Rightarrow> BDD \<Rightarrow> bool" where
  ordered_top [simp, intro]: "ordered n Top" |
  ordered_nothing [simp, intro]: "ordered n Nothing" |
  ordered_sel [simp, intro]: "n > v \<Longrightarrow> ordered v t \<Longrightarrow> ordered v e \<Longrightarrow> ordered n (Select v t e)"

theorem ordered_widen [simp]: "ordered m a \<Longrightarrow> m < n \<Longrightarrow> ordered n a"
  apply (induction a rule: ordered.induct)
  by auto

inductive rooted :: "nat \<Rightarrow> BDD \<Rightarrow> bool" where
  rooted_top [simp, intro]: "rooted 0 Top" |
  rooted_nothing [simp, intro]: "rooted 0 Nothing" |
  rooted_sel [simp, intro]: "n \<ge> tn \<Longrightarrow> n \<ge> en \<Longrightarrow> rooted tn t \<Longrightarrow> rooted en e \<Longrightarrow> rooted (Suc n) (Select n t e)"

lemma rooted_is_ordered: "rooted n b \<Longrightarrow> ordered n b"
  apply (induction rule: rooted.induct)
  apply auto
  apply (rule ordered_sel)
  apply auto
  apply (metis le_less ordered_widen)
  apply (metis le_less ordered_widen)
  done

lemma ordered_is_rooted: "ordered n b \<Longrightarrow> \<exists>m. rooted m b"
  apply (induction rule: ordered.induct)
  apply auto
  apply (rule exI)
  apply (rule rooted_sel)
  apply auto
  apply (smt (verit, best) BDD.distinct(3) BDD.distinct(5) BDD.inject Suc_leI leI not_less0 ordered.cases rooted.cases)
  apply (smt (verit, best) BDD.distinct(3) BDD.distinct(5) BDD.inject Suc_leI leI not_less0 ordered.cases rooted.cases)
  done

inductive norm :: "nat \<Rightarrow> BDD \<Rightarrow> bool" where
  norm_top [simp, intro]: "norm n Top" |
  norm_nothing [simp, intro]: "norm n Nothing" |
  norm_sel [simp, intro]: "n > v \<Longrightarrow> t \<noteq> e \<Longrightarrow> norm v t \<Longrightarrow> norm v e \<Longrightarrow> norm n (Select v t e)"

lemma norm_ord: "norm n a \<Longrightarrow> ordered n a"
  apply (induction rule: norm.induct)
  by auto

inductive rnorm :: "nat \<Rightarrow> BDD \<Rightarrow> bool" where
  rnorm_top [simp, intro]: "rnorm 0 Top" |
  rnorm_nothing [simp, intro]: "rnorm 0 Nothing" |
  rnorm_sel [simp, intro]: "n \<ge> tn \<Longrightarrow> n \<ge> en \<Longrightarrow> t \<noteq> e \<Longrightarrow> rnorm tn t \<Longrightarrow> rnorm en e \<Longrightarrow> rnorm (Suc n) (Select n t e)"

lemma rnorm_rooted: "rnorm n a \<Longrightarrow> rooted n a"
  apply (induction rule: rnorm.induct)
  by auto

typedef IBDD = "{b | b n. rnorm n b }"
  by auto

theorem norm_widen [simp]: "norm m a \<Longrightarrow> m < n \<Longrightarrow> norm n a"
  apply (induction a rule: norm.induct)
  by auto

abbreviation replace :: "'a set \<Rightarrow> 'a \<Rightarrow> bool \<Rightarrow> 'a set" where
  "replace f i v \<equiv> (if v then {i} \<union> f else f - {i})"

lemma ordered_contains_ignore_pre_l: "contains t f' \<Longrightarrow> ordered a t \<Longrightarrow> f' = replace f a x \<Longrightarrow> contains t f"
  apply (induction rule: contains.induct)
  apply simp
  apply (metis BDD.distinct(3) BDD.distinct(5) BDD.inject Diff_iff UnE contains_sel dual_order.strict_implies_not_eq ordered.cases ordered_widen singleton_iff)
  apply (metis BDD.distinct(4) BDD.inject DiffI UnI2 contains.simps less_irrefl ordered.simps ordered_widen singletonD)
  done

lemma ordered_contains_ignore_l: "ordered a t \<Longrightarrow> contains t (replace f a x) \<Longrightarrow> contains t f"
  by (simp add: ordered_contains_ignore_pre_l)

lemma ordered_contains_ignore_r: "contains t f \<Longrightarrow> ordered a t \<Longrightarrow> contains t (replace f a x)"
  apply (induction rule: contains.induct)
  apply simp
  apply (smt (z3) Diff_empty Diff_insert0 contains_sel_t insertI1 insert_Diff insert_Diff1 insert_is_Un ordered_contains_ignore_l)
  apply (smt (z3) Diff_empty Diff_insert0 contains_sel_e insertI1 insert_Diff insert_Diff1 insert_is_Un ordered_contains_ignore_l)
  done

lemma ordered_contains_ignore: "ordered a t \<Longrightarrow> contains t (replace f a x) = contains t f"
  using ordered_contains_ignore_l ordered_contains_ignore_r by blast

lemma ordered_contains_ignore_t [simp]: "ordered a t \<Longrightarrow> contains t ({a} \<union> f) = contains t f"
  apply (insert ordered_contains_ignore[of a t True f])
  apply simp
  done

lemma contains_all_select_t0: "contains s f \<Longrightarrow> s = Select a t e \<Longrightarrow> ordered a t \<Longrightarrow> (\<forall>f. contains s f) \<Longrightarrow> contains t f"
  apply (induction rule: contains.induct)
  apply auto
  apply (rule ordered_contains_ignore_l[where ?x = True and ?a = a])
  apply blast
  by (metis contains_p.simps(3) contains_p_correct insertI1 insert_is_Un)

lemma contains_all_select_t: "ordered a t \<Longrightarrow> (\<forall>f. contains (Select a t e) f) \<Longrightarrow> contains t f"
  using contains_all_select_t0 by blast

lemma contains_all_select_e0: "contains s f \<Longrightarrow> s = Select a t e \<Longrightarrow> ordered a e \<Longrightarrow> (\<forall>f. contains s f) \<Longrightarrow> contains e f"
  apply (induction rule: contains.induct)
  apply auto
  apply (rule ordered_contains_ignore_l[where ?x = False and ?a = a])
  apply auto
  by (metis Diff_iff contains_p.simps(3) contains_p_correct insertI1)

lemma contains_all_select_e: "ordered a e \<Longrightarrow> (\<forall>f. contains (Select a t e) f) \<Longrightarrow> contains e f"
  using contains_all_select_e0 by blast

lemma contains_all_select: "ordered a t \<Longrightarrow> ordered a e \<Longrightarrow> (\<forall>f. contains (Select a t e) f) \<Longrightarrow> contains t f \<and> contains e f"
  by (auto simp add: contains_all_select_e contains_all_select_t)

lemma norm_top: "norm n b \<Longrightarrow> (\<forall>f. contains b f) \<Longrightarrow> b = Top"
  apply (induction rule: norm.induct)
  apply (rule refl)
  using contains.simps apply blast
  by (metis contains_all_select norm_ord)

lemma select_var_eq0:
  "ordered va t \<Longrightarrow> ordered va e \<Longrightarrow>
   ordered vb t \<Longrightarrow> ordered vb e \<Longrightarrow>
   a = Select va t e \<Longrightarrow> b = Select vb t e \<Longrightarrow>
   f' = replace (replace f va True) vb False \<Longrightarrow>
   contains t f' \<noteq> contains e f' \<Longrightarrow>
   contains a f' = contains b f' \<Longrightarrow>
   va = vb"
  by (metis Un_insert_left contains_p.simps(3) contains_p_correct insert_iff member_remove remove_def)

lemma select_var_eq:
  "ordered va t \<Longrightarrow> ordered va e \<Longrightarrow>
   ordered vb t \<Longrightarrow> ordered vb e \<Longrightarrow>
   contains t (replace (replace f va True) vb False) \<noteq> contains e (replace (replace f va True) vb False) \<Longrightarrow>
   contains (Select va t e) (replace (replace f va True) vb False) = contains (Select vb t e) (replace (replace f va True) vb False) \<Longrightarrow>
   va = vb"
  apply (rule select_var_eq0[
        where ?a = "Select va t e" and ?b = "Select vb t e"])
  by auto

lemma double_replace_exclusion:
   "ordered va t \<Longrightarrow>
    ordered va e \<Longrightarrow>
    ordered vb t \<Longrightarrow>
    ordered vb e \<Longrightarrow>
    contains t f \<noteq> contains e f \<Longrightarrow>
    contains t (replace (replace f va x) vb y) \<noteq>
    contains e (replace (replace f va x) vb y)"
  apply (subst ordered_contains_ignore[where ?a = vb])
  apply assumption
  apply (subst ordered_contains_ignore[where ?a = vb])
  apply assumption
  apply (subst ordered_contains_ignore[where ?a = va])
  apply assumption
  apply (subst ordered_contains_ignore[where ?a = va])
  by assumption

lemma select_var_eq_gen:
  "ordered va t \<Longrightarrow> ordered va e \<Longrightarrow>
   ordered vb t \<Longrightarrow> ordered vb e \<Longrightarrow>
   contains t f \<noteq> contains e f \<Longrightarrow>
   contains (Select va t e) (replace (replace f va True) vb False) = contains (Select vb t e) (replace (replace f va True) vb False) \<Longrightarrow>
   va = vb"
  apply (rule select_var_eq[where ?f = f and ?e = e])
  apply assumption
  apply assumption
  apply assumption
  apply assumption
  defer
  apply assumption
  apply (rule double_replace_exclusion)
  by auto

lemma select_var_match0:
  "a = Select va ta ea \<Longrightarrow> b = Select vb tb eb \<Longrightarrow>
   ordered n a \<Longrightarrow> ordered m b \<Longrightarrow>
   ta = tb \<Longrightarrow>
   ea = eb \<Longrightarrow>
   contains ta f \<noteq> contains ea f \<Longrightarrow>
   (\<forall>f. contains a f = contains b f) \<Longrightarrow>
   Select va ta ea = Select vb tb eb"
  apply simp
  apply (rule select_var_eq[where ?t = tb and ?e = eb and ?f = f])
  prefer 5
  apply (rule double_replace_exclusion)
  apply (metis BDD.distinct(6) BDD.inject BDD.simps(5) ordered.cases)
  apply (metis BDD.distinct(6) BDD.inject BDD.simps(5) ordered.cases)
  apply (metis BDD.distinct(6) BDD.inject BDD.simps(5) ordered.cases)
  apply (metis BDD.distinct(6) BDD.inject BDD.simps(5) ordered.cases)
  defer
  apply (metis BDD.distinct(6) BDD.inject BDD.simps(5) ordered.cases)
  apply (metis BDD.distinct(6) BDD.inject BDD.simps(5) ordered.cases)
  apply (metis BDD.distinct(6) BDD.inject BDD.simps(5) ordered.cases)
  apply (metis BDD.distinct(6) BDD.inject BDD.simps(5) ordered.cases)
  apply auto
  done

lemma select_var_match:
  "ordered n (Select va ta ea) \<Longrightarrow> ordered m (Select vb tb eb) \<Longrightarrow>
   contains ta f \<noteq> contains ea f \<Longrightarrow>
   (\<forall>f. contains (Select va ta ea) f = contains (Select vb tb eb) f) \<Longrightarrow>
   ta = tb \<Longrightarrow>
   ea = eb \<Longrightarrow>
   Select va ta ea = Select vb tb eb"
  apply (rule select_var_match0)
  apply (rule refl)
  apply (rule refl)
  by simp_all

end