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

section{*Renaming of State Sets*}

theory Rename imports Extend begin

definition rename :: "['a => 'b, 'a program] => 'b program" where
    "rename h == extend (%(x,u::unit). h x)"

declare image_inv_f_f [simp] image_surj_f_inv_f [simp]

declare Extend.intro [simp,intro]

lemma good_map_bij [simp,intro]: "bij h ==> good_map (%(x,u). h x)"
apply (rule good_mapI)
apply (unfold bij_def inj_on_def surj_def, auto)
done

lemma fst_o_inv_eq_inv: "bij h ==> fst (inv (%(x,u). h x) s) = inv h s"
apply (unfold bij_def split_def, clarify)
apply (subgoal_tac "surj (%p. h (fst p))")
 prefer 2 apply (simp add: surj_def)
apply (erule injD)
apply (simp (no_asm_simp) add: surj_f_inv_f)
apply (erule surj_f_inv_f)
done

lemma mem_rename_set_iff: "bij h ==> z \<in> h`A = (inv h z \<in> A)"
by (force simp add: bij_is_inj bij_is_surj [THEN surj_f_inv_f])

lemma extend_set_eq_image [simp]: "extend_set (%(x,u). h x) A = h`A"
by (force simp add: extend_set_def)

lemma Init_rename [simp]: "Init (rename h F) = h`(Init F)"
by (simp add: rename_def)

subsection{*inverse properties*}

lemma extend_set_inv:
     "bij h
      ==> extend_set (%(x,u::'c). inv h x) = project_set (%(x,u::'c). h x)"
apply (unfold bij_def)
apply (rule ext)
apply (force simp add: extend_set_def project_set_def surj_f_inv_f)
done

(** for "rename" (programs) **)

lemma bij_extend_act_eq_project_act: "bij h
      ==> extend_act (%(x,u::'c). h x) = project_act (%(x,u::'c). inv h x)"
apply (rule ext)
apply (force simp add: extend_act_def project_act_def bij_def surj_f_inv_f)
done

lemma bij_extend_act: "bij h ==> bij (extend_act (%(x,u::'c). h x))"
apply (rule bijI)
apply (rule Extend.inj_extend_act)
apply simp
apply (simp add: bij_extend_act_eq_project_act)
apply (rule surjI)
apply (rule Extend.extend_act_inverse)
apply (blast intro: bij_imp_bij_inv)
done

lemma bij_project_act: "bij h ==> bij (project_act (%(x,u::'c). h x))"
apply (frule bij_imp_bij_inv [THEN bij_extend_act])
apply (simp add: bij_extend_act_eq_project_act bij_imp_bij_inv inv_inv_eq)
done

