(*  Title:      HOL/Auth/Guard/List_Msg.thy
    Author:     Frederic Blanqui, University of Cambridge Computer Laboratory
    Copyright   2001  University of Cambridge
*)

section\<open>Lists of Messages and Lists of Agents\<close>

theory List_Msg imports Extensions begin

subsection\<open>Implementation of Lists by Messages\<close>

subsubsection\<open>nil is represented by any message which is not a pair\<close>

abbreviation (input)
  cons :: "msg => msg => msg" where
  "cons x l == \<lbrace>x,l\<rbrace>"

subsubsection\<open>induction principle\<close>

lemma lmsg_induct: "\<lbrakk>!!x. not_MPair x \<Longrightarrow> P x; !!x l. P l \<Longrightarrow> P (cons x l)\<rbrakk>
\<Longrightarrow> P l"
by (induct l) auto

subsubsection\<open>head\<close>

primrec head :: "msg => msg" where
"head (cons x l) = x"

subsubsection\<open>tail\<close>

primrec tail :: "msg => msg" where
"tail (cons x l) = l"

subsubsection\<open>length\<close>

fun len :: "msg => nat" where
"len (cons x l) = Suc (len l)" |
"len other = 0"

lemma len_not_empty: "n < len l \<Longrightarrow> \<exists>x l'. l = cons x l'"
by (cases l) auto

subsubsection\<open>membership\<close>

fun isin :: "msg * msg => bool" where
"isin (x, cons y l) = (x=y | isin (x,l))" |
"isin (x, other) = False"

subsubsection\<open>delete an element\<close>

fun del :: "msg * msg => msg" where
"del (x, cons y l) = (if x=y then l else cons y (del (x,l)))" |
"del (x, other) = other"

lemma notin_del [simp]: "~ isin (x,l) \<Longrightarrow> del (x,l) = l"
by (induct l) auto

lemma isin_del [rule_format]: "isin (y, del (x,l)) --> isin (y,l)"
by (induct l) auto

subsubsection\<open>concatenation\<close>

fun app :: "msg * msg => msg" where
"app (cons x l, l') = cons x (app (l,l'))" |
"app (other, l') = l'"

lemma isin_app [iff]: "isin (x, app(l,l')) = (isin (x,l) | isin (x,l'))"
by (induct l) auto

subsubsection\<open>replacement\<close>

fun repl :: "msg * nat * msg => msg" where
"repl (cons x l, Suc i, x') = cons x (repl (l,i,x'))" |
"repl (cons x l, 0, x') = cons x' l" |
"repl (other, i, M') = other"

subsubsection\<open>ith element\<close>

fun ith :: "msg * nat => msg" where
"ith (cons x l, Suc i) = ith (l,i)" |
"ith (cons x l, 0) = x" |
"ith (other, i) = other"

lemma ith_head: "0 < len l \<Longrightarrow> ith (l,0) = head l"
by (cases l) auto

subsubsection\<open>insertion\<close>

fun ins :: "msg * nat * msg => msg" where
"ins (cons x l, Suc i, y) = cons x (ins (l,i,y))" |
"ins (l, 0, y) = cons y l"

lemma ins_head [simp]: "ins (l,0,y) = cons y l"
by (cases l) auto

subsubsection\<open>truncation\<close>

fun trunc :: "msg * nat => msg" where
"trunc (l,0) = l" |
"trunc (cons x l, Suc i) = trunc (l,i)"

lemma trunc_zero [simp]: "trunc (l,0) = l"
by (cases l) auto

subsection\<open>Agent Lists\<close>

subsubsection\<open>set of well-formed agent-list messages\<close>

abbreviation
  nil :: msg where
  "nil == Number 0"

inductive_set agl :: "msg set"
where
  Nil[intro]: "nil \<in> agl"
| Cons[intro]: "\<lbrakk>A \<in> agent; I \<in> agl\<rbrakk> \<Longrightarrow> cons (Agent A) I \<in> agl"

subsubsection\<open>basic facts about agent lists\<close>

lemma del_in_agl [intro]: "I \<in> agl \<Longrightarrow> del (a,I) \<in> agl"
by (erule agl.induct, auto)

lemma app_in_agl [intro]: "\<lbrakk>I \<in> agl; J \<in> agl\<rbrakk> \<Longrightarrow> app (I,J) \<in> agl"
by (erule agl.induct, auto)

lemma no_Key_in_agl: "I \<in> agl \<Longrightarrow> Key K \<notin> parts {I}"
by (erule agl.induct, auto)

lemma no_Nonce_in_agl: "I \<in> agl \<Longrightarrow> Nonce n \<notin> parts {I}"
by (erule agl.induct, auto)

lemma no_Key_in_appdel: "\<lbrakk>I \<in> agl; J \<in> agl\<rbrakk> \<Longrightarrow>
Key K \<notin> parts {app (J, del (Agent B, I))}"
by (rule no_Key_in_agl, auto)

lemma no_Nonce_in_appdel: "\<lbrakk>I \<in> agl; J \<in> agl\<rbrakk> \<Longrightarrow>
Nonce n \<notin> parts {app (J, del (Agent B, I))}"
by (rule no_Nonce_in_agl, auto)

lemma no_Crypt_in_agl: "I \<in> agl \<Longrightarrow> Crypt K X \<notin> parts {I}"
by (erule agl.induct, auto)

lemma no_Crypt_in_appdel: "\<lbrakk>I \<in> agl; J \<in> agl\<rbrakk> \<Longrightarrow>
Crypt K X \<notin> parts {app (J, del (Agent B,I))}"
by (rule no_Crypt_in_agl, auto)

end


theory GabrielaLimonta2
imports "~~/src/HOL/IMP/BExp"
begin

(* Homework 11.2 *)

datatype
  com = SKIP
      | Assign vname aexp       ("_ ::= _" [1000, 61] 61)
      | Seq    com  com         ("_;;/ _"  [60, 61] 60)
      | If     bexp com com     ("(IF _/ THEN _/ ELSE _)"  [0, 0, 61] 61)
      | While  bexp com         ("(WHILE _/ DO _)"  [0, 61] 61)
(* begin mod *)
      | Or     com  com         ("_ OR/ _" [60, 61] 60)
(* end mod *)

inductive
  big_step :: "com \<times> state \<Rightarrow> state \<Rightarrow> bool" (infix "\<Rightarrow>" 55)
where
Skip: "(SKIP,s) \<Rightarrow> s" |
Assign: "(x ::= a,s) \<Rightarrow> s(x := aval a s)" |
Seq: "\<lbrakk> (c\<^sub>1,s\<^sub>1) \<Rightarrow> s\<^sub>2;  (c\<^sub>2,s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk> \<Longrightarrow> (c\<^sub>1;;c\<^sub>2, s\<^sub>1) \<Rightarrow> s\<^sub>3" |
IfTrue: "\<lbrakk> bval b s;  (c\<^sub>1,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t" |
IfFalse: "\<lbrakk> \<not>bval b s;  (c\<^sub>2,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t" |
WhileFalse: "\<not>bval b s \<Longrightarrow> (WHILE b DO c,s) \<Rightarrow> s" |
WhileTrue:
"\<lbrakk> bval b s\<^sub>1;  (c,s\<^sub>1) \<Rightarrow> s\<^sub>2;  (WHILE b DO c, s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk>
\<Longrightarrow> (WHILE b DO c, s\<^sub>1) \<Rightarrow> s\<^sub>3" |
(* begin mod *)
Or1: "(c\<^sub>1, s) \<Rightarrow> t \<Longrightarrow> (c\<^sub>1 OR c\<^sub>2, s) \<Rightarrow> t" |
Or2: "(c\<^sub>2, s) \<Rightarrow> t \<Longrightarrow> (c\<^sub>1 OR c\<^sub>2, s) \<Rightarrow> t"
(* end mod *)
text_raw{*}%endsnip*}

text{* Proof automation: *}

text {* The introduction rules are good for automatically
construction small program executions. The recursive cases
may require backtracking, so we declare the set as unsafe
intro rules. *}
declare big_step.intros [intro]

text{* The standard induction rule
@{thm [display] big_step.induct [no_vars]} *}

thm big_step.induct

