header {* Linear Temporal Logic *}
(* Author: Alexander Schimpf *)
theory LTL
imports
  "../CAVA_Automata/Words"
begin

subsection "LTL formulas"

subsubsection {* Syntax *}

datatype (plugins del: size)
 'a ltl = LTLTrue
       | LTLFalse
       | LTLProp 'a
       | LTLNeg "'a ltl"
       | LTLAnd "'a ltl" "'a ltl"
       | LTLOr "'a ltl" "'a ltl"
       | LTLNext "'a ltl"
       | LTLUntil "'a ltl" "'a ltl"
       | LTLRelease "'a ltl" "'a ltl"

instantiation ltl :: (type) size
begin

text {* The new datatype package would give a size of 1 to
  @{const LTLProp}, which breaks some of the proofs below. *}
primrec size_ltl :: "'a ltl \<Rightarrow> nat" where
    "size LTLTrue = 0"
  | "size LTLFalse = 0"
  | "size (LTLProp _) = 0"
  | "size (LTLNeg \<phi>) = size \<phi> + 1"
  | "size (LTLAnd \<phi> \<psi>) = size \<phi> + size \<psi> + 1"
  | "size (LTLOr \<phi> \<psi>) = size \<phi> + size \<psi> + 1"
  | "size (LTLNext \<phi>) = size \<phi> + 1"
  | "size (LTLUntil \<phi> \<psi>) = size \<phi> + size \<psi> + 1"
  | "size (LTLRelease \<phi> \<psi>) = size \<phi> + size \<psi> + 1"

instance ..

end

text {* The following locale defines syntactic sugar for
  parsing and printing LTL formulas in Isabelle *}
locale LTL_Syntax begin
notation
           LTLTrue     ("true")
       and LTLFalse    ("false")
       and LTLProp     ("prop'(_')")
       and LTLNeg      ("not _" [85] 85)
       and LTLAnd      ("_ and _" [82,82] 81)
       and LTLOr       ("_ or _" [81,81] 80)
       and LTLNext     ("X _" [88] 87)
       and LTLUntil    ("_ U _" [84,84] 83)
       and LTLRelease  ("_ V _" [83,83] 82)
end

subsubsection {* Semantics *}
text {* We first provide an abstract semantics, that is parameterized with
  the semantics of atomic propositions *}

context begin interpretation LTL_Syntax .

primrec ltl_semantics :: "'ap set word \<Rightarrow> 'ap ltl \<Rightarrow> bool"
  ("_ \<Turnstile> _" [80,80] 80)
  where
    "\<xi> \<Turnstile> true = True"
  | "\<xi> \<Turnstile> false = False"
  | "\<xi> \<Turnstile> prop(q) = (q \<in> (\<xi> 0))"
  | "\<xi> \<Turnstile> not \<phi> = (\<not> \<xi> \<Turnstile> \<phi>)"
  | "\<xi> \<Turnstile> \<phi> and \<psi> = (\<xi> \<Turnstile> \<phi> \<and> \<xi> \<Turnstile> \<psi>)"
  | "\<xi> \<Turnstile> \<phi> or \<psi> = (\<xi> \<Turnstile> \<phi> \<or> \<xi> \<Turnstile> \<psi>)"
  | "\<xi> \<Turnstile> X \<phi> = (suffix 1 \<xi> \<Turnstile> \<phi>)"
  | "\<xi> \<Turnstile> \<phi> U \<psi> = (\<exists>i. suffix i \<xi> \<Turnstile> \<psi> \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile> \<phi>))"
  | "\<xi> \<Turnstile> \<phi> V \<psi> = (\<forall>i. suffix i \<xi> \<Turnstile> \<psi> \<or> (\<exists>j<i. suffix j \<xi> \<Turnstile> \<phi>))"

definition "ltl_language \<phi> \<equiv> {\<xi>. \<xi> \<Turnstile> \<phi>}"
end

subsubsection {* Explicit Syntactic Sugar *}
text {* In this section, we provide a formulation of LTL with
  explicit syntactic sugar deeply embedded. This formalization
  serves as a reference semantics.
*}
datatype
 'a ltlc = LTLcTrue
         | LTLcFalse
         | LTLcProp 'a
         | LTLcNeg "'a ltlc"
         | LTLcAnd "'a ltlc" "'a ltlc"
         | LTLcOr "'a ltlc" "'a ltlc"
         | LTLcImplies "'a ltlc" "'a ltlc"
         | LTLcIff "'a ltlc" "'a ltlc"
         | LTLcNext "'a ltlc"
         | LTLcFinal "'a ltlc"
         | LTLcGlobal "'a ltlc"
         | LTLcUntil "'a ltlc" "'a ltlc"
         | LTLcRelease "'a ltlc" "'a ltlc"

context LTL_Syntax begin
  notation
        LTLcTrue     ("true\<^sub>c")
    and LTLcFalse    ("false\<^sub>c")
    and LTLcProp     ("prop\<^sub>c'(_')")
    and LTLcNeg      ("not\<^sub>c _" [85] 85)
    and LTLcAnd      ("_ and\<^sub>c _" [82,82] 81)
    and LTLcOr       ("_ or\<^sub>c _" [81,81] 80)
    and LTLcImplies  ("_ implies\<^sub>c _" [81,81] 80)
    and LTLcIff      (" _ iff\<^sub>c _" [81,81] 80)
    and LTLcNext     ("X\<^sub>c _" [88] 87)
    and LTLcFinal    ("F\<^sub>c _" [88] 87)
    and LTLcGlobal   ("G\<^sub>c _" [88] 87)
    and LTLcUntil    ("_ U\<^sub>c _" [84,84] 83)
    and LTLcRelease  ("_ V\<^sub>c _" [83,83] 82)
end

context begin interpretation LTL_Syntax .

primrec ltlc_semantics
  :: "['a set word, 'a ltlc] \<Rightarrow> bool" ("_ \<Turnstile>\<^sub>c _" [80,80] 80)
where
    "\<xi> \<Turnstile>\<^sub>c true\<^sub>c = True"
  | "\<xi> \<Turnstile>\<^sub>c false\<^sub>c = False"
  | "\<xi> \<Turnstile>\<^sub>c prop\<^sub>c(q) = (q\<in>\<xi> 0)"
  | "\<xi> \<Turnstile>\<^sub>c not\<^sub>c \<phi> = (\<not> \<xi> \<Turnstile>\<^sub>c \<phi>)"
  | "\<xi> \<Turnstile>\<^sub>c \<phi> and\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<and> \<xi> \<Turnstile>\<^sub>c \<psi>)"
  | "\<xi> \<Turnstile>\<^sub>c \<phi> or\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<or> \<xi> \<Turnstile>\<^sub>c \<psi>)"
  | "\<xi> \<Turnstile>\<^sub>c \<phi> implies\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<longrightarrow> \<xi> \<Turnstile>\<^sub>c \<psi>)"
  | "\<xi> \<Turnstile>\<^sub>c \<phi> iff\<^sub>c \<psi> = (\<xi> \<Turnstile>\<^sub>c \<phi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>c \<psi>)"
  | "\<xi> \<Turnstile>\<^sub>c X\<^sub>c \<phi> = (suffix 1 \<xi> \<Turnstile>\<^sub>c \<phi>)"
  | "\<xi> \<Turnstile>\<^sub>c F\<^sub>c \<phi> = (\<exists>i. suffix i \<xi> \<Turnstile>\<^sub>c \<phi>)"
  | "\<xi> \<Turnstile>\<^sub>c G\<^sub>c \<phi> = (\<forall>i. suffix i \<xi> \<Turnstile>\<^sub>c \<phi>)"
  | "\<xi> \<Turnstile>\<^sub>c \<phi> U\<^sub>c \<psi> = (\<exists>i. suffix i \<xi> \<Turnstile>\<^sub>c \<psi> \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>c \<phi>))"
  | "\<xi> \<Turnstile>\<^sub>c \<phi> V\<^sub>c \<psi> = (\<forall>i. suffix i \<xi> \<Turnstile>\<^sub>c \<psi> \<or> (\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>c \<phi>))"

definition "ltlc_language \<phi> \<equiv> {\<xi>. \<xi> \<Turnstile>\<^sub>c \<phi>}"

lemma ltlc_language_negate[simp]:
  "ltlc_language (not\<^sub>c \<phi>) = - ltlc_language \<phi>"
unfolding ltlc_language_def
by auto

lemma ltlc_semantics_sugar:
  "\<xi> \<Turnstile>\<^sub>c \<phi> implies\<^sub>c \<psi> = \<xi> \<Turnstile>\<^sub>c (not\<^sub>c \<phi> or\<^sub>c \<psi>)"
  "\<xi> \<Turnstile>\<^sub>c \<phi> iff\<^sub>c \<psi> = \<xi> \<Turnstile>\<^sub>c ((not\<^sub>c \<phi> or\<^sub>c \<psi>) and\<^sub>c (not\<^sub>c \<psi> or\<^sub>c \<phi>))"
  "\<xi> \<Turnstile>\<^sub>c F\<^sub>c \<phi> = \<xi> \<Turnstile>\<^sub>c (true\<^sub>c U\<^sub>c \<phi>)"
  "\<xi> \<Turnstile>\<^sub>c G\<^sub>c \<phi> = \<xi> \<Turnstile>\<^sub>c (false\<^sub>c V\<^sub>c \<phi>)"
by auto

text {* Conversion from LTL with common syntax to LTL *}

fun ltlc_to_ltl :: "'a ltlc \<Rightarrow> 'a ltl"
where
  "ltlc_to_ltl true\<^sub>c = true"
| "ltlc_to_ltl false\<^sub>c = false"
| "ltlc_to_ltl prop\<^sub>c(q) = prop(q)"
| "ltlc_to_ltl (not\<^sub>c \<phi>) = not (ltlc_to_ltl \<phi>)"
| "ltlc_to_ltl (\<phi> and\<^sub>c \<psi>) = ltlc_to_ltl \<phi> and ltlc_to_ltl \<psi>"
| "ltlc_to_ltl (\<phi> or\<^sub>c \<psi>) = ltlc_to_ltl \<phi> or ltlc_to_ltl \<psi>"
| "ltlc_to_ltl (\<phi> implies\<^sub>c \<psi>) = (not (ltlc_to_ltl \<phi>)) or (ltlc_to_ltl \<psi>)"
| "ltlc_to_ltl (\<phi> iff\<^sub>c \<psi>) = (let \<phi>' = ltlc_to_ltl \<phi> in
                             let \<psi>' = ltlc_to_ltl \<psi> in
                             (not \<phi>' or \<psi>') and (not \<psi>' or \<phi>'))"
| "ltlc_to_ltl (X\<^sub>c \<phi>) = X (ltlc_to_ltl \<phi>)"
| "ltlc_to_ltl (F\<^sub>c \<phi>) = true U ltlc_to_ltl \<phi>"
| "ltlc_to_ltl (G\<^sub>c \<phi>) = false V ltlc_to_ltl \<phi>"
| "ltlc_to_ltl (\<phi> U\<^sub>c \<psi>) = ltlc_to_ltl \<phi> U ltlc_to_ltl \<psi>"
| "ltlc_to_ltl (\<phi> V\<^sub>c \<psi>) = ltlc_to_ltl \<phi> V ltlc_to_ltl \<psi>"

lemma ltlc_to_ltl_equiv:
  "\<xi> \<Turnstile> (ltlc_to_ltl \<phi>) \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>c \<phi>"
  apply (induct \<phi> arbitrary:\<xi>)
  apply (auto simp: Let_def)
  done

end

subsection {* Semantic Preserving Syntax Transformations *}

context begin interpretation LTL_Syntax .