lemma bij_inv_project_act_eq: "bij h ==> inv (project_act (%(x,u::'c). inv h x)) =
                project_act (%(x,u::'c). h x)"
apply (simp (no_asm_simp) add: bij_extend_act_eq_project_act [symmetric])
apply (rule surj_imp_inv_eq)
apply (blast intro!: bij_extend_act bij_is_surj)
apply (simp (no_asm_simp) add: Extend.extend_act_inverse)
done

lemma extend_inv: "bij h
      ==> extend (%(x,u::'c). inv h x) = project (%(x,u::'c). h x) UNIV"
apply (frule bij_imp_bij_inv)
apply (rule ext)
apply (rule program_equalityI)
  apply (simp (no_asm_simp) add: extend_set_inv)
 apply (simp add: Extend.project_act_Id Extend.Acts_extend
          insert_Id_image_Acts bij_extend_act_eq_project_act inv_inv_eq)
apply (simp add: Extend.AllowedActs_extend Extend.AllowedActs_project
             bij_project_act bij_vimage_eq_inv_image bij_inv_project_act_eq)
done

lemma rename_inv_rename [simp]: "bij h ==> rename (inv h) (rename h F) = F"
by (simp add: rename_def extend_inv Extend.extend_inverse)

lemma rename_rename_inv [simp]: "bij h ==> rename h (rename (inv h) F) = F"
apply (frule bij_imp_bij_inv)
apply (erule inv_inv_eq [THEN subst], erule rename_inv_rename)
done

lemma rename_inv_eq: "bij h ==> rename (inv h) = inv (rename h)"
by (rule inv_equality [symmetric], auto)

(** (rename h) is bijective <=> h is bijective **)

lemma bij_extend: "bij h ==> bij (extend (%(x,u::'c). h x))"
apply (rule bijI)
apply (blast intro: Extend.inj_extend)
apply (rule_tac f = "extend (% (x,u) . inv h x)" in surjI)
apply (subst (1 2) inv_inv_eq [of h, symmetric], assumption+)
apply (simp add: bij_imp_bij_inv extend_inv [of "inv h"])
apply (simp add: inv_inv_eq)
apply (rule Extend.extend_inverse)
apply (simp add: bij_imp_bij_inv)
done

lemma bij_project: "bij h ==> bij (project (%(x,u::'c). h x) UNIV)"
apply (subst extend_inv [symmetric])
apply (auto simp add: bij_imp_bij_inv bij_extend)
done

lemma inv_project_eq:
     "bij h
      ==> inv (project (%(x,u::'c). h x) UNIV) = extend (%(x,u::'c). h x)"
apply (rule inj_imp_inv_eq)
apply (erule bij_project [THEN bij_is_inj])
apply (simp (no_asm_simp) add: Extend.extend_inverse)
done

lemma Allowed_rename [simp]:
     "bij h ==> Allowed (rename h F) = rename h ` Allowed F"
apply (simp (no_asm_simp) add: rename_def Extend.Allowed_extend)
apply (subst bij_vimage_eq_inv_image)
apply (rule bij_project, blast)
apply (simp (no_asm_simp) add: inv_project_eq)
done

lemma bij_rename: "bij h ==> bij (rename h)"
apply (simp (no_asm_simp) add: rename_def bij_extend)
done
lemmas surj_rename = bij_rename [THEN bij_is_surj]

lemma inj_rename_imp_inj: "inj (rename h) ==> inj h"
apply (unfold inj_on_def, auto)
apply (drule_tac x = "mk_program ({x}, {}, {})" in spec)
apply (drule_tac x = "mk_program ({y}, {}, {})" in spec)
apply (auto simp add: program_equality_iff rename_def extend_def)
done

lemma surj_rename_imp_surj: "surj (rename h) ==> surj h"
apply (unfold surj_def, auto)
apply (drule_tac x = "mk_program ({y}, {}, {})" in spec)
apply (auto simp add: program_equality_iff rename_def extend_def)
done

lemma bij_rename_imp_bij: "bij (rename h) ==> bij h"
apply (unfold bij_def)
apply (simp (no_asm_simp) add: inj_rename_imp_inj surj_rename_imp_surj)
done

lemma bij_rename_iff [simp]: "bij (rename h) = bij h"
by (blast intro: bij_rename bij_rename_imp_bij)

subsection{*the lattice operations*}

lemma rename_SKIP [simp]: "bij h ==> rename h SKIP = SKIP"
by (simp add: rename_def Extend.extend_SKIP)

lemma rename_Join [simp]:
     "bij h ==> rename h (F Join G) = rename h F Join rename h G"
by (simp add: rename_def Extend.extend_Join)

lemma rename_JN [simp]:
     "bij h ==> rename h (JOIN I F) = (\<Squnion>i \<in> I. rename h (F i))"
by (simp add: rename_def Extend.extend_JN)

subsection{*Strong Safety: co, stable*}

lemma rename_constrains:
     "bij h ==> (rename h F \<in> (h`A) co (h`B)) = (F \<in> A co B)"
apply (unfold rename_def)
apply (subst extend_set_eq_image [symmetric])+
apply (erule good_map_bij [THEN Extend.intro, THEN Extend.extend_constrains])
done

lemma rename_stable:
     "bij h ==> (rename h F \<in> stable (h`A)) = (F \<in> stable A)"
apply (simp add: stable_def rename_constrains)
done

lemma rename_invariant:
     "bij h ==> (rename h F \<in> invariant (h`A)) = (F \<in> invariant A)"
apply (simp add: invariant_def rename_stable bij_is_inj [THEN inj_image_subset_iff])
done

lemma rename_increasing:
     "bij h ==> (rename h F \<in> increasing func) = (F \<in> increasing (func o h))"
apply (simp add: increasing_def rename_stable [symmetric] bij_image_Collect_eq bij_is_surj [THEN surj_f_inv_f])
done

subsection{*Weak Safety: Co, Stable*}

lemma reachable_rename_eq:
     "bij h ==> reachable (rename h F) = h ` (reachable F)"
apply (simp add: rename_def Extend.reachable_extend_eq)
done

lemma rename_Constrains:
     "bij h ==> (rename h F \<in> (h`A) Co (h`B)) = (F \<in> A Co B)"
by (simp add: Constrains_def reachable_rename_eq rename_constrains
               bij_is_inj image_Int [symmetric])

lemma rename_Stable:
     "bij h ==> (rename h F \<in> Stable (h`A)) = (F \<in> Stable A)"
by (simp add: Stable_def rename_Constrains)

lemma rename_Always: "bij h ==> (rename h F \<in> Always (h`A)) = (F \<in> Always A)"
by (simp add: Always_def rename_Stable bij_is_inj [THEN inj_image_subset_iff])

lemma rename_Increasing:
     "bij h ==> (rename h F \<in> Increasing func) = (F \<in> Increasing (func o h))"
by (simp add: Increasing_def rename_Stable [symmetric] bij_image_Collect_eq
              bij_is_surj [THEN surj_f_inv_f])

subsection{*Progress: transient, ensures*}

lemma rename_transient:
     "bij h ==> (rename h F \<in> transient (h`A)) = (F \<in> transient A)"
apply (unfold rename_def)
apply (subst extend_set_eq_image [symmetric])
apply (erule good_map_bij [THEN Extend.intro, THEN Extend.extend_transient])
done

lemma rename_ensures:
     "bij h ==> (rename h F \<in> (h`A) ensures (h`B)) = (F \<in> A ensures B)"
apply (unfold rename_def)
apply (subst extend_set_eq_image [symmetric])+
apply (erule good_map_bij [THEN Extend.intro, THEN Extend.extend_ensures])
done

lemma rename_leadsTo:
     "bij h ==> (rename h F \<in> (h`A) leadsTo (h`B)) = (F \<in> A leadsTo B)"
apply (unfold rename_def)
apply (subst extend_set_eq_image [symmetric])+
apply (erule good_map_bij [THEN Extend.intro, THEN Extend.extend_leadsTo])
done

lemma rename_LeadsTo:
     "bij h ==> (rename h F \<in> (h`A) LeadsTo (h`B)) = (F \<in> A LeadsTo B)"
apply (unfold rename_def)
apply (subst extend_set_eq_image [symmetric])+
apply (erule good_map_bij [THEN Extend.intro, THEN Extend.extend_LeadsTo])
done

lemma rename_rename_guarantees_eq:
     "bij h ==> (rename h F \<in> (rename h ` X) guarantees
                              (rename h ` Y)) =
                (F \<in> X guarantees Y)"
apply (unfold rename_def)
apply (subst good_map_bij [THEN Extend.intro, THEN Extend.extend_guarantees_eq [symmetric]], assumption)
apply (simp (no_asm_simp) add: fst_o_inv_eq_inv o_def)
done

lemma rename_guarantees_eq_rename_inv:
     "bij h ==> (rename h F \<in> X guarantees Y) =
                (F \<in> (rename (inv h) ` X) guarantees
                     (rename (inv h) ` Y))"
apply (subst rename_rename_guarantees_eq [symmetric], assumption)
apply (simp add: image_eq_UN o_def bij_is_surj [THEN surj_f_inv_f])
done

lemma rename_preserves:
     "bij h ==> (rename h G \<in> preserves v) = (G \<in> preserves (v o h))"
apply (subst good_map_bij [THEN Extend.intro, THEN Extend.extend_preserves [symmetric]], assumption)
apply (simp add: o_def fst_o_inv_eq_inv rename_def bij_is_surj [THEN surj_f_inv_f])
done

lemma ok_rename_iff [simp]: "bij h ==> (rename h F ok rename h G) = (F ok G)"
by (simp add: Extend.ok_extend_iff rename_def)

lemma OK_rename_iff [simp]: "bij h ==> OK I (%i. rename h (F i)) = (OK I F)"
by (simp add: Extend.OK_extend_iff rename_def)

subsection{*"image" versions of the rules, for lifting "guarantees" properties*}

(*All the proofs are similar.  Better would have been to prove one
  meta-theorem, but how can we handle the polymorphism?  E.g. in
  rename_constrains the two appearances of "co" have different types!*)
lemmas bij_eq_rename = surj_rename [THEN surj_f_inv_f, symmetric]

lemma rename_image_constrains:
     "bij h ==> rename h ` (A co B) = (h ` A) co (h`B)"
apply auto
 defer 1
 apply (rename_tac F)
 apply (subgoal_tac "\<exists>G. F = rename h G")
 apply (auto intro!: bij_eq_rename simp add: rename_constrains)
done

lemma rename_image_stable: "bij h ==> rename h ` stable A = stable (h ` A)"
apply auto
 defer 1
 apply (rename_tac F)
 apply (subgoal_tac "\<exists>G. F = rename h G")
 apply (auto intro!: bij_eq_rename simp add: rename_stable)
done

lemma rename_image_increasing:
     "bij h ==> rename h ` increasing func = increasing (func o inv h)"
apply auto
 defer 1
 apply (rename_tac F)
 apply (subgoal_tac "\<exists>G. F = rename h G")
 apply (auto intro!: bij_eq_rename simp add: rename_increasing o_def bij_is_inj)
done

lemma rename_image_invariant:
     "bij h ==> rename h ` invariant A = invariant (h ` A)"
apply auto
 defer 1
 apply (rename_tac F)
 apply (subgoal_tac "\<exists>G. F = rename h G")
 apply (auto intro!: bij_eq_rename simp add: rename_invariant)
done

lemma rename_image_Constrains:
     "bij h ==> rename h ` (A Co B) = (h ` A) Co (h`B)"
apply auto
 defer 1
 apply (rename_tac F)
 apply (subgoal_tac "\<exists>G. F = rename h G")
 apply (auto intro!: bij_eq_rename simp add: rename_Constrains)
done

lemma rename_image_preserves:
     "bij h ==> rename h ` preserves v = preserves (v o inv h)"
by (simp add: o_def rename_image_stable preserves_def bij_image_INT
              bij_image_Collect_eq)

lemma rename_image_Stable:
     "bij h ==> rename h ` Stable A = Stable (h ` A)"
apply auto
 defer 1
 apply (rename_tac F)
 apply (subgoal_tac "\<exists>G. F = rename h G")
 apply (auto intro!: bij_eq_rename simp add: rename_Stable)
done

lemma rename_image_Increasing:
     "bij h ==> rename h ` Increasing func = Increasing (func o inv h)"
apply auto
 defer 1
 apply (rename_tac F)
 apply (subgoal_tac "\<exists>G. F = rename h G")
 apply (auto intro!: bij_eq_rename simp add: rename_Increasing o_def bij_is_inj)
done

lemma rename_image_Always: "bij h ==> rename h ` Always A = Always (h ` A)"
apply auto
 defer 1
 apply (rename_tac F)
 apply (subgoal_tac "\<exists>G. F = rename h G")
 apply (auto intro!: bij_eq_rename simp add: rename_Always)
done

lemma rename_image_leadsTo:
     "bij h ==> rename h ` (A leadsTo B) = (h ` A) leadsTo (h`B)"
apply auto
 defer 1
 apply (rename_tac F)
 apply (subgoal_tac "\<exists>G. F = rename h G")
 apply (auto intro!: bij_eq_rename simp add: rename_leadsTo)
done

lemma rename_image_LeadsTo:
     "bij h ==> rename h ` (A LeadsTo B) = (h ` A) LeadsTo (h`B)"
apply auto
 defer 1
 apply (rename_tac F)
 apply (subgoal_tac "\<exists>G. F = rename h G")
 apply (auto intro!: bij_eq_rename simp add: rename_LeadsTo)
done

end


theory LazyPrelude_Either
imports "$HETS_LIB/Isabelle/MainHCPairs"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"NotFalse\", \"NotTrue\", \"AndFalse\", \"AndTrue\", \"AndSym\",
     \"OrDef\", \"OtherwiseDef\", \"NotFalse1\", \"NotTrue1\",
     \"notNot1\", \"notNot2\", \"EqualTDef\", \"EqualSymDef\",
     \"EqualReflex\", \"EqualTransT\", \"DiffDef\", \"DiffSymDef\",
     \"DiffTDef\", \"DiffFDef\", \"TE1\", \"TE2\", \"TE3\", \"TE4\",
     \"IUE1\", \"IUE2\", \"IBE1\", \"IBE2\", \"IBE3\", \"IBE4\",
     \"IBE5\", \"IBE6\", \"IBE7\", \"IBE8\", \"IOE01\", \"IOE02\",
     \"IOE03\", \"IOE04\", \"IOE05\", \"IOE06\", \"IOE07\", \"IOE08\",
     \"IOE09\", \"LeIrreflexivity\", \"LeTAsymmetry\",
     \"LeTTransitive\", \"LeTTotal\", \"GeDef\", \"GeIrreflexivity\",
     \"GeTAsymmetry\", \"GeTTransitive\", \"GeTTotal\", \"LeqDef\",
     \"LeqReflexivity\", \"LeqTTransitive\", \"LeqTTotal\", \"GeqDef\",
     \"GeqReflexivity\", \"GeqTTransitive\", \"GeqTTotal\",
     \"EqTSOrdRel\", \"EqFSOrdRel\", \"EqTOrdRel\", \"EqFOrdRel\",
     \"EqTOrdTSubstE\", \"EqTOrdFSubstE\", \"EqTOrdTSubstD\",
     \"EqTOrdFSubstD\", \"LeTGeFEqFRel\", \"LeFGeTEqTRel\",
     \"LeTGeTRel\", \"LeFGeFRel\", \"LeqTGetTRel\", \"LeqFGetFRel\",
     \"GeTLeTRel\", \"GeFLeFRel\", \"GeqTLeqTRel\", \"GeqFLeqFRel\",
     \"LeqTGeFRel\", \"LeqFGeTRel\", \"GeTLeFEqFRel\", \"GeFLeTEqTRel\",
     \"GeqTLeFRel\", \"GeqFLeTRel\", \"LeqTLeTEqTRel\",
     \"LeqFLeFEqFRel\", \"GeqTGeTEqTRel\", \"GeqFGeFEqFRel\",
     \"LeTGeqFRel\", \"GeTLeqFRel\", \"LeLeqDiff\", \"CmpLTDef\",
     \"CmpEQDef\", \"CmpGTDef\", \"MaxYDef\", \"MaxXDef\", \"MinXDef\",
     \"MinYDef\", \"MaxSym\", \"MinSym\", \"TO1\", \"TO2\", \"TO3\",
     \"TO4\", \"TO5\", \"TO6\", \"TO7\", \"IUO01\", \"IUO02\",
     \"IUO03\", \"IUO04\", \"IUO05\", \"IUO06\", \"IUO07\", \"IOO13\",
     \"IOO14\", \"IOO15\", \"IOO16\", \"IOO17\", \"IOO18\", \"IOO19\",
     \"IOO20\", \"IOO21\", \"IOO22\", \"IOO23\", \"IOO24\", \"IOO25\",
     \"IOO26\", \"IOO27\", \"IOO28\", \"IOO29\", \"IOO30\", \"IOO31\",
     \"IOO32\", \"IOO33\", \"IBO5\", \"IBO6\", \"IBO7\", \"IBO8\",
     \"IBO9\", \"IBO10\", \"IBO11\", \"IBO12\", \"EitherLeftDef\",
     \"EitherRightDef\", \"IEE01\", \"IEE02\", \"IEE03\", \"IEO01\",
     \"IEO02\", \"IEO03\", \"IEO04\", \"IEO05\", \"IEO06\", \"IEO07\",
     \"IEO08\", \"IEO09\", \"IEO10\", \"IEO11\", \"IEO12\", \"IEO13\"]"

typedecl Bool
typedecl ('a1, 'a2) Either
typedecl Unit
typedecl X_Nat

datatype Ordering = EQ | GT | LT

consts
Not__X :: "bool => bool" ("(Not''/ _)" [56] 56)
X_Left :: "'a partial => ('a, 'b) Either partial" ("Left''/'(_')" [3] 999)
X_Right :: "'b partial => ('a, 'b) Either partial" ("Right''/'(_')" [3] 999)
X__XAmpXAmp__X :: "bool => bool => bool" ("(_/ &&/ _)" [54,54] 52)
X__XEqXEq__X :: "'a partial => 'a partial => bool" ("(_/ ==''/ _)" [54,54] 52)
X__XGtXEq__X :: "'a partial => 'a partial => bool" ("(_/ >=''/ _)" [54,54] 52)
X__XGt__X :: "'a partial => 'a partial => bool" ("(_/ >''/ _)" [54,54] 52)
X__XLtXEq__X :: "'a partial => 'a partial => bool" ("(_/ <=''/ _)" [54,54] 52)
X__XLt__X :: "'a partial => 'a partial => bool" ("(_/ <''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a partial => 'a partial => bool" ("(_/ '/=/ _)" [54,54] 52)
X__XVBarXVBar__X :: "bool => bool => bool" ("(_/ ||/ _)" [54,54] 52)
X_max :: "'a partial => 'a partial => 'a partial"
X_min :: "'a partial => 'a partial => 'a partial"
compare :: "'a partial => 'a partial => Ordering partial"
either :: "('a partial => 'c partial) => ('b partial => 'c partial) => ('a, 'b) Either partial => 'c partial"
otherwiseH :: "bool"

axioms
NotFalse [rule_format] : "Not' False"

NotTrue [rule_format] : "~ Not' True"

AndFalse [rule_format] : "ALL x. ~ False && x"

AndTrue [rule_format] : "ALL x. True && x = x"

AndSym [rule_format] : "ALL x. ALL y. x && y = y && x"

OrDef [rule_format] :
"ALL x. ALL y. x || y = Not' (Not' x && Not' y)"

OtherwiseDef [rule_format] : "otherwiseH"

NotFalse1 [rule_format] : "ALL x. Not' x = (~ x)"

NotTrue1 [rule_format] : "ALL x. ~ Not' x = x"

notNot1 [rule_format] : "ALL x. (~ x) = Not' x"

notNot2 [rule_format] : "ALL x. (~ ~ x) = (~ Not' x)"

EqualTDef [rule_format] : "ALL x. ALL y. x = y --> x ==' y"

EqualSymDef [rule_format] : "ALL x. ALL y. x ==' y = y ==' x"

EqualReflex [rule_format] : "ALL x. x ==' x"

EqualTransT [rule_format] :
"ALL x. ALL y. ALL z. x ==' y & y ==' z --> x ==' z"

DiffDef [rule_format] : "ALL x. ALL y. x /= y = Not' (x ==' y)"

DiffSymDef [rule_format] : "ALL x. ALL y. x /= y = y /= x"

DiffTDef [rule_format] : "ALL x. ALL y. x /= y = Not' (x ==' y)"

DiffFDef [rule_format] : "ALL x. ALL y. (~ x /= y) = x ==' y"

TE1 [rule_format] : "ALL x. ALL y. ~ x ==' y --> ~ x = y"

TE2 [rule_format] : "ALL x. ALL y. Not' (x ==' y) = (~ x ==' y)"

TE3 [rule_format] : "ALL x. ALL y. (~ Not' (x ==' y)) = x ==' y"

TE4 [rule_format] : "ALL x. ALL y. (~ x ==' y) = (~ x ==' y)"

IUE1 [rule_format] : "makePartial () ==' makePartial ()"

IUE2 [rule_format] : "~ makePartial () /= makePartial ()"

IBE1 [rule_format] : "makePartial () ==' makePartial ()"

IBE2 [rule_format] : "undefinedOp ==' undefinedOp"

IBE3 [rule_format] : "~ undefinedOp ==' makePartial ()"

IBE4 [rule_format] : "~ makePartial () ==' undefinedOp"

IBE5 [rule_format] : "makePartial () /= undefinedOp"

IBE6 [rule_format] : "undefinedOp /= makePartial ()"

IBE7 [rule_format] : "Not' (makePartial () ==' undefinedOp)"

IBE8 [rule_format] : "~ Not' Not' (makePartial () ==' undefinedOp)"

IOE01 [rule_format] : "makePartial LT ==' makePartial LT"

IOE02 [rule_format] : "makePartial EQ ==' makePartial EQ"

IOE03 [rule_format] : "makePartial GT ==' makePartial GT"

IOE04 [rule_format] : "~ makePartial LT ==' makePartial EQ"

IOE05 [rule_format] : "~ makePartial LT ==' makePartial GT"

IOE06 [rule_format] : "~ makePartial EQ ==' makePartial GT"

IOE07 [rule_format] : "makePartial LT /= makePartial EQ"

IOE08 [rule_format] : "makePartial LT /= makePartial GT"

IOE09 [rule_format] : "makePartial EQ /= makePartial GT"

LeIrreflexivity [rule_format] :
"ALL x. ALL y. x ==' y --> ~ x <' y"

LeTAsymmetry [rule_format] : "ALL x. ALL y. x <' y --> ~ y <' x"

LeTTransitive [rule_format] :
"ALL x. ALL y. ALL z. x <' y & y <' z --> x <' z"

LeTTotal [rule_format] :
"ALL x. ALL y. (x <' y | y <' x) | x ==' y"

GeDef [rule_format] : "ALL x. ALL y. x >' y = y <' x"

GeIrreflexivity [rule_format] :
"ALL x. ALL y. x ==' y --> ~ x >' y"

GeTAsymmetry [rule_format] : "ALL x. ALL y. x >' y --> ~ y >' x"

GeTTransitive [rule_format] :
"ALL x. ALL y. ALL z. (x >' y) && (y >' z) --> x >' z"

GeTTotal [rule_format] :
"ALL x. ALL y. ((x >' y) || (y >' x)) || (x ==' y)"

LeqDef [rule_format] :
"ALL x. ALL y. x <=' y = (x <' y) || (x ==' y)"

LeqReflexivity [rule_format] : "ALL x. x <=' x"

LeqTTransitive [rule_format] :
"ALL x. ALL y. ALL z. (x <=' y) && (y <=' z) --> x <=' z"

LeqTTotal [rule_format] :
"ALL x. ALL y. (x <=' y) && (y <=' x) = x ==' y"

GeqDef [rule_format] :
"ALL x. ALL y. x >=' y = (x >' y) || (x ==' y)"

GeqReflexivity [rule_format] : "ALL x. x >=' x"

GeqTTransitive [rule_format] :
"ALL x. ALL y. ALL z. (x >=' y) && (y >=' z) --> x >=' z"

GeqTTotal [rule_format] :
"ALL x. ALL y. (x >=' y) && (y >=' x) = x ==' y"

EqTSOrdRel [rule_format] :
"ALL x. ALL y. x ==' y = (~ x <' y & ~ x >' y)"

EqFSOrdRel [rule_format] :
"ALL x. ALL y. (~ x ==' y) = (x <' y | x >' y)"

EqTOrdRel [rule_format] :
"ALL x. ALL y. x ==' y = (x <=' y & x >=' y)"

EqFOrdRel [rule_format] :
"ALL x. ALL y. (~ x ==' y) = (x <=' y | x >=' y)"

EqTOrdTSubstE [rule_format] :
"ALL x. ALL y. ALL z. x ==' y & y <' z --> x <' z"

EqTOrdFSubstE [rule_format] :
"ALL x. ALL y. ALL z. x ==' y & ~ y <' z --> ~ x <' z"

EqTOrdTSubstD [rule_format] :
"ALL x. ALL y. ALL z. x ==' y & z <' y --> z <' x"

EqTOrdFSubstD [rule_format] :
"ALL x. ALL y. ALL z. x ==' y & ~ z <' y --> ~ z <' x"

LeTGeFEqFRel [rule_format] :
"ALL x. ALL y. x <' y = (~ x >' y & ~ x ==' y)"

LeFGeTEqTRel [rule_format] :
"ALL x. ALL y. (~ x <' y) = (x >' y | x ==' y)"

LeTGeTRel [rule_format] : "ALL x. ALL y. x <' y = y >' x"

LeFGeFRel [rule_format] : "ALL x. ALL y. (~ x <' y) = (~ y >' x)"

LeqTGetTRel [rule_format] : "ALL x. ALL y. x <=' y = y >=' x"

LeqFGetFRel [rule_format] :
"ALL x. ALL y. (~ x <=' y) = (~ y >=' x)"

GeTLeTRel [rule_format] : "ALL x. ALL y. x >' y = y <' x"

GeFLeFRel [rule_format] : "ALL x. ALL y. (~ x >' y) = (~ y <' x)"

GeqTLeqTRel [rule_format] : "ALL x. ALL y. x >=' y = y <=' x"

GeqFLeqFRel [rule_format] :
"ALL x. ALL y. (~ x >=' y) = (~ y <=' x)"

LeqTGeFRel [rule_format] : "ALL x. ALL y. x <=' y = (~ x >' y)"

LeqFGeTRel [rule_format] : "ALL x. ALL y. (~ x <=' y) = x >' y"

GeTLeFEqFRel [rule_format] :
"ALL x. ALL y. x >' y = (~ x <' y & ~ x ==' y)"

GeFLeTEqTRel [rule_format] :
"ALL x. ALL y. (~ x >' y) = (x <' y | x ==' y)"

GeqTLeFRel [rule_format] : "ALL x. ALL y. x >=' y = (~ x <' y)"

GeqFLeTRel [rule_format] : "ALL x. ALL y. (~ x >=' y) = x <' y"

LeqTLeTEqTRel [rule_format] :
"ALL x. ALL y. x <=' y = (x <' y | x ==' y)"

LeqFLeFEqFRel [rule_format] :
"ALL x. ALL y. (~ x <=' y) = (~ x <' y & ~ x ==' y)"

GeqTGeTEqTRel [rule_format] :
"ALL x. ALL y. x >=' y = (x >' y | x ==' y)"

GeqFGeFEqFRel [rule_format] :
"ALL x. ALL y. (~ x >=' y) = (~ x >' y & ~ x ==' y)"

LeTGeqFRel [rule_format] : "ALL x. ALL y. x <' y = (~ x >=' y)"

GeTLeqFRel [rule_format] : "ALL x. ALL y. x >' y = (~ x <=' y)"

LeLeqDiff [rule_format] :
"ALL x. ALL y. x <' y = (x <=' y) && (x /= y)"

CmpLTDef [rule_format] :
"ALL x. ALL y. compare x y ==' makePartial LT = x <' y"

CmpEQDef [rule_format] :
"ALL x. ALL y. compare x y ==' makePartial EQ = x ==' y"

CmpGTDef [rule_format] :
"ALL x. ALL y. compare x y ==' makePartial GT = x >' y"

MaxYDef [rule_format] : "ALL x. ALL y. X_max x y ==' y = x <=' y"

MaxXDef [rule_format] : "ALL x. ALL y. X_max x y ==' x = y <=' x"

MinXDef [rule_format] : "ALL x. ALL y. X_min x y ==' x = x <=' y"

MinYDef [rule_format] : "ALL x. ALL y. X_min x y ==' y = y <=' x"

MaxSym [rule_format] :
"ALL x. ALL y. X_max x y ==' y = X_max y x ==' y"

MinSym [rule_format] :
"ALL x. ALL y. X_min x y ==' y = X_min y x ==' y"

TO1 [rule_format] : "ALL x. ALL y. (x ==' y | x <' y) = x <=' y"

TO2 [rule_format] : "ALL x. ALL y. x ==' y --> ~ x <' y"

TO3 [rule_format] :
"ALL x. ALL y. Not' Not' (x <' y) | Not' (x <' y)"

TO4 [rule_format] : "ALL x. ALL y. x <' y --> Not' (x ==' y)"

TO5 [rule_format] :
"ALL w. ALL x. ALL y. ALL z. (x <' y & y <' z) & z <' w --> x <' w"

TO6 [rule_format] : "ALL x. ALL z. z <' x --> Not' (x <' z)"

TO7 [rule_format] : "ALL x. ALL y. x <' y = y >' x"

IUO01 [rule_format] : "makePartial () <=' makePartial ()"

IUO02 [rule_format] : "~ makePartial () <' makePartial ()"

IUO03 [rule_format] : "makePartial () >=' makePartial ()"

IUO04 [rule_format] : "~ makePartial () >' makePartial ()"

IUO05 [rule_format] :
"X_max (makePartial ()) (makePartial ()) ==' makePartial ()"

IUO06 [rule_format] :
"X_min (makePartial ()) (makePartial ()) ==' makePartial ()"

IUO07 [rule_format] :
"compare (makePartial ()) (makePartial ()) ==' makePartial EQ"

IOO13 [rule_format] : "makePartial LT <' makePartial EQ"

IOO14 [rule_format] : "makePartial EQ <' makePartial GT"

IOO15 [rule_format] : "makePartial LT <' makePartial GT"

IOO16 [rule_format] : "makePartial LT <=' makePartial EQ"

IOO17 [rule_format] : "makePartial EQ <=' makePartial GT"

IOO18 [rule_format] : "makePartial LT <=' makePartial GT"

IOO19 [rule_format] : "makePartial EQ >=' makePartial LT"

IOO20 [rule_format] : "makePartial GT >=' makePartial EQ"

IOO21 [rule_format] : "makePartial GT >=' makePartial LT"

IOO22 [rule_format] : "makePartial EQ >' makePartial LT"

IOO23 [rule_format] : "makePartial GT >' makePartial EQ"

IOO24 [rule_format] : "makePartial GT >' makePartial LT"

IOO25 [rule_format] :
"X_max (makePartial LT) (makePartial EQ) ==' makePartial EQ"

IOO26 [rule_format] :
"X_max (makePartial EQ) (makePartial GT) ==' makePartial GT"

IOO27 [rule_format] :
"X_max (makePartial LT) (makePartial GT) ==' makePartial GT"

IOO28 [rule_format] :
"X_min (makePartial LT) (makePartial EQ) ==' makePartial LT"

IOO29 [rule_format] :
"X_min (makePartial EQ) (makePartial GT) ==' makePartial EQ"

IOO30 [rule_format] :
"X_min (makePartial LT) (makePartial GT) ==' makePartial LT"

IOO31 [rule_format] :
"compare (makePartial LT) (makePartial LT) ==' makePartial EQ"

IOO32 [rule_format] :
"compare (makePartial EQ) (makePartial EQ) ==' makePartial EQ"

IOO33 [rule_format] :
"compare (makePartial GT) (makePartial GT) ==' makePartial EQ"

IBO5 [rule_format] : "undefinedOp <' makePartial ()"

IBO6 [rule_format] : "~ undefinedOp >=' makePartial ()"

IBO7 [rule_format] : "makePartial () >=' undefinedOp"

IBO8 [rule_format] : "~ makePartial () <' undefinedOp"

IBO9 [rule_format] :
"X_max undefinedOp (makePartial ()) ==' makePartial ()"

IBO10 [rule_format] :
"X_min undefinedOp (makePartial ()) ==' undefinedOp"

IBO11 [rule_format] :
"compare (makePartial ()) (makePartial ()) ==' makePartial EQ"

IBO12 [rule_format] :
"compare undefinedOp undefinedOp ==' makePartial EQ"

EitherLeftDef [rule_format] :
"ALL f. ALL g. ALL x. either f g (Left'(x)) = f x"

EitherRightDef [rule_format] :
"ALL f. ALL g. ALL y. either f g (Right'(y)) = g y"

IEE01 [rule_format] :
"ALL x. ALL y. Left'(x) ==' Left'(y) = x ==' y"

IEE02 [rule_format] :
"ALL w. ALL z. Right'(z) ==' Right'(w) = z ==' w"

IEE03 [rule_format] : "ALL x. ALL z. ~ Left'(x) ==' Right'(z)"

IEO01 [rule_format] : "ALL x. ALL z. Left'(x) <' Right'(z)"

IEO02 [rule_format] : "ALL x. ALL y. Left'(x) <' Left'(y) = x <' y"

IEO03 [rule_format] :
"ALL w. ALL z. Right'(z) <' Right'(w) = z <' w"

declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare OtherwiseDef [simp]
declare NotTrue1 [simp]
declare EqualReflex [simp]
declare IUE1 [simp]
declare IUE2 [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare IOE01 [simp]
declare IOE02 [simp]
declare IOE03 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare IOE07 [simp]
declare IOE08 [simp]
declare IOE09 [simp]
declare LeIrreflexivity [simp]
declare LeTAsymmetry [simp]
declare GeIrreflexivity [simp]
declare GeTAsymmetry [simp]
declare GeTTransitive [simp]
declare GeTTotal [simp]
declare LeqReflexivity [simp]
declare LeqTTransitive [simp]
declare LeqTTotal [simp]
declare GeqReflexivity [simp]
declare GeqTTransitive [simp]
declare GeqTTotal [simp]
declare CmpLTDef [simp]
declare CmpEQDef [simp]
declare CmpGTDef [simp]
declare MaxYDef [simp]
declare MaxXDef [simp]
declare MinXDef [simp]
declare MinYDef [simp]
declare TO2 [simp]
declare TO4 [simp]
declare TO6 [simp]
declare IUO01 [simp]
declare IUO02 [simp]
declare IUO03 [simp]
declare IUO04 [simp]
declare IUO05 [simp]
declare IUO06 [simp]
declare IUO07 [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IOO16 [simp]
declare IOO17 [simp]
declare IOO18 [simp]
declare IOO19 [simp]
declare IOO20 [simp]
declare IOO21 [simp]
declare IOO22 [simp]
declare IOO23 [simp]
declare IOO24 [simp]
declare IOO25 [simp]
declare IOO26 [simp]
declare IOO27 [simp]
declare IOO28 [simp]
declare IOO29 [simp]
declare IOO30 [simp]
declare IOO31 [simp]
declare IOO32 [simp]
declare IOO33 [simp]
declare IBO5 [simp]
declare IBO6 [simp]
declare IBO7 [simp]
declare IBO8 [simp]
declare IBO9 [simp]
declare IBO10 [simp]
declare IBO11 [simp]
declare IBO12 [simp]
declare EitherLeftDef [simp]
declare EitherRightDef [simp]
declare IEE01 [simp]
declare IEE02 [simp]
declare IEE03 [simp]
declare IEO01 [simp]
declare IEO02 [simp]
declare IEO03 [simp]

theorem IEO04 : "ALL x. ALL z. ~ Left'(x) >=' Right'(z)"
apply(simp only: GeqDef OrDef GeDef)
apply(case_tac "(restrictOp (makePartial (Right'(makeTotal z))) (defOp z) <' restrictOp (makePartial (Left'(makeTotal x))) (defOp x))")
by(auto)

ML "Header.record \"IEO04\""

theorem IEO05 : "ALL x. ALL z. Right'(z) >=' Left'(x)"
apply(simp only: GeqDef OrDef GeDef)
apply(case_tac "(restrictOp (makePartial (Right'(makeTotal z))) (defOp z) <' restrictOp (makePartial (Left'(makeTotal x))) (defOp x))")
by(auto)

ML "Header.record \"IEO05\""

theorem IEO06 : "ALL x. ALL z. ~ Right'(z) <' Left'(x)"
by (auto)

ML "Header.record \"IEO06\""

theorem IEO07 :
"ALL x.
 ALL z.
 compare (Left'(x)) (Right'(z)) ==' makePartial EQ =
 Left'(x) ==' Right'(z)"
apply(rule allI)+
apply(simp add: LeqDef)
done

ML "Header.record \"IEO07\""

theorem IEO08 :
"ALL x.
 ALL z.
 compare (Left'(x)) (Right'(z)) ==' makePartial LT =
 Left'(x) <' Right'(z)"
apply(rule allI)+
apply(simp add: LeqDef)
done

ML "Header.record \"IEO08\""

theorem IEO09 :
"ALL x.
 ALL z.
 compare (Left'(x)) (Right'(z)) ==' makePartial GT =
 Left'(x) >' Right'(z)"
apply(rule allI)+
apply(simp add: GeDef)
done

ML "Header.record \"IEO09\""

theorem IEO10 :
"ALL x.
 ALL z.
 Left'(x) <=' Right'(z) =
 X_max (Left'(x)) (Right'(z)) ==' Right'(z)"
apply(rule allI)+
apply(simp add: LeqDef)
done

ML "Header.record \"IEO10\""

theorem IEO11 :
"ALL x.
 ALL z.
 Right'(z) <=' Left'(x) = X_max (Left'(x)) (Right'(z)) ==' Left'(x)"
apply(rule allI)+
apply(simp add: LeqDef)
done

ML "Header.record \"IEO11\""

theorem IEO12 :
"ALL x.
 ALL z.
 Left'(x) <=' Right'(z) = X_min (Left'(x)) (Right'(z)) ==' Left'(x)"
apply(rule allI)+
apply(simp add: LeqDef)
done

ML "Header.record \"IEO12\""

theorem IEO13 :
"ALL x.
 ALL z.
 Right'(z) <=' Left'(x) =
 X_min (Left'(x)) (Right'(z)) ==' Right'(z)"
apply(rule allI)+
apply(simp add: LeqDef)
done

ML "Header.record \"IEO13\""

end


(*  Title:      JinjaDCI/J/WWellForm.thy

    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory J/WWellForm.thy by Tobias Nipkow
*)

section \<open> Weak well-formedness of Jinja programs \<close>

theory WWellForm imports "../Common/WellForm" Expr begin

definition wwf_J_mdecl :: "J_prog \<Rightarrow> cname \<Rightarrow> J_mb mdecl \<Rightarrow> bool"
where
  "wwf_J_mdecl P C  \<equiv>  \<lambda>(M,b,Ts,T,(pns,body)).
 length Ts = length pns \<and> distinct pns \<and> \<not>sub_RI body \<and>
  (case b of
   NonStatic \<Rightarrow> this \<notin> set pns \<and> fv body \<subseteq> {this} \<union> set pns
 | Static \<Rightarrow> fv body \<subseteq> set pns)"

lemma wwf_J_mdecl_NonStatic[simp]:
  "wwf_J_mdecl P C (M,NonStatic,Ts,T,pns,body) =
  (length Ts = length pns \<and> distinct pns \<and> \<not>sub_RI body \<and> this \<notin> set pns \<and> fv body \<subseteq> {this} \<union> set pns)"
(*<*)by(simp add:wwf_J_mdecl_def)(*>*)

lemma wwf_J_mdecl_Static[simp]:
  "wwf_J_mdecl P C (M,Static,Ts,T,pns,body) =
  (length Ts = length pns \<and> distinct pns \<and> \<not>sub_RI body \<and> fv body \<subseteq> set pns)"
(*<*)by(simp add:wwf_J_mdecl_def)(*>*)

abbreviation
  wwf_J_prog :: "J_prog \<Rightarrow> bool" where
  "wwf_J_prog \<equiv> wf_prog wwf_J_mdecl"

lemma sees_wwf_nsub_RI:
 "\<lbrakk> wwf_J_prog P; P \<turnstile> C sees M,b : Ts\<rightarrow>T = (pns, body) in D \<rbrakk> \<Longrightarrow> \<not>sub_RI body"
apply(drule sees_wf_mdecl, simp)
apply(unfold wwf_J_mdecl_def wf_mdecl_def, simp)
done

end


(*  Title:      HOL/Library/Old_Datatype.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Author:     Stefan Berghofer and Markus Wenzel, TU Muenchen
*)

section \<open>Old Datatype package: constructing datatypes from Cartesian Products and Disjoint Sums\<close>

theory Old_Datatype
imports "../Main"
keywords "old_datatype" :: thy_decl
begin

ML_file "~~/src/HOL/Tools/datatype_realizer.ML"

subsection \<open>The datatype universe\<close>

definition "Node = {p. EX f x k. p = (f :: nat => 'b + nat, x ::'a + nat) & f k = Inr 0}"

typedef ('a, 'b) node = "Node :: ((nat => 'b + nat) * ('a + nat)) set"
  morphisms Rep_Node Abs_Node
  unfolding Node_def by auto

text\<open>Datatypes will be represented by sets of type \<open>node\<close>\<close>

type_synonym 'a item        = "('a, unit) node set"
type_synonym ('a, 'b) dtree = "('a, 'b) node set"

definition Push :: "[('b + nat), nat => ('b + nat)] => (nat => ('b + nat))"
  (*crude "lists" of nats -- needed for the constructions*)
  where "Push == (%b h. case_nat b h)"

definition Push_Node :: "[('b + nat), ('a, 'b) node] => ('a, 'b) node"
  where "Push_Node == (%n x. Abs_Node (apfst (Push n) (Rep_Node x)))"

(** operations on S-expressions -- sets of nodes **)

(*S-expression constructors*)
definition Atom :: "('a + nat) => ('a, 'b) dtree"
  where "Atom == (%x. {Abs_Node((%k. Inr 0, x))})"
definition Scons :: "[('a, 'b) dtree, ('a, 'b) dtree] => ('a, 'b) dtree"
  where "Scons M N == (Push_Node (Inr 1) ` M) Un (Push_Node (Inr (Suc 1)) ` N)"

(*Leaf nodes, with arbitrary or nat labels*)
definition Leaf :: "'a => ('a, 'b) dtree"
  where "Leaf == Atom o Inl"
definition Numb :: "nat => ('a, 'b) dtree"
  where "Numb == Atom o Inr"

(*Injections of the "disjoint sum"*)
definition In0 :: "('a, 'b) dtree => ('a, 'b) dtree"
  where "In0(M) == Scons (Numb 0) M"
definition In1 :: "('a, 'b) dtree => ('a, 'b) dtree"
  where "In1(M) == Scons (Numb 1) M"

(*Function spaces*)
definition Lim :: "('b => ('a, 'b) dtree) => ('a, 'b) dtree"
  where "Lim f == \<Union>{z. ? x. z = Push_Node (Inl x) ` (f x)}"

(*the set of nodes with depth less than k*)
definition ndepth :: "('a, 'b) node => nat"
  where "ndepth(n) == (%(f,x). LEAST k. f k = Inr 0) (Rep_Node n)"
definition ntrunc :: "[nat, ('a, 'b) dtree] => ('a, 'b) dtree"
  where "ntrunc k N == {n. n:N & ndepth(n)<k}"

(*products and sums for the "universe"*)
definition uprod :: "[('a, 'b) dtree set, ('a, 'b) dtree set]=> ('a, 'b) dtree set"
  where "uprod A B == UN x:A. UN y:B. { Scons x y }"
definition usum :: "[('a, 'b) dtree set, ('a, 'b) dtree set]=> ('a, 'b) dtree set"
  where "usum A B == In0`A Un In1`B"

(*the corresponding eliminators*)
definition Split :: "[[('a, 'b) dtree, ('a, 'b) dtree]=>'c, ('a, 'b) dtree] => 'c"
  where "Split c M == THE u. EX x y. M = Scons x y & u = c x y"

definition Case :: "[[('a, 'b) dtree]=>'c, [('a, 'b) dtree]=>'c, ('a, 'b) dtree] => 'c"
  where "Case c d M == THE u. (EX x . M = In0(x) & u = c(x)) | (EX y . M = In1(y) & u = d(y))"

(** equality for the "universe" **)

definition dprod :: "[(('a, 'b) dtree * ('a, 'b) dtree)set, (('a, 'b) dtree * ('a, 'b) dtree)set]
      => (('a, 'b) dtree * ('a, 'b) dtree)set"
  where "dprod r s == UN (x,x'):r. UN (y,y'):s. {(Scons x y, Scons x' y')}"

definition dsum :: "[(('a, 'b) dtree * ('a, 'b) dtree)set, (('a, 'b) dtree * ('a, 'b) dtree)set]
      => (('a, 'b) dtree * ('a, 'b) dtree)set"
  where "dsum r s == (UN (x,x'):r. {(In0(x),In0(x'))}) Un (UN (y,y'):s. {(In1(y),In1(y'))})"

lemma apfst_convE:
    "[| q = apfst f p;  !!x y. [| p = (x,y);  q = (f(x),y) |] ==> R
     |] ==> R"
by (force simp add: apfst_def)

(** Push -- an injection, analogous to Cons on lists **)

lemma Push_inject1: "Push i f = Push j g  ==> i=j"
apply (simp add: Push_def fun_eq_iff)
apply (drule_tac x=0 in spec, simp)
done

lemma Push_inject2: "Push i f = Push j g  ==> f=g"
apply (auto simp add: Push_def fun_eq_iff)
apply (drule_tac x="Suc x" in spec, simp)
done

lemma Push_inject:
    "[| Push i f =Push j g;  [| i=j;  f=g |] ==> P |] ==> P"
by (blast dest: Push_inject1 Push_inject2)

lemma Push_neq_K0: "Push (Inr (Suc k)) f = (%z. Inr 0) ==> P"
by (auto simp add: Push_def fun_eq_iff split: nat.split_asm)

lemmas Abs_Node_inj = Abs_Node_inject [THEN [2] rev_iffD1]

(*** Introduction rules for Node ***)

lemma Node_K0_I: "(%k. Inr 0, a) : Node"
by (simp add: Node_def)

lemma Node_Push_I: "p: Node ==> apfst (Push i) p : Node"
apply (simp add: Node_def Push_def)
apply (fast intro!: apfst_conv nat.case(2)[THEN trans])
done

subsection\<open>Freeness: Distinctness of Constructors\<close>

(** Scons vs Atom **)

lemma Scons_not_Atom [iff]: "Scons M N \<noteq> Atom(a)"
unfolding Atom_def Scons_def Push_Node_def One_nat_def
by (blast intro: Node_K0_I Rep_Node [THEN Node_Push_I]
         dest!: Abs_Node_inj
         elim!: apfst_convE sym [THEN Push_neq_K0])

lemmas Atom_not_Scons [iff] = Scons_not_Atom [THEN not_sym]

(*** Injectiveness ***)

(** Atomic nodes **)

lemma inj_Atom: "inj(Atom)"
apply (simp add: Atom_def)
apply (blast intro!: inj_onI Node_K0_I dest!: Abs_Node_inj)
done
lemmas Atom_inject = inj_Atom [THEN injD]

lemma Atom_Atom_eq [iff]: "(Atom(a)=Atom(b)) = (a=b)"
by (blast dest!: Atom_inject)

lemma inj_Leaf: "inj(Leaf)"
apply (simp add: Leaf_def o_def)
apply (rule inj_onI)
apply (erule Atom_inject [THEN Inl_inject])
done

lemmas Leaf_inject [dest!] = inj_Leaf [THEN injD]

lemma inj_Numb: "inj(Numb)"
apply (simp add: Numb_def o_def)
apply (rule inj_onI)
apply (erule Atom_inject [THEN Inr_inject])
done

lemmas Numb_inject [dest!] = inj_Numb [THEN injD]

(** Injectiveness of Push_Node **)

lemma Push_Node_inject:
    "[| Push_Node i m =Push_Node j n;  [| i=j;  m=n |] ==> P
     |] ==> P"
apply (simp add: Push_Node_def)
apply (erule Abs_Node_inj [THEN apfst_convE])
apply (rule Rep_Node [THEN Node_Push_I])+
apply (erule sym [THEN apfst_convE])
apply (blast intro: Rep_Node_inject [THEN iffD1] trans sym elim!: Push_inject)
done

(** Injectiveness of Scons **)

lemma Scons_inject_lemma1: "Scons M N <= Scons M' N' ==> M<=M'"
unfolding Scons_def One_nat_def
by (blast dest!: Push_Node_inject)

lemma Scons_inject_lemma2: "Scons M N <= Scons M' N' ==> N<=N'"
unfolding Scons_def One_nat_def
by (blast dest!: Push_Node_inject)

lemma Scons_inject1: "Scons M N = Scons M' N' ==> M=M'"
apply (erule equalityE)
apply (iprover intro: equalityI Scons_inject_lemma1)
done

lemma Scons_inject2: "Scons M N = Scons M' N' ==> N=N'"
apply (erule equalityE)
apply (iprover intro: equalityI Scons_inject_lemma2)
done

lemma Scons_inject:
    "[| Scons M N = Scons M' N';  [| M=M';  N=N' |] ==> P |] ==> P"
by (iprover dest: Scons_inject1 Scons_inject2)

lemma Scons_Scons_eq [iff]: "(Scons M N = Scons M' N') = (M=M' & N=N')"
by (blast elim!: Scons_inject)

(*** Distinctness involving Leaf and Numb ***)

(** Scons vs Leaf **)

lemma Scons_not_Leaf [iff]: "Scons M N \<noteq> Leaf(a)"
unfolding Leaf_def o_def by (rule Scons_not_Atom)

lemmas Leaf_not_Scons  [iff] = Scons_not_Leaf [THEN not_sym]

(** Scons vs Numb **)

lemma Scons_not_Numb [iff]: "Scons M N \<noteq> Numb(k)"
unfolding Numb_def o_def by (rule Scons_not_Atom)

lemmas Numb_not_Scons [iff] = Scons_not_Numb [THEN not_sym]

(** Leaf vs Numb **)

lemma Leaf_not_Numb [iff]: "Leaf(a) \<noteq> Numb(k)"
by (simp add: Leaf_def Numb_def)

lemmas Numb_not_Leaf [iff] = Leaf_not_Numb [THEN not_sym]

(*** ndepth -- the depth of a node ***)

lemma ndepth_K0: "ndepth (Abs_Node(%k. Inr 0, x)) = 0"
by (simp add: ndepth_def  Node_K0_I [THEN Abs_Node_inverse] Least_equality)

lemma ndepth_Push_Node_aux:
     "case_nat (Inr (Suc i)) f k = Inr 0 --> Suc(LEAST x. f x = Inr 0) <= k"
apply (induct_tac "k", auto)
apply (erule Least_le)
done

lemma ndepth_Push_Node:
    "ndepth (Push_Node (Inr (Suc i)) n) = Suc(ndepth(n))"
apply (insert Rep_Node [of n, unfolded Node_def])
apply (auto simp add: ndepth_def Push_Node_def
                 Rep_Node [THEN Node_Push_I, THEN Abs_Node_inverse])
apply (rule Least_equality)
apply (auto simp add: Push_def ndepth_Push_Node_aux)
apply (erule LeastI)
done

(*** ntrunc applied to the various node sets ***)

lemma ntrunc_0 [simp]: "ntrunc 0 M = {}"
by (simp add: ntrunc_def)

lemma ntrunc_Atom [simp]: "ntrunc (Suc k) (Atom a) = Atom(a)"
by (auto simp add: Atom_def ntrunc_def ndepth_K0)

lemma ntrunc_Leaf [simp]: "ntrunc (Suc k) (Leaf a) = Leaf(a)"
unfolding Leaf_def o_def by (rule ntrunc_Atom)

lemma ntrunc_Numb [simp]: "ntrunc (Suc k) (Numb i) = Numb(i)"
unfolding Numb_def o_def by (rule ntrunc_Atom)

lemma ntrunc_Scons [simp]:
    "ntrunc (Suc k) (Scons M N) = Scons (ntrunc k M) (ntrunc k N)"
unfolding Scons_def ntrunc_def One_nat_def
by (auto simp add: ndepth_Push_Node)

(** Injection nodes **)

lemma ntrunc_one_In0 [simp]: "ntrunc (Suc 0) (In0 M) = {}"
apply (simp add: In0_def)
apply (simp add: Scons_def)
done

lemma ntrunc_In0 [simp]: "ntrunc (Suc(Suc k)) (In0 M) = In0 (ntrunc (Suc k) M)"
by (simp add: In0_def)

lemma ntrunc_one_In1 [simp]: "ntrunc (Suc 0) (In1 M) = {}"
apply (simp add: In1_def)
apply (simp add: Scons_def)
done

lemma ntrunc_In1 [simp]: "ntrunc (Suc(Suc k)) (In1 M) = In1 (ntrunc (Suc k) M)"
by (simp add: In1_def)

subsection\<open>Set Constructions\<close>

(*** Cartesian Product ***)

lemma uprodI [intro!]: "[| M:A;  N:B |] ==> Scons M N : uprod A B"
by (simp add: uprod_def)

(*The general elimination rule*)
lemma uprodE [elim!]:
    "[| c : uprod A B;
        !!x y. [| x:A;  y:B;  c = Scons x y |] ==> P
     |] ==> P"
by (auto simp add: uprod_def)

(*Elimination of a pair -- introduces no eigenvariables*)
lemma uprodE2: "[| Scons M N : uprod A B;  [| M:A;  N:B |] ==> P |] ==> P"
by (auto simp add: uprod_def)

(*** Disjoint Sum ***)

lemma usum_In0I [intro]: "M:A ==> In0(M) : usum A B"
by (simp add: usum_def)

lemma usum_In1I [intro]: "N:B ==> In1(N) : usum A B"
by (simp add: usum_def)

lemma usumE [elim!]:
    "[| u : usum A B;
        !!x. [| x:A;  u=In0(x) |] ==> P;
        !!y. [| y:B;  u=In1(y) |] ==> P
     |] ==> P"
by (auto simp add: usum_def)

(** Injection **)

lemma In0_not_In1 [iff]: "In0(M) \<noteq> In1(N)"
unfolding In0_def In1_def One_nat_def by auto

lemmas In1_not_In0 [iff] = In0_not_In1 [THEN not_sym]

lemma In0_inject: "In0(M) = In0(N) ==>  M=N"
by (simp add: In0_def)

lemma In1_inject: "In1(M) = In1(N) ==>  M=N"
by (simp add: In1_def)

lemma In0_eq [iff]: "(In0 M = In0 N) = (M=N)"
by (blast dest!: In0_inject)

lemma In1_eq [iff]: "(In1 M = In1 N) = (M=N)"
by (blast dest!: In1_inject)

lemma inj_In0: "inj In0"
by (blast intro!: inj_onI)

lemma inj_In1: "inj In1"
by (blast intro!: inj_onI)

(*** Function spaces ***)

lemma Lim_inject: "Lim f = Lim g ==> f = g"
apply (simp add: Lim_def)
apply (rule ext)
apply (blast elim!: Push_Node_inject)
done

(*** proving equality of sets and functions using ntrunc ***)

lemma ntrunc_subsetI: "ntrunc k M <= M"
by (auto simp add: ntrunc_def)

lemma ntrunc_subsetD: "(!!k. ntrunc k M <= N) ==> M<=N"
by (auto simp add: ntrunc_def)

(*A generalized form of the take-lemma*)
lemma ntrunc_equality: "(!!k. ntrunc k M = ntrunc k N) ==> M=N"
apply (rule equalityI)
apply (rule_tac [!] ntrunc_subsetD)
apply (rule_tac [!] ntrunc_subsetI [THEN [2] subset_trans], auto)
done

lemma ntrunc_o_equality:
    "[| !!k. (ntrunc(k) o h1) = (ntrunc(k) o h2) |] ==> h1=h2"
apply (rule ntrunc_equality [THEN ext])
apply (simp add: fun_eq_iff)
done

(*** Monotonicity ***)

lemma uprod_mono: "[| A<=A';  B<=B' |] ==> uprod A B <= uprod A' B'"
by (simp add: uprod_def, blast)

lemma usum_mono: "[| A<=A';  B<=B' |] ==> usum A B <= usum A' B'"
by (simp add: usum_def, blast)

lemma Scons_mono: "[| M<=M';  N<=N' |] ==> Scons M N <= Scons M' N'"
by (simp add: Scons_def, blast)

lemma In0_mono: "M<=N ==> In0(M) <= In0(N)"
by (simp add: In0_def Scons_mono)

lemma In1_mono: "M<=N ==> In1(M) <= In1(N)"
by (simp add: In1_def Scons_mono)

(*** Split and Case ***)

lemma Split [simp]: "Split c (Scons M N) = c M N"
by (simp add: Split_def)

lemma Case_In0 [simp]: "Case c d (In0 M) = c(M)"
by (simp add: Case_def)

lemma Case_In1 [simp]: "Case c d (In1 N) = d(N)"
by (simp add: Case_def)

(**** UN x. B(x) rules ****)

lemma ntrunc_UN1: "ntrunc k (UN x. f(x)) = (UN x. ntrunc k (f x))"
by (simp add: ntrunc_def, blast)

lemma Scons_UN1_x: "Scons (UN x. f x) M = (UN x. Scons (f x) M)"
by (simp add: Scons_def, blast)

lemma Scons_UN1_y: "Scons M (UN x. f x) = (UN x. Scons M (f x))"
by (simp add: Scons_def, blast)

lemma In0_UN1: "In0(UN x. f(x)) = (UN x. In0(f(x)))"
by (simp add: In0_def Scons_UN1_y)

lemma In1_UN1: "In1(UN x. f(x)) = (UN x. In1(f(x)))"
by (simp add: In1_def Scons_UN1_y)

(*** Equality for Cartesian Product ***)

lemma dprodI [intro!]:
    "[| (M,M'):r;  (N,N'):s |] ==> (Scons M N, Scons M' N') : dprod r s"
by (auto simp add: dprod_def)

(*The general elimination rule*)
lemma dprodE [elim!]:
    "[| c : dprod r s;
        !!x y x' y'. [| (x,x') : r;  (y,y') : s;
                        c = (Scons x y, Scons x' y') |] ==> P
     |] ==> P"
by (auto simp add: dprod_def)

(*** Equality for Disjoint Sum ***)

lemma dsum_In0I [intro]: "(M,M'):r ==> (In0(M), In0(M')) : dsum r s"
by (auto simp add: dsum_def)

lemma dsum_In1I [intro]: "(N,N'):s ==> (In1(N), In1(N')) : dsum r s"
by (auto simp add: dsum_def)

lemma dsumE [elim!]:
    "[| w : dsum r s;
        !!x x'. [| (x,x') : r;  w = (In0(x), In0(x')) |] ==> P;
        !!y y'. [| (y,y') : s;  w = (In1(y), In1(y')) |] ==> P
     |] ==> P"
by (auto simp add: dsum_def)

(*** Monotonicity ***)

lemma dprod_mono: "[| r<=r';  s<=s' |] ==> dprod r s <= dprod r' s'"
by blast

lemma dsum_mono: "[| r<=r';  s<=s' |] ==> dsum r s <= dsum r' s'"
by blast

(*** Bounding theorems ***)

lemma dprod_Sigma: "(dprod (A \<times> B) (C \<times> D)) <= (uprod A C) \<times> (uprod B D)"
by blast

lemmas dprod_subset_Sigma = subset_trans [OF dprod_mono dprod_Sigma]

(*Dependent version*)
lemma dprod_subset_Sigma2:
    "(dprod (Sigma A B) (Sigma C D)) <= Sigma (uprod A C) (Split (%x y. uprod (B x) (D y)))"
by auto

lemma dsum_Sigma: "(dsum (A \<times> B) (C \<times> D)) <= (usum A C) \<times> (usum B D)"
by blast

lemmas dsum_subset_Sigma = subset_trans [OF dsum_mono dsum_Sigma]

(*** Domain theorems ***)

lemma Domain_dprod [simp]: "Domain (dprod r s) = uprod (Domain r) (Domain s)"
  by auto

lemma Domain_dsum [simp]: "Domain (dsum r s) = usum (Domain r) (Domain s)"
  by auto

text \<open>hides popular names\<close>
hide_type (open) node item
hide_const (open) Push Node Atom Leaf Numb Lim Split Case

ML_file "~~/src/HOL/Tools/Old_Datatype/old_datatype.ML"
ML_file "~~/src/HOL/Tools/inductive_realizer.ML"

end


section \<open>Some tactics\<close>

(* author: Andrei Popescu *)

theory MyTactics imports Main
begin

(* ML {* clarsimp_tac *}

ML{* val x = [1] @ [2] *}

ML {* simp_tac *}  *)

ML\<open>
val impI = @{thm impI}
val allI = @{thm allI}
val ballI = @{thm ballI}
val conjE = @{thm conjE}
val conjI = @{thm conjI}
val exE = @{thm exE}
val disjE = @{thm disjE}

fun mclarTacs ctxt i =
  [resolve_tac ctxt [impI] i,
   resolve_tac ctxt [allI] i,
   resolve_tac ctxt [ballI] i,
   eresolve_tac ctxt [conjE] i,
   eresolve_tac ctxt [exE] i];

fun mclarify_all_tac ctxt = REPEAT(SOMEGOAL(fn i => FIRST (mclarTacs ctxt i)));
fun mclarsimp_all_tac ctxt = TRY (mclarify_all_tac ctxt) THEN TRYALL (asm_full_simp_tac ctxt)

fun mautoTacs ctxt i = mclarTacs ctxt i @ [resolve_tac ctxt [conjI] i, eresolve_tac ctxt [disjE] i]
fun mauto_no_simp_tac ctxt = REPEAT(SOMEGOAL(fn i => FIRST (mautoTacs ctxt i)))

fun clarify_all_tac ctxt = TRYALL (clarify_tac ctxt)
\<close>

text\<open>Above, "m" stands for "mild" -- mainly, disjunctions are left untouched.\<close>

(* Note: The variables @{simpset} and @{claset} are *statically bound*,
hence they refer to the contents of the simp and classical databases at this
definition time.  For the classical database, this is OK for my purpose,
since all I care is that it includes HOL_cs.  However, for the simp database
I shall need to use the current version each time, since the database changes
continuously with simpliication rules for the newly defined concepts -- thereore
I shall need to pass that current version as an explicit parameter, which will
typically be (the current value of) @{simpset}.  *)

(*  Tests:
lemma "(\<forall> i j k. P \<longrightarrow> (Q1 \<or> Q2  \<and> [] @ L = L)) \<and> (\<forall> a b. G a \<and> G b \<longrightarrow> Q) \<and> D"
apply(tactic {* REPEAT(SOMEGOAL(rtac @{thm conjI})) *})
apply(tactic {* mclarify_all_tac *})
oops

lemma "V \<and> (\<forall> i j k. P \<longrightarrow> (Q1 \<or> Q2 \<and> [] @ L = L)) \<and> (\<forall> a b. G a \<and> G b \<longrightarrow> Q) \<and> D"
apply(tactic {* REPEAT(SOMEGOAL(rtac @{thm conjI})) *})
apply(tactic {* mclarsimp_all_tac @{simpset}*})
oops

lemma "V \<and> (\<forall> i j k. P \<longrightarrow> (Q1 \<or> Q2)) \<and> (\<forall> a b. G a \<and> G b \<longrightarrow> Q) \<and> D"
apply(tactic {* REPEAT(SOMEGOAL(rtac @{thm conjI})) *})
apply(tactic {* clarify_all_tac *})
apply(rule disjE)
oops

lemma "V \<and> (\<forall> i j k. P \<longrightarrow> (Q1 \<or> Q2 \<and> x = x)) \<and> (\<forall> a b. G a \<and> G b \<longrightarrow> Q) \<and> D"
apply(tactic {* REPEAT(SOMEGOAL(rtac @{thm conjI})) *})
apply(tactic {* clarsimp_all_tac @{simpset} *})
oops

lemma "(\<forall> i j k. P \<longrightarrow> Q) \<and> (\<forall> a b. G a \<and> G b \<longrightarrow> (Q \<and> R)) \<and> D"
apply(tactic {* REPEAT(SOMEGOAL(rtac @{thm conjI})) *})
apply(tactic {* mauto_no_simp_tac @{context} *})
oops

lemma test: "(\<forall> i j k. P \<longrightarrow> Q) \<and> (\<forall> a b. G a \<and> G b \<longrightarrow> Q)"
apply(tactic {* mauto_no_simp_tac @{context} *})
apply(rule disjE)
oops

*)

end


(*  Title:       Verification auxiliarities
    Author:      Jonathan Julián Huerta y Munive, 2019
    Maintainer:  Jonathan Julián Huerta y Munive <jjhuertaymunive1@sheffield.ac.uk>
*)

section \<open> VC\_diffKAD \<close>

theory VC_diffKAD_auxiliarities
  imports Main VC_diffKAD_KA "Ordinary_Differential_Equations.ODE_Analysis"

begin

subsection \<open> Stack Theories Preliminaries: VC\_KAD and ODEs \<close>

text \<open> To make our notation less code-like and more mathematical we declare: \<close>

type_synonym 'a pred = "'a \<Rightarrow> bool"

type_synonym 'a store = "string \<Rightarrow> 'a"

hide_const \<eta>

no_notation Archimedean_Field.ceiling ("\<lceil>_\<rceil>")
     and Archimedean_Field.floor ("\<lfloor>_\<rfloor>")
     and Set.image (" ` ")
     and Range_Semiring.antirange_semiring_class.ars_r ("r")
     and antidomain_semiringl.ads_d ("d")
     and n_op ("n _" [90] 91)
     and Hoare ("H")
     and tau ("\<tau>")
     and dual ("\<partial>")
     and fres (infixl "\<leftarrow>" 60)
     and n_add_op (infixl "\<oplus>" 65)
     and eta ("\<eta>")

notation Set.image ("_\<lparr>_\<rparr>")
     and Product_Type.prod.fst ("\<pi>\<^sub>1")
     and Product_Type.prod.snd ("\<pi>\<^sub>2")
     and List.zip (infixl "\<otimes>" 63)
     and rel_aka.fbox ("wp")

definition p2r :: "'a pred \<Rightarrow> 'a rel" ("(1\<lceil>_\<rceil>)") where
  "\<lceil>P\<rceil> = {(s,s) |s. P s}"

lemma p2r_simps[simp]:
  "\<lceil>P\<rceil> \<le> \<lceil>Q\<rceil> = (\<forall>s. P s \<longrightarrow> Q s)"
  "(\<lceil>P\<rceil> = \<lceil>Q\<rceil>) = (\<forall>s. P s = Q s)"
  "(\<lceil>P\<rceil> ; \<lceil>Q\<rceil>) = \<lceil>\<lambda> s. P s \<and> Q s\<rceil>"
  "(\<lceil>P\<rceil> \<union> \<lceil>Q\<rceil>) = \<lceil>\<lambda> s. P s \<or> Q s\<rceil>"
  "rel_ad \<lceil>P\<rceil> = \<lceil>\<lambda>s. \<not> P s\<rceil>"
  "rel_aka.ads_d \<lceil>P\<rceil> = \<lceil>P\<rceil>"
  unfolding p2r_def rel_ad_def rel_aka.ads_d_def by auto

lemma wp_rel: "wp R \<lceil>P\<rceil> = \<lceil>\<lambda> x. \<forall> y. (x,y) \<in> R \<longrightarrow> P y\<rceil>"
  unfolding rel_aka.fbox_def p2r_def rel_ad_def by auto

lemma boxProgrPred_chrctrztn: "(x,y) \<in> wp R \<lceil>P\<rceil> \<longleftrightarrow> (y = x \<and> (\<forall>y. (x, y) \<in> R \<longrightarrow> P y))"
  unfolding wp_rel unfolding p2r_def by simp

definition assign :: "string \<Rightarrow> ('a store \<Rightarrow> 'a) \<Rightarrow> ('a store) rel" ("_ ::= _")
  where "(x ::= e) = {(s, s(x := e s)) |s. True }"

lemma wp_assign [simp]: "wp (x ::= e) \<lceil>P\<rceil> = \<lceil>\<lambda> s. P (s(x := e s))\<rceil>"
  unfolding wp_rel assign_def by simp

abbreviation cond_sugar :: "'a pred \<Rightarrow> 'a rel \<Rightarrow> 'a rel \<Rightarrow> 'a rel" ("IF _ THEN _ ELSE _" [64,64] 63)
  where "IF P THEN X ELSE Y \<equiv> rel_aka.aka_cond \<lceil>P\<rceil> X Y"

lemma wp_loopI: "\<lceil>P\<rceil> \<le> \<lceil>I\<rceil> \<Longrightarrow> \<lceil>I\<rceil> \<le> \<lceil>Q\<rceil> \<Longrightarrow> \<lceil>I\<rceil> \<le> wp R \<lceil>I\<rceil> \<Longrightarrow> \<lceil>P\<rceil> \<le> wp (R\<^sup>*) \<lceil>Q\<rceil>"
  using rel_aka.fbox_stari[of "\<lceil>P\<rceil>" "\<lceil>I\<rceil>"] by auto

proposition cons_eq_zipE:
  "(x, y) # tail = xList \<otimes> yList \<Longrightarrow> \<exists>xTail yTail. x # xTail = xList \<and> y # yTail = yList"
  by(induction xList, simp_all, induction yList, simp_all)

proposition set_zip_left_rightD:
  "(x, y) \<in> set (xList \<otimes> yList) \<Longrightarrow> x \<in> set xList \<and> y \<in> set yList"
  apply(rule conjI)
   apply(rule_tac y="y" and ys="yList" in set_zip_leftD, simp)
  apply(rule_tac x="x" and xs="xList" in set_zip_rightD, simp)
  done

declare zip_map_fst_snd [simp]

subsection\<open> VC\_diffKAD Preliminaries \<close>

text \<open> In dL, the set of possible program variables is split in two, the set of variables $V$ and
their primed counterparts $V'$. To implement this, we use Isabelle's string-type and define a
function that primes a given string. We then define the set of primed-strings based on it. \<close>

definition vdiff ::"string \<Rightarrow> string" ("\<partial> _" [55] 70)
  where "(\<partial> x) = ''d[''@x@'']''"

definition varDiffs :: "string set"
  where "varDiffs = {y. \<exists> x. y = \<partial> x}"

proposition vdiff_inj:"(\<partial> x) = (\<partial> y) \<Longrightarrow> x = y"
  by(simp add: vdiff_def)

proposition vdiff_noFixPoints:"x \<noteq> (\<partial> x)"
  by(simp add: vdiff_def)

lemma varDiffsI:"x = (\<partial> z) \<Longrightarrow> x \<in> varDiffs"
  by(simp add: varDiffs_def vdiff_def)

lemma varDiffsE:
  assumes "x \<in> varDiffs"
  obtains y where "x = ''d[''@y@'']'' "
  using assms unfolding varDiffs_def vdiff_def by auto

proposition vdiff_invarDiffs:"(\<partial> x) \<in> varDiffs"
  by (simp add: varDiffsI)

subsubsection\<open> (primed) dSolve preliminaries \<close>

text \<open> This subsubsection is to define a function that takes a system of ODEs (expressed
as a list $xfList$), a presumed solution $uInput = [u_1,\dots,u_n]$, a state $s$ and a
time $t$, and outputs the induced flow $sol\, s[xfList\leftarrow uInput]\, t$. \<close>

abbreviation varDiffs_to_zero ::"real store \<Rightarrow> real store" ("sol")
  where "sol a \<equiv> (override_on a (\<lambda> x. 0) varDiffs)"

proposition varDiffs_to_zero_vdiff[simp]: "(sol s) (\<partial> x) = 0"
  apply(simp add: override_on_def varDiffs_def)
  by auto

proposition varDiffs_to_zero_beginning[simp]: "take 2 x \<noteq> ''d['' \<Longrightarrow> (sol s) x = s x"
  apply(simp add: varDiffs_def override_on_def vdiff_def)
  by fastforce

\<comment> \<open>Next, for each entry of the input-list, we update the state using said entry.\<close>

definition "vderiv_of f S = (SOME f'. (f has_vderiv_on f') S)"

primrec state_list_upd :: "((real \<Rightarrow> real store \<Rightarrow> real) \<times> string \<times> (real store \<Rightarrow> real)) list \<Rightarrow>
real \<Rightarrow> real store \<Rightarrow> real store" where
  "state_list_upd [] t s  = s"|
  "state_list_upd (uxf # tail) t s = (state_list_upd tail t s)
      ((\<pi>\<^sub>1 (\<pi>\<^sub>2 uxf)) := (\<pi>\<^sub>1 uxf) t s,
        \<partial> (\<pi>\<^sub>1 (\<pi>\<^sub>2 uxf)) := (if t = 0 then (\<pi>\<^sub>2 (\<pi>\<^sub>2 uxf)) s
            else vderiv_of (\<lambda> r. (\<pi>\<^sub>1 uxf) r s) {0<..< (2 *\<^sub>R t)} t))"

abbreviation state_list_cross_upd ::"real store \<Rightarrow>  (string \<times> (real store \<Rightarrow> real)) list \<Rightarrow>
(real \<Rightarrow> real store \<Rightarrow> real) list \<Rightarrow> real \<Rightarrow> (char list \<Rightarrow> real)" ("_[_\<leftarrow>_] _" [64,64,64] 63)
  where "s[xfList\<leftarrow>uInput] t \<equiv> state_list_upd (uInput \<otimes> xfList) t s"

proposition state_list_cross_upd_empty[simp]: "(s[[]\<leftarrow>list] t) = s"
  by(induction list, simp_all)

lemma inductive_state_list_cross_upd_its_vars:
  assumes distHyp:"distinct (map \<pi>\<^sub>1 ((y, g) # xftail))"
    and varHyp:"\<forall>xf\<in>set((y, g) # xftail). \<pi>\<^sub>1 xf \<notin> varDiffs"
    and indHyp:"(u, x, f) \<in> set (utail \<otimes> xftail) \<Longrightarrow> (s[xftail\<leftarrow>utail] t) x = u t s"
    and disjHyp:"(u, x, f) = (v, y, g) \<or> (u, x, f) \<in> set (utail \<otimes> xftail)"
  shows "(s[(y, g) # xftail\<leftarrow>v # utail] t) x = u t s"
  using disjHyp proof
  assume "(u, x, f) = (v, y, g)"
  hence "(s[(y, g) # xftail\<leftarrow>v # utail] t) x = ((s[xftail\<leftarrow>utail] t)(x := u t s,
  \<partial> x := if t = 0 then f s else vderiv_of (\<lambda> r. u r s) {0<..< (2 *\<^sub>R t)} t)) x"
    by simp
  also have "... = u t s"
    by (simp add: vdiff_def)
  ultimately show ?thesis
    by simp
