(*  Title:      LList_Topology.thy
    Author:     Stefan Friedrich
    Maintainer: Stefan Friedrich
    License:    LGPL
*)

header {* The topology of llists *}

theory LList_Topology
imports Topology "../Lazy-Lists-II/LList2"
begin

section{*The topology of all llists*}

text{*
  This theory introduces the topologies of all llists, of infinite
  llists, and of the non-empty llists. For all three cases it is
  proved that safety properties are closed sets and that liveness
  properties are dense sets. Finally, we prove in each of the the
  three different topologies the respective theorem of Alpern and
  Schneider \cite{alpern85:_defin_liven}, which states that every
  property can be represented as an intersection of a safety property
  and a liveness property.*}

definition
  ttop :: "'a set \<Rightarrow> 'a llist top" where
  "ttop A = topo (\<Union> s\<in>A\<^sup>\<star>. {suff A s})"

lemma ttop_topology [iff]: "topology (ttop A)"
  by (auto simp: ttop_def)

locale suffixes =
  fixes A and B
  defines [simp]: "B \<equiv> (\<Union> s\<in>A\<^sup>\<star>. {suff A s})"

locale trace_top = suffixes + topobase

lemma (in trace_top) open_iff [iff]:
  "m open = (m \<in> topo (\<Union> s\<in>A\<^sup>\<star>. {suff A s}))"
  by (simp add: T_def is_open_def)

lemma (in trace_top) suff_open [intro!]:
  "r \<in> A\<^sup>\<star> \<Longrightarrow> suff A r open"
  by auto

lemma (in trace_top) ttop_carrier: "A\<^sup>\<infinity> = carrier"
  by (auto simp: carrier_topo suff_def)

lemma (in trace_top) nhds_LNil [simp]: "nhds LNil = {A\<^sup>\<infinity>}"
proof
  show "nhds LNil \<subseteq> {A\<^sup>\<infinity>}"
  proof clarify
    fix x assume xnhd: "x \<in> nhds LNil"
    then obtain r
      where rfinpref: "r \<in> finpref A LNil" and suffsub: "suff A r \<subseteq> x"
      by (rule suff_nhd_base)
    from rfinpref have "r = LNil" by auto
    hence "suff A r = A\<^sup>\<infinity>" by auto
    with suffsub have "A\<^sup>\<infinity> \<subseteq> x" by auto
    moreover from xnhd have "x \<subseteq> A\<^sup>\<infinity>" by(auto simp: ttop_carrier elim!: nhdE)
    ultimately show "x = A\<^sup>\<infinity>" by auto
  qed
next
  show "{A\<^sup>\<infinity>} \<subseteq> nhds LNil" by (auto simp: ttop_carrier)
qed

lemma (in trace_top) adh_lemma:
assumes xpoint: "x \<in> A\<^sup>\<infinity>"
  and  PA: "P \<subseteq> A\<^sup>\<infinity>"
shows "(x adh P) = (\<forall> r \<in> finpref A x. \<exists> s \<in> A\<^sup>\<infinity>. r @@ s \<in> P)"
proof-
  from PA have "\<And>r. r \<in> A\<^sup>\<star> \<Longrightarrow> (\<exists> s \<in> A\<^sup>\<infinity>. r @@ s \<in> P) =
        (\<exists> s \<in> P. r \<le> s)"
    by (auto simp: llist_le_def iff: lapp_allT_iff)
  hence  "(\<forall> r \<in> finpref A x. \<exists> s \<in> A\<^sup>\<infinity>. r @@ s \<in> P) =
        (\<forall> r \<in> finpref A x. \<exists> s \<in> P. r \<le> s)"
    by (auto simp: finpref_def)
  also have "\<dots> = (\<forall> r \<in> finpref A x. suff A r \<inter> P \<noteq> {})"
  proof-
    have "\<And>r. (\<exists>s\<in>P. r \<le> s) = ({ra. ra \<in> A\<^sup>\<infinity> \<and> r \<le> ra} \<inter> P \<noteq> {})" using PA
      by blast
    thus ?thesis by (simp add: suff_def)
  qed
  also have "\<dots> = (\<forall> u \<in> nhds x. u \<inter> P \<noteq> {})"
  proof safe
    fix r assume uP: "\<forall>u\<in>nhds x. u \<inter> P \<noteq> {}" and
      rfinpref: "r \<in> finpref A x" and rP: "suff A r \<inter> P = {}"
    from rfinpref have "suff A r open" by (auto dest!: finpref_fin)
    hence "suff A r \<in> nhds x" using xpoint rfinpref
      by auto
    with uP rP show "False" by auto
  next
    fix u assume
      inter:     "\<forall>r\<in>finpref A x. suff A r \<inter> P \<noteq> {}" and
      unhd:   "u \<in> nhds x" and
      uinter: "u \<inter> P = {}"
    from unhd obtain r where
      "r \<in> finpref A x" and "suff A r \<subseteq> u"
      by (rule suff_nhd_base)
    with inter uinter show "False" by auto
  qed
  finally show ?thesis by (simp add: adhs_def)
qed

lemma (in trace_top) topology [iff]:
  "topology T"
by (simp add: T_def)

lemma (in trace_top) safety_closed_iff:
  "P \<subseteq> A\<^sup>\<infinity> \<Longrightarrow>  safety A P = (P closed)"
by (auto simp: safety_def topology.closed_adh adh_lemma ttop_carrier)

lemma (in trace_top) liveness_dense_iff:
  assumes P: "P \<subseteq> A\<^sup>\<infinity>"
  shows "liveness A P = (P dense)"
proof-
  have "liveness A P = (\<forall>r\<in>A\<^sup>\<star>. \<exists> s \<in> A\<^sup>\<infinity>. r @@ s \<in> P)"
    by (simp add: liveness_def)
  also have "\<dots> = (\<forall>x\<in>A\<^sup>\<infinity>. \<forall> r \<in> finpref A x. \<exists> s \<in> A\<^sup>\<infinity>. r @@ s \<in> P)"
      by (auto simp: finpref_def dest: finsubsetall)
  also have "\<dots> = (\<forall>x\<in>A\<^sup>\<infinity>. x adh P)" using P
    by (simp add: adh_lemma)
  also have "\<dots> = (A\<^sup>\<infinity> \<subseteq> closure P)" using P
    by (auto simp: adh_closure_iff ttop_carrier)
  also have "\<dots> = (P dense)"
    by (simp add: liveness_def is_dense_def is_densein_def ttop_carrier)
  finally show ?thesis .
qed

lemma (in trace_top) LNil_safety: "safety A {LNil}"
proof (unfold safety_def, clarify)
  fix t
  assume adh: "t \<in> A\<^sup>\<infinity>" "\<forall>r\<in>finpref A t. \<exists>s\<in>A\<^sup>\<infinity>. r @@ s \<in> {LNil}"
  thus "t = LNil" by (cases t)(auto simp: finpref_def)
qed

lemma (in trace_top) LNil_closed: "{LNil} closed"
by (auto intro: iffD1 [OF safety_closed_iff] LNil_safety)

theorem (in trace_top) alpern_schneider:
assumes Psub:     "P \<subseteq> A\<^sup>\<infinity>"
  shows "\<exists> S L. safety A S \<and> liveness A L \<and> P = S \<inter> L"
proof-
  from Psub have "P \<subseteq> carrier" by (simp add: ttop_carrier)
  then obtain L S where
    Lsub: "L \<subseteq> carrier" and
    Ssub: "S \<subseteq> carrier" and
    Sclosed: "S closed" and
    Ldense: "L dense" and
    Pinter: "P = S \<inter> L"
    by (blast elim: topology.ex_dense_closure_interE [OF topology])
  from Ssub Sclosed have "safety A S"
    by (simp add: safety_closed_iff ttop_carrier)
  moreover from Lsub Ldense have "liveness A L"
    by (simp add: liveness_dense_iff ttop_carrier)
  ultimately show ?thesis using Pinter
    by auto
qed

section{*The topology of infinite llists*}

definition
  itop :: "'a set \<Rightarrow> 'a llist top" where
  "itop A = topo (\<Union> s\<in>A\<^sup>\<star>. {infsuff A s})"

locale infsuffixes =
  fixes A and B
  defines [simp]: "B \<equiv> (\<Union> s\<in>A\<^sup>\<star>. {infsuff A s})"

locale itrace_top = infsuffixes + topobase

lemma (in itrace_top) open_iff [iff]:
  "m open = (m \<in> topo (\<Union> s\<in>A\<^sup>\<star>. {infsuff A s}))"
  by (simp add: T_def is_open_def)

lemma (in itrace_top) topology [iff]: "topology T"
  by (auto simp: T_def)

lemma (in itrace_top) infsuff_open [intro!]:
  "r \<in> A\<^sup>\<star> \<Longrightarrow> infsuff A r open"
  by auto

lemma (in itrace_top) itop_carrier: "carrier = A\<^sup>\<omega>"
  by (auto simp: carrier_topo infsuff_def)

lemma itop_sub_ttop_base:
  fixes A :: "'a set"
    and B :: "'a llist set set"
    and C :: "'a llist set set"
  defines [simp]: "B \<equiv> \<Union>s\<in>A\<^sup>\<star>. {suff A s}" and [simp]: "C \<equiv> \<Union>s\<in>A\<^sup>\<star>. {infsuff A s}"
  shows "C = (\<Union> t\<in>B. {t \<inter> \<Union>C})"
  by (auto simp: infsuff_def suff_def)

lemma itop_sub_ttop [folded ttop_def itop_def]:
  fixes A and C and S (structure)
  defines "C \<equiv> \<Union>s\<in>A\<^sup>\<star>. {infsuff A s}" and "S \<equiv> topo C"
  fixes B and T (structure)
  defines "B \<equiv> \<Union>s\<in>A\<^sup>\<star>. {suff A s}" and "T \<equiv> topo B"
  shows "subtopology S T"
proof -
  interpret itrace_top A C S by fact+
  interpret trace_top A B T by fact+
  show ?thesis
    by (auto intro: itop_sub_ttop_base [THEN subtop_lemma] simp: S_def T_def)
qed

lemma (in itrace_top) infsuff_nhd_base:
  assumes unhd: "u \<in> nhds t"
  and H: "\<And>r. \<lbrakk> r \<in> finpref A t; infsuff A r \<subseteq> u \<rbrakk> \<Longrightarrow> R"
  shows "R"