text{*
This induction schema is almost perfect for our purposes, but
our trick for reusing the tuple syntax means that the induction
schema has two parameters instead of the @{text c}, @{text s},
and @{text s'} that we are likely to encounter. Splitting
the tuple parameter fixes this:
*}
lemmas big_step_induct = big_step.induct[split_format(complete)]
thm big_step_induct
text {*
@{thm [display] big_step_induct [no_vars]}
*}

subsection "Rule inversion"

text{* What can we deduce from @{prop "(SKIP,s) \<Rightarrow> t"} ?
That @{prop "s = t"}. This is how we can automatically prove it: *}

inductive_cases SkipE[elim!]: "(SKIP,s) \<Rightarrow> t"
thm SkipE

text{* This is an \emph{elimination rule}. The [elim] attribute tells auto,
blast and friends (but not simp!) to use it automatically; [elim!] means that
it is applied eagerly.

Similarly for the other commands: *}

inductive_cases AssignE[elim!]: "(x ::= a,s) \<Rightarrow> t"
thm AssignE
inductive_cases SeqE[elim!]: "(c1;;c2,s1) \<Rightarrow> s3"
thm SeqE
inductive_cases IfE[elim!]: "(IF b THEN c1 ELSE c2,s) \<Rightarrow> t"
thm IfE

(* begin mod *)
inductive_cases OrE[elim]: "(c1 OR c2, s) \<Rightarrow> t"
thm OrE
(* end mod *)

inductive_cases WhileE[elim]: "(WHILE b DO c,s) \<Rightarrow> t"
thm WhileE
text{* Only [elim]: [elim!] would not terminate. *}

text_raw{*\snip{BigStepEquiv}{0}{1}{% *}
abbreviation
  equiv_c :: "com \<Rightarrow> com \<Rightarrow> bool" (infix "\<sim>" 50) where
  "c \<sim> c' \<equiv> (\<forall>s t. (c,s) \<Rightarrow> t  =  (c',s) \<Rightarrow> t)"
text_raw{*}%endsnip*}

text {*
Warning: @{text"\<sim>"} is the symbol written \verb!\ < s i m >! (without spaces).

  As an example, we show that loop unfolding is an equivalence
  transformation on programs:
*}
lemma unfold_while:
  "(WHILE b DO c) \<sim> (IF b THEN c;; WHILE b DO c ELSE SKIP)" (is "?w \<sim> ?iw")
proof -
  -- "to show the equivalence, we look at the derivation tree for"
  -- "each side and from that construct a derivation tree for the other side"
  { fix s t assume "(?w, s) \<Rightarrow> t"
    -- "as a first thing we note that, if @{text b} is @{text False} in state @{text s},"
    -- "then both statements do nothing:"
    { assume "\<not>bval b s"
      hence "t = s" using `(?w,s) \<Rightarrow> t` by blast
      hence "(?iw, s) \<Rightarrow> t" using `\<not>bval b s` by blast
    }
    moreover
    -- "on the other hand, if @{text b} is @{text True} in state @{text s},"
    -- {* then only the @{text WhileTrue} rule can have been used to derive @{text "(?w, s) \<Rightarrow> t"} *}
    { assume "bval b s"
      with `(?w, s) \<Rightarrow> t` obtain s' where
        "(c, s) \<Rightarrow> s'" and "(?w, s') \<Rightarrow> t" by auto
      -- "now we can build a derivation tree for the @{text IF}"
      -- "first, the body of the True-branch:"
      hence "(c;; ?w, s) \<Rightarrow> t" by (rule Seq)
      -- "then the whole @{text IF}"
      with `bval b s` have "(?iw, s) \<Rightarrow> t" by (rule IfTrue)
    }
    ultimately
    -- "both cases together give us what we want:"
    have "(?iw, s) \<Rightarrow> t" by blast
  }
  moreover
  -- "now the other direction:"
  { fix s t assume "(?iw, s) \<Rightarrow> t"
    -- "again, if @{text b} is @{text False} in state @{text s}, then the False-branch"
    -- "of the @{text IF} is executed, and both statements do nothing:"
    { assume "\<not>bval b s"
      hence "s = t" using `(?iw, s) \<Rightarrow> t` by blast
      hence "(?w, s) \<Rightarrow> t" using `\<not>bval b s` by blast
    }
    moreover
    -- "on the other hand, if @{text b} is @{text True} in state @{text s},"
    -- {* then this time only the @{text IfTrue} rule can have be used *}
    { assume "bval b s"
      with `(?iw, s) \<Rightarrow> t` have "(c;; ?w, s) \<Rightarrow> t" by auto
      -- "and for this, only the Seq-rule is applicable:"
      then obtain s' where
        "(c, s) \<Rightarrow> s'" and "(?w, s') \<Rightarrow> t" by auto
      -- "with this information, we can build a derivation tree for the @{text WHILE}"
      with `bval b s`
      have "(?w, s) \<Rightarrow> t" by (rule WhileTrue)
    }
    ultimately
    -- "both cases together again give us what we want:"
    have "(?w, s) \<Rightarrow> t" by blast
  }
  ultimately
  show ?thesis by blast
qed

text {* Luckily, such lengthy proofs are seldom necessary.  Isabelle can
prove many such facts automatically.  *}

lemma while_unfold:
  "(WHILE b DO c) \<sim> (IF b THEN c;; WHILE b DO c ELSE SKIP)"
by blast

type_synonym assn = "state \<Rightarrow> bool"

definition
hoare_valid :: "assn \<Rightarrow> com \<Rightarrow> assn \<Rightarrow> bool" ("\<Turnstile> {(1_)}/ (_)/ {(1_)}" 50) where
"\<Turnstile> {P}c{Q} = (\<forall>s t. P s \<and> (c,s) \<Rightarrow> t  \<longrightarrow>  Q t)"

abbreviation state_subst :: "state \<Rightarrow> aexp \<Rightarrow> vname \<Rightarrow> state"
  ("_[_'/_]" [1000,0,0] 999)
where "s[a/x] == s(x := aval a s)"

inductive
  hoare :: "assn \<Rightarrow> com \<Rightarrow> assn \<Rightarrow> bool" ("\<turnstile> ({(1_)}/ (_)/ {(1_)})" 50)
where
Skip: "\<turnstile> {P} SKIP {P}"  |

Assign:  "\<turnstile> {\<lambda>s. P(s[a/x])} x::=a {P}"  |

Seq: "\<lbrakk> \<turnstile> {P} c\<^sub>1 {Q};  \<turnstile> {Q} c\<^sub>2 {R} \<rbrakk>
      \<Longrightarrow> \<turnstile> {P} c\<^sub>1;;c\<^sub>2 {R}"  |

If: "\<lbrakk> \<turnstile> {\<lambda>s. P s \<and> bval b s} c\<^sub>1 {Q};  \<turnstile> {\<lambda>s. P s \<and> \<not> bval b s} c\<^sub>2 {Q} \<rbrakk>
     \<Longrightarrow> \<turnstile> {P} IF b THEN c\<^sub>1 ELSE c\<^sub>2 {Q}"  |

While: "\<turnstile> {\<lambda>s. P s \<and> bval b s} c {P} \<Longrightarrow>
        \<turnstile> {P} WHILE b DO c {\<lambda>s. P s \<and> \<not> bval b s}"  |

conseq: "\<lbrakk> \<forall>s. P' s \<longrightarrow> P s;  \<turnstile> {P} c {Q};  \<forall>s. Q s \<longrightarrow> Q' s \<rbrakk>
        \<Longrightarrow> \<turnstile> {P'} c {Q'}" |

(* begin mod *)
Or: "\<lbrakk> \<turnstile> {P} c\<^sub>1 {Q};  \<turnstile> {P} c\<^sub>2 {Q} \<rbrakk>
      \<Longrightarrow> \<turnstile> {P} c\<^sub>1 OR c\<^sub>2 {Q}"
(* end mod *)

lemmas [simp] = hoare.Skip hoare.Assign hoare.Seq If

lemmas [intro!] = hoare.Skip hoare.Assign hoare.Seq hoare.If

text{* The assignment and While rule are awkward to use in actual proofs
because their pre and postcondition are of a very special form and the actual
goal would have to match this form exactly. Therefore we derive two variants
with arbitrary pre and postconditions. *}

lemma Assign': "\<forall>s. P s \<longrightarrow> Q(s[a/x]) \<Longrightarrow> \<turnstile> {P} x ::= a {Q}"
by (simp add: strengthen_pre[OF _ Assign])

lemma While':
assumes "\<turnstile> {\<lambda>s. P s \<and> bval b s} c {P}" and "\<forall>s. P s \<and> \<not> bval b s \<longrightarrow> Q s"
shows "\<turnstile> {P} WHILE b DO c {Q}"
by(rule weaken_post[OF While[OF assms(1)] assms(2)])

subsection "Soundness"

lemma hoare_sound: "\<turnstile> {P}c{Q}  \<Longrightarrow>  \<Turnstile> {P}c{Q}"
proof(induction rule: hoare.induct)
  case (While P b c)
  { fix s t
    have "(WHILE b DO c,s) \<Rightarrow> t  \<Longrightarrow>  P s  \<Longrightarrow>  P t \<and> \<not> bval b t"
    proof(induction "WHILE b DO c" s t rule: big_step_induct)
      case WhileFalse thus ?case by blast
    next
      case WhileTrue thus ?case
        using While.IH unfolding hoare_valid_def by blast
    qed
  }
  thus ?case unfolding hoare_valid_def by blast
qed (auto simp: hoare_valid_def)

subsection "Weakest Precondition"

definition wp :: "com \<Rightarrow> assn \<Rightarrow> assn" where
"wp c Q = (\<lambda>s. \<forall>t. (c,s) \<Rightarrow> t  \<longrightarrow>  Q t)"

lemma wp_SKIP[simp]: "wp SKIP Q = Q"
by (rule ext) (auto simp: wp_def)

lemma wp_Ass[simp]: "wp (x::=a) Q = (\<lambda>s. Q(s[a/x]))"
by (rule ext) (auto simp: wp_def)

lemma wp_Seq[simp]: "wp (c\<^sub>1;;c\<^sub>2) Q = wp c\<^sub>1 (wp c\<^sub>2 Q)"
by (rule ext) (auto simp: wp_def)

lemma wp_If[simp]:
 "wp (IF b THEN c\<^sub>1 ELSE c\<^sub>2) Q =
 (\<lambda>s. if bval b s then wp c\<^sub>1 Q s else wp c\<^sub>2 Q s)"
by (rule ext) (auto simp: wp_def)

lemma wp_While_If:
 "wp (WHILE b DO c) Q s =
  wp (IF b THEN c;;WHILE b DO c ELSE SKIP) Q s"
unfolding wp_def by (metis unfold_while)

lemma wp_While_True[simp]: "bval b s \<Longrightarrow>
  wp (WHILE b DO c) Q s = wp (c;; WHILE b DO c) Q s"
by(simp add: wp_While_If)

lemma wp_While_False[simp]: "\<not> bval b s \<Longrightarrow> wp (WHILE b DO c) Q s = Q s"
by(simp add: wp_While_If)

lemma wp_Or: "wp (c1 OR c2) Q s = (wp c1 Q s \<and> wp c2 Q s)"
unfolding wp_def
by auto

subsection "Completeness"

lemma wp_is_pre: "\<turnstile> {wp c Q} c {Q}"
proof(induction c arbitrary: Q)
  case If thus ?case by(auto intro: conseq)
next
  case (While b c)
  let ?w = "WHILE b DO c"
  show "\<turnstile> {wp ?w Q} ?w {Q}"
  proof(rule While')
    show "\<turnstile> {\<lambda>s. wp ?w Q s \<and> bval b s} c {wp ?w Q}"
    proof(rule strengthen_pre[OF _ While.IH])
      show "\<forall>s. wp ?w Q s \<and> bval b s \<longrightarrow> wp c (wp ?w Q) s" by auto
    qed
    show "\<forall>s. wp ?w Q s \<and> \<not> bval b s \<longrightarrow> Q s" by auto
  qed
next
(* begin mod *)
  case (Or c1 c2)
  from this and wp_Or and big_step.Or1 and big_step.Or2
  show ?case unfolding wp_def sorry
(* end mod *)
qed auto

lemma hoare_complete: assumes "\<Turnstile> {P}c{Q}" shows "\<turnstile> {P}c{Q}"
proof(rule strengthen_pre)
  show "\<forall>s. P s \<longrightarrow> wp c Q s" using assms
    by (auto simp: hoare_valid_def wp_def)
  show "\<turnstile> {wp c Q} c {Q}" by(rule wp_is_pre)
qed

corollary hoare_sound_complete: "\<turnstile> {P}c{Q} \<longleftrightarrow> \<Turnstile> {P}c{Q}"
by (metis hoare_complete hoare_sound)

end


(*  Title:      RTS/JinjaSuppl/Subcls.thy
    Author:    Susannah Mansky, UIUC 2020
    Description:  Theory for the subcls relation
*)

section "@{term subcls} theory"

theory Subcls
imports "../../JinjaDCI/Common/TypeRel"
begin

lemma subcls_class_ex: "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* C'; C \<noteq> C' \<rbrakk>
 \<Longrightarrow> \<exists>D' fs ms. class P C = \<lfloor>(D', fs, ms)\<rfloor>"
proof(induct rule: converse_rtrancl_induct)
  case (step y z) then show ?case by(auto dest: subcls1D)
qed(simp)

lemma class_subcls1:
 "\<lbrakk> class P y = class P' y; P \<turnstile> y \<prec>\<^sup>1 z \<rbrakk> \<Longrightarrow> P' \<turnstile> y \<prec>\<^sup>1 z"
 by(auto dest!: subcls1D intro!: subcls1I intro: sym)

lemma subcls1_single_valued: "single_valued (subcls1 P)"
by (clarsimp simp: single_valued_def subcls1.simps)

lemma subcls_confluent:
  "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* C'; P \<turnstile> C \<preceq>\<^sup>* C'' \<rbrakk> \<Longrightarrow> P \<turnstile> C' \<preceq>\<^sup>* C'' \<or> P \<turnstile> C'' \<preceq>\<^sup>* C'"
 by (simp add: single_valued_confluent subcls1_single_valued)

lemma subcls1_confluent: "\<lbrakk> P \<turnstile> a \<prec>\<^sup>1 b; P \<turnstile> a \<preceq>\<^sup>* c; a \<noteq> c \<rbrakk> \<Longrightarrow> P \<turnstile> b \<preceq>\<^sup>* c"
using subcls1_single_valued
 by (auto elim!: converse_rtranclE[where x=a] simp: single_valued_def)

lemma subcls_self_superclass: "\<lbrakk> P \<turnstile> C \<prec>\<^sup>1 C; P \<turnstile> C \<preceq>\<^sup>* D \<rbrakk> \<Longrightarrow> D = C"
using subcls1_single_valued
 by (auto elim!: rtrancl_induct[where b=D] simp: single_valued_def)

lemma subcls_of_Obj_acyclic:
 "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* Object; C \<noteq> D\<rbrakk> \<Longrightarrow> \<not>(P \<turnstile> C \<preceq>\<^sup>* D \<and> P \<turnstile> D \<preceq>\<^sup>* C)"
proof(induct arbitrary: D rule: converse_rtrancl_induct)
  case base then show ?case by simp
next
  case (step y z) show ?case
  proof(cases "y=z")
    case True with step show ?thesis by simp
  next
    case False show ?thesis
    proof(cases "z = D")
      case True with False step.hyps(3)[of y] show ?thesis by clarsimp
    next
      case neq: False
      with step.hyps(3) have "\<not>(P \<turnstile> z \<preceq>\<^sup>* D \<and> P \<turnstile> D \<preceq>\<^sup>* z)" by simp
      moreover from step.hyps(1)
      have "P \<turnstile> D \<preceq>\<^sup>* y \<Longrightarrow> P \<turnstile> D \<preceq>\<^sup>* z" by(simp add: rtrancl_into_rtrancl)
      moreover from step.hyps(1) step.prems(1)
      have "P \<turnstile> y \<preceq>\<^sup>* D \<Longrightarrow> P \<turnstile> z \<preceq>\<^sup>* D" by(simp add: subcls1_confluent)
      ultimately show ?thesis by clarsimp
    qed
  qed
qed

lemma subcls_of_Obj: "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* Object; P \<turnstile> C \<preceq>\<^sup>* D \<rbrakk> \<Longrightarrow> P \<turnstile> D \<preceq>\<^sup>* Object"
 by(auto dest: subcls_confluent)

end


theory libs_functions
  imports Main
begin

(*----looking up functions-------------------------------------------------------*)
fun lookup_1 :: "string \<Rightarrow> (string * string list) list \<Rightarrow> string list" where
"lookup_1 k [] = []" |
"lookup_1 k (x#xs) = (if fst x = k then (snd x) else lookup_1 k xs)"

fun lookup_2 :: "string \<Rightarrow> (string * string list) list list \<Rightarrow> string list" where
"lookup_2 k [] = []" |
"lookup_2 k (x#xs) = (lookup_1 k x) @ (lookup_2 k xs)"

fun lookup_3 :: "string \<Rightarrow> (string * string list) list list list \<Rightarrow> string list" where
"lookup_3 k [] = []" |
"lookup_3 k (x#xs) = (lookup_2 k x) @ (lookup_3 k xs)"

(*----making betaSet functions-------------------------------------------------------*)
(*----make pair: (Type, Instance)------------------------*)
fun mk_pair :: "string \<Rightarrow> string list \<Rightarrow> (string * string) list" where
"mk_pair k [] = []" |
"mk_pair k (x#xs) = [(k, x)] @ mk_pair k xs"

fun mk_pair_1 :: "(string * string list) \<Rightarrow> (string * string) list" where
"mk_pair_1 k = mk_pair (fst k) (snd k)"

fun mk_pair_2 :: "(string * string list) list \<Rightarrow> (string * string) list list" where
"mk_pair_2 [] = []" |
"mk_pair_2 (x#xs) = [mk_pair_1 x] @ mk_pair_2 xs"

fun mk_pair_3 :: "(string * string list) list list \<Rightarrow> (string * string) list list list" where
"mk_pair_3 [] = []" |
"mk_pair_3 (x#xs) = [product_lists (mk_pair_2 x)] @ mk_pair_3 xs"

fun mk_pair_4 :: "(string * string list) list list list \<Rightarrow> (string * string) list list list" where
"mk_pair_4 [] = []" |
"mk_pair_4 (x#xs) = product_lists (mk_pair_3 x) @ mk_pair_4 xs"

fun mk_pair_3_no_product :: "(string * string list) list list \<Rightarrow> (string * string) list list list" where
"mk_pair_3_no_product [] = []" |
"mk_pair_3_no_product (x#xs) = [(mk_pair_2 x)] @ mk_pair_3_no_product xs"

fun mk_pair_4_no_product :: "(string * string list) list list list \<Rightarrow> (string * string) list list list" where
"mk_pair_4_no_product [] = []" |
"mk_pair_4_no_product (x#xs) = (mk_pair_3_no_product x) @ mk_pair_4_no_product xs"

fun mk_Trigger_list :: "(string * string) list list list \<Rightarrow> (string * string) list list list" where
"mk_Trigger_list [] = []" |
"mk_Trigger_list (x#xs) = [(product_lists  x)] @ mk_Trigger_list xs"
(*----
get all pairs (Type, Instance) of a  trigger list or a synchron list
----*)
fun all_pairs :: "(string * string list) list list list \<Rightarrow> (string * string) list" where
"all_pairs x = concat (concat (mk_pair_4_no_product x))"

(*----
the remaining pair (Type, Instance) of a  trigger list or a synchron list from the current connector
----*)
fun remaining_pairs :: "(string \<times> string) list \<Rightarrow> (string \<times> string) list \<Rightarrow> (string \<times> string) set" where
"remaining_pairs x y = set (x) - set (y)"

(*----------------------------
merge_list: After producting 2 lists, we need to convert list of pairs to list of lists -----------------------------*)
fun merge_list :: "('a list \<times> 'a list) list \<Rightarrow> 'a list list list" where
"merge_list []= []" |
"merge_list (x#xs) = [[(fst x)]@[(snd x)]] @ (merge_list xs)"

fun merge_list_1 :: "('a list list \<times> 'a list) list \<Rightarrow> 'a list list list" where
"merge_list_1 []= []" |
"merge_list_1 (x#xs) = [(fst x)@[(snd x)]] @ (merge_list_1 xs)"

(*----------------------------
make_betaSet_3: make all the combination between elements in the exported_list of all the trigger ()
-----------------------------*)
fun make_betaSet_3 :: "(string * string list) list list list \<Rightarrow> (string * string list) list list list" where
"make_betaSet_3 [] = []" |
"make_betaSet_3 (x#[]) =  [x]" |
"make_betaSet_3 (x#y#[]) = merge_list (List.product y x)" |
"make_betaSet_3 (x#y#xs#[]) = merge_list_1 (List.product (merge_list (List.product xs y)) (x))"|
"make_betaSet_3 (x#y#xs#ys) = merge_list_1 (List.product (make_betaSet_3 (y#xs#ys)) (x))"

fun mk_jvb :: "'a list \<Rightarrow> 'b \<Rightarrow> ('a \<times> 'b) list" where
"mk_jvb [] y = []"|
"mk_jvb (x#xs) y = [(Pair x) y] @ mk_jvb xs y"

(*------------------------------------------------------------------------------------------*)
(*test List of all the trigger C = {C_1, C_2, ..., C_n}*)
definition test_triggers_1 :: "(string * string list) list list list" where
"test_triggers_1 = [[[(''1a'',[''1'',''2''])], [(''1b'',[''1'',''2''])]],
[[(''2'',[''1''])]],
[[(''3a'',[''1''])], [(''3b1'',[''1'']),(''3b2'',[''1'',''2''])]],
[[(''4'',[''1''])]]
]"
definition test_triggers :: "(string * string list) list list list" where
"test_triggers = [
[[(''1a'',[''1'',''2'']), (''1b'',[''1''])], [(''2'',[''1'',''2'',''3''])]]
]"