lemma ltl_true_or_con[simp]:
  "\<xi> \<Turnstile> prop(p) or (not prop(p)) \<longleftrightarrow> \<xi> \<Turnstile> true"
  by auto

lemma ltl_false_true_con[simp]:
  "\<xi> \<Turnstile> not true \<longleftrightarrow> \<xi> \<Turnstile> false"
  by auto

text{*
  The negation symbol can be passed through the next operator.
*}
lemma ltl_Next_Neg_con[simp]:
  "\<xi> \<Turnstile> X (not \<phi>) \<longleftrightarrow> \<xi> \<Turnstile> not X \<phi>"
  by auto

text{*
  The connection between Until and Release
*}
lemma ltl_Release_Until_con:
 "\<xi> \<Turnstile> \<phi> V \<psi> \<longleftrightarrow> (\<not> \<xi> \<Turnstile> (not \<phi>) U (not \<psi>))"
  by auto

text{* Expand strategy *}

lemma ltl_expand_Until:
  "\<xi> \<Turnstile> \<phi> U \<psi> \<longleftrightarrow> (\<xi> \<Turnstile> \<psi> or (\<phi> and (X (\<phi> U \<psi>))))" (is "?lhs = ?rhs")
proof
  assume ?lhs
  then obtain i
        where psi_is: "suffix i \<xi> \<Turnstile> \<psi>"
          and phi_is: "\<forall>j<i. suffix j \<xi> \<Turnstile> \<phi>" by auto
  show ?rhs
  proof(cases i)
    case 0
    thus ?rhs using psi_is by auto
  next
    case (Suc k)
    with phi_is have "\<xi> \<Turnstile> \<phi>" by auto
    moreover
    have "\<xi> \<Turnstile> X (\<phi> U \<psi>)"
    using psi_is phi_is Suc by auto
    ultimately show ?rhs by auto
  qed
next
  assume rhs: ?rhs
  show ?lhs
  proof(cases "\<xi> \<Turnstile> \<psi>")
    case True
    hence "suffix 0 \<xi> \<Turnstile> \<psi>" by auto
    moreover
    have "\<forall>j<0. suffix j \<xi> \<Turnstile> \<phi>" by auto
    ultimately
    have "\<exists>i. suffix i \<xi> \<Turnstile> \<psi>
              \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile> \<phi>)" by blast
    thus ?lhs by auto
  next
    case False
    hence phi_is: "\<xi> \<Turnstile> \<phi>"
      and "\<xi> \<Turnstile> X (\<phi> U \<psi>)" using rhs by auto
    then obtain i
          where psi_suc_is: "suffix (Suc i) \<xi> \<Turnstile> \<psi>"
            and phi_suc_is: "\<forall>j<i. suffix (Suc j) \<xi> \<Turnstile> \<phi>" by auto
    have sbgoal: "\<forall>j<(Suc i). suffix j \<xi> \<Turnstile> \<phi>"
    proof(clarify)
      fix j
      assume j_less: "j<Suc i"
      show "suffix j \<xi> \<Turnstile> \<phi>"
      proof (cases j)
        assume "j=0"
        thus ?thesis using phi_is by auto
      next
        fix k
        assume "j=Suc k"
        thus ?thesis using j_less phi_suc_is by auto
      qed
    qed
    thus ?lhs using psi_suc_is phi_is by auto
  qed
qed

lemma ltl_expand_Release:
  "\<xi> \<Turnstile> \<phi> V \<psi> \<longleftrightarrow> (\<xi> \<Turnstile> \<psi> and (\<phi> or (X (\<phi> V \<psi>))))"
proof -
  from ltl_expand_Until[of \<xi> "not \<phi>" "not \<psi>"]
  show ?thesis by auto
qed

text{* Double negation structure of an LTL formula *}

lemma ltl_double_neg_struct:
  shows "\<exists>n \<psi>. \<phi> = ((\<lambda>\<xi>. not not \<xi>) ^^ n) \<psi> \<and> (\<forall>\<nu>. \<psi> \<noteq> not not \<nu>)"
  (is "\<exists>n \<psi>. ?Q \<phi> n \<psi>")
proof(cases "\<forall>\<nu>. \<phi> \<noteq> not \<nu>")
  case goal1
    hence "?Q \<phi> 0 \<phi>" by auto
    thus ?thesis by blast