next
  assume yTailHyp:"(u, x, f) \<in> set (utail \<otimes> xftail)"
  from this and indHyp have 3:"(s[xftail\<leftarrow>utail] t) x = u t s"
    by fastforce
  from yTailHyp and distHyp have 2:"y \<noteq> x" using set_zip_left_rightD
    by force
  from yTailHyp and varHyp have 1:"x \<noteq> \<partial> y"
  using set_zip_left_rightD vdiff_invarDiffs by fastforce
  from 1 and 2 have "(s[(y, g) # xftail\<leftarrow>v # utail] t) x = (s[xftail\<leftarrow>utail] t) x"
    by simp
  thus ?thesis using 3
    by simp
qed

theorem state_list_cross_upd_its_vars:
  assumes distinctHyp:"distinct (map \<pi>\<^sub>1 xfList)"
    and lengthHyp:"length xfList = length uInput"
    and varsHyp:"\<forall> xf \<in> set xfList. \<pi>\<^sub>1 xf \<notin> varDiffs"
    and its_var: "(u,x,f) \<in> set (uInput \<otimes> xfList)"
  shows "(s[xfList\<leftarrow>uInput] t) x = u t s"
  using assms apply(induct xfList uInput arbitrary: x rule: list_induct2', simp, simp, simp)
  by(clarify, rule inductive_state_list_cross_upd_its_vars, simp_all)

lemma override_on_upd:"x \<in> X \<Longrightarrow> (override_on f g X)(x := z) = (override_on f (g(x := z)) X)"
  by (rule ext, simp add: override_on_def)

lemma inductive_state_list_cross_upd_its_dvars:
  assumes "\<exists>g. (s[xfTail\<leftarrow>uTail] 0) = override_on s g varDiffs"
    and "\<forall>xf\<in>set (xf # xfTail). \<pi>\<^sub>1 xf \<notin> varDiffs"
    and "\<forall>uxf\<in>set (u # uTail \<otimes> xf # xfTail). \<pi>\<^sub>1 uxf 0 s = s (\<pi>\<^sub>1 (\<pi>\<^sub>2 uxf))"
  shows "\<exists>g. (s[xf # xfTail\<leftarrow>u # uTail] 0) = override_on s g varDiffs"
proof-
  let ?gLHS="(s[(xf # xfTail)\<leftarrow>(u # uTail)] 0)"
  have observ:"\<partial> (\<pi>\<^sub>1 xf) \<in> varDiffs" by (auto simp: varDiffs_def)
  from assms(1) obtain g where "(s[xfTail\<leftarrow>uTail] 0) = override_on s g varDiffs" by force
  then have "?gLHS = (override_on s g varDiffs)(\<pi>\<^sub>1 xf := u 0 s, \<partial> (\<pi>\<^sub>1 xf) := \<pi>\<^sub>2 xf s)" by simp
  also have "\<dots> = (override_on s g varDiffs)(\<partial> (\<pi>\<^sub>1 xf) := \<pi>\<^sub>2 xf s)"
    using override_on_def varDiffs_def assms by auto
  also have "... = (override_on s (g(\<partial> (\<pi>\<^sub>1 xf) := \<pi>\<^sub>2 xf s)) varDiffs)"
    using observ and override_on_upd by force
  ultimately show ?thesis by auto
qed

theorem state_list_cross_upd_its_dvars:
  assumes lengthHyp:"length xfList = length uInput"
    and varsHyp:"\<forall> xf \<in> set xfList. \<pi>\<^sub>1 xf \<notin> varDiffs"
    and solHyp1:"\<forall>uxf\<in>set (uInput \<otimes> xfList). (\<pi>\<^sub>1 uxf) 0 s = s (\<pi>\<^sub>1 (\<pi>\<^sub>2 uxf))"
  shows "\<exists> g. (s[xfList\<leftarrow>uInput] 0) = (override_on s g varDiffs)"
  using assms proof(induct xfList uInput rule: list_induct2')
  case 1
  have "(s[[]\<leftarrow>[]] 0) = override_on s s varDiffs"
    unfolding override_on_def by simp
  thus ?case by metis
next
  case (2 xf xfTail)
  have "(s[(xf # xfTail)\<leftarrow>[]] 0) = override_on s s varDiffs"
    unfolding override_on_def by simp
  thus ?case by metis
next
  case (3 u utail)
  have "(s[[]\<leftarrow>utail] 0) = override_on s s varDiffs"
    unfolding override_on_def by simp
  thus ?case by force
next
  case (4 xf xfTail u uTail)
  then have "\<exists>g. (s[xfTail\<leftarrow>uTail] 0) = override_on s g varDiffs" by simp
  thus ?case using inductive_state_list_cross_upd_its_dvars "4.prems" by blast
qed

lemma vderiv_unique_within_open_interval:
  assumes "(f has_vderiv_on f') {0<..< t}" and "t>0"
    and "(f has_vderiv_on f''){0<..< t}" and tauHyp:"\<tau> \<in> {0<..< t}"
  shows "f' \<tau> = f'' \<tau>"
  using assms apply(simp add: has_vderiv_on_def has_vector_derivative_def)
  using frechet_derivative_unique_within_open_interval by (metis box_real(1) scaleR_one tauHyp)

lemma has_vderiv_on_cong_open_interval:
  assumes gHyp:"\<forall> \<tau> > 0. f \<tau> = g \<tau>" and tHyp: "t>0"
    and fHyp:"(f has_vderiv_on f') {0<..<t}"
  shows "(g has_vderiv_on f') {0<..<t}"
proof-
  from gHyp have "\<And>\<tau>. \<tau> \<in> {0<..< t} \<Longrightarrow> f \<tau> = g \<tau>" using tHyp by force
  hence eqDs:"(f has_vderiv_on f') {0<..<t} = (g has_vderiv_on f') {0<..<t}"
    apply(rule_tac has_vderiv_on_cong) by auto
  thus "(g has_vderiv_on f') {0<..<t}" using eqDs fHyp by simp
qed

lemma closed_vderiv_on_cong_to_open_vderiv:
  assumes gHyp:"\<forall> \<tau> > 0. f \<tau> = g \<tau>"
    and fHyp:"\<forall>t\<ge>0. (f has_vderiv_on f') {0..t}"
    and tHyp: "t>0" and cHyp: "c > 1"
  shows "vderiv_of g {0<..< (c *\<^sub>R t)} t = f' t"
proof-
  have ctHyp:"c \<cdot> t > 0" using tHyp and cHyp by auto
  from fHyp have "(f has_vderiv_on f') {0<..<c \<cdot> t}" using has_vderiv_on_subset
    by (metis greaterThanLessThan_subseteq_atLeastAtMost_iff less_eq_real_def)
  then have derivHyp:"(g has_vderiv_on f') {0<..<c \<cdot> t}"
    using gHyp ctHyp and has_vderiv_on_cong_open_interval by blast
  hence f'Hyp:"\<forall> f''. (g has_vderiv_on f'') {0<..<c \<cdot> t} \<longrightarrow> (\<forall> \<tau> \<in> {0<..< c \<cdot> t}. f' \<tau> = f'' \<tau>)"
    using vderiv_unique_within_open_interval ctHyp by blast
  also have "(g has_vderiv_on (vderiv_of g {0<..< (c *\<^sub>R t)})) {0<..<c \<cdot> t}"
    by(simp add: vderiv_of_def, metis derivHyp someI_ex)
  ultimately show"vderiv_of g {0<..<c *\<^sub>R t} t = f' t" using tHyp cHyp by force
qed

lemma vderiv_of_to_sol_its_vars:
  assumes distinctHyp:"distinct (map \<pi>\<^sub>1 xfList)"
    and lengthHyp:"length xfList = length uInput"
    and varsHyp:"\<forall> xf \<in> set xfList. \<pi>\<^sub>1 xf \<notin> varDiffs"
    and solHyp2:"\<forall>t\<ge>0. ((\<lambda>\<tau>. (sol s[xfList\<leftarrow>uInput] \<tau>) x)
has_vderiv_on (\<lambda>\<tau>. f (sol s[xfList\<leftarrow>uInput] \<tau>))) {0..t}"
    and tHyp: "t>0" and uxfHyp:"(u, x, f) \<in> set (uInput \<otimes> xfList)"
  shows "vderiv_of (\<lambda>\<tau>. u \<tau> (sol s)) {0<..< (2 *\<^sub>R t)} t = f (sol s[xfList\<leftarrow>uInput] t)"
  apply(rule_tac f="(\<lambda>\<tau>. (sol s[xfList\<leftarrow>uInput] \<tau>) x)" in closed_vderiv_on_cong_to_open_vderiv)
  subgoal using assms and state_list_cross_upd_its_vars by metis
  by(simp_all add: solHyp2 tHyp)