definition test_triggers_null :: "(string * string list) list list list" where
"test_triggers_null = [[[]]]"

definition test_synchron_1 :: "(string * string list) list list list" where
"test_synchron_1 = [ [[(''4'', [''1'',''2''])]],
[[(''5c'',[''1'']),(''5d'',[''1'',''2''])]]
]"

definition test_synchron :: "(string * string list) list list list" where
"test_synchron = [
[[(''4'', [''1'',''2''])]],
[[(''5c'',[''1'',''2'']),(''5d'',[''1'',''2'', ''3''])]]
]"

definition Connector :: "((string \<times> string) list list \<times> (string \<times> string) list list list) list" where
"Connector = mk_jvb (mk_pair_4_no_product test_synchron) (mk_pair_4 (make_betaSet_3 test_triggers))"

(*------------------------------- test -------------------------------*)

(*test List of all the trigger C = {C_1, C_2, ..., C_n}*)
definition test_triggers_11 :: "(string * string list) list list list" where
"test_triggers_11 = [[[(''1a'',[''1'',''2''])], [(''1b'',[''1'',''2''])]],
[[(''2'',[''1''])]],
[[(''3a'',[''1''])], [(''3b1'',[''1'']),(''3b2'',[''1'',''2''])]],
[[(''4'',[''1''])]]
]"