proof-
  from unhd obtain m where
    uA: "u \<subseteq> A\<^sup>\<omega>" and
    mopen: "m open" and
    tm: "t \<in> m" and
    mu: "m \<subseteq> u"
    by (auto simp: itop_carrier)
  from mopen tm have
    "\<exists>r \<in> finpref A t. infsuff A r \<subseteq> m"
  proof (induct "m")
    case (basic a)
    then obtain s where sA: "s \<in> A\<^sup>\<star>" and as: "a = infsuff A s" and ta: "t \<in> a"
      by auto
    from sA as ta have "s \<in> finpref A t" by (auto dest: infsuff_finpref)
    thus ?case using as by auto
  next case (inter a b)
    then obtain r r' where
      rt: "r \<in> finpref A t" and ra: "infsuff A r \<subseteq> a" and
      r't: "r' \<in> finpref A t" and r'b: "infsuff A r' \<subseteq> b"
      by auto
    from rt r't have "r \<le> r' \<or> r' \<le> r"
      by (auto simp: finpref_def dest: pref_locally_linear)
    thus ?case
    proof
      assume "r \<le> r'"
      hence "infsuff A r' \<subseteq> infsuff A r" by (rule infsuff_mono2)
      thus ?case using r't ra r'b by auto
    next assume "r' \<le> r"
      hence "infsuff A r \<subseteq> infsuff A r'" by (rule infsuff_mono2)
      thus ?case using rt r'b ra by auto
    qed
  next case (union M)
    then obtain v where
      "t \<in> v" and vM: "v \<in> M"
      by blast
    then obtain r where "r\<in>finpref A t" "infsuff A r \<subseteq> v" using union
      by auto
    thus ?case using vM by auto
  qed
  with mu show ?thesis by (auto intro: H)
qed

lemma (in itrace_top) hausdorff [iff]: "T2 T"
proof(rule T2I, clarify)
  fix x y assume xpoint: "x \<in> carrier"
    and ypoint: "y \<in> carrier"
    and neq: "x \<noteq> y"
  from xpoint ypoint have xA: "x \<in> A\<^sup>\<omega>" and yA: "y \<in> A\<^sup>\<omega>"
    by (auto simp: itop_carrier)
  then obtain s where
    sA: "s \<in> A\<^sup>\<star>" and sx: "s \<le> x" and sy: "\<not> s \<le> y" using neq
    by (rule inf_neqE) auto
  from neq have "y \<noteq> x" ..
  with yA xA obtain t where
    tA: "t \<in> A\<^sup>\<star>" and ty: "t \<le> y" and tx: "\<not> t \<le> x"
    by (rule inf_neqE) auto
  let ?u = "infsuff A s" and ?v = "infsuff A t"
  have inter: "?u \<inter> ?v = {}"
  proof (rule ccontr, auto)
    fix z assume "z \<in> ?u" and "z \<in> ?v"
    hence "s \<le> z" and  "t \<le> z" by (unfold infsuff_def) auto
    hence "s \<le> t \<or> t \<le> s" by (rule pref_locally_linear)
    thus False using sx sy tx ty by (auto dest: llist_le_trans)
  qed
  moreover {
    from sA tA have "?u open" and "?v open"
      by auto
    moreover from xA yA sx ty have "x \<in> ?u" and "y \<in> ?v"
      by (auto simp: infsuff_def)
    ultimately have "infsuff A s \<in> nhds x" and
      "infsuff A t \<in> nhds y"
      by auto }
  ultimately show "\<exists> u \<in> nhds x. \<exists> v \<in> nhds y. u \<inter> v = {}"
    by auto
qed

corollary (in itrace_top) unique_convergence:
  "\<lbrakk> x \<in> carrier;
     y \<in> carrier;
     F \<in> Filters ;
     F -\<longrightarrow> x;
     F -\<longrightarrow> y \<rbrakk> \<Longrightarrow> x = y"
  apply (rule T2.unique_convergence)
  prefer 2
  apply (rule filter.intro)
  apply auto
  done

(*
lemma safty_closed:
  fixes   A :: "'a set"
  defines "T \<equiv> itop A"
  assumes P: "P \<subseteq> A\<^sup>\<omega>"
  and safety: "safety A P"
  shows "P iscl T"
proof-
  have istopT [iff]: "istop T" by (simp add: T_def)
  have carrT [simp]: "carr T = A\<^sup>\<omega>" by (simp add: T_def itop_carr)
  show ?thesis
  proof (rule closure_eq_closed, auto)
    fix x assume xclos: "x \<in> clos T P"
    with P have "x \<in> carr T"
      by (intro subsetD [OF closure_subset]) auto
    hence xA: "x \<in> A\<^sup>\<omega>" by simp
    moreover
    from P xclos have adhx: "adh T P x" by (auto intro!: closure_imp_adh)
    have "\<forall> r \<in> finpref A x. \<exists> s \<in> A\<^sup>\<omega>. r @@ s \<in> P"
    proof
      fix r assume "r \<in> finpref A x"
      hence "x \<in> infsuff A r" and rA: "r \<in> A\<^sup>\<star>" using xA
        by (auto simp: finpref_def infsuff_def)
      hence "infsuff A r \<in> nhds T x" by (auto simp: T_def)
      with adhx have  "infsuff A r \<inter> P \<noteq> {}" by (elim adhCE) auto
      then obtain t where "t \<in> infsuff A r" and tP: "t \<in> P" by auto
      then obtain s where "s \<in> A\<^sup>\<omega>" and "t = r @@ s" using rA
        by (auto elim!: infsuff_appE)
      thus "\<exists> s \<in> A\<^sup>\<omega>. r @@ s \<in> P" using tP by auto
    qed
    ultimately show "x \<in> P" using safety
      by (auto elim: safetyE)
  qed
qed
*)
lemma (in itrace_top) adh_lemma:
assumes xpoint: "x \<in> A\<^sup>\<omega>"
  and  PA: "P \<subseteq> A\<^sup>\<omega>"
shows "x adh P = (\<forall> r \<in> finpref A x. \<exists> s \<in> A\<^sup>\<omega>. r @@ s \<in> P)"
proof-
  from PA have "\<And>r. r \<in> A\<^sup>\<star> \<Longrightarrow> (\<exists> s \<in> A\<^sup>\<omega>. r @@ s \<in> P) =
        (\<exists> s \<in> P. r \<le> s)"
    by (auto simp: llist_le_def iff: lapp_infT)
  hence  "(\<forall> r \<in> finpref A x. \<exists> s \<in> A\<^sup>\<omega>. r @@ s \<in> P) =
        (\<forall> r \<in> finpref A x. \<exists> s \<in> P. r \<le> s)"
    by (auto simp: finpref_def)
  also have "\<dots> = (\<forall> r \<in> finpref A x. infsuff A r \<inter> P \<noteq> {})"
  proof-
    have "\<And>r. (\<exists>s\<in>P. r \<le> s) = ({ra. ra \<in> A\<^sup>\<omega> \<and> r \<le> ra} \<inter> P \<noteq> {})" using PA
      by blast
    thus ?thesis by (simp add: infsuff_def)
  qed
  also have "\<dots> = (\<forall> u \<in> nhds x. u \<inter> P \<noteq> {})"
  proof safe
    fix r assume uP: "\<forall> u \<in> nhds x. u \<inter> P \<noteq> {}" and
      rfinpref: "r \<in> finpref A x" and rP: "infsuff A r \<inter> P = {}"
    from rfinpref have "infsuff A r open" by (auto dest!: finpref_fin)
    hence "infsuff A r \<in> nhds x" using xpoint rfinpref
      by auto
    with uP rP show "False" by auto
  next
    fix u assume
      inter:     "\<forall>r\<in>finpref A x. infsuff A r \<inter> P \<noteq> {}" and
      unhd:   "u \<in> nhds x" and
      uinter: "u \<inter> P = {}"
    from unhd obtain r where
      "r \<in> finpref A x" and "infsuff A r \<subseteq> u"
      by (rule infsuff_nhd_base)
    with inter uinter show "False" by auto
  qed
  finally show ?thesis by (simp add: adhs_def)
qed

lemma (in itrace_top) infsafety_closed_iff:
  "P \<subseteq> A\<^sup>\<omega> \<Longrightarrow>  infsafety A P = (P closed)"
  by (auto simp: infsafety_def topology.closed_adh adh_lemma itop_carrier)

lemma (in itrace_top) empty:
  "A = {} \<Longrightarrow> T = {{}}"
proof (auto simp: T_def)
  fix m x assume "m \<in> topo {{}}" and  xm: "x \<in> m"
  thus False
    by (induct m) auto
qed

lemma itop_empty: "itop {} = {{}}"
proof (auto simp: itop_def)
  fix m x assume "m \<in> topo {{}}" and  xm: "x \<in> m"
  thus False
    by (induct m) auto
qed

lemma infliveness_empty:
  "infliveness {} P \<Longrightarrow> False"
  by (auto simp: infliveness_def)

lemma (in trivial) dense:
  "P dense"
  by auto

lemma (in itrace_top) infliveness_dense_iff:
  assumes notempty: "A \<noteq> {}"
  and P: "P \<subseteq> A\<^sup>\<omega>"
  shows "infliveness A P = (P dense)"
proof-
  have "infliveness A P = (\<forall>r\<in>A\<^sup>\<star>. \<exists> s \<in> A\<^sup>\<omega>. r @@ s \<in> P)"
    by (simp add: infliveness_def)
  also have "\<dots> = (\<forall>x\<in>A\<^sup>\<omega>. \<forall> r \<in> finpref A x. \<exists> s \<in> A\<^sup>\<omega>. r @@ s \<in> P)"
  proof-
    from notempty obtain a where "a \<in> A"
      by auto
    hence lc: "lconst a \<in> A\<^sup>\<omega>"
      by (rule lconstT)
    hence "\<And>P. (\<forall>x\<in>A\<^sup>\<omega>. \<forall>r\<in>finpref A x. P r) = (\<forall> r\<in>A\<^sup>\<star>. P r)"
    proof (auto dest: finpref_fin)
      fix P r  assume lc: "lconst a \<in> A\<^sup>\<omega>"
        and Pr: "\<forall>x\<in>A\<^sup>\<omega>. \<forall>r\<in>finpref A x. P r"
        and rA: "r \<in> A\<^sup>\<star>"
      from rA lc have rlc: "r @@ lconst a \<in> A\<^sup>\<omega>" by (rule lapp_fin_infT)
      moreover from rA rlc have "r \<in> finpref A (r @@ lconst a)"
        by (auto simp: finpref_def llist_le_def)
      ultimately show "P r" using Pr by auto
    qed
    thus ?thesis by simp
  qed
  also have "\<dots> = (\<forall>x\<in>A\<^sup>\<omega>. x adh P)" using P
    by (simp add: adh_lemma)
  also have "\<dots> = (A\<^sup>\<omega> \<subseteq> closure P)" using P
    by (auto simp: adh_closure_iff itop_carrier)
  also have "\<dots> = (P dense)"
    by (simp add: infliveness_def is_dense_def is_densein_def itop_carrier)
  finally show ?thesis .