lemma inductive_to_sol_zero_its_dvars:
  assumes eqFuncs:"\<forall> s. \<forall>g. \<forall>xf\<in>set ((x, f) # xfs). \<pi>\<^sub>2 xf (override_on s g varDiffs) = \<pi>\<^sub>2 xf s"
    and eqLengths:"length ((x, f) # xfs) = length (u # us)"
    and distinct:"distinct (map \<pi>\<^sub>1 ((x, f) # xfs))"
    and vars:"\<forall>xf\<in>set ((x, f) # xfs). \<pi>\<^sub>1 xf \<notin> varDiffs"
    and solHyp1:"\<forall>uxf\<in>set ((u # us) \<otimes> ((x, f) # xfs)). \<pi>\<^sub>1 uxf 0 (sol s) = sol s (\<pi>\<^sub>1 (\<pi>\<^sub>2 uxf))"
    and disjHyp:"(y, g) = (x, f) \<or> (y, g) \<in> set xfs"
    and indHyp:"(y, g) \<in> set xfs \<Longrightarrow> (sol s[xfs\<leftarrow>us] 0) (\<partial> y) = g (sol s[xfs\<leftarrow>us] 0)"
  shows "(sol s[(x, f) # xfs\<leftarrow>u # us] 0) (\<partial> y) = g (sol s[(x, f) # xfs\<leftarrow>u # us] 0)"