definition test_triggers_2 :: "(string * string list) list list list" where
"test_triggers_2 = [[[(''1a'',[''1'',''2''])], [(''1b'',[''1'',''2''])]],
[[(''2'',[''1''])]],
[[(''3a'',[''1''])], [(''3b1'',[''1'']),(''3b2'',[''1'',''2''])]],
[[(''4'',[''1''])]],
[[(''5a'',[''1''])], [(''5b'',[''6''])]]
]"

value "Connector"

lemma for_synchron: "(\<forall>j \<in> set test_synchron. \<forall>u \<in> set j. \<forall>t \<in> set u. \<forall>l \<in> set (snd t).(P ((fst t), l) \<longrightarrow> (\<forall>l1 \<in> set (snd t) - {l}. \<not>P ((fst t), l1))))
\<Longrightarrow>
(\<forall>j \<in> set test_synchron. \<forall>u \<in> set j. \<forall>t \<in> set u. \<forall>l \<in> set (snd t). (P ((fst t), l) \<longleftrightarrow> (P ((fst t), l) \<and> (\<forall>l1 \<in> set (snd t) - {l}. \<not>P ((fst t), l1)))))"
  by blast

lemma for_trigger: "(\<forall>i \<in> set test_triggers. \<forall>v \<in> set i. \<forall>k \<in> set v. \<forall>h \<in> set (snd k).(Q ((fst k), h) \<longrightarrow> (\<forall>h1 \<in> set (snd k) - {h}. \<not>Q ((fst k), h1))))
\<Longrightarrow>
(\<forall>i \<in> set test_triggers. \<forall>v \<in> set i. \<forall>k \<in> set v. \<forall>h \<in> set (snd k). (Q ((fst k), h) \<longleftrightarrow> (Q ((fst k), h) \<and> (\<forall>h1 \<in> set (snd k) - {h}. \<not>Q ((fst k), h1)))))"
  by blast

value "(\<forall>connector\<in>set Connector.\<forall>trig_list\<in>set(snd connector).\<forall>trig\<in>set trig_list. \<forall>t_elm\<in>set trig. (Q ((fst t_elm), (snd t_elm)) \<and> (\<forall>h \<in> set (lookup_3 (fst t_elm) test_triggers) - {snd t_elm}. \<not>Q ((fst t_elm), h)) ))"

value "(\<forall>i \<in> set test_triggers. \<forall>v \<in> set i. \<forall>k \<in> set v. \<forall>h \<in> set (snd k).(Q ((fst k), h)) \<longrightarrow> (\<forall>h \<in> set (lookup_3 (fst k) test_triggers) - {h}. \<not>Q ((fst k), h)))"
end


theory prop_34
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype Nat = Z | S "Nat"
  fun min2 :: "Nat => Nat => Nat" where
  "min2 (Z) y = Z"
  | "min2 (S z) (Z) = Z"
  | "min2 (S z) (S y1) = S (min2 z y1)"
  fun le :: "Nat => Nat => bool" where
  "le (Z) y = True"
  | "le (S z) (Z) = False"
  | "le (S z) (S x2) = le z x2"
  fun equal2 :: "Nat => Nat => bool" where
  "equal2 (Z) (Z) = True"
  | "equal2 (Z) (S z) = False"
  | "equal2 (S x2) (Z) = False"
  | "equal2 (S x2) (S y2) = equal2 x2 y2"
  (*hipster min2 le equal2 *)
  theorem x0 :
    "(equal2 (min2 a b) b) = (le b a)"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
end


(*
  File:   Akra_Bazzi_Library.thy
  Author: Manuel Eberl <manuel@pruvisto.org>

  Lemma bucket for the Akra-Bazzi theorem.
*)

section \<open>Auxiliary lemmas\<close>
theory Akra_Bazzi_Library
imports
  Complex_Main
  "Landau_Symbols.Landau_More"
  "Pure-ex.Guess"
begin

(* TODO: Move? *)