next
  case goal2
    thus ?thesis
    proof(induct \<phi>)
      case (LTLNeg \<phi>')
        thus ?case
        proof(cases "\<forall>\<nu>. \<phi>' \<noteq> not \<nu>")
          case goal1
            hence "?Q (not \<phi>') 0 (not \<phi>')" by auto
            thus ?case by blast
        next
          case goal2
            then obtain n' \<psi>' where "?Q \<phi>' n' \<psi>'" by auto
            thus ?case
            proof(cases "\<exists>\<psi>''. \<psi>' = not \<psi>''")
              case goal1
                then obtain \<psi>''
                      where "\<psi>' = not \<psi>''" by auto
                hence "?Q (not \<phi>') (n'+1) \<psi>''" using goal1 by auto
                thus ?case by blast
            next
              case goal2
                hence "?Q (not \<phi>') n' (not \<psi>')" by auto
                thus ?case by blast
            qed
        qed
    qed auto
qed

lemma ltl_size_double_neg:
  assumes "\<psi> = ((\<lambda>\<mu>. not not \<mu>) ^^ n) \<phi>"
    shows "size \<phi> \<le> size \<psi>"
using assms proof (induct n arbitrary:\<phi> \<psi>)
  case (Suc k)
    obtain \<mu> where \<mu>_eq: "\<mu> = ((\<lambda>\<mu>. not not \<mu>) ^^ k) \<phi>" by auto
    hence "\<psi> = not not \<mu>" using Suc by auto
    moreover have "size \<phi> \<le> size \<mu>" using Suc \<mu>_eq by auto
    ultimately show ?case by auto
qed auto

text{* Pushing negation to the top of a proposition *}

fun
  ltl_pushneg :: "'a ltl \<Rightarrow> 'a ltl"
  where
    "ltl_pushneg true = true"
  | "ltl_pushneg false = false"
  | "ltl_pushneg prop(q) = prop(q)"
  | "ltl_pushneg (not true) = false"
  | "ltl_pushneg (not false) = true"
  | "ltl_pushneg (not prop(q)) = not prop(q)"
  | "ltl_pushneg (not (not \<psi>)) = ltl_pushneg \<psi>"
  | "ltl_pushneg (not (\<nu> and \<mu>)) = ltl_pushneg (not \<nu>) or ltl_pushneg (not \<mu>)"
  | "ltl_pushneg (not (\<nu> or \<mu>)) = ltl_pushneg (not \<nu>) and ltl_pushneg (not \<mu>)"
  | "ltl_pushneg (not (X \<psi>)) = X ltl_pushneg (not \<psi>)"
  | "ltl_pushneg (not (\<nu> U \<mu>)) = ltl_pushneg (not \<nu>) V ltl_pushneg (not \<mu>)"
  | "ltl_pushneg (not (\<nu> V \<mu>)) = ltl_pushneg (not \<nu>) U ltl_pushneg (not \<mu>)"
  | "ltl_pushneg (\<phi> and \<psi>) = (ltl_pushneg \<phi>) and (ltl_pushneg \<psi>)"
  | "ltl_pushneg (\<phi> or \<psi>) = (ltl_pushneg \<phi>) or (ltl_pushneg \<psi>)"
  | "ltl_pushneg (X \<phi>) = X (ltl_pushneg \<phi>)"
  | "ltl_pushneg (\<phi> U \<psi>) = (ltl_pushneg \<phi>) U (ltl_pushneg \<psi>)"
  | "ltl_pushneg (\<phi> V \<psi>) = (ltl_pushneg \<phi>) V (ltl_pushneg \<psi>)"

text{*
  In fact, the @{text ltl_pushneg} function does not change the
  semantics of the input formula.
*}

lemma ltl_pushneg_neg:
  shows "\<xi> \<Turnstile> ltl_pushneg (not \<phi>) \<longleftrightarrow> \<xi> \<Turnstile> not ltl_pushneg \<phi>"
  by (induct \<phi> arbitrary: \<xi>) auto

theorem ltl_pushneg_equiv[simp]:
  "\<xi> \<Turnstile> ltl_pushneg \<phi> \<longleftrightarrow> \<xi> \<Turnstile> \<phi>"
proof (induct \<phi> arbitrary: \<xi>)
  case (LTLNeg \<psi>)
  with ltl_pushneg_neg show ?case by auto
qed auto

text{*
  We can now show that @{text ltl_pushneg} does what it should do.
  Actually the negation occurs after the transformation
  only on top of a proposition.
*} (* TODO (Alex): Formulation! Describe the 'what' in one or two sentences! *)

lemma ltl_pushneg_double_neg:
  shows "ltl_pushneg (((\<lambda>\<phi>. not not \<phi>) ^^ n) \<phi>) = ltl_pushneg \<phi>"
by (induct n arbitrary:\<phi>) auto

lemma ltl_pushneg_neg_struct:
  assumes "ltl_pushneg \<phi> = not \<psi>"
    shows "\<exists>q. \<psi> = prop(q)"
proof -
  from ltl_double_neg_struct
  obtain n \<mu> where \<phi>_eq: "\<phi> = ((\<lambda>\<mu>. not not \<mu>) ^^ n) \<mu>"
               and \<mu>_neq: "(\<forall>\<nu>. \<mu> \<noteq> not not \<nu>)" by blast
  with ltl_pushneg_double_neg have "ltl_pushneg \<phi> = ltl_pushneg \<mu>" by auto
  thus ?thesis using \<phi>_eq assms \<mu>_neq
  proof(induct \<mu>)
    case (LTLNeg f) thus ?case by (cases f) auto
  qed auto
qed

inductive subfrml
where
  "subfrml \<phi> (not \<phi>)"
| "subfrml \<phi> (\<phi> and \<psi>)"
| "subfrml \<psi> (\<phi> and \<psi>)"
| "subfrml \<phi> (\<phi> or \<psi>)"
| "subfrml \<psi> (\<phi> or \<psi>)"
| "subfrml \<phi> (X \<phi>)"
| "subfrml \<phi> (\<phi> U \<psi>)"
| "subfrml \<psi> (\<phi> U \<psi>)"
| "subfrml \<phi> (\<phi> V \<psi>)"
| "subfrml \<psi> (\<phi> V \<psi>)"

abbreviation is_subfrml ("_ is'_subformula'_of _")
where
  "is_subfrml \<psi> \<phi> \<equiv> subfrml\<^sup>*\<^sup>* \<psi> \<phi>"

lemma subfrml_size:
  assumes "subfrml \<psi> \<phi>"
    shows "size \<psi> < size \<phi>"
using assms by (induct \<phi>) auto

lemma subformula_size:
  assumes "\<psi> is_subformula_of \<phi>"
    shows "size \<psi> < size \<phi> \<or> \<psi> = \<phi>"
using assms proof(induct \<phi>)
  case base thus ?case by auto
next
  case (step \<nu> \<mu>)
    hence "size \<nu> < size \<mu>" by (rule_tac subfrml_size)
    thus ?case using step by auto
qed

lemma subformula_on_ltl_pushneg:
  assumes "\<psi> is_subformula_of (ltl_pushneg \<phi>)"
    shows "\<exists>\<mu>. \<psi> = ltl_pushneg \<mu>"
proof(cases "\<psi> = ltl_pushneg \<phi>")
  case True thus ?thesis by blast
next
  case False thus ?thesis using assms
  proof(induct \<phi> rule:ltl_pushneg.induct)
    case goal1 thus ?case using subformula_size by force
  next
    case goal2 thus ?case using subformula_size by force
  next
    case goal3 thus ?case using subformula_size by force
  next
    case goal4 thus ?case using subformula_size by force
  next
    case goal5 thus ?case using subformula_size by force
  next
    case (goal6 q)
      let ?frml = "not prop(q)"
      from rtrancl_eq_or_trancl[to_pred, of subfrml]
      have t_prm: "subfrml\<^sup>+\<^sup>+ \<psi> ?frml"
      using goal6 by auto
      obtain \<mu>
       where sf_prm: "subfrml \<psi>  \<mu>"
         and rt_prm: "\<mu> is_subformula_of ?frml"
      using tranclpD[OF t_prm] by blast
      show ?case
      proof(cases "\<mu> = ?frml")
        assume "\<mu> = ?frml"
        with sf_prm have "\<psi> = ltl_pushneg prop(q)"
        by (cases \<psi>) auto
        thus ?thesis by blast
      next
        assume "\<mu> \<noteq> ?frml"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp[of subfrml]
             subformula_size[of \<mu> ?frml]
        have "size \<mu> = 0" by auto
        with subfrml_size[OF sf_prm]
        show ?thesis by auto
      qed
  next
    case goal7 thus ?case by auto
  next
    case (goal8 \<nu> \<mu>)
      let ?frml = "not (\<nu> and \<mu>)"
      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
           rtrancl_eq_or_trancl[to_pred, of subfrml]
      obtain z
       where "subfrml z (ltl_pushneg ?frml)"
         and rt_prm: "\<psi> is_subformula_of z"
       using goal8 by auto
      hence z_is:
            "z = ltl_pushneg (not \<nu>) \<or>
             z = ltl_pushneg (not \<mu>)" by (cases z) auto
      show ?case
      proof(cases "\<psi> = z")
        assume "\<psi> = z"
        with z_is show ?thesis by auto
      next
        assume "\<psi> \<noteq> z"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp
        have "\<psi> is_subformula_of z" by auto
        thus ?thesis using goal8 z_is by auto
      qed
  next
    case (goal9 \<nu> \<mu>)
      let ?frml = "not (\<nu> or \<mu>)"
      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
           rtrancl_eq_or_trancl[to_pred, of subfrml]
      obtain z
       where "subfrml z (ltl_pushneg ?frml)"
         and rt_prm: "\<psi> is_subformula_of z"
       using goal9 by auto
      hence z_is:
            "z = ltl_pushneg (not \<nu>) \<or>
             z = ltl_pushneg (not \<mu>)" by (cases z) auto
      show ?case
      proof(cases "\<psi> = z")
        assume "\<psi> = z"
        with z_is show ?thesis by auto
      next
        assume "\<psi> \<noteq> z"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp
        have "\<psi> is_subformula_of z" by auto
        thus ?thesis using goal9 z_is by auto
      qed
  next
    case (goal10 \<mu>)
      let ?frml = "not (X \<mu>)"
      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
           rtrancl_eq_or_trancl[to_pred, of subfrml]
      obtain z
       where "subfrml z (ltl_pushneg ?frml)"
         and rt_prm: "\<psi> is_subformula_of z"
       using goal10 by auto
      hence z_is: "z = ltl_pushneg (not \<mu>)"
      by (cases z) auto
      show ?case
      proof(cases "\<psi> = z")
        assume "\<psi> = z"
        with z_is show ?thesis by auto
      next
        assume "\<psi> \<noteq> z"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp
        have "\<psi> is_subformula_of z" by auto
        thus ?thesis using goal10 z_is by auto
      qed
  next
    case (goal11 \<nu> \<mu>)
      let ?frml = "not (\<nu> U \<mu>)"
      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
           rtrancl_eq_or_trancl[to_pred, of subfrml]
      obtain z
       where "subfrml z (ltl_pushneg ?frml)"
         and rt_prm: "\<psi> is_subformula_of z"
       using goal11 by auto
      hence z_is:
            "z = ltl_pushneg (not \<nu>) \<or>
             z = ltl_pushneg (not \<mu>)" by (cases z) auto
      show ?case
      proof(cases "\<psi> = z")
        assume "\<psi> = z"
        with z_is show ?thesis by auto
      next
        assume "\<psi> \<noteq> z"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp
        have "\<psi> is_subformula_of z" by auto
        thus ?thesis using goal11 z_is by auto
      qed
  next
    case (goal12 \<nu> \<mu>)
      let ?frml = "not (\<nu> V \<mu>)"
      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
           rtrancl_eq_or_trancl[to_pred, of subfrml]
      obtain z
       where "subfrml z (ltl_pushneg ?frml)"
         and rt_prm: "\<psi> is_subformula_of z"
       using goal12 by auto
      hence z_is:
            "z = ltl_pushneg (not \<nu>) \<or>
             z = ltl_pushneg (not \<mu>)" by (cases z) auto
      show ?case
      proof(cases "\<psi> = z")
        assume "\<psi> = z"
        with z_is show ?thesis by auto
      next
        assume "\<psi> \<noteq> z"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp
        have "\<psi> is_subformula_of z" by auto
        thus ?thesis using goal12 z_is by auto
      qed
  next
    case (goal13 \<nu> \<mu>)
      let ?frml = "\<nu> and \<mu>"
      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
           rtrancl_eq_or_trancl[to_pred, of subfrml]
      obtain z
       where "subfrml z (ltl_pushneg ?frml)"
         and rt_prm: "\<psi> is_subformula_of z"
       using goal13 by auto
      hence z_is:
            "z = ltl_pushneg \<nu> \<or>
             z = ltl_pushneg \<mu>" by (cases z) auto
      show ?case
      proof(cases "\<psi> = z")
        assume "\<psi> = z"
        with z_is show ?thesis by auto
      next
        assume "\<psi> \<noteq> z"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp
        have "\<psi> is_subformula_of z" by auto
        thus ?thesis using goal13 z_is by auto
      qed
  next
    case (goal14 \<nu> \<mu>)
      let ?frml = "\<nu> or \<mu>"
      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
           rtrancl_eq_or_trancl[to_pred, of subfrml]
      obtain z
       where "subfrml z (ltl_pushneg ?frml)"
         and rt_prm: "\<psi> is_subformula_of z"
       using goal14 by auto
      hence z_is:
            "z = ltl_pushneg \<nu> \<or>
             z = ltl_pushneg \<mu>" by (cases z) auto
      show ?case
      proof(cases "\<psi> = z")
        assume "\<psi> = z"
        with z_is show ?thesis by auto
      next
        assume "\<psi> \<noteq> z"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp
        have "\<psi> is_subformula_of z" by auto
        thus ?thesis using goal14 z_is by auto
      qed
  next
    case (goal15 \<mu>)
      let ?frml = "X \<mu>"
      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
           rtrancl_eq_or_trancl[to_pred, of subfrml]
      obtain z
       where "subfrml z (ltl_pushneg ?frml)"
         and rt_prm: "\<psi> is_subformula_of z"
       using goal15 by auto
      hence z_is: "z = ltl_pushneg \<mu>" by (cases z) auto
      show ?case
      proof(cases "\<psi> = z")
        assume "\<psi> = z"
        with z_is show ?thesis by auto
      next
        assume "\<psi> \<noteq> z"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp
        have "\<psi> is_subformula_of z" by auto
        thus ?thesis using goal15 z_is by auto
      qed
  next
    case (goal16 \<nu> \<mu>)
      let ?frml = "\<nu> U \<mu>"
      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
           rtrancl_eq_or_trancl[to_pred, of subfrml]
      obtain z
       where "subfrml z (ltl_pushneg ?frml)"
         and rt_prm: "\<psi> is_subformula_of z"
       using goal16 by auto
      hence z_is:
            "z = ltl_pushneg \<nu> \<or>
             z = ltl_pushneg \<mu>" by (cases z) auto
      show ?case
      proof(cases "\<psi> = z")
        assume "\<psi> = z"
        with z_is show ?thesis by auto
      next
        assume "\<psi> \<noteq> z"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp
        have "\<psi> is_subformula_of z" by auto
        thus ?thesis using goal16 z_is by auto
      qed
  next
    case (goal17 \<nu> \<mu>)
      let ?frml = "\<nu> V \<mu>"
      from tranclD2[to_pred, of subfrml \<psi> "ltl_pushneg ?frml"]
           rtrancl_eq_or_trancl[to_pred, of subfrml]
      obtain z
       where "subfrml z (ltl_pushneg ?frml)"
         and rt_prm: "\<psi> is_subformula_of z"
       using goal17 by auto
      hence z_is:
            "z = ltl_pushneg \<nu> \<or>
             z = ltl_pushneg \<mu>" by (cases z) auto
      show ?case
      proof(cases "\<psi> = z")
        assume "\<psi> = z"
        with z_is show ?thesis by auto
      next
        assume "\<psi> \<noteq> z"
        with rtranclpD[OF rt_prm]
             tranclp_into_rtranclp
        have "\<psi> is_subformula_of z" by auto
        thus ?thesis using goal17 z_is by auto
      qed
  qed
qed

text{*
  The fact that after pushing the negation the structure of a
  formula changes, is shown by the following theorem.
  Indeed, after pushing the negation symbol inside a
  formula, it occurs at most on top of a proposition.
*}

theorem ltl_pushneg_struct:
  assumes "(not \<psi>) is_subformula_of (ltl_pushneg \<phi>)"
    shows "\<exists>q. \<psi> = prop(q)"
proof -
  from assms subformula_on_ltl_pushneg
  obtain \<mu>
   where prm:"not \<psi> = ltl_pushneg \<mu>" by blast
  from ltl_pushneg_neg_struct[OF sym[OF prm]]
  show ?thesis by auto
qed

text{*
  Now we want to show that the size of the formula,
  which is transformed by @{text ltl_pushneg}, does not increase
  'too much', i.e. there is no exponential blowup
  produced by the transformation.
  For that purpose we need an additional function,
  which counts the literals of the derivation tree
  of a formula.
  The idea is, that, assuming the worst case, the
  pushing of negation can only increase the size of a
  formula by putting the negation symbol on top of every
  proposition inside the formula.
*}

fun leafcnt :: "'a ltl \<Rightarrow> nat"
where
  "leafcnt true = 1"
| "leafcnt false = 1"
| "leafcnt prop(q) = 1"
| "leafcnt (not \<phi>) = leafcnt \<phi>"
| "leafcnt (\<phi> and \<psi>) = (leafcnt \<phi>) + (leafcnt \<psi>)"
| "leafcnt (\<phi> or \<psi>) = (leafcnt \<phi>) + (leafcnt \<psi>)"
| "leafcnt (X \<phi>) = leafcnt \<phi>"
| "leafcnt (\<phi> U \<psi>) = (leafcnt \<phi>) + (leafcnt \<psi>)"
| "leafcnt (\<phi> V \<psi>) = (leafcnt \<phi>) + (leafcnt \<psi>)"

lemma leafcnt_double_neg_ident:
  "leafcnt (((\<lambda>\<mu>. not not \<mu>) ^^ n) \<phi>) = leafcnt \<phi>"
by (induct n arbitrary:\<phi>) auto

lemma ltl_pushneg_help:
  "\<exists>\<phi>. ltl_pushneg \<psi> = ltl_pushneg \<phi>
       \<and> ((\<exists>\<nu>. \<phi> = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi> \<noteq> not \<mu>))
       \<and> size \<phi> \<le> size \<psi>
       \<and> leafcnt \<phi> = leafcnt \<psi>"
  (is "\<exists>\<phi>. ?P \<psi> \<phi> \<and> ?Q \<phi> \<and> ?R \<phi>")
proof -
  from ltl_double_neg_struct
  obtain n \<phi> where dblneg: "\<psi> = ((\<lambda>\<mu>. not not \<mu>) ^^ n) \<phi>"
               and \<phi>_neq: "(\<forall>\<nu>. \<phi> \<noteq> not not \<nu>)"
                by blast
  have "?Q \<phi>"
  proof(rule ccontr)
    assume "\<not> ?Q \<phi>"
    thus "False"
    proof(cases "\<exists>\<mu>. \<phi> = not \<mu>")
      case goal1
        then obtain \<mu> where "\<phi> = not \<mu>" by blast
        with goal1 dblneg \<phi>_neq show ?case by auto
    qed auto
  qed
  with dblneg \<phi>_neq
       ltl_pushneg_double_neg[of n \<phi>]
       leafcnt_double_neg_ident[of n \<phi>]
       ltl_size_double_neg[OF dblneg] show ?thesis by auto
qed

lemma ltl_pushneg_size_lin_help:
  assumes "\<psi> = ltl_pushneg \<phi>"
    shows "size \<psi> + 1 \<le> size \<phi> + leafcnt \<phi>"
using assms proof (induct \<psi> arbitrary: \<phi>)
  case goal1 show ?case by (cases \<phi>) auto
next
  case goal2 show ?case by (cases \<phi>) auto
next
  case goal3 show ?case by (cases \<phi>) auto
next
  case (goal4 \<psi>')
    with ltl_pushneg_neg_struct[of \<phi> \<psi>'] obtain q where "\<psi>' = prop(q)" by auto
    moreover
    with ltl_pushneg_help[of \<phi>]
    obtain \<phi>' where "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
                and "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
                and "size \<phi>' \<le> size \<phi>"
                and "leafcnt \<phi>' = leafcnt \<phi>" by auto
    ultimately show ?case using goal4
    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
      case goal1
        then obtain \<nu> where \<phi>'is:"\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
        thus ?case using goal1 by (cases \<nu>) auto
    next
      case goal2 thus ?case by (cases \<phi>') force+
    qed
next
  case (goal5 f g)
    with ltl_pushneg_help[of \<phi>]
    obtain \<phi>' where "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
                and "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
                and "size \<phi>' \<le> size \<phi>"
                and "leafcnt \<phi>' = leafcnt \<phi>" by auto
    with goal5 show ?case
    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
      case goal1
        then obtain \<nu> where \<phi>'is:"\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
        hence "size (f and g) \<le> size \<nu> + leafcnt \<nu>" using goal1 by (cases \<nu>) force+
        thus ?case using goal1 \<phi>'is by auto
    next
      case goal2 thus ?case by (cases \<phi>') force+
    qed
next
  case (goal6 f g)
    with ltl_pushneg_help[of \<phi>]
    obtain \<phi>' where "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
                and "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
                and "size \<phi>' \<le> size \<phi>"
                and "leafcnt \<phi>' = leafcnt \<phi>" by auto
    with goal6 show ?case
    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
      case goal1
        then obtain \<nu> where \<phi>'is:"\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
        hence "size (f or g) \<le> size \<nu> + leafcnt \<nu>" using goal1 by (cases \<nu>) force+
        thus ?case using goal1 \<phi>'is by auto
    next
      case goal2 thus ?case by (cases \<phi>') force+
    qed
next
  case (goal7 f)
    with ltl_pushneg_help[of \<phi>]
    obtain \<phi>' where "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
                and "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
                and "size \<phi>' \<le> size \<phi>"
                and "leafcnt \<phi>' = leafcnt \<phi>" by auto
    with goal7 show ?case
    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
      case goal1
        then obtain \<nu> where \<phi>'is:"\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
        with goal1 show ?case by (cases \<nu>) force+
    next
      case goal2 thus ?case by (cases \<phi>') force+
    qed
next
  case (goal8 f g)
    with ltl_pushneg_help[of \<phi>]
    obtain \<phi>' where "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
                and "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
                and "size \<phi>' \<le> size \<phi>"
                and "leafcnt \<phi>' = leafcnt \<phi>" by auto
    with goal8 show ?case
    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
      case goal1
        then obtain \<nu> where \<phi>'is:"\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
        hence "size (f U g) \<le> size \<nu> + leafcnt \<nu>" using goal1 by (cases \<nu>) force+
        thus ?case using goal1 \<phi>'is by auto
    next
      case goal2 thus ?case by (cases \<phi>') force+
    qed
next
  case (goal9 f g)
    with ltl_pushneg_help[of \<phi>]
    obtain \<phi>' where "ltl_pushneg \<phi> = ltl_pushneg \<phi>'"
                and "(\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)) \<or> (\<forall>\<mu>. \<phi>' \<noteq> not \<mu>)"
                and "size \<phi>' \<le> size \<phi>"
                and "leafcnt \<phi>' = leafcnt \<phi>" by auto
    with goal9 show ?case
    proof(cases "\<exists>\<nu>. \<phi>' = not \<nu> \<and> (\<forall>\<mu>. \<nu> \<noteq> not \<mu>)")
      case goal1
        then obtain \<nu> where \<phi>'is:"\<phi>' = not \<nu>" and "\<forall>\<mu>. \<nu> \<noteq> not \<mu>" by auto
        hence "size (f V g) \<le> size \<nu> + leafcnt \<nu>" using goal1 by (cases \<nu>) force+
        thus ?case using goal1 \<phi>'is by auto
    next
      case goal2 thus ?case by (cases \<phi>') force+
    qed
qed

theorem ltl_pushneg_size_lin:
  "size (ltl_pushneg \<phi>) \<le> 2 * size \<phi>"
proof -
  have "leafcnt \<phi> \<le> size \<phi> + 1" by (induct \<phi>) auto
  with ltl_pushneg_size_lin_help[of _ \<phi>]
  have "size (ltl_pushneg \<phi>) + 1 \<le> size \<phi> + size \<phi> + 1" by force
  thus ?thesis by auto
qed

end

subsection {* LTL formula in negation normal form (NNF) *}
text{*
  We define a type of LTL formula in negation normal form (NNF)
*}

datatype
  'a ltln = LTLnTrue
       | LTLnFalse
       | LTLnProp 'a
       | LTLnNProp 'a
       | LTLnAnd "'a ltln" "'a ltln"
       | LTLnOr "'a ltln" "'a ltln"
       | LTLnNext "'a ltln"
       | LTLnUntil "'a ltln" "'a ltln"
       | LTLnRelease "'a ltln" "'a ltln"

context LTL_Syntax begin
  notation
        LTLnTrue      ("true\<^sub>n")
    and LTLnFalse     ("false\<^sub>n")
    and LTLnProp      ("prop\<^sub>n'(_')")
    and LTLnNProp     ("nprop\<^sub>n'(_')")
    and LTLnAnd       ("_ and\<^sub>n _" [82,82] 81)
    and LTLnOr        ("_ or\<^sub>n _" [84,84] 83)
    and LTLnNext      ("X\<^sub>n _" [88] 87)
    and LTLnUntil     ("_ U\<^sub>n _" [84,84] 83)
    and LTLnRelease   ("_ V\<^sub>n _" [84,84] 83)

  abbreviation ltln_eventuality :: "'a ltln \<Rightarrow> 'a ltln" ("\<diamondsuit>\<^sub>n _" [88] 87)
    where "ltln_eventuality \<phi> \<equiv> true\<^sub>n U\<^sub>n \<phi>"

  abbreviation ltln_universality :: "'a ltln \<Rightarrow> 'a ltln" ("\<box>\<^sub>n _" [88] 87)
    where "ltln_universality \<phi> \<equiv> false\<^sub>n V\<^sub>n \<phi>"

end

context begin interpretation LTL_Syntax .

primrec ltln_semantics :: "['a set word, 'a ltln] \<Rightarrow> bool"
("_ \<Turnstile>\<^sub>n _" [80,80] 80)
  where
    "\<xi> \<Turnstile>\<^sub>n true\<^sub>n = True"
  | "\<xi> \<Turnstile>\<^sub>n false\<^sub>n = False"
  | "\<xi> \<Turnstile>\<^sub>n prop\<^sub>n(q) = (q\<in>\<xi> 0)"
  | "\<xi> \<Turnstile>\<^sub>n nprop\<^sub>n(q) = (q\<notin>\<xi> 0)"
  | "\<xi> \<Turnstile>\<^sub>n \<phi> and\<^sub>n \<psi> = (\<xi> \<Turnstile>\<^sub>n \<phi> \<and> \<xi> \<Turnstile>\<^sub>n \<psi>)"
  | "\<xi> \<Turnstile>\<^sub>n \<phi> or\<^sub>n \<psi> = (\<xi> \<Turnstile>\<^sub>n \<phi> \<or> \<xi> \<Turnstile>\<^sub>n \<psi>)"
  | "\<xi> \<Turnstile>\<^sub>n X\<^sub>n \<phi> = (suffix 1 \<xi> \<Turnstile>\<^sub>n \<phi>)"
  | "\<xi> \<Turnstile>\<^sub>n \<phi> U\<^sub>n \<psi> = (\<exists>i. suffix i \<xi> \<Turnstile>\<^sub>n \<psi> \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>))"
  | "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n \<psi> = (\<forall>i. suffix i \<xi> \<Turnstile>\<^sub>n \<psi> \<or> (\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>))"

definition "ltln_language \<phi> \<equiv> {\<xi>. \<xi> \<Turnstile>\<^sub>n \<phi>}"

text{*
  Conversion from LTL to LTL in NNF
*}

fun ltl_to_ltln :: "'a ltl \<Rightarrow> 'a ltln"
where
  "ltl_to_ltln true = true\<^sub>n"
| "ltl_to_ltln false = false\<^sub>n"
| "ltl_to_ltln prop(q) = prop\<^sub>n(q)"
| "ltl_to_ltln (not prop(q)) = nprop\<^sub>n(q)"
| "ltl_to_ltln (\<phi> and \<psi>) = ltl_to_ltln \<phi> and\<^sub>n ltl_to_ltln \<psi>"
| "ltl_to_ltln (\<phi> or \<psi>) = ltl_to_ltln \<phi> or\<^sub>n ltl_to_ltln \<psi>"
| "ltl_to_ltln (X \<phi>) = X\<^sub>n (ltl_to_ltln \<phi>)"
| "ltl_to_ltln (\<phi> U \<psi>) = ltl_to_ltln \<phi> U\<^sub>n ltl_to_ltln \<psi>"
| "ltl_to_ltln (\<phi> V \<psi>) = ltl_to_ltln \<phi> V\<^sub>n ltl_to_ltln \<psi>"

lemma ltl_to_ltln_on_ltl_pushneg_equiv:
  assumes "\<phi> = ltl_pushneg \<psi>"
  shows "\<xi> \<Turnstile> \<phi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n ltl_to_ltln \<phi>"
using assms proof(induct \<phi> arbitrary: \<xi> \<psi>)
  case goal1 show ?case by auto
next
  case goal2 show ?case by auto
next
  case goal3 show ?case by auto
next
  case (goal4 \<phi>)
    with ltl_pushneg_neg_struct[of \<psi> \<phi>]
    obtain q
     where "\<phi> = prop(q)"
        by auto
    thus ?case by auto
next
  case (goal5 f g \<xi> \<psi>)
    hence frml_eq: "ltl_pushneg \<psi> = f and g" by auto
    with subformula_on_ltl_pushneg[of _ \<psi>]
    obtain \<mu>
     where "f = ltl_pushneg \<mu>"
        by (auto intro: subfrml.intros)
    moreover
    from frml_eq subformula_on_ltl_pushneg[of _ \<psi>]
    obtain \<nu>
     where "g = ltl_pushneg \<nu>"
        by (auto intro: subfrml.intros)
    ultimately
    have "\<xi> \<Turnstile> f = \<xi> \<Turnstile>\<^sub>n ltl_to_ltln f"
     and "\<xi> \<Turnstile> g = \<xi> \<Turnstile>\<^sub>n ltl_to_ltln g"
    using goal5 by auto
    thus ?case by auto
next
  case (goal6 f g \<xi> \<psi>)
    hence frml_eq: "ltl_pushneg \<psi> = f or g" by auto
    with subformula_on_ltl_pushneg[of _ \<psi>]
    obtain \<mu>
     where "f = ltl_pushneg \<mu>"
        by (auto intro: subfrml.intros)
    moreover
    from frml_eq subformula_on_ltl_pushneg[of _ \<psi>]
    obtain \<nu>
     where "g = ltl_pushneg \<nu>"
        by (auto intro: subfrml.intros)
    ultimately
    have "\<xi> \<Turnstile> f = \<xi> \<Turnstile>\<^sub>n ltl_to_ltln f"
     and "\<xi> \<Turnstile> g = \<xi> \<Turnstile>\<^sub>n ltl_to_ltln g"
    using goal6 by auto
    thus ?case by auto
next
  case (goal7 \<phi> \<xi> \<psi>)
    hence "ltl_pushneg \<psi> = X \<phi>" by auto
    with subformula_on_ltl_pushneg[of \<phi> \<psi>]
    obtain \<mu>
     where "\<phi> = ltl_pushneg \<mu>"
        by (auto intro: subfrml.intros)
    hence "suffix 1 \<xi> \<Turnstile> \<phi> = suffix 1 \<xi> \<Turnstile>\<^sub>n ltl_to_ltln \<phi>"
    using goal7 by auto
    thus ?case by auto
next
  case (goal8 f g \<xi> \<psi>)
    hence frml_eq: "ltl_pushneg \<psi> = f U g" by auto
    with subformula_on_ltl_pushneg[of _ \<psi>]
    obtain \<mu>
     where "f = ltl_pushneg \<mu>"
        by (auto intro: subfrml.intros)
    moreover
    from frml_eq subformula_on_ltl_pushneg[of _ \<psi>]
    obtain \<nu>
     where "g = ltl_pushneg \<nu>"
        by (auto intro: subfrml.intros)
    ultimately
    have "\<forall>i. suffix i \<xi> \<Turnstile> f = suffix i \<xi> \<Turnstile>\<^sub>n ltl_to_ltln f"
     and "\<forall>i. suffix i \<xi> \<Turnstile> g = suffix i \<xi> \<Turnstile>\<^sub>n ltl_to_ltln g"
    using goal8 by auto
    thus ?case by auto
next
  case (goal9 f g \<xi> \<psi>)
    hence frml_eq: "ltl_pushneg \<psi> = f V g" by auto
    with subformula_on_ltl_pushneg[of _ \<psi>]
    obtain \<mu>
     where "f = ltl_pushneg \<mu>"
        by (auto intro: subfrml.intros)
    moreover
    from frml_eq subformula_on_ltl_pushneg[of _ \<psi>]
    obtain \<nu>
     where "g = ltl_pushneg \<nu>"
        by (auto intro: subfrml.intros)
    ultimately
    have "\<forall>i. suffix i \<xi> \<Turnstile> f = suffix i \<xi> \<Turnstile>\<^sub>n ltl_to_ltln f"
     and "\<forall>i. suffix i \<xi> \<Turnstile> g = suffix i \<xi> \<Turnstile>\<^sub>n ltl_to_ltln g"
    using goal9 by auto
    thus ?case by auto
qed

lemma ltl_nnf_equiv[simp]:
  "\<xi> \<Turnstile>\<^sub>n ltl_to_ltln (ltl_pushneg \<psi>) \<longleftrightarrow> \<xi> \<Turnstile> \<psi>"
  using sym[OF ltl_pushneg_equiv] ltl_to_ltln_on_ltl_pushneg_equiv by blast

fun subfrmlsn :: "'a ltln \<Rightarrow> 'a ltln set"
where
  "subfrmlsn (\<mu> and\<^sub>n \<psi>) = {\<mu> and\<^sub>n \<psi>} \<union> subfrmlsn \<mu> \<union> subfrmlsn \<psi>"
| "subfrmlsn (X\<^sub>n \<mu>) = {X\<^sub>n \<mu>} \<union> subfrmlsn \<mu>"
| "subfrmlsn (\<mu> U\<^sub>n \<psi>) = {\<mu> U\<^sub>n \<psi>} \<union> subfrmlsn \<mu> \<union> subfrmlsn \<psi>"
| "subfrmlsn (\<mu> V\<^sub>n \<psi>) = {\<mu> V\<^sub>n \<psi>} \<union> subfrmlsn \<mu> \<union> subfrmlsn \<psi>"
| "subfrmlsn (\<mu> or\<^sub>n \<psi>) = {\<mu> or\<^sub>n \<psi>} \<union> subfrmlsn \<mu> \<union> subfrmlsn \<psi>"
| "subfrmlsn x = {x}"

lemma subfrmlsn_id[simp]: "\<phi> \<in> subfrmlsn \<phi>" by (induct \<phi>) auto
lemma subfrmlsn_finite: "finite (subfrmlsn \<phi>)" by (induct \<phi>) auto
lemma subfrmlsn_subset:"\<psi> \<in> subfrmlsn \<phi> \<Longrightarrow> subfrmlsn \<psi> \<subseteq> subfrmlsn \<phi>"
by (induct \<phi> arbitrary:\<psi>) auto

fun size_frmln :: "'a ltln \<Rightarrow> nat"
where
  "size_frmln (\<phi> and\<^sub>n \<psi>) = size_frmln \<phi> + size_frmln \<psi> + 1"
| "size_frmln (X\<^sub>n \<phi>) = size_frmln \<phi> + 1"
| "size_frmln (\<phi> U\<^sub>n \<psi>) = size_frmln \<phi> + size_frmln \<psi> + 1"
| "size_frmln (\<phi> V\<^sub>n \<psi>) = size_frmln \<phi> + size_frmln \<psi> + 1"
| "size_frmln (\<phi> or\<^sub>n \<psi>) = size_frmln \<phi> + size_frmln \<psi> + 1"
| "size_frmln _ = 1"

lemma size_frmln_gt_zero[simp]: "size_frmln \<phi> > 0" by (induct \<phi>) auto

abbreviation
  "frmlset_sumn \<Phi> \<equiv> setsum size_frmln \<Phi>" -- "FIXME: lemmas about this?"

lemma frmlset_sumn_diff_less[intro!]:
  assumes finS:"finite S"
      and "A\<noteq>{}"
      and subset:"A\<subseteq>S"
    shows "frmlset_sumn (S - A) < frmlset_sumn S"
proof -
  have finA: "finite A" using assms by (rule_tac finite_subset)
  hence "frmlset_sumn A > 0" using assms size_frmln_gt_zero by (induct rule:finite_induct) auto
  moreover
  have "frmlset_sumn A \<le> frmlset_sumn S" using assms size_frmln_gt_zero by (rule_tac setsum_mono2) auto
  ultimately show ?thesis using setsum_diff_nat[OF finA, of S size_frmln] assms by auto
qed

definition
  "frmln_props \<phi> \<equiv> {p. prop\<^sub>n(p) \<in> subfrmlsn \<phi> \<or> nprop\<^sub>n(p) \<in> subfrmlsn \<phi>}"

lemma ltln_expand_Until:
  "\<xi> \<Turnstile>\<^sub>n \<phi> U\<^sub>n \<psi> = (\<xi> \<Turnstile>\<^sub>n \<psi> or\<^sub>n (\<phi> and\<^sub>n (X\<^sub>n (\<phi> U\<^sub>n \<psi>))))" (is "?lhs = ?rhs")
proof
  assume ?lhs
  then obtain i
        where psi_is: "suffix i \<xi> \<Turnstile>\<^sub>n \<psi>"
          and phi_is: "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>" by auto
  show ?rhs
  proof(cases i)
    assume "i=0"
    thus ?rhs using psi_is by auto
  next
    fix k
    assume i_eq: "i = Suc k"
    with phi_is have "\<xi> \<Turnstile>\<^sub>n \<phi>" by auto
    moreover
    have "\<xi> \<Turnstile>\<^sub>n X\<^sub>n (\<phi> U\<^sub>n \<psi>)"
    using psi_is phi_is i_eq by auto
    ultimately show ?rhs by auto
  qed
next
  assume rhs: ?rhs
  show ?lhs
  proof(cases "\<xi> \<Turnstile>\<^sub>n \<psi>")
    assume "\<xi> \<Turnstile>\<^sub>n \<psi>"
    hence "suffix 0 \<xi> \<Turnstile>\<^sub>n \<psi>" by auto
    moreover
    have "\<forall>j<0. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>" by auto
    ultimately
    have "\<exists>i. suffix i \<xi> \<Turnstile>\<^sub>n \<psi>
              \<and> (\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>)" by blast
    thus ?lhs by auto
  next
    assume "\<not> \<xi> \<Turnstile>\<^sub>n \<psi>"
    hence phi_is: "\<xi> \<Turnstile>\<^sub>n \<phi>"
      and "\<xi> \<Turnstile>\<^sub>n X\<^sub>n (\<phi> U\<^sub>n \<psi>)" using rhs by auto
    then obtain i
          where psi_suc_is: "suffix (Suc i) \<xi> \<Turnstile>\<^sub>n \<psi>"
            and phi_suc_is: "\<forall>j<i. suffix (Suc j) \<xi> \<Turnstile>\<^sub>n \<phi>" by auto
    have sbgoal: "\<forall>j<(Suc i). suffix j \<xi> \<Turnstile>\<^sub>n \<phi>"
    proof(clarify)
      fix j
      assume j_less: "j<Suc i"
      show "suffix j \<xi> \<Turnstile>\<^sub>n \<phi>"
      proof (cases j)
        assume "j=0"
        thus ?thesis using phi_is by auto
      next
        fix k
        assume "j=Suc k"
        thus ?thesis using j_less phi_suc_is by auto
      qed
    qed
    thus ?lhs using psi_suc_is phi_is by auto
  qed
qed

lemma ltln_expand_Release:
  "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n \<psi> = (\<xi> \<Turnstile>\<^sub>n \<psi> and\<^sub>n (\<phi> or\<^sub>n (X\<^sub>n (\<phi> V\<^sub>n \<psi>))))" (is "?lhs = ?rhs")
proof
  assume lhs: ?lhs
  hence psi_is: "\<xi> \<Turnstile>\<^sub>n \<psi>" by force

  have "\<And>i. \<lbrakk>\<not> \<xi> \<Turnstile>\<^sub>n \<phi>; \<not> suffix (Suc i) \<xi> \<Turnstile>\<^sub>n \<psi>\<rbrakk>
            \<Longrightarrow> (\<exists>j<i. suffix (Suc j) \<xi> \<Turnstile>\<^sub>n \<phi>)"
  proof -
    fix i
    assume phi_nis: "\<not> \<xi> \<Turnstile>\<^sub>n \<phi>"
       and "\<not> suffix (Suc i) \<xi> \<Turnstile>\<^sub>n \<psi>"
    then obtain j
          where "j<Suc i"
            and "suffix j \<xi> \<Turnstile>\<^sub>n \<phi>" using lhs by auto
    hence "j - 1 < i \<and> suffix (Suc (j - 1)) \<xi> \<Turnstile>\<^sub>n \<phi>"
    using phi_nis by (cases j) auto
    thus "\<exists>j<i. suffix (Suc j) \<xi> \<Turnstile>\<^sub>n \<phi>" by auto
  qed
  thus ?rhs using psi_is by auto
next
  assume rhs: ?rhs
  hence psi_is: "\<xi> \<Turnstile>\<^sub>n \<psi>" by auto

  show ?lhs
  proof(cases "\<xi> \<Turnstile>\<^sub>n \<phi>")
    assume "\<xi> \<Turnstile>\<^sub>n \<phi>"
    thus ?thesis using psi_is by force
  next
    assume phi_nis: "\<not> \<xi> \<Turnstile>\<^sub>n \<phi>"

    hence "\<forall>i. suffix (Suc i) \<xi> \<Turnstile>\<^sub>n \<psi>
               \<or> (\<exists>j<Suc i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>)"
    using rhs by auto

    have "\<And>i. \<not> suffix i \<xi> \<Turnstile>\<^sub>n \<psi>
              \<Longrightarrow> (\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>)"
    proof -
      fix i
      assume psi_suf_nis: "\<not> suffix i \<xi> \<Turnstile>\<^sub>n \<psi>"
      show "\<exists>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<phi>"
      proof(cases "i")
        assume "i=0"
        with psi_suf_nis psi_is show ?thesis by auto
      next
        fix k
        assume i_eq: "i=Suc k"
        with psi_suf_nis rhs show ?thesis by force
      qed
    qed
    thus ?thesis by auto
  qed
qed

lemma ltln_Release_alterdef:
  "\<xi> \<Turnstile>\<^sub>n \<phi> V\<^sub>n \<psi> \<longleftrightarrow> \<xi> \<Turnstile>\<^sub>n (\<box>\<^sub>n \<psi>) or\<^sub>n (\<psi> U\<^sub>n (\<phi> and\<^sub>n \<psi>))" (is "?lhs = ?rhs")
proof
  assume ?lhs
  { assume "\<not> (\<forall>i. suffix i \<xi> \<Turnstile>\<^sub>n \<psi>)"
    then obtain i where \<psi>_neq: "\<not> suffix i \<xi> \<Turnstile>\<^sub>n \<psi>" by auto
    let ?k = "LEAST i. \<not> suffix i \<xi> \<Turnstile>\<^sub>n \<psi>"
    from \<psi>_neq `?lhs` have "\<forall>j<?k. suffix j \<xi> \<Turnstile>\<^sub>n \<psi>" by (metis not_less_Least)
    moreover
    have "\<not> suffix ?k \<xi> \<Turnstile>\<^sub>n \<psi>" by (rule LeastI, rule \<psi>_neq)
    moreover then obtain j where "j<?k" and "suffix j \<xi> \<Turnstile>\<^sub>n \<phi>" using `?lhs` by auto
    ultimately have "\<xi> \<Turnstile>\<^sub>n \<psi> U\<^sub>n (\<phi> and\<^sub>n \<psi>)" by auto }
  with `?lhs` show ?rhs by auto
next
  assume ?rhs
  { assume "\<not> \<xi> \<Turnstile>\<^sub>n \<box>\<^sub>n \<psi>"
    with `?rhs` obtain i where "suffix i \<xi> \<Turnstile>\<^sub>n \<phi> and\<^sub>n \<psi>" and "\<forall>j<i. suffix j \<xi> \<Turnstile>\<^sub>n \<psi>" by auto
    hence ?lhs by (auto, metis nat_neq_iff) }
  thus ?lhs using `?rhs` by auto
qed

end
end


(*  Title:      HOL/Library/Numeral_Type.thy
    Author:     Brian Huffman
*)

section \<open>Numeral Syntax for Types\<close>

theory Numeral_Type
imports Cardinality
begin

subsection \<open>Numeral Types\<close>

typedef num0 = "UNIV :: nat set" ..
typedef num1 = "UNIV :: unit set" ..

typedef 'a bit0 = "{0 ..< 2 * int CARD('a::finite)}"
proof
  show "0 \<in> {0 ..< 2 * int CARD('a)}"
    by simp
qed

typedef 'a bit1 = "{0 ..< 1 + 2 * int CARD('a::finite)}"
proof
  show "0 \<in> {0 ..< 1 + 2 * int CARD('a)}"
    by simp
qed

lemma card_num0 [simp]: "CARD (num0) = 0"
  unfolding type_definition.card [OF type_definition_num0]
  by simp

lemma infinite_num0: "\<not> finite (UNIV :: num0 set)"
  using card_num0[unfolded card_eq_0_iff]
  by simp

lemma card_num1 [simp]: "CARD(num1) = 1"
  unfolding type_definition.card [OF type_definition_num1]
  by (simp only: card_UNIV_unit)

lemma card_bit0 [simp]: "CARD('a bit0) = 2 * CARD('a::finite)"
  unfolding type_definition.card [OF type_definition_bit0]
  by simp

lemma card_bit1 [simp]: "CARD('a bit1) = Suc (2 * CARD('a::finite))"
  unfolding type_definition.card [OF type_definition_bit1]
  by simp

instance num1 :: finite
proof
  show "finite (UNIV::num1 set)"
    unfolding type_definition.univ [OF type_definition_num1]
    using finite by (rule finite_imageI)
qed

instance bit0 :: (finite) card2
proof
  show "finite (UNIV::'a bit0 set)"
    unfolding type_definition.univ [OF type_definition_bit0]
    by simp
  show "2 \<le> CARD('a bit0)"
    by simp
qed

instance bit1 :: (finite) card2
proof
  show "finite (UNIV::'a bit1 set)"
    unfolding type_definition.univ [OF type_definition_bit1]
    by simp
  show "2 \<le> CARD('a bit1)"
    by simp
qed

subsection \<open>Locales for for modular arithmetic subtypes\<close>

locale mod_type =
  fixes n :: int
  and Rep :: "'a::{zero,one,plus,times,uminus,minus} \<Rightarrow> int"
  and Abs :: "int \<Rightarrow> 'a::{zero,one,plus,times,uminus,minus}"
  assumes type: "type_definition Rep Abs {0..<n}"
  and size1: "1 < n"
  and zero_def: "0 = Abs 0"
  and one_def:  "1 = Abs 1"
  and add_def:  "x + y = Abs ((Rep x + Rep y) mod n)"
  and mult_def: "x * y = Abs ((Rep x * Rep y) mod n)"
  and diff_def: "x - y = Abs ((Rep x - Rep y) mod n)"
  and minus_def: "- x = Abs ((- Rep x) mod n)"
begin

lemmas definitions =
  zero_def one_def add_def mult_def minus_def diff_def

lemma Rep_less_n: "Rep x < n"
by (rule type_definition.Rep [OF type, simplified, THEN conjunct2])

lemma Rep_le_n: "Rep x \<le> n"
by (rule Rep_less_n [THEN order_less_imp_le])

lemma Rep_inject_sym: "x = y \<longleftrightarrow> Rep x = Rep y"
by (rule type_definition.Rep_inject [OF type, symmetric])

lemma Rep_inverse: "Abs (Rep x) = x"
by (rule type_definition.Rep_inverse [OF type])

lemma Abs_inverse: "m \<in> {0..<n} \<Longrightarrow> Rep (Abs m) = m"
by (rule type_definition.Abs_inverse [OF type])

lemma Rep_Abs_mod: "Rep (Abs (m mod n)) = m mod n"
by (simp add: Abs_inverse pos_mod_conj [OF size0])

lemma Rep_Abs_0: "Rep (Abs 0) = 0"
by (simp add: Abs_inverse size0)

lemma Rep_0: "Rep 0 = 0"
by (simp add: zero_def Rep_Abs_0)

lemma Rep_Abs_1: "Rep (Abs 1) = 1"
by (simp add: Abs_inverse size1)

lemma Rep_1: "Rep 1 = 1"
by (simp add: one_def Rep_Abs_1)

lemma Rep_mod: "Rep x mod n = Rep x"
apply (rule_tac x=x in type_definition.Abs_cases [OF type])
apply (simp add: type_definition.Abs_inverse [OF type])
apply (simp add: mod_pos_pos_trivial)
done

lemmas Rep_simps =
  Rep_inject_sym Rep_inverse Rep_Abs_mod Rep_mod Rep_Abs_0 Rep_Abs_1

lemma comm_ring_1: "OFCLASS('a, comm_ring_1_class)"
apply (intro_classes, unfold definitions)
apply (simp_all add: Rep_simps zmod_simps field_simps)
done

end

locale mod_ring = mod_type n Rep Abs
  for n :: int
  and Rep :: "'a::{comm_ring_1} \<Rightarrow> int"
  and Abs :: "int \<Rightarrow> 'a::{comm_ring_1}"
begin

lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
apply (induct k)
apply (simp add: zero_def)
apply (simp add: Rep_simps add_def one_def zmod_simps ac_simps)
done

lemma of_int_eq: "of_int z = Abs (z mod n)"
apply (cases z rule: int_diff_cases)
apply (simp add: Rep_simps of_nat_eq diff_def zmod_simps)
done

lemma Rep_numeral:
  "Rep (numeral w) = numeral w mod n"
using of_int_eq [of "numeral w"]
by (simp add: Rep_inject_sym Rep_Abs_mod)

lemma iszero_numeral:
  "iszero (numeral w::'a) \<longleftrightarrow> numeral w mod n = 0"
by (simp add: Rep_inject_sym Rep_numeral Rep_0 iszero_def)

lemma cases:
  assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
  shows "P"
apply (cases x rule: type_definition.Abs_cases [OF type])
apply (rule_tac z="y" in 1)
apply (simp_all add: of_int_eq mod_pos_pos_trivial)
done

lemma induct:
  "(\<And>z. \<lbrakk>0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P (of_int z)) \<Longrightarrow> P (x::'a)"
by (cases x rule: cases) simp

end

subsection \<open>Ring class instances\<close>

text \<open>
  Unfortunately \<open>ring_1\<close> instance is not possible for
  @{typ num1}, since 0 and 1 are not distinct.
\<close>

instantiation num1 :: "{comm_ring,comm_monoid_mult,numeral}"
begin

lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
  by (induct x, induct y) simp

instance
  by standard (simp_all add: num1_eq_iff)

end

instantiation
  bit0 and bit1 :: (finite) "{zero,one,plus,times,uminus,minus}"
begin

definition Abs_bit0' :: "int \<Rightarrow> 'a bit0" where
  "Abs_bit0' x = Abs_bit0 (x mod int CARD('a bit0))"

definition Abs_bit1' :: "int \<Rightarrow> 'a bit1" where
  "Abs_bit1' x = Abs_bit1 (x mod int CARD('a bit1))"

definition "0 = Abs_bit0 0"
definition "1 = Abs_bit0 1"
definition "x + y = Abs_bit0' (Rep_bit0 x + Rep_bit0 y)"
definition "x * y = Abs_bit0' (Rep_bit0 x * Rep_bit0 y)"
definition "x - y = Abs_bit0' (Rep_bit0 x - Rep_bit0 y)"
definition "- x = Abs_bit0' (- Rep_bit0 x)"

definition "0 = Abs_bit1 0"
definition "1 = Abs_bit1 1"
definition "x + y = Abs_bit1' (Rep_bit1 x + Rep_bit1 y)"
definition "x * y = Abs_bit1' (Rep_bit1 x * Rep_bit1 y)"
definition "x - y = Abs_bit1' (Rep_bit1 x - Rep_bit1 y)"
definition "- x = Abs_bit1' (- Rep_bit1 x)"

instance ..

end

interpretation bit0:
  mod_type "int CARD('a::finite bit0)"
           "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
           "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
apply (rule mod_type.intro)
apply (simp add: of_nat_mult type_definition_bit0)
apply (rule one_less_int_card)
apply (rule zero_bit0_def)
apply (rule one_bit0_def)
apply (rule plus_bit0_def [unfolded Abs_bit0'_def])
apply (rule times_bit0_def [unfolded Abs_bit0'_def])
apply (rule minus_bit0_def [unfolded Abs_bit0'_def])
apply (rule uminus_bit0_def [unfolded Abs_bit0'_def])
done

interpretation bit1:
  mod_type "int CARD('a::finite bit1)"
           "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
           "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
apply (rule mod_type.intro)
apply (simp add: of_nat_mult type_definition_bit1)
apply (rule one_less_int_card)
apply (rule zero_bit1_def)
apply (rule one_bit1_def)
apply (rule plus_bit1_def [unfolded Abs_bit1'_def])
apply (rule times_bit1_def [unfolded Abs_bit1'_def])
apply (rule minus_bit1_def [unfolded Abs_bit1'_def])
apply (rule uminus_bit1_def [unfolded Abs_bit1'_def])
done

instance bit0 :: (finite) comm_ring_1
  by (rule bit0.comm_ring_1)

instance bit1 :: (finite) comm_ring_1
  by (rule bit1.comm_ring_1)

interpretation bit0:
  mod_ring "int CARD('a::finite bit0)"
           "Rep_bit0 :: 'a::finite bit0 \<Rightarrow> int"
           "Abs_bit0 :: int \<Rightarrow> 'a::finite bit0"
  ..

interpretation bit1:
  mod_ring "int CARD('a::finite bit1)"
           "Rep_bit1 :: 'a::finite bit1 \<Rightarrow> int"
           "Abs_bit1 :: int \<Rightarrow> 'a::finite bit1"
  ..

text \<open>Set up cases, induction, and arithmetic\<close>

lemmas bit0_cases [case_names of_int, cases type: bit0] = bit0.cases
lemmas bit1_cases [case_names of_int, cases type: bit1] = bit1.cases

lemmas bit0_induct [case_names of_int, induct type: bit0] = bit0.induct
lemmas bit1_induct [case_names of_int, induct type: bit1] = bit1.induct

lemmas bit0_iszero_numeral [simp] = bit0.iszero_numeral
lemmas bit1_iszero_numeral [simp] = bit1.iszero_numeral

lemmas [simp] = eq_numeral_iff_iszero [where 'a="'a bit0"] for dummy :: "'a::finite"
lemmas [simp] = eq_numeral_iff_iszero [where 'a="'a bit1"] for dummy :: "'a::finite"

subsection \<open>Order instances\<close>

instantiation bit0 and bit1 :: (finite) linorder begin
definition "a < b \<longleftrightarrow> Rep_bit0 a < Rep_bit0 b"
definition "a \<le> b \<longleftrightarrow> Rep_bit0 a \<le> Rep_bit0 b"
definition "a < b \<longleftrightarrow> Rep_bit1 a < Rep_bit1 b"
definition "a \<le> b \<longleftrightarrow> Rep_bit1 a \<le> Rep_bit1 b"

instance
  by(intro_classes)
    (auto simp add: less_eq_bit0_def less_bit0_def less_eq_bit1_def less_bit1_def Rep_bit0_inject Rep_bit1_inject)
end

lemma (in preorder) tranclp_less: "op <\<^sup>+\<^sup>+ = op <"
by(auto simp add: fun_eq_iff intro: less_trans elim: tranclp.induct)

instance bit0 and bit1 :: (finite) wellorder
proof -
  have "wf {(x :: 'a bit0, y). x < y}"
    by(auto simp add: trancl_def tranclp_less intro!: finite_acyclic_wf acyclicI)
  thus "OFCLASS('a bit0, wellorder_class)"
    by(rule wf_wellorderI) intro_classes
next
  have "wf {(x :: 'a bit1, y). x < y}"
    by(auto simp add: trancl_def tranclp_less intro!: finite_acyclic_wf acyclicI)
  thus "OFCLASS('a bit1, wellorder_class)"
    by(rule wf_wellorderI) intro_classes
qed

subsection \<open>Code setup and type classes for code generation\<close>

text \<open>Code setup for @{typ num0} and @{typ num1}\<close>

definition Num0 :: num0 where "Num0 = Abs_num0 0"
code_datatype Num0

instantiation num0 :: equal begin
definition equal_num0 :: "num0 \<Rightarrow> num0 \<Rightarrow> bool"
  where "equal_num0 = op ="
instance by intro_classes (simp add: equal_num0_def)
end

lemma equal_num0_code [code]:
  "equal_class.equal Num0 Num0 = True"
by(rule equal_refl)

code_datatype "1 :: num1"

instantiation num1 :: equal begin
definition equal_num1 :: "num1 \<Rightarrow> num1 \<Rightarrow> bool"
  where "equal_num1 = op ="
instance by intro_classes (simp add: equal_num1_def)
end

lemma equal_num1_code [code]:
  "equal_class.equal (1 :: num1) 1 = True"
by(rule equal_refl)

instantiation num1 :: enum begin
definition "enum_class.enum = [1 :: num1]"
definition "enum_class.enum_all P = P (1 :: num1)"
definition "enum_class.enum_ex P = P (1 :: num1)"
instance
  by intro_classes
     (auto simp add: enum_num1_def enum_all_num1_def enum_ex_num1_def num1_eq_iff Ball_def,
      (metis (full_types) num1_eq_iff)+)
end

instantiation num0 and num1 :: card_UNIV begin
definition "finite_UNIV = Phantom(num0) False"
definition "card_UNIV = Phantom(num0) 0"
definition "finite_UNIV = Phantom(num1) True"
definition "card_UNIV = Phantom(num1) 1"
instance
  by intro_classes
     (simp_all add: finite_UNIV_num0_def card_UNIV_num0_def infinite_num0 finite_UNIV_num1_def card_UNIV_num1_def)
end

text \<open>Code setup for @{typ "'a bit0"} and @{typ "'a bit1"}\<close>

declare
  bit0.Rep_inverse[code abstype]
  bit0.Rep_0[code abstract]
  bit0.Rep_1[code abstract]

lemma Abs_bit0'_code [code abstract]:
  "Rep_bit0 (Abs_bit0' x :: 'a :: finite bit0) = x mod int (CARD('a bit0))"
by(auto simp add: Abs_bit0'_def intro!: Abs_bit0_inverse)

lemma inj_on_Abs_bit0:
  "inj_on (Abs_bit0 :: int \<Rightarrow> 'a bit0) {0..<2 * int CARD('a :: finite)}"
by(auto intro: inj_onI simp add: Abs_bit0_inject)

declare
  bit1.Rep_inverse[code abstype]
  bit1.Rep_0[code abstract]
  bit1.Rep_1[code abstract]

lemma Abs_bit1'_code [code abstract]:
  "Rep_bit1 (Abs_bit1' x :: 'a :: finite bit1) = x mod int (CARD('a bit1))"
  by(auto simp add: Abs_bit1'_def intro!: Abs_bit1_inverse)

lemma inj_on_Abs_bit1:
  "inj_on (Abs_bit1 :: int \<Rightarrow> 'a bit1) {0..<1 + 2 * int CARD('a :: finite)}"
by(auto intro: inj_onI simp add: Abs_bit1_inject)

instantiation bit0 and bit1 :: (finite) equal begin

definition "equal_class.equal x y \<longleftrightarrow> Rep_bit0 x = Rep_bit0 y"
definition "equal_class.equal x y \<longleftrightarrow> Rep_bit1 x = Rep_bit1 y"

instance
  by intro_classes (simp_all add: equal_bit0_def equal_bit1_def Rep_bit0_inject Rep_bit1_inject)

end

instantiation bit0 :: (finite) enum begin
definition "(enum_class.enum :: 'a bit0 list) = map (Abs_bit0' \<circ> int) (upt 0 (CARD('a bit0)))"
definition "enum_class.enum_all P = (\<forall>b :: 'a bit0 \<in> set enum_class.enum. P b)"
definition "enum_class.enum_ex P = (\<exists>b :: 'a bit0 \<in> set enum_class.enum. P b)"

instance
proof(intro_classes)
  show "distinct (enum_class.enum :: 'a bit0 list)"
    by (simp add: enum_bit0_def distinct_map inj_on_def Abs_bit0'_def Abs_bit0_inject mod_pos_pos_trivial)

  show univ_eq: "(UNIV :: 'a bit0 set) = set enum_class.enum"
    unfolding enum_bit0_def type_definition.Abs_image[OF type_definition_bit0, symmetric]
    by(simp add: image_comp [symmetric] inj_on_Abs_bit0 card_image image_int_atLeastLessThan)
      (auto intro!: image_cong[OF refl] simp add: Abs_bit0'_def mod_pos_pos_trivial)

  fix P :: "'a bit0 \<Rightarrow> bool"
  show "enum_class.enum_all P = Ball UNIV P"
    and "enum_class.enum_ex P = Bex UNIV P"
    by(simp_all add: enum_all_bit0_def enum_ex_bit0_def univ_eq)
qed

end

instantiation bit1 :: (finite) enum begin
definition "(enum_class.enum :: 'a bit1 list) = map (Abs_bit1' \<circ> int) (upt 0 (CARD('a bit1)))"
definition "enum_class.enum_all P = (\<forall>b :: 'a bit1 \<in> set enum_class.enum. P b)"
definition "enum_class.enum_ex P = (\<exists>b :: 'a bit1 \<in> set enum_class.enum. P b)"

instance
proof(intro_classes)
  show "distinct (enum_class.enum :: 'a bit1 list)"
    by(simp only: Abs_bit1'_def zmod_int[symmetric] enum_bit1_def distinct_map Suc_eq_plus1 card_bit1 o_apply inj_on_def)
      (clarsimp simp add: Abs_bit1_inject)

  show univ_eq: "(UNIV :: 'a bit1 set) = set enum_class.enum"
    unfolding enum_bit1_def type_definition.Abs_image[OF type_definition_bit1, symmetric]
    by(simp add: image_comp [symmetric] inj_on_Abs_bit1 card_image image_int_atLeastLessThan)
      (auto intro!: image_cong[OF refl] simp add: Abs_bit1'_def mod_pos_pos_trivial)

  fix P :: "'a bit1 \<Rightarrow> bool"
  show "enum_class.enum_all P = Ball UNIV P"
    and "enum_class.enum_ex P = Bex UNIV P"
    by(simp_all add: enum_all_bit1_def enum_ex_bit1_def univ_eq)
qed

end

instantiation bit0 and bit1 :: (finite) finite_UNIV begin
definition "finite_UNIV = Phantom('a bit0) True"
definition "finite_UNIV = Phantom('a bit1) True"
instance by intro_classes (simp_all add: finite_UNIV_bit0_def finite_UNIV_bit1_def)
end

instantiation bit0 and bit1 :: ("{finite,card_UNIV}") card_UNIV begin
definition "card_UNIV = Phantom('a bit0) (2 * of_phantom (card_UNIV :: 'a card_UNIV))"
definition "card_UNIV = Phantom('a bit1) (1 + 2 * of_phantom (card_UNIV :: 'a card_UNIV))"
instance by intro_classes (simp_all add: card_UNIV_bit0_def card_UNIV_bit1_def card_UNIV)
end

subsection \<open>Syntax\<close>

syntax
  "_NumeralType" :: "num_token => type"  ("_")
  "_NumeralType0" :: type ("0")
  "_NumeralType1" :: type ("1")

translations
  (type) "1" == (type) "num1"
  (type) "0" == (type) "num0"

parse_translation \<open>
  let
    fun mk_bintype n =
      let
        fun mk_bit 0 = Syntax.const @{type_syntax bit0}
          | mk_bit 1 = Syntax.const @{type_syntax bit1};
        fun bin_of n =
          if n = 1 then Syntax.const @{type_syntax num1}
          else if n = 0 then Syntax.const @{type_syntax num0}
          else if n = ~1 then raise TERM ("negative type numeral", [])
          else
            let val (q, r) = Integer.div_mod n 2;
            in mk_bit r $ bin_of q end;
      in bin_of n end;

    fun numeral_tr [Free (str, _)] = mk_bintype (the (Int.fromString str))
      | numeral_tr ts = raise TERM ("numeral_tr", ts);

  in [(@{syntax_const "_NumeralType"}, K numeral_tr)] end;
\<close>

print_translation \<open>
  let
    fun int_of [] = 0
      | int_of (b :: bs) = b + 2 * int_of bs;

    fun bin_of (Const (@{type_syntax num0}, _)) = []
      | bin_of (Const (@{type_syntax num1}, _)) = [1]
      | bin_of (Const (@{type_syntax bit0}, _) $ bs) = 0 :: bin_of bs
      | bin_of (Const (@{type_syntax bit1}, _) $ bs) = 1 :: bin_of bs
      | bin_of t = raise TERM ("bin_of", [t]);

    fun bit_tr' b [t] =
          let
            val rev_digs = b :: bin_of t handle TERM _ => raise Match
            val i = int_of rev_digs;
            val num = string_of_int (abs i);
          in
            Syntax.const @{syntax_const "_NumeralType"} $ Syntax.free num
          end
      | bit_tr' b _ = raise Match;
  in
   [(@{type_syntax bit0}, K (bit_tr' 0)),
    (@{type_syntax bit1}, K (bit_tr' 1))]
  end;
\<close>

subsection \<open>Examples\<close>

lemma "CARD(0) = 0" by simp
lemma "CARD(17) = 17" by simp
lemma "8 * 11 ^ 3 - 6 = (2::5)" by simp

end


text\<open> 1 October 2021: Exercise for Homework Assignment 05 in CS 511 \<close>
text\<open> Your task to remove every invocation of the pre-defined method blast,
      by an equivalent sequence of 'apply' steps \<close>

theory HW05
  imports Main
begin

lemma prelim1 : "(True \<longrightarrow> A) \<Longrightarrow> A"
  apply(erule impE)
   apply(rule TrueI)
  apply assumption
  done

lemma prelim2 : "((Phi = False) \<and> Psi1 \<and> Psi2) \<or> (Phi = True) \<Longrightarrow> (Phi \<or> Psi1) \<and> (Phi \<or> Psi2)"
   apply (erule disjE)
    apply (erule conjE)+
    apply (rule conjI)
     apply (rule disjI2)
     apply assumption
    apply (rule disjI2)
    apply assumption
   apply (rule conjI)
    apply (rule disjI1)
    apply (erule iffE)
    apply (erule impE)
     apply (rule prelim1)
     apply assumption
    apply (erule mp)
    apply assumption
   apply (erule iffE)
   apply (erule impE)
    apply (rule prelim1)
    apply assumption
   apply (rule disjI1)
   apply (erule mp)
  apply assumption
  done

lemma prelim3 : "(Phi \<or> Psi1) \<and> (Phi \<or> Psi2) \<Longrightarrow> ((Phi = False) \<and> Psi1 \<and> Psi2) \<or> (Phi = True)"
  apply (erule conjE)
  apply (erule disjE)+
    apply (rule disjI2)
    apply (rule iffI)
     apply (rule TrueI)
    apply assumption
   apply (rule disjI2)
   apply (rule iffI)
    apply (rule TrueI)
   apply assumption
  apply(erule disjE)
   apply (rule disjI2)
   apply (rule iffI)
    apply (rule TrueI)
   apply assumption
  apply clarify
  apply (rule conjI)
   apply (rule iffI)
    apply (erule notE)
    apply (rule iffI)
    apply (rule TrueI)
    apply assumption
    apply (erule notE)
   apply (rule iffI)
    apply (rule TrueI)
   apply (rule classical)
   apply (rule FalseE)
   apply assumption
  apply (rule conjI)
  apply (rule classical)
   apply (rule FalseE)
   apply (erule notE)
   apply (rule iffI)
    apply (rule TrueI)
  apply (rule classical)
   apply (rule FalseE)
  apply (erule notE)
   apply assumption
  apply (rule classical)
   apply (rule FalseE)
  apply (erule notE)
  apply (rule iffI)
   apply (rule TrueI)
  apply (rule classical)
  apply (rule FalseE)
  apply (erule notE)
  apply assumption
  done

theorem "((Phi = False) \<and> Psi1 \<and> Psi2) \<or> (Phi = True) \<longleftrightarrow> (Phi \<or> Psi1) \<and> (Phi \<or> Psi2)"
  apply (rule iffI)
   apply (erule prelim2)
  apply (erule prelim3)
  done

end


(*
  Correctness proof of CTL model checking algorithm
  Isabelle 2014

  Based on:
  Isabelle/HOL
  A Proof Assistant for Higher-Order Logic
  Tobias Nipkow Lawrence C. Paulson Markus Wenzel
  August 15, 2018
  section 6.6
*)
theory ModelChecking imports Main begin

typedecl state
consts M :: "(state * state)set"
typedecl "atom"
consts L :: "state => atom set"

datatype formula = Atom "atom"
                 | Neg formula
                 | And formula formula
                 | EN formula   (* Next: instead of EX *)
                 | EU formula formula
                 | EG formula

definition Paths :: "state => (nat => state)set" where
  "Paths s == {p. s = p 0 & (ALL i. (p i, p(i+1)) : M)}"

definition FPaths :: "state => state list set" where
  "FPaths s ==
  {p. length p > 0 & s = p!0 & (ALL i<length p - 1. (p!i, p!(i+1)) : M)}"

primrec valid :: "state => formula => bool" ("(_ |= _)" [80,80] 80)
  where
  "s |= Atom a = (a : L s)" |
  "s |= Neg f = (~ (s |= f))" |
  "s |= And f g = (s |= f & s |= g)" |
  "s |= EN f = (EX t. (s,t) : M & t |= f)" |
  "s |= EU f g = (EX p : FPaths s.  p!(length p - 1) |= g & (ALL j<length p - 1. p!j |= f))" |
  "s |= EG f = (EX p : Paths s. ALL i. p i |= f)"

(* E[φUψ] = ψ ∨ (φ ∧ EX E[φUψ]) *)
definition eu :: "state set => state set => state set => state set" where
  "eu A B T == B Un {s. s : A & (EX t. (s, t) : M & t : T)}"

(* EGφ = φ ∧ EX EGφ *)
definition eg :: "state set => state set => state set" where
  "eg A T == A Int {s. EX t. (s, t) : M & t : T}"

primrec mc :: "formula => state set" where
  "mc(Atom a) = {s. a : L s}" |
  "mc(Neg f) = -mc f" |
  "mc(And f g) = mc f Int mc g" |
  "mc(EN f) = {s. EX t. (s,t) : M & t : mc f}" |
  "mc(EU f g) = lfp (eu (mc f) (mc g))" |
  "mc(EG f) = gfp (eg (mc f))"

lemma mono_eu: "mono (eu A B)"
apply(simp add: mono_def eu_def)
apply(blast)
done

lemma mono_eg: "mono (eg A)"
apply(simp add: mono_def eg_def)
apply(blast)
done

primrec path :: "state => (state => bool) => (nat => state)" where
  "path s Q 0 = s" |
  "path s Q (Suc n) = (SOME t. (path s Q n,t) : M & Q t)"

lemma infinity_lemma:
  "[| Q s; ALL s. Q s --> (EX t. (s,t) : M & Q t) |] ==>
  EX p : Paths s. ALL i. Q(p i)"
apply(subgoal_tac
  "EX p. s = p 0 & (ALL i::nat. (p i, p(i+1)) : M & Q(p i))")
apply(simp add: Paths_def, blast)
apply(rule_tac x = "path s Q" in exI)
apply(clarsimp)
apply(induct_tac i)
apply(simp)
apply(fast intro: someI2_ex)
apply(simp)
apply(rule someI2_ex)
apply(blast)
apply(rule someI2_ex)
apply(blast)
apply(blast)
done

theorem EU_lemma1:
  "lfp (eu A B) <= {s. EX p : FPaths s. p!(length p - 1) : B & (ALL j<length p - 1. p!j : A)}"
apply(rule lfp_lowerbound)
apply(auto simp add: eu_def FPaths_def)
apply(rule_tac x="[x]" in exI)
apply(clarsimp)
apply(rule_tac x="x#p" in exI)
apply(auto)
apply(case_tac i)
apply(auto)
apply(case_tac j)
apply(auto)
done

lemma lfp_eu [rule_format]:
  "p ~= [] -->
  (ALL i<length p - Suc 0. (p ! i, p ! Suc i) : M) -->
  p ! (length p - Suc 0) : B -->
  (ALL j<length p - Suc 0. p ! j : A) -->
  p ! 0 : lfp (eu A B)"
apply(induct_tac p)
apply(clarsimp)
apply(clarsimp)
apply(case_tac list)
apply(clarsimp)
apply(subst lfp_unfold[OF mono_eu])
apply(subst eu_def)
apply(clarsimp)
apply(clarsimp)
apply(drule mp)
apply(clarsimp)
apply(drule_tac x="i+1" in spec)
apply(rotate_tac -1)
apply(drule mp)
apply(clarsimp)
apply(clarsimp)
apply(drule mp)
apply(clarsimp)
apply(rotate_tac -2)
apply(drule_tac x="j+1" in spec)
apply(rotate_tac -1)
apply(drule mp)
apply(clarsimp)
apply(clarsimp)
apply(subst lfp_unfold[OF mono_eu])
apply(subst eu_def)
apply(clarify)
apply(rule)
apply (metis nth_Cons_0 zero_less_Suc)
apply(rule_tac x="aa" in exI)
apply(clarsimp)
by (metis nth_Cons_0 zero_less_Suc)

theorem EU_lemma2:
  "{s. EX p : FPaths s. p!(length p - 1) : B & (ALL j<length p - 1. p!j : A)} <= lfp (eu A B)"
apply(unfold FPaths_def)
apply(clarsimp)
apply(rule lfp_eu)
apply(auto)
done

lemma gfp_eg [rule_format]: "x : gfp (eg A) --> x : A"
apply(subst gfp_unfold[OF mono_eg])
apply(subst eg_def)
apply(clarsimp)
done

lemma EG_lemma1:
  "gfp (eg A) <= {s. EX p : Paths s. ALL i. p i : A}"
apply(clarsimp)
apply(drule_tac Q="%x. x : gfp (eg A)" in infinity_lemma)
apply(subst gfp_unfold[OF mono_eg])
apply(clarsimp)
apply(simp add: eg_def)
apply(clarsimp)
apply(rule_tac x="p" in bexI)
apply(clarsimp)
apply(drule_tac x="i" in spec)
apply(drule gfp_eg)
apply(assumption)
apply(assumption)
done

lemma EG_lemma2:
  "{s. EX p : Paths s. ALL i. p i : A} <= gfp (eg A)"
apply(rule coinduct)
apply(rule mono_eg)
apply(clarsimp)
apply(simp add: eg_def)
apply(unfold Paths_def)
apply(clarsimp)
apply(rule_tac x="p 1" in exI)
apply(clarsimp)
apply(rule_tac x="%k. p (Suc k)" in exI)
apply(clarsimp)
done

theorem "mc f = {s. s |= f}"
apply(induct_tac f)
apply(auto simp add: equalityI[OF EU_lemma1 EU_lemma2] equalityI[OF EG_lemma1 EG_lemma2])
done

end