proof-
  from assms obtain h1 where h1Def:"(sol s[((x, f) # xfs)\<leftarrow>(u # us)] 0) =
(override_on (sol s) h1 varDiffs)" using state_list_cross_upd_its_dvars by blast
  from disjHyp show "(sol s[(x, f) # xfs\<leftarrow>u # us] 0) (\<partial> y) = g (sol s[(x, f) # xfs\<leftarrow>u # us] 0)"
  proof
    assume eqHeads:"(y, g) = (x, f)"
    then have "g (sol s[(x, f) # xfs\<leftarrow>u # us] 0) = f (sol s)" using h1Def eqFuncs by simp
    also have "... = (sol s[(x, f) # xfs\<leftarrow>u # us] 0) (\<partial> y)" using eqHeads by auto
    ultimately show ?thesis by linarith
  next
    assume tailHyp:"(y, g) \<in> set xfs"
    then have "y \<noteq> x" using distinct set_zip_left_rightD by force
    hence "\<partial> x \<noteq> \<partial> y" by(simp add: vdiff_def)
    have "x \<noteq> \<partial> y" using vars vdiff_invarDiffs by auto
    obtain h2 where h2Def:"(sol s[xfs\<leftarrow>us] 0) = override_on (sol s) h2 varDiffs"
      using state_list_cross_upd_its_dvars eqLengths distinct vars and solHyp1 by force
    have "(sol s[(x, f) # xfs\<leftarrow>u # us] 0) (\<partial> y) = g (sol s[xfs\<leftarrow>us] 0)"
      using tailHyp indHyp \<open>x \<noteq> \<partial> y\<close> and \<open>\<partial> x \<noteq> \<partial> y\<close> by simp
    also have "... = g (override_on (sol s) h2 varDiffs)" using h2Def by simp
    also have "... = g (sol s)" using eqFuncs and tailHyp by force
    also have "... = g (sol s[(x, f) # xfs\<leftarrow>u # us] 0)"
      using eqFuncs h1Def tailHyp and eq_snd_iff by fastforce
    ultimately show ?thesis by simp
  qed