lemma ln_mono: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> x \<le> y \<Longrightarrow> ln (x::real) \<le> ln y"
  by (subst ln_le_cancel_iff) simp_all

lemma ln_mono_strict: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> x < y \<Longrightarrow> ln (x::real) < ln y"
  by (subst ln_less_cancel_iff) simp_all

declare DERIV_powr[THEN DERIV_chain2, derivative_intros]

lemma sum_pos':
  assumes "finite I"
  assumes "\<exists>x\<in>I. f x > (0 :: _ :: linordered_ab_group_add)"
  assumes "\<And>x. x \<in> I \<Longrightarrow> f x \<ge> 0"
  shows   "sum f I > 0"
proof-
  from assms(2) guess x by (elim bexE) note x = this
  from x have "I = insert x I" by blast
  also from assms(1) have "sum f ... = f x + sum f (I - {x})" by (rule sum.insert_remove)
  also from x assms have "... > 0" by (intro add_pos_nonneg sum_nonneg) simp_all
  finally show ?thesis .
qed

lemma min_mult_left:
  assumes "(x::real) > 0"
  shows   "x * min y z = min (x*y) (x*z)"
  using assms by (auto simp add: min_def algebra_simps)

lemma max_mult_left:
  assumes "(x::real) > 0"
  shows   "x * max y z = max (x*y) (x*z)"
  using assms by (auto simp add: max_def algebra_simps)

lemma DERIV_nonneg_imp_mono:
  assumes "\<And>t. t\<in>{x..y} \<Longrightarrow> (f has_field_derivative f' t) (at t)"
  assumes "\<And>t. t\<in>{x..y} \<Longrightarrow> f' t \<ge> 0"
  assumes "(x::real) \<le> y"
  shows   "(f x :: real) \<le> f y"
proof (cases x y rule: linorder_cases)
  assume xy: "x < y"
  hence "\<exists>z. x < z \<and> z < y \<and> f y - f x = (y - x) * f' z"
    by (rule MVT2) (insert assms(1), simp)
  then guess z by (elim exE conjE) note z = this
  from z(1,2) assms(2) xy have "0 \<le> (y - x) * f' z" by (intro mult_nonneg_nonneg) simp_all
  also note z(3)[symmetric]
  finally show "f x \<le> f y" by simp
qed (insert assms(3), simp_all)

lemma eventually_conjE: "eventually (\<lambda>x. P x \<and> Q x) F \<Longrightarrow> (eventually P F \<Longrightarrow> eventually Q F \<Longrightarrow> R) \<Longrightarrow> R"
  apply (frule eventually_rev_mp[of _ _ P], simp)
  apply (drule eventually_rev_mp[of _ _ Q], simp)
  apply assumption
  done

lemma real_natfloor_nat: "x \<in> \<nat> \<Longrightarrow> real (nat \<lfloor>x\<rfloor>) = x" by (elim Nats_cases) simp

lemma eventually_natfloor:
  assumes "eventually P (at_top :: nat filter)"
  shows   "eventually (\<lambda>x. P (nat \<lfloor>x\<rfloor>)) (at_top :: real filter)"
proof-
  from assms obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> P n" using eventually_at_top_linorder by blast
  have "\<forall>n\<ge>real N. P (nat \<lfloor>n\<rfloor>)" by (intro allI impI N le_nat_floor) simp_all
  thus ?thesis using eventually_at_top_linorder by blast
qed

lemma tendsto_0_smallo_1: "f \<in> o(\<lambda>x. 1 :: real) \<Longrightarrow> (f \<longlongrightarrow> 0) at_top"
  by (drule smalloD_tendsto) simp

lemma filterlim_at_top_smallomega_1:
  assumes "f \<in> \<omega>[F](\<lambda>x. 1 :: real)" "eventually (\<lambda>x. f x > 0) F"
  shows   "filterlim f at_top F"
proof -
  from assms have "filterlim (\<lambda>x. norm (f x / 1)) at_top F"
    by (intro smallomegaD_filterlim_at_top_norm) (auto elim: eventually_mono)
  also have "?this \<longleftrightarrow> ?thesis"
    using assms by (intro filterlim_cong refl) (auto elim!: eventually_mono)
  finally show ?thesis .
qed

lemma smallo_imp_abs_less_real:
  assumes "f \<in> o[F](g)" "eventually (\<lambda>x. g x > (0::real)) F"
  shows   "eventually (\<lambda>x. \<bar>f x\<bar> < g x) F"
proof -
  have "1/2 > (0::real)" by simp
  from landau_o.smallD[OF assms(1) this] assms(2) show ?thesis
    by eventually_elim auto
qed

lemma smallo_imp_less_real:
  assumes "f \<in> o[F](g)" "eventually (\<lambda>x. g x > (0::real)) F"
  shows   "eventually (\<lambda>x. f x < g x) F"
  using smallo_imp_abs_less_real[OF assms] by eventually_elim simp

lemma smallo_imp_le_real:
  assumes "f \<in> o[F](g)" "eventually (\<lambda>x. g x \<ge> (0::real)) F"
  shows   "eventually (\<lambda>x. f x \<le> g x) F"
  using landau_o.smallD[OF assms(1) zero_less_one] assms(2) by eventually_elim simp

(* TODO MOVE *)

lemma one_plus_x_powr_approx_ex:
  assumes x: "abs (x::real) \<le> 1/2"
  obtains t where "abs t < 1/2" "(1 + x) powr p =
    1 + p * x + p * (p - 1) * (1 + t) powr (p - 2) / 2 * x ^ 2"
proof (cases "x = 0")
  assume x': "x \<noteq> 0"
  let ?f = "\<lambda>x. (1 + x) powr p"
  let ?f' = "\<lambda>x. p * (1 + x) powr (p - 1)"
  let ?f'' = "\<lambda>x. p * (p - 1) * (1 + x) powr (p - 2)"
  let ?fs = "(!) [?f, ?f', ?f'']"

  have A: "\<forall>m t. m < 2 \<and> t \<ge> -0.5 \<and> t \<le> 0.5 \<longrightarrow> (?fs m has_real_derivative ?fs (Suc m) t) (at t)"
  proof (clarify)
    fix m :: nat and t :: real assume m: "m < 2" and t: "t \<ge> -0.5" "t \<le> 0.5"
    thus "(?fs m has_real_derivative ?fs (Suc m) t) (at t)"
      using m by (cases m) (force intro: derivative_eq_intros algebra_simps)+
  qed
  have "\<exists>t. (if x < 0 then x < t \<and> t < 0 else 0 < t \<and> t < x) \<and>
              (1 + x) powr p = (\<Sum>m<2. ?fs m 0 / (fact m) * (x - 0)^m) +
              ?fs 2 t / (fact 2) * (x - 0)\<^sup>2"
    using assms x' by (intro Taylor[OF _ _ A]) simp_all
  then guess t by (elim exE conjE)
  note t = this
  with assms have "abs t < 1/2" by (auto split: if_split_asm)
  moreover from t(2) have "(1 + x) powr p = 1 + p * x + p * (p - 1) * (1 + t) powr (p - 2) / 2 * x ^ 2"
    by (simp add: numeral_2_eq_2 of_nat_Suc)
  ultimately show ?thesis by (rule that)
next
  assume "x = 0"
  with that[of 0] show ?thesis by simp
qed