qed

theorem (in itrace_top) alpern_schneider:
assumes notempty: "A \<noteq> {}"
  and   Psub:     "P \<subseteq> A\<^sup>\<omega>"
  shows "\<exists> S L. infsafety A S \<and> infliveness A L \<and> P = S \<inter> L"
proof-
  from Psub have "P \<subseteq> carrier"
    by (simp add: itop_carrier [THEN sym])
  then obtain L S where
    Lsub: "L \<subseteq> carrier" and
    Ssub: "S \<subseteq> carrier" and
    Sclosed: "S closed" and
    Ldense: "L dense" and
    Pinter: "P = S \<inter> L"
    by (rule topology.ex_dense_closure_interE [OF topology]) auto
  from Ssub Sclosed have "infsafety A S"
    by (simp add: infsafety_closed_iff itop_carrier)
  moreover from notempty Lsub Ldense have "infliveness A L"
    by (simp add: infliveness_dense_iff itop_carrier)
  ultimately show ?thesis using Pinter
    by auto
qed

section{*The topology of non-empty llists*}

definition
  ptop :: "'a set \<Rightarrow> 'a llist top" where
  "ptop A \<equiv> topo (\<Union> s\<in>A\<^sup>\<clubsuit>. {suff A s})"

locale possuffixes =
  fixes A and B
  defines [simp]: "B \<equiv> (\<Union> s\<in>A\<^sup>\<clubsuit>. {suff A s})"

locale ptrace_top = possuffixes + topobase

lemma (in ptrace_top) open_iff [iff]:
  "m open = (m \<in> topo (\<Union> s\<in>A\<^sup>\<clubsuit>. {suff A s}))"
  by (simp add: T_def is_open_def)

lemma (in ptrace_top) topology [iff]: "topology T"
  by (simp add: T_def)

lemma (in ptrace_top) ptop_carrier: "carrier = A\<^sup>\<spadesuit>"
by (auto simp add: carrier_topo suff_def)
   (auto elim: alllsts.cases)

lemma pptop_subtop_ttop:
  fixes S (structure)
  fixes A and B and T (structure)
  defines "B \<equiv> \<Union>s\<in>A\<^sup>\<star>. {suff A s}" and "T \<equiv> topo B"
  defines "S \<equiv> \<Union> t \<in> T. {t - {LNil}}"
  shows "subtopology S T"
by (rule subtopology.intro, auto simp add: is_open_def S_def carr_def)

lemma pptop_top:
  fixes S (structure)
  fixes A and B and T (structure)
  defines "B \<equiv> \<Union>s\<in>A\<^sup>\<star>. {suff A s}" and "T \<equiv> topo B"
  defines "S \<equiv> \<Union> t \<in> T. {t - {LNil}}"
  shows  "topology (\<Union> t \<in> T. {t - {LNil}})"
proof -
  interpret trace_top A B T by fact+
  show ?thesis
    by (auto intro!: subtopology.subtop_topology [OF pptop_subtop_ttop]
      trace_top.topology simp: T_def)
qed