qed

lemma to_sol_zero_its_dvars:
  assumes funcsHyp:"\<forall> s. \<forall> g. \<forall> xf \<in> set xfList. \<pi>\<^sub>2 xf (override_on s g varDiffs) = \<pi>\<^sub>2 xf s"
    and distinctHyp:"distinct (map \<pi>\<^sub>1 xfList)"
    and lengthHyp:"length xfList = length uInput"
    and varsHyp:"\<forall>xf \<in> set xfList. \<pi>\<^sub>1 xf \<notin> varDiffs"
    and solHyp1:"\<forall> uxf \<in> set (uInput \<otimes> xfList). (\<pi>\<^sub>1 uxf) 0 (sol s) = (sol s) (\<pi>\<^sub>1 (\<pi>\<^sub>2 uxf))"
    and ygHyp:"(y, g) \<in> set xfList"
  shows "(sol s[xfList\<leftarrow>uInput] 0)(\<partial> y) = g (sol s[xfList\<leftarrow>uInput] 0)"
  using assms apply(induct xfList uInput rule: list_induct2', simp, simp, simp, clarify)
  by(rule inductive_to_sol_zero_its_dvars, simp_all)

lemma inductive_to_sol_greater_than_zero_its_dvars:
  assumes lengthHyp:"length ((y, g) # xfs) = length (v # vs)"
    and distHyp:"distinct (map \<pi>\<^sub>1 ((y, g) # xfs))"
    and varHyp:" \<forall>xf\<in>set ((y, g) # xfs). \<pi>\<^sub>1 xf \<notin> varDiffs"
    and indHyp:"(u,x,f) \<in> set (vs \<otimes> xfs) \<Longrightarrow> (s[xfs\<leftarrow>vs]t)(\<partial> x) = vderiv_of (\<lambda>r. u r s) {0<..<2*\<^sub>Rt} t"
    and disjHyp:"(v, y, g) = (u, x, f) \<or> (u, x, f) \<in> set (vs \<otimes> xfs)" and tHyp:"t > 0"
  shows "(s[(y, g) # xfs\<leftarrow>v # vs] t) (\<partial> x) = vderiv_of (\<lambda>r. u r s) {0<..<2 *\<^sub>R t} t"
proof-
  let ?lhs = "((s[xfs\<leftarrow>vs] t)(y := v t s, \<partial> y := vderiv_of (\<lambda> r. v r s) {0<..< (2 \<cdot> t)} t)) (\<partial> x)"
  let ?rhs = "vderiv_of (\<lambda>r. u r s) {0<..< (2 \<cdot> t)} t"
  have "(s[(y, g) # xfs\<leftarrow>v # vs] t) (\<partial> x) = ?lhs" using tHyp by simp
  also have "vderiv_of (\<lambda>r. u r s) {0<..<2 *\<^sub>R t} t =?rhs" by simp
  ultimately have obs:"?thesis = (?lhs = ?rhs)" by simp
  from disjHyp have "?lhs = ?rhs"
  proof
    assume uxfEq:"(v, y, g) = (u, x, f)"
    then have "?lhs = vderiv_of (\<lambda> r. u r s) {0<..< (2 \<cdot> t)} t" by simp
    also have "vderiv_of (\<lambda> r. u r s) {0<..< (2 \<cdot> t)} t = ?rhs" using uxfEq by simp
    ultimately show "?lhs = ?rhs" by simp
  next
    assume sygTail:"(u, x, f) \<in> set (vs \<otimes> xfs)"
    from this have "y \<noteq> x" using distHyp set_zip_left_rightD by force
    hence "\<partial> x \<noteq> \<partial> y" by(simp add: vdiff_def)
    have "y \<noteq> \<partial> x" using varHyp using vdiff_invarDiffs by auto
    then have "?lhs = (s[xfs\<leftarrow>vs] t) (\<partial> x)" using \<open>y \<noteq> \<partial> x\<close> and \<open>\<partial> x \<noteq> \<partial> y\<close> by simp
    also have "(s[xfs\<leftarrow>vs] t) (\<partial> x) = ?rhs" using indHyp sygTail by simp
    ultimately show "?lhs = ?rhs" by simp
  qed
  from this and obs show ?thesis by simp
qed

lemma to_sol_greater_than_zero_its_dvars:
  assumes distinctHyp:"distinct (map \<pi>\<^sub>1 xfList)"
    and lengthHyp:"length xfList = length uInput"
    and varsHyp:"\<forall>xf \<in> set xfList. \<pi>\<^sub>1 xf \<notin> varDiffs"
    and uxfHyp:"(u, x, f) \<in> set (uInput \<otimes> xfList)" and tHyp:"t > 0"
  shows "(s[xfList\<leftarrow>uInput] t) (\<partial> x) = vderiv_of (\<lambda> r. u r s) {0<..< (2 *\<^sub>R t)} t"
  using assms apply(induct xfList uInput rule: list_induct2', simp, simp, simp, clarify)
  by(rule_tac f="f" in inductive_to_sol_greater_than_zero_its_dvars, auto)

subsubsection\<open> dInv preliminaries \<close>

text \<open> Here, we introduce syntactic notation to talk about differential invariants. \<close>

no_notation Antidomain_Semiring.antidomain_left_monoid_class.am_add_op (infixl "\<oplus>" 65)
no_notation Dioid.times_class.opp_mult (infixl "\<odot>" 70)
no_notation Lattices.inf_class.inf (infixl "\<sqinter>" 70)
no_notation Lattices.sup_class.sup (infixl "\<squnion>" 65)

datatype trms = Const real ("t\<^sub>C _" [54] 70) | Var string ("t\<^sub>V _" [54] 70) |
  Mns trms ("\<ominus> _" [54] 65) | Sum trms trms (infixl "\<oplus>" 65) |
  Mult trms trms (infixl "\<odot>" 68)

term test_monoid_class.n_add_op

primrec tval ::"trms \<Rightarrow> (real store \<Rightarrow> real)" ("(1\<lbrakk> _ \<rbrakk>\<^sub>t)") where
  "\<lbrakk>t\<^sub>C r\<rbrakk>\<^sub>t = (\<lambda> s. r)"|
  "\<lbrakk>t\<^sub>V x\<rbrakk>\<^sub>t = (\<lambda> s. s x)"|
  "\<lbrakk>\<ominus> \<theta>\<rbrakk>\<^sub>t = (\<lambda> s. - (\<lbrakk>\<theta>\<rbrakk>\<^sub>t) s)"|
  "\<lbrakk>\<theta> \<oplus> \<eta>\<rbrakk>\<^sub>t = (\<lambda> s. (\<lbrakk>\<theta>\<rbrakk>\<^sub>t) s + (\<lbrakk>\<eta>\<rbrakk>\<^sub>t) s)"|
  "\<lbrakk>\<theta> \<odot> \<eta>\<rbrakk>\<^sub>t = (\<lambda> s. (\<lbrakk>\<theta>\<rbrakk>\<^sub>t) s \<cdot> (\<lbrakk>\<eta>\<rbrakk>\<^sub>t) s)"

datatype props = Eq trms trms (infixr "\<doteq>" 60) | Less trms trms (infixr "\<prec>" 62) |
  Leq trms trms (infixr "\<preceq>" 61) | And props props (infixl "\<sqinter>" 63) |
  Or props props (infixl "\<squnion>" 64)

primrec pval ::"props \<Rightarrow> (real store \<Rightarrow> bool)" ("(1\<lbrakk>_\<rbrakk>\<^sub>P)") where
  "\<lbrakk>\<theta> \<doteq> \<eta>\<rbrakk>\<^sub>P = (\<lambda> s. (\<lbrakk>\<theta>\<rbrakk>\<^sub>t) s = (\<lbrakk>\<eta>\<rbrakk>\<^sub>t) s)"|
  "\<lbrakk>\<theta> \<prec> \<eta>\<rbrakk>\<^sub>P = (\<lambda> s. (\<lbrakk>\<theta>\<rbrakk>\<^sub>t) s < (\<lbrakk>\<eta>\<rbrakk>\<^sub>t) s)"|
  "\<lbrakk>\<theta> \<preceq> \<eta>\<rbrakk>\<^sub>P = (\<lambda> s. (\<lbrakk>\<theta>\<rbrakk>\<^sub>t) s \<le> (\<lbrakk>\<eta>\<rbrakk>\<^sub>t) s)"|
  "\<lbrakk>\<phi> \<sqinter> \<psi>\<rbrakk>\<^sub>P = (\<lambda> s. (\<lbrakk>\<phi>\<rbrakk>\<^sub>P) s \<and> (\<lbrakk>\<psi>\<rbrakk>\<^sub>P) s)"|
  "\<lbrakk>\<phi> \<squnion> \<psi>\<rbrakk>\<^sub>P = (\<lambda> s. (\<lbrakk>\<phi>\<rbrakk>\<^sub>P) s \<or> (\<lbrakk>\<psi>\<rbrakk>\<^sub>P) s)"

primrec tdiff ::"trms \<Rightarrow> trms" ("\<partial>\<^sub>t _" [54] 70) where
  "(\<partial>\<^sub>t t\<^sub>C r) = t\<^sub>C 0"|
  "(\<partial>\<^sub>t t\<^sub>V x) = t\<^sub>V (\<partial> x)"|
  "(\<partial>\<^sub>t \<ominus> \<theta>) = \<ominus> (\<partial>\<^sub>t \<theta>)"|
  "(\<partial>\<^sub>t (\<theta> \<oplus> \<eta>)) = (\<partial>\<^sub>t \<theta>) \<oplus> (\<partial>\<^sub>t \<eta>)"|
  "(\<partial>\<^sub>t (\<theta> \<odot> \<eta>)) = ((\<partial>\<^sub>t \<theta>) \<odot> \<eta>) \<oplus> (\<theta> \<odot> (\<partial>\<^sub>t \<eta>))"

primrec pdiff ::"props \<Rightarrow> props" ("\<partial>\<^sub>P _" [54] 70) where
  "(\<partial>\<^sub>P (\<theta> \<doteq> \<eta>)) = ((\<partial>\<^sub>t \<theta>) \<doteq> (\<partial>\<^sub>t \<eta>))"|
  "(\<partial>\<^sub>P (\<theta> \<prec> \<eta>)) = ((\<partial>\<^sub>t \<theta>) \<preceq> (\<partial>\<^sub>t \<eta>))"|
  "(\<partial>\<^sub>P (\<theta> \<preceq> \<eta>)) = ((\<partial>\<^sub>t \<theta>) \<preceq> (\<partial>\<^sub>t \<eta>))"|
  "(\<partial>\<^sub>P (\<phi> \<sqinter> \<psi>)) = (\<partial>\<^sub>P \<phi>) \<sqinter> (\<partial>\<^sub>P \<psi>)"|
  "(\<partial>\<^sub>P (\<phi> \<squnion> \<psi>)) = (\<partial>\<^sub>P \<phi>) \<sqinter> (\<partial>\<^sub>P \<psi>)"

primrec trmVars :: "trms \<Rightarrow> string set" where
  "trmVars (t\<^sub>C r) = {}"|
  "trmVars (t\<^sub>V x) = {x}"|
  "trmVars (\<ominus> \<theta>) = trmVars \<theta>"|
  "trmVars (\<theta> \<oplus> \<eta>) = trmVars \<theta> \<union> trmVars \<eta>"|
  "trmVars (\<theta> \<odot> \<eta>) = trmVars \<theta> \<union> trmVars \<eta>"

fun substList ::"(string \<times> trms) list \<Rightarrow> trms \<Rightarrow> trms" ("_\<langle>_\<rangle>" [54] 80) where
  "xtList\<langle>t\<^sub>C r\<rangle> = t\<^sub>C r"|
  "[]\<langle>t\<^sub>V x\<rangle> = t\<^sub>V x"|
  "((y,\<xi>) # xtTail)\<langle>Var x\<rangle> = (if x = y then \<xi> else xtTail\<langle>Var x\<rangle>)"|
  "xtList\<langle>\<ominus> \<theta>\<rangle> = \<ominus> (xtList\<langle>\<theta>\<rangle>)"|
  "xtList\<langle>\<theta> \<oplus> \<eta>\<rangle> = (xtList\<langle>\<theta>\<rangle>) \<oplus> (xtList\<langle>\<eta>\<rangle>)"|
  "xtList\<langle>\<theta> \<odot> \<eta>\<rangle> = (xtList\<langle>\<theta>\<rangle>) \<odot> (xtList\<langle>\<eta>\<rangle>)"

proposition substList_on_compl_of_varDiffs:
  assumes "trmVars \<eta> \<subseteq> (UNIV - varDiffs)"
    and "set (map \<pi>\<^sub>1 xtList) \<subseteq> varDiffs"
  shows "xtList\<langle>\<eta>\<rangle> = \<eta>"
  using assms apply(induction \<eta>, simp_all add: varDiffs_def)
  by(induction xtList, auto)

lemma substList_help1:"set (map \<pi>\<^sub>1 ((map (vdiff \<circ> \<pi>\<^sub>1) xfList) \<otimes> uInput)) \<subseteq> varDiffs"
  apply(induct xfList uInput rule: list_induct2', simp_all add: varDiffs_def)
  by auto

lemma substList_help2:
  assumes "trmVars \<eta> \<subseteq> (UNIV - varDiffs)"
  shows "((map (vdiff \<circ> \<pi>\<^sub>1) xfList) \<otimes> uInput)\<langle>\<eta>\<rangle> = \<eta>"
  using assms substList_help1 substList_on_compl_of_varDiffs by blast

lemma substList_cross_vdiff_on_non_ocurring_var:
  assumes "x \<notin> set list1"
  shows "((map vdiff list1) \<otimes> list2)\<langle>t\<^sub>V (\<partial> x)\<rangle> = t\<^sub>V (\<partial> x)"
  using assms apply(induct list1 list2 rule: list_induct2', simp, simp, clarsimp)
  by(simp add: vdiff_def)

primrec propVars :: "props \<Rightarrow> string set" where
  "propVars (\<theta> \<doteq> \<eta>) = trmVars \<theta> \<union> trmVars \<eta>"|
  "propVars (\<theta> \<prec> \<eta>) = trmVars \<theta> \<union> trmVars \<eta>"|
  "propVars (\<theta> \<preceq> \<eta>) = trmVars \<theta> \<union> trmVars \<eta>"|
  "propVars (\<phi> \<sqinter> \<psi>) = propVars \<phi> \<union> propVars \<psi>"|
  "propVars (\<phi> \<squnion> \<psi>) = propVars \<phi> \<union> propVars \<psi>"

primrec subspList :: "(string \<times> trms) list \<Rightarrow> props \<Rightarrow> props" ("_\<restriction>_\<restriction>" [54] 80) where
  "xtList\<restriction>\<theta> \<doteq> \<eta>\<restriction> = ((xtList\<langle>\<theta>\<rangle>) \<doteq> (xtList\<langle>\<eta>\<rangle>))"|
  "xtList\<restriction>\<theta> \<prec> \<eta>\<restriction> = ((xtList\<langle>\<theta>\<rangle>) \<prec> (xtList\<langle>\<eta>\<rangle>))"|
  "xtList\<restriction>\<theta> \<preceq> \<eta>\<restriction> = ((xtList\<langle>\<theta>\<rangle>) \<preceq> (xtList\<langle>\<eta>\<rangle>))"|
  "xtList\<restriction>\<phi> \<sqinter> \<psi>\<restriction> = ((xtList\<restriction>\<phi>\<restriction>) \<sqinter> (xtList\<restriction>\<psi>\<restriction>))"|
  "xtList\<restriction>\<phi> \<squnion> \<psi>\<restriction> = ((xtList\<restriction>\<phi>\<restriction>) \<squnion> (xtList\<restriction>\<psi>\<restriction>))"

subsubsection\<open> ODE Extras \<close>

text\<open> For exemplification purposes, we compile some concrete derivatives used commonly in classical
mechanics. A more general approach should be taken that generates this theorems as instantiations. \<close>

named_theorems ubc_definitions "definitions used in the locale unique_on_bounded_closed"

declare unique_on_bounded_closed_def [ubc_definitions]
  and unique_on_bounded_closed_axioms_def [ubc_definitions]
  and unique_on_closed_def [ubc_definitions]
  and compact_interval_def [ubc_definitions]
  and compact_interval_axioms_def [ubc_definitions]
  and self_mapping_def [ubc_definitions]
  and self_mapping_axioms_def [ubc_definitions]
  and continuous_rhs_def [ubc_definitions]
  and closed_domain_def [ubc_definitions]
  and global_lipschitz_def [ubc_definitions]
  and interval_def [ubc_definitions]
  and nonempty_set_def [ubc_definitions]
  and lipschitz_on_def [ubc_definitions]

named_theorems poly_deriv "temporal compilation of derivatives representing galilean transformations"
named_theorems galilean_transform "temporal compilation of vderivs representing galilean transformations"
named_theorems galilean_transform_eq "the equational version of galilean-transform"

lemma vector_derivative_line_at_origin:"((\<cdot>) a has_vector_derivative a) (at x within T)"
  by (auto intro: derivative_eq_intros)

lemma [poly_deriv]:"((\<cdot>) a has_derivative (\<lambda>x. x *\<^sub>R a)) (at x within T)"
  using vector_derivative_line_at_origin unfolding has_vector_derivative_def by simp

lemma quadratic_monomial_derivative:
  "((\<lambda>t::real. a \<cdot> t\<^sup>2) has_derivative (\<lambda>t. a \<cdot> (2 \<cdot> x \<cdot> t))) (at x within T)"
  apply(rule_tac g'1="\<lambda> t. 2 \<cdot> x \<cdot> t" in derivative_eq_intros(6))
  apply(rule_tac f'1="\<lambda> t. t" in derivative_eq_intros(16))
  by (auto intro: derivative_eq_intros)

lemma quadratic_monomial_derivative2:
  "((\<lambda>t::real. a \<cdot> t\<^sup>2 / 2) has_derivative (\<lambda>t. a \<cdot> x \<cdot> t)) (at x within T)"
  apply(rule_tac f'1="\<lambda>t. a \<cdot> (2 \<cdot> x \<cdot> t)" and g'1="\<lambda> x. 0" in derivative_eq_intros(18))
  using quadratic_monomial_derivative by auto

lemma quadratic_monomial_vderiv[poly_deriv]:"((\<lambda>t. a \<cdot> t\<^sup>2 / 2) has_vderiv_on (\<cdot>) a) T"
  apply(simp add: has_vderiv_on_def has_vector_derivative_def, clarify)
  using quadratic_monomial_derivative2 by (simp add: mult_commute_abs)

lemma galilean_position[galilean_transform]:
  "((\<lambda>t. a \<cdot> t\<^sup>2 / 2 + v \<cdot> t + x) has_vderiv_on (\<lambda>t. a \<cdot> t + v)) T"
  apply(rule_tac f'="\<lambda> x. a \<cdot> x + v" and g'1="\<lambda> x. 0" in derivative_intros(189))
  apply(rule_tac f'1="\<lambda> x. a \<cdot> x" and g'1="\<lambda> x. v" in derivative_intros(189))
  using poly_deriv(2) by(auto intro: derivative_intros)

lemma [poly_deriv]:
  "t \<in> T \<Longrightarrow> ((\<lambda>\<tau>. a \<cdot> \<tau>\<^sup>2 / 2 + v \<cdot> \<tau> + x) has_derivative (\<lambda>x. x *\<^sub>R (a \<cdot> t + v))) (at t within T)"
  using galilean_position unfolding has_vderiv_on_def has_vector_derivative_def by simp

lemma [galilean_transform_eq]:
  "t > 0 \<Longrightarrow> vderiv_of (\<lambda>t. a \<cdot> t^2 / 2 + v \<cdot> t + x) {0<..<2 \<cdot> t} t = a \<cdot> t + v"
proof-
  let ?f = "vderiv_of (\<lambda>t. a \<cdot> t^2 / 2 + v \<cdot> t + x) {0<..<2 \<cdot> t}"
  assume "t > 0" hence "t \<in> {0<..<2 \<cdot> t}" by auto
  have "\<exists> f. ((\<lambda>t. a \<cdot> t\<^sup>2 / 2 + v \<cdot> t + x) has_vderiv_on f) {0<..<2 \<cdot> t}"
    using galilean_position by blast
  hence "((\<lambda>t. a \<cdot> t^2 / 2 + v \<cdot> t + x) has_vderiv_on ?f) {0<..<2 \<cdot> t}"
    unfolding vderiv_of_def  by (metis (mono_tags, lifting) someI_ex)
  also have "((\<lambda>t. a \<cdot> t\<^sup>2 / 2 + v \<cdot> t + x) has_vderiv_on (\<lambda>t. a \<cdot> t + v)) {0<..<2 \<cdot> t}"
    using galilean_position by simp
  ultimately show "(vderiv_of (\<lambda>t. a \<cdot> t^2 / 2 + v \<cdot> t + x) {0<..<2 \<cdot> t}) t = a \<cdot> t + v"
    apply(rule_tac f'="?f" and \<tau>="t" and t="2\<cdot>t" in vderiv_unique_within_open_interval)
    using \<open>t \<in> {0<..<2 \<cdot> t}\<close> by auto
qed

(* A remainder of how not to prove the above theorem... *)
lemma "t > 0 \<Longrightarrow> vderiv_of (\<lambda>t. a \<cdot> t^2 / 2 + v \<cdot> t + x) {0<..<2 \<cdot> t} t = a \<cdot> t + v"
  unfolding vderiv_of_def apply(subst some1_equality[of _ "(\<lambda>t. a \<cdot> t + v)"])
  apply(rule_tac a="\<lambda>t. a \<cdot> t + v" in ex1I)
  apply(simp_all add: galilean_position)
  apply(rule ext, rename_tac f \<tau>)
  apply(rule_tac f="\<lambda>t. a \<cdot> t\<^sup>2 / 2 + v \<cdot> t + x" and t="2 \<cdot> t" and f'="f" in vderiv_unique_within_open_interval)
  apply(simp_all add: galilean_position)
  oops

lemma galilean_velocity[galilean_transform]:"((\<lambda>r. a \<cdot> r + v) has_vderiv_on (\<lambda>t. a)) T"
  apply(rule_tac f'1="\<lambda> x. a" and g'1="\<lambda> x. 0" in derivative_intros(189))
  unfolding has_vderiv_on_def by(auto intro: derivative_eq_intros)

lemma [galilean_transform_eq]:
  "t > 0 \<Longrightarrow> vderiv_of (\<lambda>r. a \<cdot> r + v) {0<..<2 \<cdot> t} t = a"
proof-
  let ?f = "vderiv_of (\<lambda>r. a \<cdot> r + v) {0<..<2 \<cdot> t}"
  assume "t > 0" hence "t \<in> {0<..<2 \<cdot> t}" by auto
  have "\<exists> f. ((\<lambda>r. a \<cdot> r + v) has_vderiv_on f) {0<..<2 \<cdot> t}"
    using galilean_velocity by blast
  hence "((\<lambda>r. a \<cdot> r + v) has_vderiv_on ?f) {0<..<2 \<cdot> t}"
    unfolding vderiv_of_def  by (metis (mono_tags, lifting) someI_ex)
  also have "((\<lambda>r. a \<cdot> r + v) has_vderiv_on (\<lambda>t. a)) {0<..<2 \<cdot> t}"
    using galilean_velocity by simp
  ultimately show "(vderiv_of (\<lambda>r. a \<cdot> r + v) {0<..<2 \<cdot> t}) t = a"
    apply(rule_tac f'="?f" and \<tau>="t" and t="2\<cdot>t" in vderiv_unique_within_open_interval)
    using \<open>t \<in> {0<..<2 \<cdot> t}\<close> by auto
qed

lemma [galilean_transform]:
  "((\<lambda>t. v \<cdot> t - a \<cdot> t\<^sup>2 / 2 + x) has_vderiv_on (\<lambda>x. v - a \<cdot> x)) {0..t}"
  apply(subgoal_tac "((\<lambda>t. - a \<cdot> t\<^sup>2 / 2 + v \<cdot> t  +x) has_vderiv_on (\<lambda>x. - a \<cdot> x + v)) {0..t}", simp)
  by(rule galilean_transform)

lemma [galilean_transform_eq]:"t > 0 \<Longrightarrow> vderiv_of (\<lambda>t. v \<cdot> t - a \<cdot> t^2 / 2 + x) {0<..<2 \<cdot> t} t = v - a \<cdot> t"
  apply(subgoal_tac "vderiv_of (\<lambda>t. - a \<cdot> t\<^sup>2 / 2 + v \<cdot> t + x) {0<..<2 \<cdot> t} t = - a \<cdot> t + v", simp)
  by(rule galilean_transform_eq)

lemma [galilean_transform]:
  "((\<lambda>t. v - a \<cdot> t) has_vderiv_on (\<lambda>x. - a)) {0..t}"
  apply(subgoal_tac "((\<lambda>t. - a \<cdot> t + v) has_vderiv_on (\<lambda>x. - a)) {0..t}", simp)
  by(rule galilean_transform)

lemma [galilean_transform_eq]:"t > 0 \<Longrightarrow> vderiv_of (\<lambda>r. v - a \<cdot> r) {0<..<2 \<cdot> t} t = - a"
  apply(subgoal_tac "vderiv_of (\<lambda>t. - a \<cdot> t + v) {0<..<2 \<cdot> t} t = - a", simp)
  by(rule galilean_transform_eq)

end