lemma powr_lower_bound: "\<lbrakk>(l::real) > 0; l \<le> x; x \<le> u\<rbrakk> \<Longrightarrow> min (l powr z) (u powr z) \<le> x powr z"
apply (cases "z \<ge> 0")
apply (rule order.trans[OF min.cobounded1 powr_mono2], simp_all) []
apply (rule order.trans[OF min.cobounded2 powr_mono2'], simp_all) []
done

lemma powr_upper_bound: "\<lbrakk>(l::real) > 0; l \<le> x; x \<le> u\<rbrakk> \<Longrightarrow> max (l powr z) (u powr z) \<ge> x powr z"
apply (cases "z \<ge> 0")
apply (rule order.trans[OF powr_mono2 max.cobounded2], simp_all) []
apply (rule order.trans[OF powr_mono2' max.cobounded1], simp_all) []
done

lemma one_plus_x_powr_Taylor2:
  obtains k where "\<And>x. abs (x::real) \<le> 1/2 \<Longrightarrow> abs ((1 + x) powr p - 1 - p*x) \<le> k*x^2"
proof-
  define k where "k = \<bar>p*(p - 1)\<bar> * max ((1/2) powr (p - 2)) ((3/2) powr (p - 2)) / 2"
  show ?thesis
  proof (rule that[of k])
    fix x :: real assume "abs x \<le> 1/2"
    from one_plus_x_powr_approx_ex[OF this, of p] guess t . note t = this
    from t have "abs ((1 + x) powr p - 1 - p*x) = \<bar>p*(p - 1)\<bar> * (1 + t) powr (p - 2)/2 * x\<^sup>2"
      by (simp add: abs_mult)
    also from t(1) have "(1 + t) powr (p - 2) \<le> max ((1/2) powr (p - 2)) ((3/2) powr (p - 2))"
      by (intro powr_upper_bound) simp_all
    finally show "abs ((1 + x) powr p - 1 - p*x) \<le> k*x^2"
      by (simp add: mult_left_mono mult_right_mono k_def)
  qed
qed

lemma one_plus_x_powr_Taylor2_bigo:
  assumes lim: "(f \<longlongrightarrow> 0) F"
  shows   "(\<lambda>x. (1 + f x) powr (p::real) - 1 - p * f x) \<in> O[F](\<lambda>x. f x ^ 2)"
proof -
  from one_plus_x_powr_Taylor2[of p] guess k .
  moreover from tendstoD[OF lim, of "1/2"]
    have "eventually (\<lambda>x. abs (f x) < 1/2) F" by (simp add: dist_real_def)
  ultimately have "eventually (\<lambda>x. norm ((1 + f x) powr p - 1 - p * f x) \<le> k * norm (f x ^ 2)) F"
    by (auto elim!: eventually_mono)
  thus ?thesis by (rule bigoI)
qed

lemma one_plus_x_powr_Taylor1_bigo:
  assumes lim: "(f \<longlongrightarrow> 0) F"
  shows   "(\<lambda>x. (1 + f x) powr (p::real) - 1) \<in> O[F](\<lambda>x. f x)"
proof -
  from assms have "(\<lambda>x. (1 + f x) powr p - 1 - p * f x) \<in> O[F](\<lambda>x. (f x)\<^sup>2)"
    by (rule one_plus_x_powr_Taylor2_bigo)
  also from assms have "f \<in> O[F](\<lambda>_. 1)" by (intro bigoI_tendsto) simp_all
  from landau_o.big.mult[of f F f, OF _ this] have "(\<lambda>x. (f x)^2) \<in> O[F](\<lambda>x. f x)"
    by (simp add: power2_eq_square)
  finally have A: "(\<lambda>x. (1 + f x) powr p - 1 - p * f x) \<in> O[F](f)" .
  have B: "(\<lambda>x. p * f x) \<in> O[F](f)" by simp
  from sum_in_bigo(1)[OF A B] show ?thesis by simp
qed

lemma x_times_x_minus_1_nonneg: "x \<le> 0 \<or> x \<ge> 1 \<Longrightarrow> (x::_::linordered_idom) * (x - 1) \<ge> 0"
proof (elim disjE)
  assume x: "x \<le> 0"
  also have "0 \<le> x^2" by simp
  finally show "x * (x - 1) \<ge> 0" by (simp add: power2_eq_square algebra_simps)
qed simp

lemma x_times_x_minus_1_nonpos: "x \<ge> 0 \<Longrightarrow> x \<le> 1 \<Longrightarrow> (x::_::linordered_idom) * (x - 1) \<le> 0"
  by (intro mult_nonneg_nonpos) simp_all

lemma powr_mono':
  assumes "(x::real) > 0" "x \<le> 1" "a \<le> b"
  shows   "x powr b \<le> x powr a"
proof-
  have "inverse x powr a \<le> inverse x powr b" using assms
    by (intro powr_mono) (simp_all add: field_simps)
  hence "inverse (x powr a) \<le> inverse (x powr b)" using assms by simp
  with assms show ?thesis by (simp add: field_simps)
qed

lemma powr_less_mono':
  assumes "(x::real) > 0" "x < 1" "a < b"
  shows   "x powr b < x powr a"
proof-
  have "inverse x powr a < inverse x powr b" using assms
    by (intro powr_less_mono) (simp_all add: field_simps)
  hence "inverse (x powr a) < inverse (x powr b)" using assms by simp
  with assms show ?thesis by (simp add: field_simps)
qed

lemma real_powr_at_bot:
  assumes "(a::real) > 1"
  shows   "((\<lambda>x. a powr x) \<longlongrightarrow> 0) at_bot"
proof-
  from assms have "filterlim (\<lambda>x. ln a * x) at_bot at_bot"
    by (intro filterlim_tendsto_pos_mult_at_bot[OF tendsto_const _ filterlim_ident]) auto
  hence "((\<lambda>x. exp (x * ln a)) \<longlongrightarrow> 0) at_bot"
    by (intro filterlim_compose[OF exp_at_bot]) (simp add: algebra_simps)
  thus ?thesis using assms unfolding powr_def by simp
qed

lemma real_powr_at_bot_neg:
  assumes "(a::real) > 0" "a < 1"
  shows   "filterlim (\<lambda>x. a powr x) at_top at_bot"
proof-
  from assms have "LIM x at_bot. ln (inverse a) * -x :> at_top"
    by (intro filterlim_tendsto_pos_mult_at_top[OF tendsto_const] filterlim_uminus_at_top_at_bot)
       (simp_all add: ln_inverse)
  with assms have "LIM x at_bot. x * ln a :> at_top"
    by (subst (asm) ln_inverse) (simp_all add: mult.commute)
  hence "LIM x at_bot. exp (x * ln a) :> at_top"
    by (intro filterlim_compose[OF exp_at_top]) simp
  thus ?thesis using assms unfolding powr_def by simp
qed

lemma real_powr_at_top_neg:
  assumes "(a::real) > 0" "a < 1"
  shows   "((\<lambda>x. a powr x) \<longlongrightarrow> 0) at_top"
proof-
  from assms have "LIM x at_top. ln (inverse a) * x :> at_top"
    by (intro filterlim_tendsto_pos_mult_at_top[OF tendsto_const])
       (simp_all add: filterlim_ident field_simps)
  with assms have "LIM x at_top. ln a * x :> at_bot"
    by (subst filterlim_uminus_at_bot) (simp add: ln_inverse)
  hence "((\<lambda>x. exp (x * ln a)) \<longlongrightarrow> 0) at_top"
    by (intro filterlim_compose[OF exp_at_bot]) (simp_all add: mult.commute)
  with assms show ?thesis unfolding powr_def by simp
qed

lemma eventually_nat_real:
  assumes "eventually P (at_top :: real filter)"
  shows   "eventually (\<lambda>x. P (real x)) (at_top :: nat filter)"
  using assms filterlim_real_sequentially
  unfolding filterlim_def le_filter_def eventually_filtermap by auto

end


theory Lambda imports "../Nominal2" begin

atom_decl name

nominal_datatype lam =
  Var "name"
| App "lam" "lam"
| Lam x::"name" l::"lam"  binds x in l ("Lam [_]. _" [100, 100] 100)

nominal_function lam_rec ::
  "(name \<Rightarrow> 'a :: pt) \<Rightarrow> (lam \<Rightarrow> lam \<Rightarrow> 'a) \<Rightarrow> (name \<Rightarrow> lam \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'b :: fs \<Rightarrow> lam \<Rightarrow> 'a"
where
  "lam_rec fv fa fl fd P (Var n) = fv n"
| "lam_rec fv fa fl fd P (App l r) = fa l r"
| "(atom x \<sharp> P \<and> (\<forall>y s. atom y \<sharp> P \<longrightarrow> Lam [x]. t = Lam [y]. s \<longrightarrow> fl x t = fl y s)) \<Longrightarrow>
     lam_rec fv fa fl fd P (Lam [x]. t) = fl x t"
| "(atom x \<sharp> P \<and> \<not>(\<forall>y s. atom y \<sharp> P \<longrightarrow> Lam [x]. t = Lam [y]. s \<longrightarrow> fl x t = fl y s)) \<Longrightarrow>
     lam_rec fv fa fl fd P (Lam [x]. t) = fd"
  apply (simp add: eqvt_def lam_rec_graph_def)
  apply (rule, perm_simp, rule, rule)
  apply (case_tac x)
  apply (rule_tac y="f" and c="e" in lam.strong_exhaust)
  apply metis
  apply metis
  unfolding fresh_star_def
  apply simp
  apply metis
  apply simp_all[2]
  apply (metis (no_types) Pair_inject lam.distinct)+
  apply simp
  apply (metis (no_types) Pair_inject lam.distinct)+
  done

nominal_termination (eqvt) by lexicographic_order

lemma lam_rec_cong[fundef_cong]:
  " (\<And>v. l = Var v \<Longrightarrow> fv v = fv' v) \<Longrightarrow>
    (\<And>t1 t2. l = App t1 t2 \<Longrightarrow> fa t1 t2 = fa' t1 t2) \<Longrightarrow>
    (\<And>n t. l = Lam [n]. t \<Longrightarrow> fl n t = fl' n t) \<Longrightarrow>
  lam_rec fv fa fl fd P l = lam_rec fv' fa' fl' fd P l"
  apply (rule_tac y="l" and c="P" in lam.strong_exhaust)
  apply auto
  apply (case_tac "(\<forall>y s. atom y \<sharp> P \<longrightarrow> Lam [name]. lam = Lam [y]. s \<longrightarrow> fl name lam = fl y s)")
  apply (subst lam_rec.simps) apply (simp add: fresh_star_def)
  apply (subst lam_rec.simps) apply (simp add: fresh_star_def)
  using Abs1_eq_iff lam.eq_iff apply metis
  apply (subst lam_rec.simps(4)) apply (simp add: fresh_star_def)
  apply (subst lam_rec.simps(4)) apply (simp add: fresh_star_def)
  using Abs1_eq_iff lam.eq_iff apply metis
  done

nominal_function substr where
[simp del]: "substr l y s = lam_rec
  (%x. if x = y then s else (Var x))
  (%t1 t2. App (substr t1 y s) (substr t2 y s))
  (%x t. Lam [x]. (substr t y s)) (Lam [y]. Var y) (y, s) l"
unfolding eqvt_def substr_graph_def
apply (rule, perm_simp, rule, rule)
by pat_completeness auto

nominal_termination (eqvt) by lexicographic_order

lemma fresh_fun_eqvt_app3:
  assumes e: "eqvt f"
  shows "\<lbrakk>a \<sharp> x; a \<sharp> y; a \<sharp> z\<rbrakk> \<Longrightarrow> a \<sharp> f x y z"
  using fresh_fun_eqvt_app[OF e] fresh_fun_app by (metis (lifting, full_types))

lemma substr_simps:
  "substr (Var x) y s = (if x = y then s else (Var x))"
  "substr (App t1 t2) y s = App (substr t1 y s) (substr t2 y s)"
  "atom x \<sharp> (y, s) \<Longrightarrow> substr (Lam [x]. t) y s = Lam [x]. (substr t y s)"
  apply (subst substr.simps) apply (simp only: lam_rec.simps)
  apply (subst substr.simps) apply (simp only: lam_rec.simps)
  apply (subst substr.simps) apply (subst lam_rec.simps)
  apply (auto simp add: Abs1_eq_iff substr.eqvt swap_fresh_fresh)
  apply (rule fresh_fun_eqvt_app3[of substr])
  apply (simp add: eqvt_def eqvts_raw)
  apply (simp_all add: fresh_Pair)
  done

end


(*  Title:      HOL/Isar_Examples/Basic_Logic.thy
    Author:     Markus Wenzel, TU Muenchen

Basic propositional and quantifier reasoning.
*)

section \<open>Basic logical reasoning\<close>

theory Basic_Logic
imports Main
begin

subsection \<open>Pure backward reasoning\<close>

text \<open>In order to get a first idea of how Isabelle/Isar proof
  documents may look like, we consider the propositions @{text I},
  @{text K}, and @{text S}.  The following (rather explicit) proofs
  should require little extra explanations.\<close>

lemma I: "A \<longrightarrow> A"
proof
  assume A
  show A by fact
qed

lemma S: "(A \<longrightarrow> B \<longrightarrow> C) \<longrightarrow> (A \<longrightarrow> B) \<longrightarrow> A \<longrightarrow> C"
proof
  assume "A \<longrightarrow> B \<longrightarrow> C"
  show "(A \<longrightarrow> B) \<longrightarrow> A \<longrightarrow> C"
  proof
    assume "A \<longrightarrow> B"
    show "A \<longrightarrow> C"
    proof
      assume A
      show C
      proof (rule mp)
        show "B \<longrightarrow> C" by (rule mp) fact+
        show B by (rule mp) fact+
      qed
    qed
  qed
qed

text \<open>Isar provides several ways to fine-tune the reasoning,
  avoiding excessive detail.  Several abbreviated language elements
  are available, enabling the writer to express proofs in a more
  concise way, even without referring to any automated proof tools
  yet.

  First of all, proof by assumption may be abbreviated as a single
  dot.\<close>

lemma "A \<longrightarrow> A"
proof
  assume A
  show A by fact+
qed

text \<open>In fact, concluding any (sub-)proof already involves solving
  any remaining goals by assumption\footnote{This is not a completely
  trivial operation, as proof by assumption may involve full
  higher-order unification.}.  Thus we may skip the rather vacuous
  body of the above proof as well.\<close>

lemma "A \<longrightarrow> A"
proof
qed

text \<open>Note that the \isacommand{proof} command refers to the @{text
  rule} method (without arguments) by default.  Thus it implicitly
  applies a single rule, as determined from the syntactic form of the
  statements involved.  The \isacommand{by} command abbreviates any
  proof with empty body, so the proof may be further pruned.\<close>

lemma "A \<longrightarrow> A"
  by rule

text \<open>Proof by a single rule may be abbreviated as double-dot.\<close>

lemma "A \<longrightarrow> A" ..

text \<open>Thus we have arrived at an adequate representation of the
  proof of a tautology that holds by a single standard
  rule.\footnote{Apparently, the rule here is implication
  introduction.}\<close>

text \<open>Let us also reconsider @{text K}.  Its statement is composed
  of iterated connectives.  Basic decomposition is by a single rule at
  a time, which is why our first version above was by nesting two
  proofs.

  The @{text intro} proof method repeatedly decomposes a goal's
  conclusion.\footnote{The dual method is @{text elim}, acting on a
  goal's premises.}\<close>

lemma "A \<longrightarrow> B \<longrightarrow> A"
proof (intro impI)
  assume A
  show A by fact
qed

text \<open>Again, the body may be collapsed.\<close>

lemma "A \<longrightarrow> B \<longrightarrow> A"
  by (intro impI)

text \<open>Just like @{text rule}, the @{text intro} and @{text elim}
  proof methods pick standard structural rules, in case no explicit
  arguments are given.  While implicit rules are usually just fine for
  single rule application, this may go too far with iteration.  Thus
  in practice, @{text intro} and @{text elim} would be typically
  restricted to certain structures by giving a few rules only, e.g.\
  \isacommand{proof}~@{text "(intro impI allI)"} to strip implications
  and universal quantifiers.

  Such well-tuned iterated decomposition of certain structures is the
  prime application of @{text intro} and @{text elim}.  In contrast,
  terminal steps that solve a goal completely are usually performed by
  actual automated proof methods (such as \isacommand{by}~@{text
  blast}.\<close>

subsection \<open>Variations of backward vs.\ forward reasoning\<close>

text \<open>Certainly, any proof may be performed in backward-style only.
  On the other hand, small steps of reasoning are often more naturally
  expressed in forward-style.  Isar supports both backward and forward
  reasoning as a first-class concept.  In order to demonstrate the
  difference, we consider several proofs of @{text "A \<and> B \<longrightarrow> B \<and> A"}.

  The first version is purely backward.\<close>

lemma "A \<and> B \<longrightarrow> B \<and> A"
proof
  assume "A \<and> B"
  show "B \<and> A"
  proof
    show B by (rule conjunct2) fact
    show A by (rule conjunct1) fact
  qed
qed

text \<open>Above, the @{text "conjunct_1/2"} projection rules had to be
  named explicitly, since the goals @{text B} and @{text A} did not
  provide any structural clue.  This may be avoided using
  \isacommand{from} to focus on the @{text "A \<and> B"} assumption as the
  current facts, enabling the use of double-dot proofs.  Note that
  \isacommand{from} already does forward-chaining, involving the
  @{text conjE} rule here.\<close>

lemma "A \<and> B \<longrightarrow> B \<and> A"
proof
  assume "A \<and> B"
  show "B \<and> A"
  proof
    from \<open>A \<and> B\<close> show B ..
    from \<open>A \<and> B\<close> show A ..
  qed
qed

text \<open>In the next version, we move the forward step one level
  upwards.  Forward-chaining from the most recent facts is indicated
  by the \isacommand{then} command.  Thus the proof of @{text "B \<and> A"}
  from @{text "A \<and> B"} actually becomes an elimination, rather than an
  introduction.  The resulting proof structure directly corresponds to
  that of the @{text conjE} rule, including the repeated goal
  proposition that is abbreviated as @{text ?thesis} below.\<close>

lemma "A \<and> B \<longrightarrow> B \<and> A"
proof
  assume "A \<and> B"
  then show "B \<and> A"
  proof                    -- \<open>rule @{text conjE} of @{text "A \<and> B"}\<close>
    assume B A
    then show ?thesis ..   -- \<open>rule @{text conjI} of @{text "B \<and> A"}\<close>
  qed
qed

text \<open>In the subsequent version we flatten the structure of the main
  body by doing forward reasoning all the time.  Only the outermost
  decomposition step is left as backward.\<close>

lemma "A \<and> B \<longrightarrow> B \<and> A"
proof
  assume "A \<and> B"
  from \<open>A \<and> B\<close> have A ..
  from \<open>A \<and> B\<close> have B ..
  from \<open>B\<close> \<open>A\<close> show "B \<and> A" ..
qed

text \<open>We can still push forward-reasoning a bit further, even at the
  risk of getting ridiculous.  Note that we force the initial proof
  step to do nothing here, by referring to the ``-'' proof method.\<close>

lemma "A \<and> B \<longrightarrow> B \<and> A"
proof -
  {
    assume "A \<and> B"
    from \<open>A \<and> B\<close> have A ..
    from \<open>A \<and> B\<close> have B ..
    from \<open>B\<close> \<open>A\<close> have "B \<and> A" ..
  }
  then show ?thesis ..         -- \<open>rule @{text impI}\<close>
qed

text \<open>\medskip With these examples we have shifted through a whole
  range from purely backward to purely forward reasoning.  Apparently,
  in the extreme ends we get slightly ill-structured proofs, which
  also require much explicit naming of either rules (backward) or
  local facts (forward).

  The general lesson learned here is that good proof style would
  achieve just the \emph{right} balance of top-down backward
  decomposition, and bottom-up forward composition.  In general, there
  is no single best way to arrange some pieces of formal reasoning, of
  course.  Depending on the actual applications, the intended audience
  etc., rules (and methods) on the one hand vs.\ facts on the other
  hand have to be emphasized in an appropriate way.  This requires the
  proof writer to develop good taste, and some practice, of course.\<close>

text \<open>For our example the most appropriate way of reasoning is
  probably the middle one, with conjunction introduction done after
  elimination.\<close>

lemma "A \<and> B \<longrightarrow> B \<and> A"
proof
  assume "A \<and> B"
  then show "B \<and> A"
  proof
    assume B A
    then show ?thesis ..
  qed
qed

subsection \<open>A few examples from ``Introduction to Isabelle''\<close>

text \<open>We rephrase some of the basic reasoning examples of
  @{cite "isabelle-intro"}, using HOL rather than FOL.\<close>

subsubsection \<open>A propositional proof\<close>

text \<open>We consider the proposition @{text "P \<or> P \<longrightarrow> P"}.  The proof
  below involves forward-chaining from @{text "P \<or> P"}, followed by an
  explicit case-analysis on the two \emph{identical} cases.\<close>

lemma "P \<or> P \<longrightarrow> P"
proof
  assume "P \<or> P"
  then show P
  proof                    -- \<open>
    rule @{text disjE}: \smash{$\infer{C}{A \disj B & \infer*{C}{[A]} & \infer*{C}{[B]}}$}
\<close>
    assume P show P by fact
  next
    assume P show P by fact
  qed
qed

text \<open>Case splits are \emph{not} hardwired into the Isar language as
  a special feature.  The \isacommand{next} command used to separate
  the cases above is just a short form of managing block structure.

  \medskip In general, applying proof methods may split up a goal into
  separate ``cases'', i.e.\ new subgoals with individual local
  assumptions.  The corresponding proof text typically mimics this by
  establishing results in appropriate contexts, separated by blocks.

  In order to avoid too much explicit parentheses, the Isar system
  implicitly opens an additional block for any new goal, the
  \isacommand{next} statement then closes one block level, opening a
  new one.  The resulting behavior is what one would expect from
  separating cases, only that it is more flexible.  E.g.\ an induction
  base case (which does not introduce local assumptions) would
  \emph{not} require \isacommand{next} to separate the subsequent step
  case.

  \medskip In our example the situation is even simpler, since the two
  cases actually coincide.  Consequently the proof may be rephrased as
  follows.\<close>

lemma "P \<or> P \<longrightarrow> P"
proof
  assume "P \<or> P"
  then show P
  proof
    assume P
    show P by fact
    show P by fact
  qed
qed

text \<open>Again, the rather vacuous body of the proof may be collapsed.
  Thus the case analysis degenerates into two assumption steps, which
  are implicitly performed when concluding the single rule step of the
  double-dot proof as follows.\<close>

lemma "P \<or> P \<longrightarrow> P"
proof
  assume "P \<or> P"
  then show P ..
qed

subsubsection \<open>A quantifier proof\<close>

text \<open>To illustrate quantifier reasoning, let us prove @{text
  "(\<exists>x. P (f x)) \<longrightarrow> (\<exists>y. P y)"}.  Informally, this holds because any
  @{text a} with @{text "P (f a)"} may be taken as a witness for the
  second existential statement.

  The first proof is rather verbose, exhibiting quite a lot of
  (redundant) detail.  It gives explicit rules, even with some
  instantiation.  Furthermore, we encounter two new language elements:
  the \isacommand{fix} command augments the context by some new
  ``arbitrary, but fixed'' element; the \isacommand{is} annotation
  binds term abbreviations by higher-order pattern matching.\<close>

lemma "(\<exists>x. P (f x)) \<longrightarrow> (\<exists>y. P y)"
proof
  assume "\<exists>x. P (f x)"
  then show "\<exists>y. P y"
  proof (rule exE)             -- \<open>
    rule @{text exE}: \smash{$\infer{B}{\ex x A(x) & \infer*{B}{[A(x)]_x}}$}
\<close>
    fix a
    assume "P (f a)" (is "P ?witness")
    then show ?thesis by (rule exI [of P ?witness])
  qed
qed

text \<open>While explicit rule instantiation may occasionally improve
  readability of certain aspects of reasoning, it is usually quite
  redundant.  Above, the basic proof outline gives already enough
  structural clues for the system to infer both the rules and their
  instances (by higher-order unification).  Thus we may as well prune
  the text as follows.\<close>

lemma "(\<exists>x. P (f x)) \<longrightarrow> (\<exists>y. P y)"
proof
  assume "\<exists>x. P (f x)"
  then show "\<exists>y. P y"
  proof
    fix a
    assume "P (f a)"
    then show ?thesis ..
  qed
qed

text \<open>Explicit @{text \<exists>}-elimination as seen above can become quite
  cumbersome in practice.  The derived Isar language element
  ``\isakeyword{obtain}'' provides a more handsome way to do
  generalized existence reasoning.\<close>

lemma "(\<exists>x. P (f x)) \<longrightarrow> (\<exists>y. P y)"
proof
  assume "\<exists>x. P (f x)"
  then obtain a where "P (f a)" ..
  then show "\<exists>y. P y" ..
qed

text \<open>Technically, \isakeyword{obtain} is similar to
  \isakeyword{fix} and \isakeyword{assume} together with a soundness
  proof of the elimination involved.  Thus it behaves similar to any
  other forward proof element.  Also note that due to the nature of
  general existence reasoning involved here, any result exported from
  the context of an \isakeyword{obtain} statement may \emph{not} refer
  to the parameters introduced there.\<close>

subsubsection \<open>Deriving rules in Isabelle\<close>

text \<open>We derive the conjunction elimination rule from the
  corresponding projections.  The proof is quite straight-forward,
  since Isabelle/Isar supports non-atomic goals and assumptions fully
  transparently.\<close>

theorem conjE: "A \<and> B \<Longrightarrow> (A \<Longrightarrow> B \<Longrightarrow> C) \<Longrightarrow> C"
proof -
  assume "A \<and> B"
  assume r: "A \<Longrightarrow> B \<Longrightarrow> C"
  show C
  proof (rule r)
    show A by (rule conjunct1) fact
    show B by (rule conjunct2) fact
  qed
qed

end


theory Lens_Record_Example
  imports Optics
begin

text \<open>The alphabet command supports syntax illustrated in the following comments.\<close>

alphabet mylens =
  x :: nat
  y :: string

thm base_more_bij_lens
thm indeps
thm equivs
thm sublenses
thm quotients
thm compositions
thm lens

lemma mylens_composition:
  "x +\<^sub>L y +\<^sub>L more\<^sub>L \<approx>\<^sub>L 1\<^sub>L" (is "?P \<approx>\<^sub>L ?Q")
proof -
  have "?Q \<approx>\<^sub>L base\<^sub>L +\<^sub>L more\<^sub>L"
    by (simp add: lens_equiv_sym)
  also have "... \<approx>\<^sub>L (x +\<^sub>L y) +\<^sub>L more\<^sub>L"
    by (simp add: lens_plus_eq_left)
  also have "... \<approx>\<^sub>L x +\<^sub>L y +\<^sub>L more\<^sub>L"
    by (simp add: lens_plus_assoc)
  finally show ?thesis
    using lens_equiv_sym
    by blast
qed

lemma mylens_bij_lens:
  "bij_lens (x +\<^sub>L y +\<^sub>L more\<^sub>L)"
  using bij_lens_equiv_id mylens_composition by auto

alphabet mylens_2 = mylens +
  z :: int
  k :: "string list"

thm base_more_bij_lens
thm bij_lenses
thm indeps
thm equivs
thm sublenses

alphabet mylens_3 = mylens_2 +
  n :: real
  h :: nat

thm base_more_bij_lens
thm indeps
thm equivs
thm sublenses

alphabet 't::monoid_add mylens_4 =
  mn :: "'t"

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_weird_nat_add3acc_rot
imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

fun add3acc :: "Nat => Nat => Nat => Nat" where
"add3acc (Z) (Z) z = z"
| "add3acc (Z) (S x3) z = add3acc Z x3 (S z)"
| "add3acc (S x2) y z = add3acc x2 (S y) z"

theorem property0 :
  "((add3acc x y z) = (add3acc y x z))"
  oops

end