(*
lemma
  includes ptrace_top A B S
  includes trace_top  A C T
  fixes S' (structure)
  defines  "S' \<equiv> (\<Union> t \<in> T. {t - {LNil}})"
  shows "S = S'"
proof-
  have [iff]: "\<And> m. m open\<^sub>3 = (\<exists>t. t open\<^sub>2 \<and> m = t - {LNil})"
    by (auto simp add: S'_def is_open_def)
  show ?thesis
  proof
    fix m assume "m open"
    thus "m open\<^sub>3"
    proof (induct m)
      case (basic m) thus ?case by auto
    next case (inter u v) thus ?case
        by (blast intro: topology.Int_open [OF pptop_top])
    next case (union M) thus ?case
        by (auto intro!: topology.union_open [OF pptop_top] simp: S'_def T_def)
    qed
  next
    fix m assume "m open\<^sub>3"
    then obtain t where "t open\<^sub>2" and mt: "m = t - {LNil}" by auto
    hence "t - {LNil} open\<^sub>1"
    proof (induct t)
      case (basic x)
      then obtain s where sfin: "s \<in> A\<^sup>\<star>" and
        ms: "x = suff A s"
        by auto
      thus ?case
      proof (cases s)
        case LNil_fin with ms
        have "x - {LNil} = carrier" by (auto simp: ptop_carrier)
        thus ?thesis by (auto intro!: topology.carrier_open [OF pptop_top])
      next
        case (LCons_fin a l) with ms show ?thesis
          by (auto simp: ptop_def)
      qed
    next case (inter u v)
      hence "(u - {LNil}) \<inter> (v - {LNil}) \<in> ptop A" by auto
      moreover have "(u - {LNil}) \<inter> (v - {LNil}) = (u \<inter> v) - {LNil}"
        by auto
      ultimately show ?case by auto
    next case (union M)
      hence "\<Union>{u. \<exists>x\<in>M. u = x - {LNil}} \<in> ptop A" by auto
      moreover have "\<Union>{u. \<exists>x\<in>M. u = x - {LNil}} = \<Union>M - {LNil}" by auto
      ultimately show ?case by auto
    qed
    thus "x \<in> ptop A" using xt by auto
  qed
qed
*)
lemma (in ptrace_top) suff_open [intro!]:
  "r \<in> A\<^sup>\<clubsuit> \<Longrightarrow> suff A r open"
  by auto

lemma (in ptrace_top) suff_ptop_nhd_base:
  assumes unhd: "u \<in> nhds t"
  and H: "\<And>r. \<lbrakk> r \<in> pfinpref A t; suff A r \<subseteq> u \<rbrakk> \<Longrightarrow> R"
  shows "R"
proof-
  from unhd obtain m where
    uA: "u \<subseteq> A\<^sup>\<spadesuit>" and
    mopen: "m open" and
    tm: "t \<in> m" and
    mu: "m \<subseteq> u"
    by (auto simp: ptop_carrier)
  from mopen tm have
    "\<exists>r \<in> pfinpref A t. suff A r \<subseteq> m"
  proof (induct "m")
    case (basic a)
    then obtain s where sA: "s \<in> A\<^sup>\<clubsuit>" and as: "a = suff A s" and ta: "t \<in> a"
      by auto
    from sA as ta have "s \<in> pfinpref A t"
      by (auto simp: pfinpref_def dest: suff_finpref)
    thus ?case using as by auto
  next case (inter a b)
    then obtain r r' where
      rt: "r \<in> pfinpref A t" and ra: "suff A r \<subseteq> a" and
      r't: "r' \<in> pfinpref A t" and r'b: "suff A r' \<subseteq> b"
      by auto
    from rt r't have "r \<le> r' \<or> r' \<le> r"
      by (auto simp: pfinpref_def finpref_def dest: pref_locally_linear)
    thus ?case
    proof
      assume "r \<le> r'"
      hence "suff A r' \<subseteq> suff A r" by (rule suff_mono2)
      thus ?case using r't ra r'b by auto
    next assume "r' \<le> r"
      hence "suff A r \<subseteq> suff A r'" by (rule suff_mono2)
      thus ?case using rt r'b ra by auto
    qed
  next case (union M)
    then obtain v where
      "t \<in> v" and vM: "v \<in> M"
      by blast
    then obtain r where "r\<in>pfinpref A t" "suff A r \<subseteq> v" using union
      by auto
    thus ?case using vM by auto
  qed
  with mu show ?thesis by (auto intro: H)
qed

lemma pfinpref_LNil [simp]: "pfinpref A LNil = {}"
  by (auto simp: pfinpref_def)

lemma (in ptrace_top) adh_lemma:
  assumes xpoint: "x \<in> A\<^sup>\<spadesuit>"
  and  P_subset_A: "P \<subseteq> A\<^sup>\<spadesuit>"
  shows "x adh P = (\<forall> r \<in> pfinpref A x. \<exists> s \<in> A\<^sup>\<infinity>. r @@ s \<in> P)"
proof
  assume adh_x: "x adh P"
  show "\<forall>r\<in>pfinpref A x. \<exists>s\<in>A\<^sup>\<infinity>. r @@ s \<in> P"
  proof
    fix r let ?u = "suff A r"
    assume r_pfinpref_x: "r \<in> pfinpref A x"
    hence r_pos: "r \<in> A\<^sup>\<clubsuit>" by (auto dest: finpref_fin)
    hence "?u open" by auto
    hence "?u \<in> nhds x" using xpoint r_pfinpref_x
      by auto
    with adh_x have  "?u \<inter> P \<noteq> {}" by (auto elim!:adhCE)
    then obtain t where tu: "t \<in> ?u" and tP: "t \<in> P"
      by auto
    from tu obtain s where "t = r @@ s" using r_pos
      by (auto elim!: suff_appE)
    with tP show "\<exists>s\<in>A\<^sup>\<infinity>. r @@ s \<in> P" using P_subset_A r_pos
      by (auto iff: lapp_allT_iff)
  qed
next
  assume H: "\<forall>r\<in>pfinpref A x. \<exists>s\<in>A\<^sup>\<infinity>. r @@ s \<in> P"
  show "x adh P"
  proof
    fix U assume unhd: "U \<in> nhds x"
    then obtain r where r_pfinpref_x: "r \<in> pfinpref A x" and
      suff_subset_U: "suff A r \<subseteq> U" by (elim suff_ptop_nhd_base)
    from r_pfinpref_x have rpos: "r \<in> A\<^sup>\<clubsuit>" by (auto intro: finpref_fin)
    show "U \<inter> P \<noteq> {}" using rpos
    proof (cases r)
      case (LCons a l)
      hence r_pfinpref_x: "r \<in> pfinpref A x" using r_pfinpref_x
        by auto
      with H obtain s where sA: "s \<in> A\<^sup>\<infinity>" and asP: "r@@s \<in> P"
        by  auto
      moreover have "r @@ s \<in> suff A r" using sA rpos
        by (auto simp: suff_def iff: lapp_allT_iff)
      ultimately show ?thesis using suff_subset_U by auto
    qed
  qed
qed

lemma (in ptrace_top) possafety_closed_iff:
  "P \<subseteq> A\<^sup>\<spadesuit> \<Longrightarrow>  possafety A P = (P closed)"
  by (auto simp: possafety_def topology.closed_adh ptop_carrier adh_lemma)
(*
lemma ptop_empty: "ptop {} = {{}}"
proof (auto simp: ptop_def intro!: topobase.basic)
  fix m x assume "m \<in> topo {}" and  xm: "x \<in> m"
  thus False
    by (induct m) auto
qed

lemma posliveness_empty:
  "posliveness {} P"
  by (auto simp: posliveness_def)
*)

lemma (in ptrace_top) posliveness_dense_iff:
  assumes P: "P \<subseteq> A\<^sup>\<spadesuit>"
  shows "posliveness A P = (P dense)"
proof-
  have "posliveness A P = (\<forall>r\<in>A\<^sup>\<clubsuit>. \<exists> s \<in> A\<^sup>\<infinity>. r @@ s \<in> P)"
    by (simp add: posliveness_def)
  also have "\<dots> = (\<forall>x\<in>A\<^sup>\<spadesuit>. \<forall> r \<in> pfinpref A x. \<exists> s \<in> A\<^sup>\<infinity>. r @@ s \<in> P)"
      by (auto simp: pfinpref_def finpref_def dest: finsubsetall)
  also have "\<dots> = (\<forall>x\<in>A\<^sup>\<spadesuit>. x adh P)" using P
    by (auto simp: adh_lemma simp del: poslsts_iff)
  also have "\<dots> = (A\<^sup>\<spadesuit> \<subseteq> closure P)" using P
    by (auto simp: adh_closure_iff ptop_carrier simp del: poslsts_iff)
  also have "\<dots> = (P dense)"
    by (simp add: posliveness_def is_dense_def is_densein_def ptop_carrier)
  finally show ?thesis .
qed

theorem (in ptrace_top) alpern_schneider:
assumes Psub: "P \<subseteq> A\<^sup>\<spadesuit>"
  shows "\<exists> S L. possafety A S \<and> posliveness A L \<and> P = S \<inter> L"
proof-
  from Psub have "P \<subseteq> carrier" by (simp add: ptop_carrier)
  then obtain L S where
    Lsub: "L \<subseteq> carrier" and
    Ssub: "S \<subseteq> carrier" and
    Sclosed: "S closed" and
    Ldense: "L dense" and
    Pinter: "P = S \<inter> L"
    by (blast elim: topology.ex_dense_closure_interE [OF topology])
  from Ssub Sclosed have "possafety A S"
    by (simp add: possafety_closed_iff ptop_carrier)
  moreover from Lsub Ldense have "posliveness A L"
    by (simp add: posliveness_dense_iff ptop_carrier)
  ultimately show ?thesis using Pinter
    by auto
qed

end


(*<*)
theory Logic
imports LaTeXsugar
begin
(*>*)
text{*
\vspace{-5ex}
\section{Formulas}

The core syntax of formulas (\textit{form} below)
provides the standard logical constructs, in decreasing order of precedence:
\[
\begin{array}{rcl}

\mathit{form} & ::= &
  @{text"(form)"} ~\mid~
  @{const True} ~\mid~
  @{const False} ~\mid~
  @{prop "term = term"}\\
 &\mid& @{prop"\<not> form"}\index{$HOL4@\isasymnot} ~\mid~
  @{prop "form \<and> form"}\index{$HOL0@\isasymand} ~\mid~
  @{prop "form \<or> form"}\index{$HOL1@\isasymor} ~\mid~
  @{prop "form \<longrightarrow> form"}\index{$HOL2@\isasymlongrightarrow}\\
 &\mid& @{prop"\<forall>x. form"}\index{$HOL6@\isasymforall} ~\mid~  @{prop"\<exists>x. form"}\index{$HOL7@\isasymexists}
\end{array}
\]
Terms are the ones we have seen all along, built from constants, variables,
function application and @{text"\<lambda>"}-abstraction, including all the syntactic
sugar like infix symbols, @{text "if"}, @{text "case"}, etc.
\begin{warn}
Remember that formulas are simply terms of type @{text bool}. Hence
@{text "="} also works for formulas. Beware that @{text"="} has a higher
precedence than the other logical operators. Hence @{prop"s = t \<and> A"} means
@{text"(s = t) \<and> A"}, and @{prop"A\<and>B = B\<and>A"} means @{text"A \<and> (B = B) \<and> A"}.
Logical equivalence can also be written with
@{text "\<longleftrightarrow>"} instead of @{text"="}, where @{text"\<longleftrightarrow>"} has the same low
precedence as @{text"\<longrightarrow>"}. Hence @{text"A \<and> B \<longleftrightarrow> B \<and> A"} really means
@{text"(A \<and> B) \<longleftrightarrow> (B \<and> A)"}.
\end{warn}
\begin{warn}
Quantifiers need to be enclosed in parentheses if they are nested within
other constructs (just like @{text "if"}, @{text case} and @{text let}).
\end{warn}
The most frequent logical symbols and their ASCII representations are shown
in Fig.~\ref{fig:log-symbols}.
\begin{figure}
\begin{center}
\begin{tabular}{l@ {\qquad}l@ {\qquad}l}
@{text "\<forall>"} & \xsymbol{forall} & \texttt{ALL}\\
@{text "\<exists>"} & \xsymbol{exists} & \texttt{EX}\\
@{text "\<lambda>"} & \xsymbol{lambda} & \texttt{\%}\\
@{text "\<longrightarrow>"} & \texttt{-{}->}\\
@{text "\<longleftrightarrow>"} & \texttt{<->}\\
@{text "\<and>"} & \texttt{/\char`\\} & \texttt{\&}\\
@{text "\<or>"} & \texttt{\char`\\/} & \texttt{|}\\
@{text "\<not>"} & \xsymbol{not} & \texttt{\char`~}\\
@{text "\<noteq>"} & \xsymbol{noteq} & \texttt{\char`~=}
\end{tabular}
\end{center}
\caption{Logical symbols and their ASCII forms}
\label{fig:log-symbols}
\end{figure}
The first column shows the symbols, the other columns ASCII representations.
The \texttt{\char`\\}\texttt{<...>} form is always converted into the symbolic form
by the Isabelle interfaces, the treatment of the other ASCII forms
depends on the interface. The ASCII forms \texttt{/\char`\\} and
\texttt{\char`\\/}
are special in that they are merely keyboard shortcuts for the interface and
not logical symbols by themselves.
\begin{warn}
The implication @{text"\<Longrightarrow>"} is part of the Isabelle framework. It structures
theorems and proof states, separating assumptions from conclusions.
The implication @{text"\<longrightarrow>"} is part of the logic HOL and can occur inside the
formulas that make up the assumptions and conclusion.
Theorems should be of the form @{text"\<lbrakk> A\<^sub>1; \<dots>; A\<^sub>n \<rbrakk> \<Longrightarrow> A"},
not @{text"A\<^sub>1 \<and> \<dots> \<and> A\<^sub>n \<longrightarrow> A"}. Both are logically equivalent
but the first one works better when using the theorem in further proofs.
\end{warn}

\section{Sets}
\label{sec:Sets}

Sets of elements of type @{typ 'a} have type @{typ"'a set"}\index{set@@{text set}}.
They can be finite or infinite. Sets come with the usual notation:
\begin{itemize}
\item \indexed{@{term"{}"}}{$IMP042},\quad @{text"{e\<^sub>1,\<dots>,e\<^sub>n}"}
\item @{prop"e \<in> A"}\index{$HOLSet0@\isasymin},\quad @{prop"A \<subseteq> B"}\index{$HOLSet2@\isasymsubseteq}
\item @{term"A \<union> B"}\index{$HOLSet4@\isasymunion},\quad @{term"A \<inter> B"}\index{$HOLSet5@\isasyminter},\quad @{term"A - B"},\quad @{term"-A"}
\end{itemize}
(where @{term"A-B"} and @{text"-A"} are set difference and complement)
and much more. @{const UNIV} is the set of all elements of some type.
Set comprehension\index{set comprehension} is written
@{term"{x. P}"}\index{$IMP042@@{term"{x. P}"}} rather than @{text"{x | P}"}.
\begin{warn}
In @{term"{x. P}"} the @{text x} must be a variable. Set comprehension
involving a proper term @{text t} must be written
\noquotes{@{term[source] "{t | x y. P}"}}\index{$IMP042@@{text"{t |x. P}"}},
where @{text "x y"} are those free variables in @{text t}
that occur in @{text P}.
This is just a shorthand for @{term"{v. EX x y. v = t \<and> P}"}, where
@{text v} is a new variable. For example, @{term"{x+y|x. x \<in> A}"}
is short for \noquotes{@{term[source]"{v. \<exists>x. v = x+y \<and> x \<in> A}"}}.
\end{warn}

Here are the ASCII representations of the mathematical symbols:
\begin{center}
\begin{tabular}{l@ {\quad}l@ {\quad}l}
@{text "\<in>"} & \texttt{\char`\\\char`\<in>} & \texttt{:}\\
@{text "\<subseteq>"} & \texttt{\char`\\\char`\<subseteq>} & \texttt{<=}\\
@{text "\<union>"} & \texttt{\char`\\\char`\<union>} & \texttt{Un}\\
@{text "\<inter>"} & \texttt{\char`\\\char`\<inter>} & \texttt{Int}
\end{tabular}
\end{center}
Sets also allow bounded quantifications @{prop"ALL x : A. P"} and
@{prop"EX x : A. P"}.

For the more ambitious, there are also @{text"\<Union>"}\index{$HOLSet6@\isasymUnion}
and @{text"\<Inter>"}\index{$HOLSet7@\isasymInter}:
\begin{center}
@{thm Union_eq} \qquad @{thm Inter_eq}
\end{center}
The ASCII forms of @{text"\<Union>"} are \texttt{\char`\\\char`\<Union>} and \texttt{Union},
those of @{text"\<Inter>"} are \texttt{\char`\\\char`\<Inter>} and \texttt{Inter}.
There are also indexed unions and intersections:
\begin{center}
@{thm UNION_eq} \\ @{thm INTER_eq}
\end{center}
The ASCII forms are \ \texttt{UN x:A.~B} \ and \ \texttt{INT x:A. B} \
where \texttt{x} may occur in \texttt{B}.
If \texttt{A} is \texttt{UNIV} you can write \ \texttt{UN x.~B} \ and \ \texttt{INT x. B}.

Some other frequently useful functions on sets are the following:
\begin{center}
\begin{tabular}{l@ {\quad}l}
@{const_typ set}\index{set@@{const set}} & converts a list to the set of its elements\\
@{const_typ finite}\index{finite@@{const finite}} & is true iff its argument is finite\\
\noquotes{@{term[source] "card :: 'a set \<Rightarrow> nat"}}\index{card@@{const card}} & is the cardinality of a finite set\\
 & and is @{text 0} for all infinite sets\\
@{thm image_def}\index{$IMP042@@{term"f ` A"}} & is the image of a function over a set
\end{tabular}
\end{center}
See @{cite "Nipkow-Main"} for the wealth of further predefined functions in theory
@{theory Main}.

\subsection*{Exercises}

\exercise
Start from the data type of binary trees defined earlier:
*}

datatype 'a tree = Tip | Node "'a tree" 'a "'a tree"

text{*
Define a function @{text "set ::"} @{typ "'a tree \<Rightarrow> 'a set"}
that returns the elements in a tree and a function
@{text "ord ::"} @{typ "int tree \<Rightarrow> bool"}
that tests if an @{typ "int tree"} is ordered.

Define a function @{text ins} that inserts an element into an ordered @{typ "int tree"}
while maintaining the order of the tree. If the element is already in the tree, the
same tree should be returned. Prove correctness of @{text ins}:
@{prop "set(ins x t) = {x} \<union> set t"} and @{prop "ord t \<Longrightarrow> ord(ins i t)"}.
\endexercise

\section{Proof Automation}

So far we have only seen @{text simp} and \indexed{@{text auto}}{auto}: Both perform
rewriting, both can also prove linear arithmetic facts (no multiplication),
and @{text auto} is also able to prove simple logical or set-theoretic goals:
*}

lemma "\<forall>x. \<exists>y. x = y"
by auto

lemma "A \<subseteq> B \<inter> C \<Longrightarrow> A \<subseteq> B \<union> C"
by auto

text{* where
\begin{quote}
\isacom{by} \textit{proof-method}
\end{quote}
is short for
\begin{quote}
\isacom{apply} \textit{proof-method}\\
\isacom{done}
\end{quote}
The key characteristics of both @{text simp} and @{text auto} are
\begin{itemize}
\item They show you where they got stuck, giving you an idea how to continue.
\item They perform the obvious steps but are highly incomplete.
\end{itemize}
A proof method is \conceptnoidx{complete} if it can prove all true formulas.
There is no complete proof method for HOL, not even in theory.
Hence all our proof methods only differ in how incomplete they are.

A proof method that is still incomplete but tries harder than @{text auto} is
\indexed{@{text fastforce}}{fastforce}.  It either succeeds or fails, it acts on the first
subgoal only, and it can be modified like @{text auto}, e.g.,
with @{text "simp add"}. Here is a typical example of what @{text fastforce}
can do:
*}

lemma "\<lbrakk> \<forall>xs \<in> A. \<exists>ys. xs = ys @ ys;  us \<in> A \<rbrakk>
   \<Longrightarrow> \<exists>n. length us = n+n"
by fastforce

text{* This lemma is out of reach for @{text auto} because of the
quantifiers.  Even @{text fastforce} fails when the quantifier structure
becomes more complicated. In a few cases, its slow version @{text force}
succeeds where @{text fastforce} fails.

The method of choice for complex logical goals is \indexed{@{text blast}}{blast}. In the
following example, @{text T} and @{text A} are two binary predicates. It
is shown that if @{text T} is total, @{text A} is antisymmetric and @{text T} is
a subset of @{text A}, then @{text A} is a subset of @{text T}:
*}

lemma
  "\<lbrakk> \<forall>x y. T x y \<or> T y x;
     \<forall>x y. A x y \<and> A y x \<longrightarrow> x = y;
     \<forall>x y. T x y \<longrightarrow> A x y \<rbrakk>
   \<Longrightarrow> \<forall>x y. A x y \<longrightarrow> T x y"
by blast

text{*
We leave it to the reader to figure out why this lemma is true.
Method @{text blast}
\begin{itemize}
\item is (in principle) a complete proof procedure for first-order formulas,
  a fragment of HOL. In practice there is a search bound.
\item does no rewriting and knows very little about equality.
\item covers logic, sets and relations.
\item either succeeds or fails.
\end{itemize}
Because of its strength in logic and sets and its weakness in equality reasoning, it complements the earlier proof methods.

\subsection{\concept{Sledgehammer}}

Command \isacom{sledgehammer} calls a number of external automatic
theorem provers (ATPs) that run for up to 30 seconds searching for a
proof. Some of these ATPs are part of the Isabelle installation, others are
queried over the internet. If successful, a proof command is generated and can
be inserted into your proof.  The biggest win of \isacom{sledgehammer} is
that it will take into account the whole lemma library and you do not need to
feed in any lemma explicitly. For example,*}

lemma "\<lbrakk> xs @ ys = ys @ xs;  length xs = length ys \<rbrakk> \<Longrightarrow> xs = ys"

txt{* cannot be solved by any of the standard proof methods, but
\isacom{sledgehammer} finds the following proof: *}

by (metis append_eq_conv_conj)

text{* We do not explain how the proof was found but what this command
means. For a start, Isabelle does not trust external tools (and in particular
not the translations from Isabelle's logic to those tools!)
and insists on a proof that it can check. This is what \indexed{@{text metis}}{metis} does.
It is given a list of lemmas and tries to find a proof using just those lemmas
(and pure logic). In contrast to using @{text simp} and friends who know a lot of
lemmas already, using @{text metis} manually is tedious because one has
to find all the relevant lemmas first. But that is precisely what
\isacom{sledgehammer} does for us.
In this case lemma @{thm[source]append_eq_conv_conj} alone suffices:
@{thm[display] append_eq_conv_conj}
We leave it to the reader to figure out why this lemma suffices to prove
the above lemma, even without any knowledge of what the functions @{const take}
and @{const drop} do. Keep in mind that the variables in the two lemmas
are independent of each other, despite the same names, and that you can
substitute arbitrary values for the free variables in a lemma.

Just as for the other proof methods we have seen, there is no guarantee that
\isacom{sledgehammer} will find a proof if it exists. Nor is
\isacom{sledgehammer} superior to the other proof methods.  They are
incomparable. Therefore it is recommended to apply @{text simp} or @{text
auto} before invoking \isacom{sledgehammer} on what is left.

\subsection{Arithmetic}

By arithmetic formulas we mean formulas involving variables, numbers, @{text
"+"}, @{text"-"}, @{text "="}, @{text "<"}, @{text "\<le>"} and the usual logical
connectives @{text"\<not>"}, @{text"\<and>"}, @{text"\<or>"}, @{text"\<longrightarrow>"},
@{text"\<longleftrightarrow>"}. Strictly speaking, this is known as \concept{linear arithmetic}
because it does not involve multiplication, although multiplication with
numbers, e.g., @{text"2*n"}, is allowed. Such formulas can be proved by
\indexed{@{text arith}}{arith}:
*}

lemma "\<lbrakk> (a::nat) \<le> x + b; 2*x < c \<rbrakk> \<Longrightarrow> 2*a + 1 \<le> 2*b + c"
by arith

text{* In fact, @{text auto} and @{text simp} can prove many linear
arithmetic formulas already, like the one above, by calling a weak but fast
version of @{text arith}. Hence it is usually not necessary to invoke
@{text arith} explicitly.

The above example involves natural numbers, but integers (type @{typ int})
and real numbers (type @{text real}) are supported as well. As are a number
of further operators like @{const min} and @{const max}. On @{typ nat} and
@{typ int}, @{text arith} can even prove theorems with quantifiers in them,
but we will not enlarge on that here.

\subsection{Trying Them All}

If you want to try all of the above automatic proof methods you simply type
\begin{isabelle}
\isacom{try}
\end{isabelle}
There is also a lightweight variant \isacom{try0} that does not call
sledgehammer. If desired, specific simplification and introduction rules
can be added:
\begin{isabelle}
\isacom{try0} @{text"simp: \<dots> intro: \<dots>"}
\end{isabelle}

\section{Single Step Proofs}

Although automation is nice, it often fails, at least initially, and you need
to find out why. When @{text fastforce} or @{text blast} simply fail, you have
no clue why. At this point, the stepwise
application of proof rules may be necessary. For example, if @{text blast}
fails on @{prop"A \<and> B"}, you want to attack the two
conjuncts @{text A} and @{text B} separately. This can
be achieved by applying \emph{conjunction introduction}
\[ @{thm[mode=Rule,show_question_marks]conjI}\ @{text conjI}
\]
to the proof state. We will now examine the details of this process.

\subsection{Instantiating Unknowns}

We had briefly mentioned earlier that after proving some theorem,
Isabelle replaces all free variables @{text x} by so called \conceptidx{unknowns}{unknown}
@{text "?x"}. We can see this clearly in rule @{thm[source] conjI}.
These unknowns can later be instantiated explicitly or implicitly:
\begin{itemize}
\item By hand, using \indexed{@{text of}}{of}.
The expression @{text"conjI[of \"a=b\" \"False\"]"}
instantiates the unknowns in @{thm[source] conjI} from left to right with the
two formulas @{text"a=b"} and @{text False}, yielding the rule
@{thm[display,mode=Rule,margin=100]conjI[of "a=b" False]}

In general, @{text"th[of string\<^sub>1 \<dots> string\<^sub>n]"} instantiates
the unknowns in the theorem @{text th} from left to right with the terms
@{text string\<^sub>1} to @{text string\<^sub>n}.

\item By unification. \conceptidx{Unification}{unification} is the process of making two
terms syntactically equal by suitable instantiations of unknowns. For example,
unifying @{text"?P \<and> ?Q"} with \mbox{@{prop"a=b \<and> False"}} instantiates
@{text "?P"} with @{prop "a=b"} and @{text "?Q"} with @{prop False}.
\end{itemize}
We need not instantiate all unknowns. If we want to skip a particular one we
can write @{text"_"} instead, for example @{text "conjI[of _ \"False\"]"}.
Unknowns can also be instantiated by name using \indexed{@{text "where"}}{where}, for example
@{text "conjI[where ?P = \"a=b\""} \isacom{and} @{text"?Q = \"False\"]"}.

\subsection{Rule Application}

\conceptidx{Rule application}{rule application} means applying a rule backwards to a proof state.
For example, applying rule @{thm[source]conjI} to a proof state
\begin{quote}
@{text"1.  \<dots>  \<Longrightarrow> A \<and> B"}
\end{quote}
results in two subgoals, one for each premise of @{thm[source]conjI}:
\begin{quote}
@{text"1.  \<dots>  \<Longrightarrow> A"}\\
@{text"2.  \<dots>  \<Longrightarrow> B"}
\end{quote}
In general, the application of a rule @{text"\<lbrakk> A\<^sub>1; \<dots>; A\<^sub>n \<rbrakk> \<Longrightarrow> A"}
to a subgoal \mbox{@{text"\<dots> \<Longrightarrow> C"}} proceeds in two steps:
\begin{enumerate}
\item
Unify @{text A} and @{text C}, thus instantiating the unknowns in the rule.
\item
Replace the subgoal @{text C} with @{text n} new subgoals @{text"A\<^sub>1"} to @{text"A\<^sub>n"}.
\end{enumerate}
This is the command to apply rule @{text xyz}:
\begin{quote}
\isacom{apply}@{text"(rule xyz)"}\index{rule@@{text rule}}
\end{quote}
This is also called \concept{backchaining} with rule @{text xyz}.

\subsection{Introduction Rules}

Conjunction introduction (@{thm[source] conjI}) is one example of a whole
class of rules known as \conceptidx{introduction rules}{introduction rule}. They explain under which
premises some logical construct can be introduced. Here are some further
useful introduction rules:
\[
\inferrule*[right=\mbox{@{text impI}}]{\mbox{@{text"?P \<Longrightarrow> ?Q"}}}{\mbox{@{text"?P \<longrightarrow> ?Q"}}}
\qquad
\inferrule*[right=\mbox{@{text allI}}]{\mbox{@{text"\<And>x. ?P x"}}}{\mbox{@{text"\<forall>x. ?P x"}}}
\]
\[
\inferrule*[right=\mbox{@{text iffI}}]{\mbox{@{text"?P \<Longrightarrow> ?Q"}} \\ \mbox{@{text"?Q \<Longrightarrow> ?P"}}}
  {\mbox{@{text"?P = ?Q"}}}
\]
These rules are part of the logical system of \concept{natural deduction}
(e.g., @{cite HuthRyan}). Although we intentionally de-emphasize the basic rules
of logic in favour of automatic proof methods that allow you to take bigger
steps, these rules are helpful in locating where and why automation fails.
When applied backwards, these rules decompose the goal:
\begin{itemize}
\item @{thm[source] conjI} and @{thm[source]iffI} split the goal into two subgoals,
\item @{thm[source] impI} moves the left-hand side of a HOL implication into the list of assumptions,
\item and @{thm[source] allI} removes a @{text "\<forall>"} by turning the quantified variable into a fixed local variable of the subgoal.
\end{itemize}
Isabelle knows about these and a number of other introduction rules.
The command
\begin{quote}
\isacom{apply} @{text rule}\index{rule@@{text rule}}
\end{quote}
automatically selects the appropriate rule for the current subgoal.

You can also turn your own theorems into introduction rules by giving them
the \indexed{@{text"intro"}}{intro} attribute, analogous to the @{text simp} attribute.  In
that case @{text blast}, @{text fastforce} and (to a limited extent) @{text
auto} will automatically backchain with those theorems. The @{text intro}
attribute should be used with care because it increases the search space and
can lead to nontermination.  Sometimes it is better to use it only in
specific calls of @{text blast} and friends. For example,
@{thm[source] le_trans}, transitivity of @{text"\<le>"} on type @{typ nat},
is not an introduction rule by default because of the disastrous effect
on the search space, but can be useful in specific situations:
*}

lemma "\<lbrakk> (a::nat) \<le> b; b \<le> c; c \<le> d; d \<le> e \<rbrakk> \<Longrightarrow> a \<le> e"
by(blast intro: le_trans)

text{*
Of course this is just an example and could be proved by @{text arith}, too.

\subsection{Forward Proof}
\label{sec:forward-proof}

Forward proof means deriving new theorems from old theorems. We have already
seen a very simple form of forward proof: the @{text of} operator for
instantiating unknowns in a theorem. The big brother of @{text of} is
\indexed{@{text OF}}{OF} for applying one theorem to others. Given a theorem @{prop"A \<Longrightarrow> B"} called
@{text r} and a theorem @{text A'} called @{text r'}, the theorem @{text
"r[OF r']"} is the result of applying @{text r} to @{text r'}, where @{text
r} should be viewed as a function taking a theorem @{text A} and returning
@{text B}.  More precisely, @{text A} and @{text A'} are unified, thus
instantiating the unknowns in @{text B}, and the result is the instantiated
@{text B}. Of course, unification may also fail.
\begin{warn}
Application of rules to other rules operates in the forward direction: from
the premises to the conclusion of the rule; application of rules to proof
states operates in the backward direction, from the conclusion to the
premises.
\end{warn}

In general @{text r} can be of the form @{text"\<lbrakk> A\<^sub>1; \<dots>; A\<^sub>n \<rbrakk> \<Longrightarrow> A"}
and there can be multiple argument theorems @{text r\<^sub>1} to @{text r\<^sub>m}
(with @{text"m \<le> n"}), in which case @{text "r[OF r\<^sub>1 \<dots> r\<^sub>m]"} is obtained
by unifying and thus proving @{text "A\<^sub>i"} with @{text "r\<^sub>i"}, @{text"i = 1\<dots>m"}.
Here is an example, where @{thm[source]refl} is the theorem
@{thm[show_question_marks] refl}:
*}

thm conjI[OF refl[of "a"] refl[of "b"]]

text{* yields the theorem @{thm conjI[OF refl[of "a"] refl[of "b"]]}.
The command \isacom{thm} merely displays the result.

Forward reasoning also makes sense in connection with proof states.
Therefore @{text blast}, @{text fastforce} and @{text auto} support a modifier
@{text dest} which instructs the proof method to use certain rules in a
forward fashion. If @{text r} is of the form \mbox{@{text "A \<Longrightarrow> B"}}, the modifier
\mbox{@{text"dest: r"}}\index{dest@@{text"dest:"}}
allows proof search to reason forward with @{text r}, i.e.,
to replace an assumption @{text A'}, where @{text A'} unifies with @{text A},
with the correspondingly instantiated @{text B}. For example, @{thm[source,show_question_marks] Suc_leD} is the theorem \mbox{@{thm Suc_leD}}, which works well for forward reasoning:
*}

lemma "Suc(Suc(Suc a)) \<le> b \<Longrightarrow> a \<le> b"
by(blast dest: Suc_leD)

text{* In this particular example we could have backchained with
@{thm[source] Suc_leD}, too, but because the premise is more complicated than the conclusion this can easily lead to nontermination.

%\subsection{Finding Theorems}
%
%Command \isacom{find{\isacharunderscorekeyword}theorems} searches for specific theorems in the current
%theory. Search criteria include pattern matching on terms and on names.
%For details see the Isabelle/Isar Reference Manual~@{cite IsarRef}.
%\bigskip

\begin{warn}
To ease readability we will drop the question marks
in front of unknowns from now on.
\end{warn}

\section{Inductive Definitions}
\label{sec:inductive-defs}\index{inductive definition|(}

Inductive definitions are the third important definition facility, after
datatypes and recursive function.
\ifsem
In fact, they are the key construct in the
definition of operational semantics in the second part of the book.
\fi

\subsection{An Example: Even Numbers}
\label{sec:Logic:even}

Here is a simple example of an inductively defined predicate:
\begin{itemize}
\item 0 is even
\item If $n$ is even, so is $n+2$.
\end{itemize}
The operative word ``inductive'' means that these are the only even numbers.
In Isabelle we give the two rules the names @{text ev0} and @{text evSS}
and write
*}

inductive ev :: "nat \<Rightarrow> bool" where
ev0:    "ev 0" |
evSS:  (*<*)"ev n \<Longrightarrow> ev (Suc(Suc n))"(*>*)
text_raw{* @{prop[source]"ev n \<Longrightarrow> ev (n + 2)"} *}

text{* To get used to inductive definitions, we will first prove a few
properties of @{const ev} informally before we descend to the Isabelle level.

How do we prove that some number is even, e.g., @{prop "ev 4"}? Simply by combining the defining rules for @{const ev}:
\begin{quote}
@{text "ev 0 \<Longrightarrow> ev (0 + 2) \<Longrightarrow> ev((0 + 2) + 2) = ev 4"}
\end{quote}

\subsubsection{Rule Induction}\index{rule induction|(}

Showing that all even numbers have some property is more complicated.  For
example, let us prove that the inductive definition of even numbers agrees
with the following recursive one:*}

fun evn :: "nat \<Rightarrow> bool" where
"evn 0 = True" |
"evn (Suc 0) = False" |
"evn (Suc(Suc n)) = evn n"

text{* We prove @{prop"ev m \<Longrightarrow> evn m"}.  That is, we
assume @{prop"ev m"} and by induction on the form of its derivation
prove @{prop"evn m"}. There are two cases corresponding to the two rules
for @{const ev}:
\begin{description}
\item[Case @{thm[source]ev0}:]
 @{prop"ev m"} was derived by rule @{prop "ev 0"}: \\
 @{text"\<Longrightarrow>"} @{prop"m=(0::nat)"} @{text"\<Longrightarrow>"} @{text "evn m = evn 0 = True"}
\item[Case @{thm[source]evSS}:]
 @{prop"ev m"} was derived by rule @{prop "ev n \<Longrightarrow> ev(n+2)"}: \\
@{text"\<Longrightarrow>"} @{prop"m=n+(2::nat)"} and by induction hypothesis @{prop"evn n"}\\
@{text"\<Longrightarrow>"} @{text"evn m = evn(n + 2) = evn n = True"}
\end{description}

What we have just seen is a special case of \concept{rule induction}.
Rule induction applies to propositions of this form
\begin{quote}
@{prop "ev n \<Longrightarrow> P n"}
\end{quote}
That is, we want to prove a property @{prop"P n"}
for all even @{text n}. But if we assume @{prop"ev n"}, then there must be
some derivation of this assumption using the two defining rules for
@{const ev}. That is, we must prove
\begin{description}
\item[Case @{thm[source]ev0}:] @{prop"P(0::nat)"}
\item[Case @{thm[source]evSS}:] @{prop"\<lbrakk> ev n; P n \<rbrakk> \<Longrightarrow> P(n + 2::nat)"}
\end{description}
The corresponding rule is called @{thm[source] ev.induct} and looks like this:
\[
\inferrule{
\mbox{@{thm (prem 1) ev.induct[of "n"]}}\\
\mbox{@{thm (prem 2) ev.induct}}\\
\mbox{@{prop"!!n. \<lbrakk> ev n; P n \<rbrakk> \<Longrightarrow> P(n+2)"}}}
{\mbox{@{thm (concl) ev.induct[of "n"]}}}
\]
The first premise @{prop"ev n"} enforces that this rule can only be applied
in situations where we know that @{text n} is even.

Note that in the induction step we may not just assume @{prop"P n"} but also
\mbox{@{prop"ev n"}}, which is simply the premise of rule @{thm[source]
evSS}.  Here is an example where the local assumption @{prop"ev n"} comes in
handy: we prove @{prop"ev m \<Longrightarrow> ev(m - 2)"} by induction on @{prop"ev m"}.
Case @{thm[source]ev0} requires us to prove @{prop"ev(0 - 2)"}, which follows
from @{prop"ev 0"} because @{prop"0 - 2 = (0::nat)"} on type @{typ nat}. In
case @{thm[source]evSS} we have \mbox{@{prop"m = n+(2::nat)"}} and may assume
@{prop"ev n"}, which implies @{prop"ev (m - 2)"} because @{text"m - 2 = (n +
2) - 2 = n"}. We did not need the induction hypothesis at all for this proof (it
is just a case analysis of which rule was used) but having @{prop"ev n"}
at our disposal in case @{thm[source]evSS} was essential.
This case analysis of rules is also called ``rule inversion''
and is discussed in more detail in \autoref{ch:Isar}.

\subsubsection{In Isabelle}

Let us now recast the above informal proofs in Isabelle. For a start,
we use @{const Suc} terms instead of numerals in rule @{thm[source]evSS}:
@{thm[display] evSS}
This avoids the difficulty of unifying @{text"n+2"} with some numeral,
which is not automatic.

The simplest way to prove @{prop"ev(Suc(Suc(Suc(Suc 0))))"} is in a forward
direction: @{text "evSS[OF evSS[OF ev0]]"} yields the theorem @{thm evSS[OF
evSS[OF ev0]]}. Alternatively, you can also prove it as a lemma in backwards
fashion. Although this is more verbose, it allows us to demonstrate how each
rule application changes the proof state: *}

lemma "ev(Suc(Suc(Suc(Suc 0))))"
txt{*
@{subgoals[display,indent=0,goals_limit=1]}
*}
apply(rule evSS)
txt{*
@{subgoals[display,indent=0,goals_limit=1]}
*}
apply(rule evSS)
txt{*
@{subgoals[display,indent=0,goals_limit=1]}
*}
apply(rule ev0)
done

text{* \indent
Rule induction is applied by giving the induction rule explicitly via the
@{text"rule:"} modifier:\index{inductionrule@@{text"induction ... rule:"}}*}

lemma "ev m \<Longrightarrow> evn m"
apply(induction rule: ev.induct)
by(simp_all)

text{* Both cases are automatic. Note that if there are multiple assumptions
of the form @{prop"ev t"}, method @{text induction} will induct on the leftmost
one.

As a bonus, we also prove the remaining direction of the equivalence of
@{const ev} and @{const evn}:
*}

lemma "evn n \<Longrightarrow> ev n"
apply(induction n rule: evn.induct)

txt{* This is a proof by computation induction on @{text n} (see
\autoref{sec:recursive-funs}) that sets up three subgoals corresponding to
the three equations for @{const evn}:
@{subgoals[display,indent=0]}
The first and third subgoals follow with @{thm[source]ev0} and @{thm[source]evSS}, and the second subgoal is trivially true because @{prop"evn(Suc 0)"} is @{const False}:
*}

by (simp_all add: ev0 evSS)

text{* The rules for @{const ev} make perfect simplification and introduction
rules because their premises are always smaller than the conclusion. It
makes sense to turn them into simplification and introduction rules
permanently, to enhance proof automation. They are named @{thm[source] ev.intros}
\index{intros@@{text".intros"}} by Isabelle: *}

declare ev.intros[simp,intro]

text{* The rules of an inductive definition are not simplification rules by
default because, in contrast to recursive functions, there is no termination
requirement for inductive definitions.

\subsubsection{Inductive Versus Recursive}

We have seen two definitions of the notion of evenness, an inductive and a
recursive one. Which one is better? Much of the time, the recursive one is
more convenient: it allows us to do rewriting in the middle of terms, and it
expresses both the positive information (which numbers are even) and the
negative information (which numbers are not even) directly. An inductive
definition only expresses the positive information directly. The negative
information, for example, that @{text 1} is not even, has to be proved from
it (by induction or rule inversion). On the other hand, rule induction is
tailor-made for proving \mbox{@{prop"ev n \<Longrightarrow> P n"}} because it only asks you
to prove the positive cases. In the proof of @{prop"evn n \<Longrightarrow> P n"} by
computation induction via @{thm[source]evn.induct}, we are also presented
with the trivial negative cases. If you want the convenience of both
rewriting and rule induction, you can make two definitions and show their
equivalence (as above) or make one definition and prove additional properties
from it, for example rule induction from computation induction.

But many concepts do not admit a recursive definition at all because there is
no datatype for the recursion (for example, the transitive closure of a
relation), or the recursion would not terminate (for example,
an interpreter for a programming language). Even if there is a recursive
definition, if we are only interested in the positive information, the
inductive definition may be much simpler.

\subsection{The Reflexive Transitive Closure}
\label{sec:star}

Evenness is really more conveniently expressed recursively than inductively.
As a second and very typical example of an inductive definition we define the
reflexive transitive closure.
\ifsem
It will also be an important building block for
some of the semantics considered in the second part of the book.
\fi

The reflexive transitive closure, called @{text star} below, is a function
that maps a binary predicate to another binary predicate: if @{text r} is of
type @{text"\<tau> \<Rightarrow> \<tau> \<Rightarrow> bool"} then @{term "star r"} is again of type @{text"\<tau> \<Rightarrow>
\<tau> \<Rightarrow> bool"}, and @{prop"star r x y"} means that @{text x} and @{text y} are in
the relation @{term"star r"}. Think @{term"r^*"} when you see @{term"star
r"}, because @{text"star r"} is meant to be the reflexive transitive closure.
That is, @{prop"star r x y"} is meant to be true if from @{text x} we can
reach @{text y} in finitely many @{text r} steps. This concept is naturally
defined inductively: *}

inductive star :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"  for r where
refl:  "star r x x" |
step:  "r x y \<Longrightarrow> star r y z \<Longrightarrow> star r x z"

text{* The base case @{thm[source] refl} is reflexivity: @{term "x=y"}. The
step case @{thm[source]step} combines an @{text r} step (from @{text x} to
@{text y}) and a @{term"star r"} step (from @{text y} to @{text z}) into a
@{term"star r"} step (from @{text x} to @{text z}).
The ``\isacom{for}~@{text r}'' in the header is merely a hint to Isabelle
that @{text r} is a fixed parameter of @{const star}, in contrast to the
further parameters of @{const star}, which change. As a result, Isabelle
generates a simpler induction rule.

By definition @{term"star r"} is reflexive. It is also transitive, but we
need rule induction to prove that: *}

lemma star_trans: "star r x y \<Longrightarrow> star r y z \<Longrightarrow> star r x z"
apply(induction rule: star.induct)
(*<*)
defer
apply(rename_tac u x y)
defer
(*>*)
txt{* The induction is over @{prop"star r x y"} (the first matching assumption)
and we try to prove \mbox{@{prop"star r y z \<Longrightarrow> star r x z"}},
which we abbreviate by @{prop"P x y"}. These are our two subgoals:
@{subgoals[display,indent=0]}
The first one is @{prop"P x x"}, the result of case @{thm[source]refl},
and it is trivial:\index{assumption@@{text assumption}}
*}
apply(assumption)
txt{* Let us examine subgoal @{text 2}, case @{thm[source] step}.
Assumptions @{prop"r u x"} and \mbox{@{prop"star r x y"}}
are the premises of rule @{thm[source]step}.
Assumption @{prop"star r y z \<Longrightarrow> star r x z"} is \mbox{@{prop"P x y"}},
the IH coming from @{prop"star r x y"}. We have to prove @{prop"P u y"},
which we do by assuming @{prop"star r y z"} and proving @{prop"star r u z"}.
The proof itself is straightforward: from \mbox{@{prop"star r y z"}} the IH
leads to @{prop"star r x z"} which, together with @{prop"r u x"},
leads to \mbox{@{prop"star r u z"}} via rule @{thm[source]step}:
*}
apply(metis step)
done

text{*\index{rule induction|)}

\subsection{The General Case}

Inductive definitions have approximately the following general form:
\begin{quote}
\isacom{inductive} @{text"I :: \"\<tau> \<Rightarrow> bool\""} \isacom{where}
\end{quote}
followed by a sequence of (possibly named) rules of the form
\begin{quote}
@{text "\<lbrakk> I a\<^sub>1; \<dots>; I a\<^sub>n \<rbrakk> \<Longrightarrow> I a"}
\end{quote}
separated by @{text"|"}. As usual, @{text n} can be 0.
The corresponding rule induction principle
@{text I.induct} applies to propositions of the form
\begin{quote}
@{prop "I x \<Longrightarrow> P x"}
\end{quote}
where @{text P} may itself be a chain of implications.
\begin{warn}
Rule induction is always on the leftmost premise of the goal.
Hence @{text "I x"} must be the first premise.
\end{warn}
Proving @{prop "I x \<Longrightarrow> P x"} by rule induction means proving
for every rule of @{text I} that @{text P} is invariant:
\begin{quote}
@{text "\<lbrakk> I a\<^sub>1; P a\<^sub>1; \<dots>; I a\<^sub>n; P a\<^sub>n \<rbrakk> \<Longrightarrow> P a"}
\end{quote}

The above format for inductive definitions is simplified in a number of
respects. @{text I} can have any number of arguments and each rule can have
additional premises not involving @{text I}, so-called \conceptidx{side
conditions}{side condition}. In rule inductions, these side conditions appear as additional
assumptions. The \isacom{for} clause seen in the definition of the reflexive
transitive closure simplifies the induction rule.
\index{inductive definition|)}

\subsection*{Exercises}

\begin{exercise}
Formalize the following definition of palindromes
\begin{itemize}
\item The empty list and a singleton list are palindromes.
\item If @{text xs} is a palindrome, so is @{term "a # xs @ [a]"}.
\end{itemize}
as an inductive predicate @{text "palindrome ::"} @{typ "'a list \<Rightarrow> bool"}
and prove that @{prop "rev xs = xs"} if @{text xs} is a palindrome.
\end{exercise}

\exercise
We could also have defined @{const star} as follows:
*}

inductive star' :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" for r where
refl': "star' r x x" |
step': "star' r x y \<Longrightarrow> r y z \<Longrightarrow> star' r x z"

text{*
The single @{text r} step is performed after rather than before the @{text star'}
steps. Prove @{prop "star' r x y \<Longrightarrow> star r x y"} and
@{prop "star r x y \<Longrightarrow> star' r x y"}. You may need lemmas.
Note that rule induction fails
if the assumption about the inductive predicate is not the first assumption.
\endexercise

\begin{exercise}\label{exe:iter}
Analogous to @{const star}, give an inductive definition of the @{text n}-fold iteration
of a relation @{text r}: @{term "iter r n x y"} should hold if there are @{text x\<^sub>0}, \dots, @{text x\<^sub>n}
such that @{prop"x = x\<^sub>0"}, @{prop"x\<^sub>n = y"} and @{text"r x\<^bsub>i\<^esub> x\<^bsub>i+1\<^esub>"} for
all @{prop"i < n"}. Correct and prove the following claim:
@{prop"star r x y \<Longrightarrow> iter r n x y"}.
\end{exercise}

\begin{exercise}\label{exe:cfg}
A context-free grammar can be seen as an inductive definition where each
nonterminal $A$ is an inductively defined predicate on lists of terminal
symbols: $A(w)$ means that $w$ is in the language generated by $A$.
For example, the production $S \to a S b$ can be viewed as the implication
@{prop"S w \<Longrightarrow> S (a # w @ [b])"} where @{text a} and @{text b} are terminal symbols,
i.e., elements of some alphabet. The alphabet can be defined like this:
\isacom{datatype} @{text"alpha = a | b | \<dots>"}

Define the two grammars (where $\varepsilon$ is the empty word)
\[
\begin{array}{r@ {\quad}c@ {\quad}l}
S &\to& \varepsilon \quad\mid\quad aSb \quad\mid\quad SS \\
T &\to& \varepsilon \quad\mid\quad TaTb
\end{array}
\]
as two inductive predicates.
If you think of @{text a} and @{text b} as ``@{text "("}'' and  ``@{text ")"}'',
the grammar defines strings of balanced parentheses.
Prove @{prop"T w \<Longrightarrow> S w"} and \mbox{@{prop "S w \<Longrightarrow> T w"}} separately and conclude
@{prop "S w = T w"}.
\end{exercise}

\ifsem
\begin{exercise}
In \autoref{sec:AExp} we defined a recursive evaluation function
@{text "aval :: aexp \<Rightarrow> state \<Rightarrow> val"}.
Define an inductive evaluation predicate
@{text "aval_rel :: aexp \<Rightarrow> state \<Rightarrow> val \<Rightarrow> bool"}
and prove that it agrees with the recursive function:
@{prop "aval_rel a s v \<Longrightarrow> aval a s = v"},
@{prop "aval a s = v \<Longrightarrow> aval_rel a s v"} and thus
\noquotes{@{prop [source] "aval_rel a s v \<longleftrightarrow> aval a s = v"}}.
\end{exercise}

\begin{exercise}
Consider the stack machine from Chapter~3
and recall the concept of \concept{stack underflow}
from Exercise~\ref{exe:stack-underflow}.
Define an inductive predicate
@{text "ok :: nat \<Rightarrow> instr list \<Rightarrow> nat \<Rightarrow> bool"}
such that @{text "ok n is n'"} means that with any initial stack of length
@{text n} the instructions @{text "is"} can be executed
without stack underflow and that the final stack has length @{text n'}.
Prove that @{text ok} correctly computes the final stack size
@{prop[display] "\<lbrakk>ok n is n'; length stk = n\<rbrakk> \<Longrightarrow> length (exec is s stk) = n'"}
and that instruction sequences generated by @{text comp}
cannot cause stack underflow: \ @{text "ok n (comp a) ?"} \ for
some suitable value of @{text "?"}.
\end{exercise}
\fi
*}
(*<*)
end
(*>*)


(*  Title:      HOL/Hoare/Hoare_Logic_Abort.thy
    Author:     Leonor Prensa Nieto & Tobias Nipkow
    Copyright   2003 TUM

Like Hoare.thy, but with an Abort statement for modelling run time errors.
*)

theory Hoare_Logic_Abort
imports Main
begin

type_synonym 'a bexp = "'a set"
type_synonym 'a assn = "'a set"

datatype 'a com =
  Basic "'a \<Rightarrow> 'a"
| Abort
| Seq "'a com" "'a com"               ("(_;/ _)"      [61,60] 60)
| Cond "'a bexp" "'a com" "'a com"    ("(1IF _/ THEN _ / ELSE _/ FI)"  [0,0,0] 61)
| While "'a bexp" "'a assn" "'a com"  ("(1WHILE _/ INV {_} //DO _ /OD)"  [0,0,0] 61)

abbreviation annskip ("SKIP") where "SKIP == Basic id"

type_synonym 'a sem = "'a option => 'a option => bool"

inductive Sem :: "'a com \<Rightarrow> 'a sem"
where
  "Sem (Basic f) None None"
| "Sem (Basic f) (Some s) (Some (f s))"
| "Sem Abort s None"
| "Sem c1 s s'' \<Longrightarrow> Sem c2 s'' s' \<Longrightarrow> Sem (c1;c2) s s'"
| "Sem (IF b THEN c1 ELSE c2 FI) None None"
| "s \<in> b \<Longrightarrow> Sem c1 (Some s) s' \<Longrightarrow> Sem (IF b THEN c1 ELSE c2 FI) (Some s) s'"
| "s \<notin> b \<Longrightarrow> Sem c2 (Some s) s' \<Longrightarrow> Sem (IF b THEN c1 ELSE c2 FI) (Some s) s'"
| "Sem (While b x c) None None"
| "s \<notin> b \<Longrightarrow> Sem (While b x c) (Some s) (Some s)"
| "s \<in> b \<Longrightarrow> Sem c (Some s) s'' \<Longrightarrow> Sem (While b x c) s'' s' \<Longrightarrow>
   Sem (While b x c) (Some s) s'"

inductive_cases [elim!]:
  "Sem (Basic f) s s'" "Sem (c1;c2) s s'"
  "Sem (IF b THEN c1 ELSE c2 FI) s s'"

definition Valid :: "'a bexp \<Rightarrow> 'a com \<Rightarrow> 'a bexp \<Rightarrow> bool" where
  "Valid p c q \<equiv> \<forall>s s'. Sem c s s' \<longrightarrow> s \<in> Some ` p \<longrightarrow> s' \<in> Some ` q"

syntax
  "_assign" :: "idt => 'b => 'a com"  ("(2_ :=/ _)" [70, 65] 61)

syntax
  "_hoare_abort_vars" :: "[idts, 'a assn,'a com,'a assn] => bool"
                 ("VARS _// {_} // _ // {_}" [0,0,55,0] 50)
syntax ("" output)
  "_hoare_abort"      :: "['a assn,'a com,'a assn] => bool"
                 ("{_} // _ // {_}" [0,55,0] 50)

ML_file \<open>hoare_syntax.ML\<close>
parse_translation \<open>[(\<^syntax_const>\<open>_hoare_abort_vars\<close>, K Hoare_Syntax.hoare_vars_tr)]\<close>
print_translation
  \<open>[(\<^const_syntax>\<open>Valid\<close>, K (Hoare_Syntax.spec_tr' \<^syntax_const>\<open>_hoare_abort\<close>))]\<close>

section \<open>The proof rules\<close>

lemma SkipRule: "p \<subseteq> q \<Longrightarrow> Valid p (Basic id) q"
by (auto simp:Valid_def)

lemma BasicRule: "p \<subseteq> {s. f s \<in> q} \<Longrightarrow> Valid p (Basic f) q"
by (auto simp:Valid_def)

lemma SeqRule: "Valid P c1 Q \<Longrightarrow> Valid Q c2 R \<Longrightarrow> Valid P (c1;c2) R"
by (auto simp:Valid_def)

lemma CondRule:
 "p \<subseteq> {s. (s \<in> b \<longrightarrow> s \<in> w) \<and> (s \<notin> b \<longrightarrow> s \<in> w')}
  \<Longrightarrow> Valid w c1 q \<Longrightarrow> Valid w' c2 q \<Longrightarrow> Valid p (Cond b c1 c2) q"
by (fastforce simp:Valid_def image_def)

lemma While_aux:
  assumes "Sem (WHILE b INV {i} DO c OD) s s'"
  shows "\<forall>s s'. Sem c s s' \<longrightarrow> s \<in> Some ` (I \<inter> b) \<longrightarrow> s' \<in> Some ` I \<Longrightarrow>
    s \<in> Some ` I \<Longrightarrow> s' \<in> Some ` (I \<inter> -b)"
  using assms
  by (induct "WHILE b INV {i} DO c OD" s s') auto

lemma WhileRule:
 "p \<subseteq> i \<Longrightarrow> Valid (i \<inter> b) c i \<Longrightarrow> i \<inter> (-b) \<subseteq> q \<Longrightarrow> Valid p (While b i c) q"
apply(simp add:Valid_def)
apply(simp (no_asm) add:image_def)
apply clarify
apply(drule While_aux)
  apply assumption
 apply blast
apply blast
done

lemma AbortRule: "p \<subseteq> {s. False} \<Longrightarrow> Valid p Abort q"
by(auto simp:Valid_def)

subsection \<open>Derivation of the proof rules and, most importantly, the VCG tactic\<close>

lemma Compl_Collect: "-(Collect b) = {x. \<not>(b x)}"
  by blast

ML_file \<open>hoare_tac.ML\<close>

method_setup vcg = \<open>
  Scan.succeed (fn ctxt => SIMPLE_METHOD' (Hoare.hoare_tac ctxt (K all_tac)))\<close>
  "verification condition generator"

method_setup vcg_simp = \<open>
  Scan.succeed (fn ctxt =>
    SIMPLE_METHOD' (Hoare.hoare_tac ctxt (asm_full_simp_tac ctxt)))\<close>
  "verification condition generator plus simplification"

\<comment> \<open>Special syntax for guarded statements and guarded array updates:\<close>
syntax
  "_guarded_com" :: "bool \<Rightarrow> 'a com \<Rightarrow> 'a com"  ("(2_ \<rightarrow>/ _)" 71)
  "_array_update" :: "'a list \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a com"  ("(2_[_] :=/ _)" [70, 65] 61)
translations
  "P \<rightarrow> c" == "IF P THEN c ELSE CONST Abort FI"
  "a[i] := v" => "(i < CONST length a) \<rightarrow> (a := CONST list_update a i v)"
  \<comment> \<open>reverse translation not possible because of duplicate \<open>a\<close>\<close>

text \<open>
  Note: there is no special syntax for guarded array access. Thus
  you must write \<open>j < length a \<rightarrow> a[i] := a!j\<close>.
\<close>

end