(*<*)
theory HOTL imports Main
begin (*An Embedding of Higher-Order Temporal Logic (HOTL) in HOL *)
(*>*)
subsection \<open>HOTL - Higher order temporal logic \label{subsec:HOTL}\<close>

text\<open>
This section introduces the logical operators and data types we will be working with in \hyperref[subsec:Simulation]{Simulation}.
\<close>
subsubsection\<open>Data types \label{subsubsec:types}\<close>

text\<open>
There are two new data types @{text "g"} @{text "time"} and one derived data type @{text "\<sigma>"}.
\<close>

text\<open>%
\noindent Type @{text "g"} is for governmental institutions, with @{text "Congress"} being Congress, @{text "P"} being the President and @{text "Courts"}
 being the Supreme Court as well as other courts set up by Congress. The legislative, executive
and judicial powers shall later be bestowed upon these three instances of @{text "g"}. We use @{text "Courts"} rather than
just the Supreme Court since Art. III, \S 1. states that the ``judicial Power
[...] shall be vested in one supreme Court, and in such inferior Courts as the Congress may [...] ordain and establish."
\<close>

datatype g = Congress | P | Courts

text\<open>
\noindent There are four instances of time: @{text "t\<^sub>1"}-@{text "t\<^sub>3"} as in \ref{subsubsec:time} and @{text "t\<^sub>e"}, the  instance that marks
the end of time.
At @{text "t\<^sub>1"} the 1947 version of the Constitution is valid.  @{text "t\<^sub>2"} holds the version with an amended Art. V that allows for
amendments that do not maintain states' suffrage and  @{text "t\<^sub>3"} with the Constitution upholding dictatorship.

Note that there is a fourth instance  @{text "t\<^sub>e"}. We need this for technical reasons. Since we want to use an operator  @{text "\<^bold>X"}
that carries a formula from one instance to its successor, it is convenient to have a successor for each instance of time used.
Unless we define a circular successor relation we need a further instance of time that can be the successor of  @{text "t\<^sub>3"} to
avoid inconsistencies. We shall point out where  @{text "t\<^sub>e"} prevents inconsistencies when it becomes relevant below.
\<close>

datatype time = t\<^sub>1 |t\<^sub>2 |t\<^sub>3 |t\<^sub>e

text\<open>
\noindent Since we will only consider a formula's validity at a certain point in time we need a
time dependant type for them, as well as operators lifted to that type.

See the following definition of a time dependant formula's type. We will use it to explain what a lifted operator is
and as a basis for our lifted operators.\<close>

type_synonym \<sigma>="(time\<Rightarrow>bool)"(*Type of time dependant formulas *)

text\<open>\noindent %
Assume you have operator
\[\text{ @{text "op::'a\<Rightarrow>bool"}}\]
 where @{text "'a"} is an arbitrary type and @{text "bool"} is Isabelle's version of the boolean type.
 A lifted version
\[\text{@{text "op\<^sub>l::'a\<Rightarrow>\<sigma>"}}\] of @{text "op"} would be an operator such that for any argument @{text "arg::'a"}
\[\text{@{text "op\<^sub>l arg \<equiv> \<Phi>(op)(arg)"}}\]
 with @{text "\<Phi>::('a\<Rightarrow>bool)\<Rightarrow>'a\<Rightarrow>\<sigma>"} being a suitable function to translate the notion of what @{text "op"} does to a notion
of what it does at a particular instance of time.
What this function @{text "\<Phi>"} looks like depends on @{text "op"}. See below how it is done for the operators we require.
\<close>

(*Lifted HOTL connectives: they operate on time dependant formulas(truth sets).*)
subsubsection\<open>Lifted operators \label{subsubsec:op}\<close>
text\<open>
\noindent
The following are lifted versions for standard logical operators @{text "{\<not>,\<and>,\<or>,\<longrightarrow>.\<longleftrightarrow>}"}, as well as
for @{text "{=,!=}"} and for quantifiers @{text "{\<forall>,\<exists>}"}.

Observe that the quantifiers lifted may each only be
used for one type of argument. We shall go into detail about polymorphism in \ref{subsubsec:Polym}.

Note also that they need an additional binding for the form we are used to. This is because
the initial definition actually refers to operator $\Pi_{(\alpha \Rightarrow bool)\Rightarrow bool}$ which
allows us to define a lifted @{text "\<forall>"} using only lambda abstraction%
\footnote{S. \cite{sep-type-theory-church},``1.1 Fundamental Ideas"}.
\<close>

definition tneg :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<not>_"[52]53)  where "\<^bold>\<not>\<phi> \<equiv> \<lambda>t. \<not>\<phi>(t)"
definition tand :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<and>"51) where "\<phi>\<^bold>\<and>\<psi> \<equiv> \<lambda>t. \<phi>(t)\<and>\<psi>(t)"
definition tor  :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<or>"50) where "\<phi>\<^bold>\<or>\<psi> \<equiv> \<lambda>t. \<phi>(t)\<or>\<psi>(t)"
definition timp :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<longrightarrow>"49) where "\<phi>\<^bold>\<longrightarrow> \<psi> \<equiv> \<lambda>t. \<phi>(t)\<longrightarrow>\<psi>(t)"
definition tequ :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<longleftrightarrow>"48) where "\<phi>\<^bold>\<longleftrightarrow>\<psi> \<equiv> \<lambda>t. \<phi>(t)\<longleftrightarrow>\<psi>(t)"
(**)
definition teq :: "g\<Rightarrow>g\<Rightarrow>\<sigma>" (infixr"\<^bold>="40) where "\<phi>\<^bold>=\<psi> \<equiv> \<lambda>t. \<phi>=\<psi>"
definition tneq :: "g\<Rightarrow>g\<Rightarrow>\<sigma>" (infixr"\<^bold>!="40) where "\<phi>\<^bold>!=\<psi> \<equiv> \<lambda>t.\<not>(\<phi>=\<psi>)"
(**)
definition tall_g :: "(g\<Rightarrow>\<sigma>)\<Rightarrow>\<sigma>" ("\<^bold>\<forall>\<^sub>g") where "\<^bold>\<forall>\<^sub>g\<Phi> \<equiv> \<lambda>t.\<forall>x. \<Phi>(x)(t)"
definition tallB_g:: "(g\<Rightarrow>\<sigma>)\<Rightarrow>\<sigma>" (binder"\<^bold>\<forall>\<^sub>g"[8]9) where "\<^bold>\<forall>\<^sub>gx. \<phi>(x) \<equiv> \<^bold>\<forall>\<^sub>g\<phi>"
(**)
definition texi_g :: "(g\<Rightarrow>\<sigma>)\<Rightarrow>\<sigma>" ("\<^bold>\<exists>\<^sub>g") where "\<^bold>\<exists>\<^sub>g\<Phi> \<equiv> \<lambda>t.\<exists>x. \<Phi>(x)(t)"
definition texiB_g:: "(g\<Rightarrow>\<sigma>)\<Rightarrow>\<sigma>" (binder"\<^bold>\<exists>\<^sub>g"[8]9) where "\<^bold>\<exists>\<^sub>gx. \<phi>(x) \<equiv> \<^bold>\<exists>\<^sub>g\<phi>"
 (**)
definition tall_s :: "(\<sigma>\<Rightarrow>\<sigma>)\<Rightarrow>\<sigma>" ("\<^bold>\<forall>\<^sub>\<sigma>") where "\<^bold>\<forall>\<^sub>\<sigma>\<Phi> \<equiv> \<lambda>t.\<forall>\<phi>. \<Phi>(\<phi>)(t)"
definition tallB_s:: "(\<sigma>\<Rightarrow>\<sigma>)\<Rightarrow>\<sigma>" (binder"\<^bold>\<forall>\<^sub>\<sigma>"[8]9) where "\<^bold>\<forall>\<^sub>\<sigma>\<phi>. \<Phi>(\<phi>) \<equiv> \<^bold>\<forall>\<^sub>\<sigma>\<Phi>"
(**)
definition texi_s :: "(\<sigma>\<Rightarrow>\<sigma>)\<Rightarrow>\<sigma>" ("\<^bold>\<exists>\<^sub>\<sigma>") where "\<^bold>\<exists>\<^sub>\<sigma>\<Phi> \<equiv> \<lambda>t. \<exists>\<phi>. \<Phi>(\<phi>)(t)"
definition texiB_s:: "(\<sigma>\<Rightarrow>\<sigma>)\<Rightarrow>\<sigma>" (binder"\<^bold>\<exists>\<^sub>\<sigma>"[8]9) where "\<^bold>\<exists>\<^sub>\<sigma>\<phi>. \<Phi>(\<phi>) \<equiv> \<^bold>\<exists>\<^sub>\<sigma>\<Phi>"

text\<open>
\noindent The last operator we want to introduce is @{text "\<^bold>X"}. This requires a precedence relation.
To stress the fact that we are talking about a \textit{future} instance of time when using @{text "\<^bold>X"} we
call the relation @{text "succ"} for successor, rather than @{text "pred"} for predecessor.
\<close>

consts  succ::"time\<Rightarrow>time\<Rightarrow>bool"
axiomatization where
  t1_s_t2: "succ t\<^sub>1 t\<^sub>2"     and
  t2_s_t3: "succ t\<^sub>2 t\<^sub>3"     and
  t3_s_te: "succ t\<^sub>3 t\<^sub>e"     and
  te_s_te: "succ t\<^sub>e t\<^sub>e"     and
  Nt1_s_t1: "\<not>(succ t\<^sub>1 t\<^sub>1)" and
  Nt1_s_t3: "\<not>(succ t\<^sub>1 t\<^sub>3)" and
  Nt1_s_te: "\<not>(succ t\<^sub>1 t\<^sub>e)" and
  Nt2_s_t1: "\<not>(succ t\<^sub>2 t\<^sub>1)" and
  Nt2_s_t2: "\<not>(succ t\<^sub>2 t\<^sub>2)" and
  Nt2_s_te: "\<not>(succ t\<^sub>2 t\<^sub>e)" and
  Nt3_s_t1: "\<not>(succ t\<^sub>3 t\<^sub>1)" and
  Nt3_s_t2: "\<not>(succ t\<^sub>3 t\<^sub>2)" and
  Nt3_s_t3: "\<not>(succ t\<^sub>3 t\<^sub>3)" and
  Nte_s_t1: "\<not>(succ t\<^sub>e t\<^sub>1)" and
  Nte_s_t2: "\<not>(succ t\<^sub>e t\<^sub>2)" and
  Nte_s_t3: "\<not>(succ t\<^sub>e t\<^sub>3)"

text\<open>
\noindent So in Kripke semantics%
\footnote{S. \cite{sep-logic-modal}}
 a visualisation of the instances with @{text "succ"} as accessibility
relation would look as follows:
\begin{center}
\begin{tikzpicture}[scale=0.2]
\tikzstyle{every node}+=[inner sep=0pt]
\draw [black] (11.3,-8.6) circle (3);
\draw (11.3,-8.6) node {$t_1$};
\draw [black] (23.9,-8.6) circle (3);
\draw (23.9,-8.6) node {$t_2$};
\draw [black] (36.7,-8.6) circle (3);
\draw (36.7,-8.6) node {$t_3$};
\draw [black] (48.9,-8.6) circle (3);
\draw (48.9,-8.6) node {$t_e$};
\draw [black] (39.7,-8.6) -- (45.9,-8.6);
\fill [black] (45.9,-8.6) -- (45.1,-8.1) -- (45.1,-9.1);
\draw [black] (51.407,-6.973) arc (150.70984:-137.29016:2.25);
\fill [black] (51.72,-9.6) -- (52.17,-10.43) -- (52.66,-9.56);
\draw [black] (26.9,-8.6) -- (33.7,-8.6);
\fill [black] (33.7,-8.6) -- (32.9,-8.1) -- (32.9,-9.1);
\draw [black] (14.3,-8.6) -- (20.9,-8.6);
\fill [black] (20.9,-8.6) -- (20.1,-8.1) -- (20.1,-9.1);
\end{tikzpicture}
\end{center}\<close>

text\<open>\noindent %
 Based on @{text "succ"} we can then define @{text "\<^bold>X"}.\<close>

definition tnext :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>X_") where "\<^bold>X\<phi> \<equiv> (\<lambda>t. \<forall>t'. ((succ t t') \<longrightarrow> \<phi> t'))"

 (*Global and local validity of lifted formulas*)
subsubsection\<open>Validity \label{subsubsec:val}\<close>
text\<open>\noindent %
Lastly, we want to define a notion of \textit{validity}. We distinguish between global and local validity.

A formula shall be globally valid when it is valid independently of the the current time. This is
useful for universally valid definitions such as what we mean by \textit{dictatorship}.
A formula shall be locally valid for a specific @{text "t"} if it is valid at that instance of time.
 \<close>
definition global_valid :: "\<sigma> \<Rightarrow> bool" ("\<lfloor>_\<rfloor>"[7]8) where "\<lfloor>\<phi>\<rfloor> \<equiv> \<forall>t. \<phi> t"
definition local_valid :: "\<sigma>\<Rightarrow>time \<Rightarrow> bool" ("\<lfloor>_\<rfloor>\<^sub>_"[9]10) where "\<lfloor>\<phi>\<rfloor>\<^sub>t \<equiv> \<phi> t"

text\<open>\noindent %
We conclude this section with checking satisfiability and enlisting all definitions in @{text "Defs"}
so we may access them conveniently in proofs later on.

Lemmas used to test the modelling begin with a @{text "T"} to signify that they are testing lemmas.
The check for satisfiability is one such testing lemma.
\<close>

lemma T_basic_sat_HOTL:"True" nitpick[satisfy,user_axioms,show_all]oops
(*
Introducing "Defs" as the set of the above definitions; useful for convenient unfolding.*)
named_theorems Defs declare
  tneg_def[Defs] tand_def[Defs]
  tor_def[Defs] timp_def[Defs] tequ_def[Defs]
  teq_def[Defs] tneq_def[Defs]
  tall_g_def[Defs] tallB_g_def[Defs]
  texi_g_def[Defs] texiB_g_def[Defs]
  tall_s_def[Defs] tallB_s_def[Defs]
  texi_s_def[Defs] texiB_s_def[Defs]
  tnext_def[Defs]
  global_valid_def[Defs] local_valid_def[Defs]

(*<*)
end
(*>*)


(*  Title:      Construct_SSA.thy
    Author:     Sebastian Ullrich
*)

section \<open>SSA Construction\<close>
subsection \<open>CFG to SSA CFG\<close>

theory Construct_SSA imports SSA_CFG
  "HOL-Library.While_Combinator"
  "HOL-Library.Product_Lexorder"
begin

datatype Def = SimpleDef | PhiDef
type_synonym ('node, 'var) ssaVal = "'var \<times> 'node \<times> Def"

instantiation Def :: linorder
begin
  definition "x < y \<longleftrightarrow> x = SimpleDef \<and> y = PhiDef"
  definition "less_eq_Def (x :: Def) y \<longleftrightarrow> x = y \<or> x < y"
  instance by intro_classes (metis Def.distinct(1) less_Def_def less_eq_Def_def Def.exhaust)+
end

locale CFG_Construct = CFG \<alpha>e \<alpha>n invar inEdges' Entry "defs" "uses"
for
  \<alpha>e :: "'g \<Rightarrow> ('node::linorder \<times> 'edgeD \<times> 'node) set" and
  \<alpha>n :: "'g \<Rightarrow> 'node list" and
  invar :: "'g \<Rightarrow> bool" and
  inEdges' :: "'g \<Rightarrow> 'node \<Rightarrow> ('node \<times> 'edgeD) list" and
  Entry::"'g \<Rightarrow> 'node" and
  "defs" :: "'g \<Rightarrow> 'node \<Rightarrow> 'var::linorder set" and
  "uses" :: "'g \<Rightarrow> 'node \<Rightarrow> 'var set"
begin
  fun phiDefNodes_aux :: "'g \<Rightarrow> 'var \<Rightarrow> 'node list \<Rightarrow> 'node \<Rightarrow> 'node set" where
    "phiDefNodes_aux g v unvisited n =(
        if n \<notin> set unvisited \<or> v \<in> defs g n then {}
        else fold (\<union>)
          [phiDefNodes_aux g v (removeAll n unvisited) m . m \<leftarrow> predecessors g n]
          (if length (predecessors g n) \<noteq> 1 then {n} else {})
    )"

  definition phiDefNodes :: "'g \<Rightarrow> 'var \<Rightarrow> 'node set" where
    "phiDefNodes g v \<equiv> fold (\<union>)
      [phiDefNodes_aux g v (\<alpha>n g) n . n \<leftarrow> \<alpha>n g, v \<in> uses g n]
      {}"

  definition var :: "'g \<Rightarrow> ('node, 'var) ssaVal \<Rightarrow> 'var" where "var g \<equiv> fst"
  abbreviation defNode :: "('node, 'var) ssaVal \<Rightarrow> 'node" where "defNode v \<equiv> fst (snd v)"
  abbreviation defKind :: "('node, 'var) ssaVal \<Rightarrow> Def" where "defKind v \<equiv> snd (snd v)"

  declare var_def[simp]

  function lookupDef :: "'g \<Rightarrow> 'node \<Rightarrow> 'var \<Rightarrow> ('node, 'var) ssaVal" where
    "lookupDef g n v =(
        if n \<notin> set (\<alpha>n g) then undefined
        else if v \<in> defs g n then (v,n,SimpleDef)
        else case predecessors g n of
          [m] \<Rightarrow> lookupDef g m v
          | _ \<Rightarrow> (v,n,PhiDef)
    )"

  by auto
  termination by (relation "measure (\<lambda>(g,n,_). shortestPath g n)") (auto intro:shortestPath_predecessor)
  declare lookupDef.simps [code]

  definition defs' :: "'g \<Rightarrow> 'node \<Rightarrow> ('node, 'var) ssaVal set" where
    "defs' g n \<equiv> (\<lambda>v. (v,n,SimpleDef)) ` defs g n"
  definition uses' :: "'g \<Rightarrow> 'node \<Rightarrow> ('node, 'var) ssaVal set" where
    "uses' g n \<equiv> lookupDef g n ` uses g n"
  definition phis' :: "'g \<Rightarrow> ('node, ('node, 'var) ssaVal) phis" where
    "phis' \<equiv> \<lambda>g (n,(v,m,def)).
      if m = n \<and> n \<in> phiDefNodes g v \<and> v \<in> vars g \<and> def = PhiDef then
        Some [lookupDef g m v . m \<leftarrow> predecessors g n]
      else None"
  declare uses'_def [code] defs'_def [code] phis'_def [code]

  abbreviation "lookupDefNode g n v \<equiv> defNode (lookupDef g n v)"
  declare lookupDef.simps [simp del]
  declare phiDefNodes_aux.simps [simp del]

  lemma phiDefNodes_aux_cases:
    obtains (nonrec) "phiDefNodes_aux g v unvisited n = {}" "(n \<notin> set unvisited \<or> v \<in> defs g n)"
    | (rec) "phiDefNodes_aux g v unvisited n = fold union (map (phiDefNodes_aux g v (removeAll n unvisited)) (predecessors g n))
          (if length (predecessors g n) = 1 then {} else {n})"
       "n \<in> set unvisited" "v \<notin> defs g n"
  proof (cases "n \<in> set unvisited \<and> v \<notin> defs g n")
    case True
    thus ?thesis using rec by (simp add:phiDefNodes_aux.simps)
  next
    case False
    thus ?thesis using nonrec by (simp add:phiDefNodes_aux.simps)
  qed

  lemma phiDefNode_aux_is_join_node:
    assumes "n \<in> phiDefNodes_aux g v un m"
    shows "length (predecessors g n) \<noteq> 1"
  using assms proof (induction un arbitrary: m rule:removeAll_induct)
    case (1 un m)
    thus ?case
    proof (cases un v g m rule:phiDefNodes_aux_cases)
      case rec
      with 1 show ?thesis by (fastforce elim!:fold_union_elem split:if_split_asm)
    qed auto
  qed

  lemma phiDefNode_is_join_node:
    assumes "n \<in> phiDefNodes g v"
    shows "length (predecessors g n) \<noteq> 1"
  using assms unfolding phiDefNodes_def
  by (auto elim!:fold_union_elem dest!:phiDefNode_aux_is_join_node)

  abbreviation unvisitedPath :: "'node list \<Rightarrow> 'node list \<Rightarrow> bool" where
    "unvisitedPath un ns \<equiv> distinct ns \<and> set ns \<subseteq> set un"

  lemma unvisitedPath_removeLast:
    assumes "unvisitedPath un ns" "length ns \<ge> 2"
    shows "unvisitedPath (removeAll (last ns) un) (butlast ns)"
  proof-
    let ?n = "last ns"
    let ?ns' = "butlast ns"
    let ?un' = "removeAll ?n un"
    let ?n' = "last ?ns'"
    from assms(2) have [simp]: "?n = ns ! (length ns - 1)" by -(rule last_conv_nth, auto)
    from assms(1) have "distinct ?ns'" by -(rule distinct_butlast, simp)
    moreover
    have "set ?ns' \<subseteq> set ?un'"
    proof
      fix n
      assume assm: "n \<in> set ?ns'"
      then obtain i where "n = ?ns' ! i" "i < length ?ns'" by (auto simp add:in_set_conv_nth)
      hence i: "n = ns ! i" "i < length ns - 1" by (auto simp add:nth_butlast)
      with assms have 1: "n \<noteq> ?n" by (auto iff:nth_eq_iff_index_eq)
      from i assms(1) have "n \<in> set un" by auto
      with \<open>n \<in> set ?ns'\<close> assms(1) 1 show "n \<in> set ?un'" by auto
    qed
    ultimately show ?thesis by simp
  qed

  lemma phiDefNodes_auxI:
    assumes "g \<turnstile> n-ns\<rightarrow>m" "unvisitedPath un ns" "\<forall>n \<in> set ns. v \<notin> defs g n" "length (predecessors g n) \<noteq> 1"
    shows "n \<in> phiDefNodes_aux g v un m"
  using assms(1,2,3) proof (induction un arbitrary: m ns rule:removeAll_induct)
    case (1 un)
    show ?case
    proof (cases un v g m rule:phiDefNodes_aux_cases)
      case nonrec
      from "1.prems"(1) have "m \<in> set ns" unfolding path2_def by auto
      with nonrec show ?thesis using "1.prems"(2,3) by auto
    next
      case rec
      show ?thesis
      proof (cases "n = m")
        case True
        thus ?thesis using rec assms(4) by -(subst rec(1), rule fold_union_elemI[of _ "{m}"], auto)
      next
        case False
        let ?ns' = "butlast ns"
        let ?m' = "last ?ns'"
        from "1.prems"(1) have [simp]: "m = last ns" unfolding path2_def by simp
        with 1(2) False have ns': "g \<turnstile> n-?ns'\<rightarrow>?m'" "?m' \<in> set (predecessors g m)" by (auto intro: path2_unsnoc)

        have "n \<in> phiDefNodes_aux g v (removeAll m un) ?m'"
        using rec(2) ns'
        apply-
        proof (rule "1.IH")
          from "1.prems"(1) False have "length ns \<ge> 2" by (auto simp del:\<open>m = last ns\<close>)
          with "1.prems"(2) show "unvisitedPath (removeAll m un) ?ns'" by (subst \<open>m = last ns\<close>, rule unvisitedPath_removeLast)
          from "1.prems"(3) show "\<forall>n \<in> set ?ns'. v \<notin> defs g n" by (auto intro:in_set_butlastD)
        qed
        with ns'(2) show ?thesis by -(subst rec, rule fold_union_elemI, auto)
      qed
    qed
  qed

  lemma phiDefNodes_auxE:
    assumes "n \<in> phiDefNodes_aux g v un m" "m \<in> set (\<alpha>n g)"
    obtains ns where "g \<turnstile> n-ns\<rightarrow>m" "\<forall>n \<in> set ns. v \<notin> defs g n" "length (predecessors g n) \<noteq> 1" "unvisitedPath un ns"
  using assms proof (atomize_elim, induction un arbitrary:m rule:removeAll_induct)
    case (1 un)
    show ?case
    proof (cases un v g m rule:phiDefNodes_aux_cases)
      case nonrec
      thus ?thesis using "1.prems" by simp
    next
      case rec
      show ?thesis
      proof (cases "n \<in> (if length (predecessors g m) = 1 then {} else {m})")
        case True
        hence "n = m" by (simp split:if_split_asm)
        thus ?thesis using "1.prems"(2) rec True by auto
      next
        case False
        with rec "1.prems"(1) obtain m' where m': "n \<in> phiDefNodes_aux g v (removeAll m un) m'" "m' \<in> set (predecessors g m)"
          by (auto elim!:fold_union_elem)
        with "1.prems"(2) have "m' \<in> set (\<alpha>n g)" by auto
        with "1.IH"[of m m'] m' rec obtain ns where "g \<turnstile> n-ns\<rightarrow>m'" "\<forall>n \<in> set ns. v \<notin> defs g n" "length (predecessors g n) \<noteq> 1" "unvisitedPath (removeAll m un) ns" by auto
        thus ?thesis using m' rec by -(rule exI, auto)
      qed
    qed
  qed

  lemma phiDefNodesE:
    assumes "n \<in> phiDefNodes g v"
    obtains ns m where "g \<turnstile> n-ns\<rightarrow>m" "\<forall>n \<in> set ns. v \<notin> defs g n" "v \<in> uses g m"
  using assms
  by (auto elim!:phiDefNodes_auxE elim!:fold_union_elem simp:phiDefNodes_def)

  lemma phiDefNodes_\<alpha>n[simp]: "n \<in> phiDefNodes g v \<Longrightarrow> n \<in> set (\<alpha>n g)"
  by (erule phiDefNodesE, auto)

  lemma phiDefNodesI:
    assumes "g \<turnstile> n-ns\<rightarrow>m" "v \<in> uses g m" "\<forall>n \<in> set ns. v \<notin> defs g n" "length (predecessors g n) \<noteq> 1"
    shows "n \<in> phiDefNodes g v"
  proof-
    from assms(1) have "m \<in> set (\<alpha>n g)" by (rule path2_in_\<alpha>n, auto)
    from assms obtain ns' where "g \<turnstile> n-ns'\<rightarrow>m" "distinct ns'" "\<forall>n \<in> set ns'. v \<notin> defs g n" by -(rule simple_path2, auto)
    with assms(4) have 1: "n \<in> phiDefNodes_aux g v (\<alpha>n g) m" by -(rule phiDefNodes_auxI, auto intro:path2_in_\<alpha>n)
    thus ?thesis using assms(2) \<open>m \<in> set (\<alpha>n g)\<close>
    unfolding phiDefNodes_def
    by -(rule fold_union_elemI, auto)
  qed

  lemma lookupDef_cases[consumes 1]:
    assumes "n \<in> set (\<alpha>n g)"
    obtains (SimpleDef) "v \<in> defs g n" "lookupDef g n v = (v,n,SimpleDef)"
          | (PhiDef)    "v \<notin> defs g n" "length (predecessors g n) \<noteq> 1" "lookupDef g n v = (v,n,PhiDef)"
          | (rec) m where "v \<notin> defs g n" "predecessors g n = [m]" "m \<in> set (\<alpha>n g)" "lookupDef g n v = lookupDef g m v"
  proof (cases "v \<in> defs g n")
    case True
    thus thesis using assms SimpleDef by (simp add:lookupDef.simps)
  next
    case False
    thus thesis
    proof (cases "length (predecessors g n) = 1")
      case True
      then obtain m where m: "predecessors g n = [m]" by (cases "predecessors g n", auto)
      hence "m \<in> set (predecessors g n)" by simp
      thus thesis using False rec assms m by -(subst(asm) lookupDef.simps, drule predecessor_is_node, auto)
    next
      case False
      thus thesis using \<open>v \<notin> defs g n\<close> assms by -(rule PhiDef, assumption, assumption, subst lookupDef.simps, auto split:list.split)
    qed
  qed

  lemma lookupDef_cases'[consumes 1]:
    assumes "n \<in> set (\<alpha>n g)"
    obtains (SimpleDef) "v \<in> defs g n" "defNode (lookupDef g n v) = n" "defKind (lookupDef g n v) = SimpleDef"
          | (PhiDef)    "v \<notin> defs g n" "length (predecessors g n) \<noteq> 1" "lookupDefNode g n v = n" "defKind (lookupDef g n v) = PhiDef"
          | (rec) m where "v \<notin> defs g n" "predecessors g n = [m]" "m \<in> set (\<alpha>n g)" "lookupDef g n v = lookupDef g m v"
  using assms
  by (rule lookupDef_cases[of n g v]) simp_all

  lemma lookupDefE:
    assumes "lookupDef g n v = v'" "n \<in> set (\<alpha>n g)"
    obtains (SimpleDef) "v \<in> defs g n" "v' = (v,n,SimpleDef)"
          | (PhiDef)    "v \<notin> defs g n" "length (predecessors g n) \<noteq> 1" "v' = (v,n,PhiDef)"
          | (rec) m where "v \<notin> defs g n" "predecessors g n = [m]" "m \<in> set (\<alpha>n g)" "v' = lookupDef g m v"
  using assms by -(atomize_elim, cases rule:lookupDef_cases[of n g v], auto)

  lemma lookupDef_induct[consumes 1, case_names SimpleDef PhiDef rec]:
    assumes "n \<in> set (\<alpha>n g)"
            "\<And>n. \<lbrakk>n \<in> set (\<alpha>n g); v \<in> defs g n; lookupDef g n v = (v,n,SimpleDef)\<rbrakk> \<Longrightarrow> P n"
            "\<And>n. \<lbrakk>n \<in> set (\<alpha>n g); v \<notin> defs g n; length (predecessors g n) \<noteq> 1; lookupDef g n v = (v,n,PhiDef)\<rbrakk> \<Longrightarrow> P n"
            "\<And>n m. \<lbrakk>v \<notin> defs g n; predecessors g n = [m]; m \<in> set (\<alpha>n g); lookupDef g n v = lookupDef g m v; P m\<rbrakk> \<Longrightarrow> P n"
    shows "P n"
  apply (induct rule:lookupDef.induct[where P = "\<lambda>g' n v'. g'=g \<and> v'=v \<and> n \<in> set (\<alpha>n g) \<longrightarrow> P n", of g v n, simplified (no_asm), THEN mp])
   apply clarsimp
   apply (rule_tac v=v and n=n in lookupDef_cases; auto intro: assms lookupDef_cases)
  by (rule assms(1))

  lemma lookupDef_induct'[consumes 2, case_names SimpleDef PhiDef rec]:
    assumes "n \<in> set (\<alpha>n g)" "lookupDef g n v = (v,n',def)"
            "\<lbrakk>v \<in> defs g n'; def = SimpleDef\<rbrakk> \<Longrightarrow> P n'"
            "\<lbrakk>v \<notin> defs g n'; length (predecessors g n') \<noteq> 1; def = PhiDef\<rbrakk> \<Longrightarrow> P n'"
            "\<And>n m. \<lbrakk>v \<notin> defs g n; predecessors g n = [m]; m \<in> set (\<alpha>n g); lookupDef g n v = lookupDef g m v; P m\<rbrakk> \<Longrightarrow> P n"
    shows "P n"
    using assms(1,2)
    proof (induction rule:lookupDef_induct[where v=v])
      case (SimpleDef n)
      with assms(2) have "n = n'" "def = SimpleDef" by auto
      with SimpleDef assms(3) show ?case by simp
    next
      case (PhiDef n)
      with assms(2) have "n = n'" "def = PhiDef" by auto
      with PhiDef assms(4) show ?case by simp
    qed (rule assms(5), simp_all)

  lemma lookupDef_looksup[simp]:
    assumes "lookupDef g n v = (v',n',def)" "n \<in> set (\<alpha>n g)"
    shows "v' = v"
  using assms(1) assms(2) by (induction rule:lookupDef.induct) (auto elim:lookupDefE)

  lemma lookupDef_looksup':
    assumes "(v',n',def) = lookupDef g n v" "n \<in> set (\<alpha>n g)"
    shows "v' = v"
  using assms(1)[symmetric] assms(2) by (rule lookupDef_looksup)

  lemma lookupDef_fst[simp]: "n \<in> set (\<alpha>n g) \<Longrightarrow> fst (lookupDef g n v) = v"
  by (metis fst_conv lookupDef_looksup'')

  lemma lookupDef_to_\<alpha>n:
    assumes "lookupDef g n v = (v',n',def)" "n \<in> set (\<alpha>n g)"
    shows "n' \<in> set (\<alpha>n g)"
  using assms(2,1)
  by (induction rule:lookupDef_induct[of n g v]) simp_all

  lemma lookupDef_to_\<alpha>n'[simp]:
    assumes "lookupDef g n v = val" "n \<in> set (\<alpha>n g)"
    shows "defNode val \<in> set (\<alpha>n g)"
  using assms by (cases val) (auto simp:lookupDef_to_\<alpha>n)

  lemma lookupDef_induct''[consumes 2, case_names SimpleDef PhiDef rec]:
    assumes "lookupDef g n v = val" "n \<in> set (\<alpha>n g)"
            "\<lbrakk>v \<in> defs g (defNode val); defKind val = SimpleDef\<rbrakk> \<Longrightarrow> P (defNode val)"
            "\<lbrakk>v \<notin> defs g (defNode val); length (predecessors g (defNode val)) \<noteq> 1; defKind val = PhiDef\<rbrakk> \<Longrightarrow> P (defNode val)"
            "\<And>n m. \<lbrakk>v \<notin> defs g n; predecessors g n = [m]; m \<in> set (\<alpha>n g); lookupDef g n v = lookupDef g m v; P m\<rbrakk> \<Longrightarrow> P n"
    shows "P n"
  using assms
  apply (cases val)
  apply (simp)
  apply (erule lookupDef_induct')
  using assms(2) by auto

  lemma defs'_finite: "finite (defs' g n)"
  unfolding defs'_def using defs_finite
  by simp

  lemma uses'_finite: "finite (uses' g n)"
  unfolding uses'_def using uses_finite
  by simp

  lemma defs'_uses'_disjoint: "n \<in> set (\<alpha>n g) \<Longrightarrow> defs' g n \<inter> uses' g n = {}"
  unfolding defs'_def uses'_def using defs_uses_disjoint
  by (auto dest:lookupDef_looksup')

  lemma phiDefNodes_aux_finite: "finite (phiDefNodes_aux g v un m)"
  proof (induction un arbitrary:m rule:removeAll_induct)
    case (1 un)
    thus ?case by (cases un v g m rule:phiDefNodes_aux_cases) auto
  qed

  lemma phis'_finite: "finite (dom (phis' g))"
  proof-
    let ?super = "set (\<alpha>n g) \<times> vars g \<times> set (\<alpha>n g) \<times> {PhiDef}"
    have "finite ?super" by auto
    thus ?thesis
    by - (rule finite_subset[of _ ?super], auto simp:phis'_def split:if_split_asm)
  qed

  lemma phis'_wf: "phis' g (n, v) = Some args \<Longrightarrow> length (predecessors g n) = length args"
  unfolding phis'_def predecessors_def by (auto split:prod.splits if_split_asm)

  lemma simpleDefs_phiDefs_disjoint: "n \<in> set (\<alpha>n g) \<Longrightarrow> defs' g n \<inter> {v. (n, v) \<in> dom (phis' g)} = {}"
  unfolding phis'_def defs'_def by auto

  lemma oldDefs_correct: "defs g n = var g ` defs' g n"
  by (simp add:defs'_def image_image)

  lemma oldUses_correct: "n \<in> set (\<alpha>n g) \<Longrightarrow> uses g n = var g ` uses' g n"
  by (simp add:uses'_def image_image)

  lemmas base_SSA_defs = CFG_SSA_base.CFG_SSA_defs

  sublocale braun_ssa: CFG_SSA \<alpha>e \<alpha>n invar inEdges' Entry defs' uses' phis'
  apply unfold_locales
           apply (rule defs'_uses'_disjoint, simp_all)
          apply (rule defs'_finite)
         apply (auto simp add: uses'_def uses_in_\<alpha>n)[1]
        apply (rule uses'_finite)
       apply (rule invar)
      apply (rule phis'_finite)
     apply (auto simp: phis'_def split: if_split_asm)[1]
    apply (rule phis'_wf, simp_all add: base_SSA_defs)
   apply (erule simpleDefs_phiDefs_disjoint)
  apply (erule allDefs'_disjoint, simp, simp)
  done
end

declare (in CFG) invar[rule del]
declare (in CFG) Entry_no_predecessor[simp del]
context CFG_Construct
begin
  declare invar[intro!]
  declare Entry_no_predecessor[simp]

  lemma no_disjoint_cycle[simp]:
    assumes "g \<turnstile> n-ns\<rightarrow>n" "distinct ns"
    shows "ns = [n]"
  using assms unfolding path2_def
  by (metis distinct.simps(2) hd_Cons_tl last_in_set last_tl path_not_Nil)

  lemma lookupDef_path:
    assumes "m \<in> set (\<alpha>n g)"
    obtains ns where  "g \<turnstile> lookupDefNode g m v-ns\<rightarrow>m" "(\<forall>x \<in> set (tl ns). v \<notin> defs g x)"
  apply atomize_elim
  using assms proof (induction rule:lookupDef_induct[of m g v])
    case (SimpleDef n)
    thus ?case by -(rule exI[of _ "[n]"], auto)
  next
    case (PhiDef n)
    thus ?case by -(rule exI[of _ "[n]"], auto)
  next
    case (rec m m')
    then obtain ns where "g \<turnstile> lookupDefNode g m v-ns\<rightarrow>m'" "\<forall>x \<in> set (tl ns). v \<notin> defs g x" by auto
    with rec.hyps(1,2) show ?case by - (rule exI[of _ "ns@[m]"], auto simp: path2_not_Nil)
  qed

  lemma lookupDef_path_conventional:
    assumes "g \<turnstile> n-ns\<rightarrow>m" "n = lookupDefNode g m v" "n \<notin> set (tl ns)" "x \<in> set (tl ns)" "v' \<in> braun_ssa.allDefs g x"
    shows "var g v' \<noteq> v"
  using assms(1-4) proof (induction rule:path2_rev_induct)
    case empty
    from empty.prems(3) have False by simp
    thus ?case ..
  next
    case (snoc ns m m')
    note snoc.prems(1)[simp]
    from snoc.hyps have p: "g \<turnstile> n-ns@[m']\<rightarrow>m'" by auto
    hence "m' \<in> set (\<alpha>n g)" by auto
    thus ?thesis
    proof (cases rule:lookupDef_cases'[of m' g v])
      case SimpleDef
      with snoc.prems(2,3) have False by (simp add:tl_append split:list.split_asm)
      thus ?thesis ..
    next
      case PhiDef
      with snoc.prems(2,3) have False by (simp add:tl_append split:list.split_asm)
      thus ?thesis ..
    next
      case (rec m\<^sub>2)
      from this(2) snoc.hyps(2) have[simp]: "m\<^sub>2 = m" by simp
      show ?thesis
      proof (cases "x \<in> set (tl ns)")
        case True
        with rec(4) snoc.prems(2) show ?thesis by - (rule snoc.IH, simp_all add:tl_append split:list.split_asm)
      next
        case False
        with snoc.prems(3) have[simp]: "x = m'" by (simp add:tl_append split:list.split_asm)

        show ?thesis
        proof (cases "v' \<in> defs' g x")
          case True
          with rec(1) show ?thesis by (auto simp add:defs'_def)
        next
          case False
          with assms(5) have "v' \<in> braun_ssa.phiDefs g m'" by (simp add:braun_ssa.allDefs_def)
          hence "m' \<in> phiDefNodes g (fst v')"
            unfolding braun_ssa.phiDefs_def by (auto simp add: phis'_def split:prod.split_asm if_split_asm)
          with rec(2) show ?thesis by (auto dest:phiDefNode_is_join_node)
        qed
      qed
    qed
  qed

  lemma allUse_lookupDef:
    assumes "v \<in> braun_ssa.allUses g m" "m \<in> set (\<alpha>n g)"
    shows "lookupDef g m (var g v) = v"
  proof (cases "v \<in> uses' g m")
    case True
    then obtain v' where v': "v = lookupDef g m v'" "v' \<in> uses g m" by (auto simp add:uses'_def)
    with assms(2) have "var g v = v'" unfolding var_def by (metis lookupDef_fst)
    with v' show ?thesis by simp
  next
    case False
    with assms(1) obtain  m' v' vs where "(m,v) \<in> set (zip (predecessors g m') vs)" "phis' g (m', v') = Some vs"
      by (auto simp add:braun_ssa.allUses_def elim:braun_ssa.phiUsesE)
    hence l: "v = lookupDef g m (var g v')" by (auto simp add:phis'_def split:prod.split_asm if_split_asm elim:in_set_zip_map)
    with assms(2) have "var g v = var g v'" unfolding var_def by (metis lookupDef_fst)
    with l show ?thesis by simp
  qed

  lemma phis'_fst:
    assumes "phis' g (n,v) = Some vs" "v' \<in> set vs"
    shows "var g v' = var g v"
  using assms by (auto intro!:lookupDef_fst dest!:phiDefNodes_\<alpha>n simp add:phis'_def split:prod.split_asm if_split_asm)

  lemma allUse_simpleUse:
    assumes "v \<in> braun_ssa.allUses g m" "m \<in> set (\<alpha>n g)"
    obtains ms m' where "g \<turnstile> m-ms\<rightarrow>m'" "var g v \<in> uses g m'" "\<forall>x \<in> set (tl ms). var g v \<notin> defs g x"
  proof (cases "v \<in> uses' g m")
    case True
    then obtain v' where v': "v = lookupDef g m v'" "v' \<in> uses g m" by (auto simp add:uses'_def)
    with assms(2) have "var g v = v'" unfolding var_def by (metis lookupDef_fst)
    with v' assms(2) show ?thesis by - (rule that, auto)
  next
    case False
    with assms(1) obtain  m' v' vs where phi: "(m,v) \<in> set (zip (predecessors g m') vs)" "phis' g (m', v') = Some vs"
      by (auto simp add:braun_ssa.allUses_def elim:braun_ssa.phiUsesE)
    hence m': "m' \<in> phiDefNodes g (var g v')" by (auto simp add:phis'_def split:prod.split_asm if_split_asm)
    from phi have[simp]: "var g v = var g v'" by - (rule phis'_fst, auto)
    from m' obtain m'' ms where "g \<turnstile> m'-ms\<rightarrow>m''" "\<forall>x \<in> set ms. var g v' \<notin> defs g x" "var g v' \<in> uses g m''" by (erule phiDefNodesE)
    with phi(1) show ?thesis by - (rule that[of "m#ms" m''], auto simp del:var_def)
  qed

  lemma defs': "v \<in> defs' g n \<longleftrightarrow> var g v \<in> defs g n \<and> defKind v = SimpleDef \<and> defNode v = n"
  by (cases v, auto simp add:defs'_def)

  lemma use_implies_allDef:
    assumes "lookupDef g m (var g v) = v"  "m \<in> set (\<alpha>n g)" "var g v \<in> uses g m'" "g \<turnstile> m-ms\<rightarrow>m'" "\<forall>x \<in> set (tl ms). var g v \<notin> defs g x"
    shows "v \<in> braun_ssa.allDefs g (defNode v)"
  using assms proof (induction arbitrary:ms rule:lookupDef_induct'')
      case SimpleDef
      hence "v \<in> defs' g (defNode v)" by (simp add:defs')
      thus ?case by (simp add:braun_ssa.allDefs_def)
    next
      case PhiDef
      from PhiDef.prems(1,2) have vars: "var g v \<in> vars g" by auto
      from PhiDef.hyps(1) PhiDef.prems(2,3) have "\<forall>n\<in>set ms. var g v \<notin> defs g n" by (metis hd_Cons_tl path2_def path2_not_Nil set_ConsD)
      with PhiDef have "defNode v \<in> phiDefNodes g (var g v)" by - (rule phiDefNodesI)
      with PhiDef.hyps(3) vars have "v \<in> braun_ssa.phiDefs g (defNode v)" unfolding braun_ssa.phiDefs_def by (auto simp add: phis'_def split:prod.split)
      thus ?case by (simp add:braun_ssa.allDefs_def)
    next
      case (rec n m)
      from rec.hyps(1) rec.prems(2,3) have "\<forall>n\<in>set ms. var g v \<notin> defs g n" by (metis hd_Cons_tl path2_def path2_not_Nil set_ConsD)
      with rec show ?case by - (rule rec.IH[of "m#ms"], auto)
    qed

  lemma allUse_defNode_in_\<alpha>n[simp]:
    assumes "v \<in> braun_ssa.allUses g m" "m \<in> set (\<alpha>n g)"
    shows "defNode v \<in> set (\<alpha>n g)"
  proof-
    let ?n = "defNode (lookupDef g m (var g v))"
    from assms(1,2) have l: "lookupDef g m (var g v) = v" by (rule allUse_lookupDef)
    from assms obtain ns where ns: "g \<turnstile> ?n-ns\<rightarrow>m" by - (rule lookupDef_path, auto)
    with l show ?thesis by auto
  qed

  lemma allUse_implies_allDef:
    assumes "v \<in> braun_ssa.allUses g m" "m \<in> set (\<alpha>n g)"
    shows "v \<in> braun_ssa.allDefs g (defNode v)"
  proof-
    let ?n = "defNode (lookupDef g m (var g v))"
    from assms(1,2) have l: "lookupDef g m (var g v) = v" by (rule allUse_lookupDef)
    from assms obtain ns where ns: "g \<turnstile> ?n-ns\<rightarrow>m" "\<forall>x \<in> set (tl ns). var g v \<notin> defs g x" by - (rule lookupDef_path, auto)
    from assms obtain ms m' where "g \<turnstile> m-ms\<rightarrow>m'" "var g v \<in> uses g m'" "\<forall>x \<in> set (tl ms). var g v \<notin> defs g x" by - (rule allUse_simpleUse)
    hence "v \<in> braun_ssa.allDefs g (defNode v)" using ns assms(2) l by - (rule use_implies_allDef, auto)
    with assms(2) l show ?thesis by simp
  qed

  lemma conventional:
    assumes "g \<turnstile> n-ns\<rightarrow>m" "n \<notin> set (tl ns)" "v \<in> braun_ssa.allDefs g n" "v \<in> braun_ssa.allUses g m"
      "x \<in> set (tl ns)" "v' \<in> braun_ssa.allDefs g x"
    shows "var g v' \<noteq> var g v"
  proof-
    from assms(1) have[simp]: "m \<in> set (\<alpha>n g)" by auto
    from assms(4) have[simp]: "lookupDef g m (var g v) = v" by - (rule allUse_lookupDef, auto)

    from assms(1,4) have "v \<in> braun_ssa.allDefs g (defNode v)" by - (rule allUse_implies_allDef, auto)
    with assms(1,3,4) braun_ssa.allDefs_disjoint[of n g "defNode v"] have[simp]: "defNode v = n" by - (rule braun_ssa.allDefs_disjoint', auto)

    from assms show ?thesis by - (rule lookupDef_path_conventional[where m=m], simp_all add:uses'_def del:var_def)
  qed

  lemma allDefs_var_disjoint_aux: "n \<in> set (\<alpha>n g) \<Longrightarrow> v \<in> defs g n \<Longrightarrow> n \<notin> phiDefNodes g v"
    by (auto elim!:phiDefNodesE dest:path2_hd_in_ns)

  lemma allDefs_var_disjoint: "\<lbrakk>n \<in> set (\<alpha>n g); v \<in> braun_ssa.allDefs g n; v' \<in> braun_ssa.allDefs g n; v \<noteq> v'\<rbrakk> \<Longrightarrow> var g v' \<noteq> var g v"
    unfolding braun_ssa.allDefs_def braun_ssa.phiDefs_def
    by (auto simp: defs'_def phis'_def allDefs_var_disjoint_aux split:prod.splits if_split_asm)

  lemma[simp]: "n \<in> set (\<alpha>n g) \<Longrightarrow> length (predecessors g n) \<noteq> 1 \<Longrightarrow> lookupDefNode g n v = n"
  by (cases rule:lookupDef_cases[of n g v]) simp_all

  lemma lookupDef_idem[simp]:
    assumes "n \<in> set (\<alpha>n g)"
    shows "lookupDef g (lookupDefNode g n v) v = lookupDef g n v"
  using assms by (induction rule:lookupDef_induct''[of g n v, OF refl]) (simp_all add:assms)
end

locale CFG_Construct_wf = CFG_Construct \<alpha>e \<alpha>n invar inEdges' Entry "defs" "uses" + CFG_wf \<alpha>e \<alpha>n invar inEdges' Entry "defs" "uses"
for
  \<alpha>e :: "'g \<Rightarrow> ('node::linorder \<times> 'edgeD \<times> 'node) set" and
  \<alpha>n :: "'g \<Rightarrow> 'node list" and
  invar :: "'g \<Rightarrow> bool" and
  inEdges' :: "'g \<Rightarrow> 'node \<Rightarrow> ('node \<times> 'edgeD) list" and
  Entry::"'g \<Rightarrow> 'node" and
  "defs" :: "'g \<Rightarrow> 'node \<Rightarrow> 'var::linorder set" and
  "uses" :: "'g \<Rightarrow> 'node \<Rightarrow> 'var set"
begin
  lemma def_ass_allUses_aux:
    assumes "g \<turnstile> Entry g-ns\<rightarrow>n"
    shows "lookupDefNode g n (var g v) \<in> set ns"
  proof-
    from assms have[simp]: "n \<in> set (\<alpha>n g)" by auto
    thus ?thesis using assms
    proof (induction arbitrary:ns rule:lookupDef_induct''[of g n "var g v", OF refl, consumes 1])
      case (3 m m' ns)
      show ?case
      proof (cases "length ns \<ge> 2")
        case False
        with "3.prems" have "m = Entry g" by (metis path2_nontrivial)
        with "3.hyps"(2) have False by simp
        thus ?thesis ..
      next
        case True
        with "3.prems" have "g \<turnstile> Entry g-butlast ns\<rightarrow>m'"
        by (rule path2_unsnoc) (simp add:"3.hyps"(2))
        with "3.hyps" "3.IH"[of "butlast ns"] show ?thesis by (simp add:in_set_butlastD)
      qed
    qed auto
  qed

  lemma def_ass_allUses:
    assumes "v \<in> braun_ssa.allUses g n" "n \<in> set (\<alpha>n g)"
    shows "braun_ssa.defAss g n v"
  proof (rule braun_ssa.defAssI)
    fix ns
    assume asm: "g \<turnstile> Entry g-ns\<rightarrow>n"
    let ?m = "lookupDefNode g n (var g v)"
    from asm have "?m \<in> set ns" by (rule def_ass_allUses_aux)
    moreover from assms allUse_lookupDef have "?m = defNode v" by simp
    moreover from assms allUse_implies_allDef have "v \<in> braun_ssa.allDefs g (defNode v)" by simp
    ultimately show "\<exists>n\<in>set ns. v \<in> braun_ssa.allDefs g n" by auto
  qed

  lemma Empty_no_phis:
    shows "phis' g (Entry g, v) = None"
  proof-
    have "\<And>v. Entry g \<notin> phiDefNodes g v"
    proof (rule, rule phiDefNodesE, assumption)
      fix v ns m
      assume asm: "g \<turnstile> Entry g-ns\<rightarrow>m" "\<forall>n\<in>set ns. v \<notin> defs g n" "v \<in> uses g m"
      hence "m \<in> set (\<alpha>n g)" by auto
      from def_ass_uses[of g, THEN bspec[OF _ this], THEN bspec[OF _ asm(3)]] asm
      show False by (auto elim!:defAss'E)
    qed
    thus ?thesis by (auto simp:phis'_def split:prod.split)
  qed

  lemma braun_ssa_CFG_SSA_wf:
    "CFG_SSA_wf \<alpha>e \<alpha>n invar inEdges' Entry defs' uses' phis'"
  apply unfold_locales
   apply (erule def_ass_allUses, assumption)
  apply (rule Empty_no_phis)
  done

  sublocale braun_ssa: CFG_SSA_wf \<alpha>e \<alpha>n invar inEdges' Entry defs' uses' phis'
  by (rule braun_ssa_CFG_SSA_wf)

  lemma braun_ssa_CFG_SSA_Transformed:
    "CFG_SSA_Transformed \<alpha>e \<alpha>n invar inEdges' Entry defs uses defs' uses' phis' var"
  apply unfold_locales
      apply (rule oldDefs_correct)
     apply (erule oldUses_correct)
    apply (erule conventional, simp, simp, simp, simp, simp)
   apply (erule phis'_fst, simp)
  apply (erule allDefs_var_disjoint, simp, simp, simp)
  done

  sublocale braun_ssa: CFG_SSA_Transformed \<alpha>e \<alpha>n invar inEdges' Entry "defs" "uses" defs' uses' phis' var
  by (rule braun_ssa_CFG_SSA_Transformed)

  lemma PhiDef_defNode_eq:
    assumes "n \<in> set (\<alpha>n g)" "n \<in> phiDefNodes g v" "v \<in> vars g"
    shows "braun_ssa.defNode g (v,n,PhiDef) = n"
  using assms by - (rule braun_ssa.defNode_eq, rule assms(1), subst braun_ssa.allDefs_def, subst braun_ssa.phiDefs_def, auto simp: phis'_def)

  lemma phiDefNodes_aux_pruned_aux:
    assumes "n \<in> phiDefNodes_aux g v (\<alpha>n g) nUse" "v \<in> uses g nUse" "g \<turnstile> n-ns\<rightarrow>m" "g \<turnstile>m-ms\<rightarrow>nUse" "braun_ssa.liveVal g (lookupDef g m v)" "\<forall>n \<in> set (ns@ms). v \<notin> defs g n"
    shows "braun_ssa.liveVal g (v,n,PhiDef)"
  using assms(3-) proof (induction n ns m arbitrary:ms rule:path2_rev_induct)
    case empty
    with assms(1) have "lookupDef g n v = (v,n,PhiDef)"
      by -(drule phiDefNode_aux_is_join_node, cases rule:lookupDef_cases, auto)
    with empty.prems(2) show ?case by simp
  next
    case (snoc ns m m')
    from snoc.prems have "m' \<in> set (\<alpha>n g)" by auto
    thus ?case
    proof (cases rule:lookupDef_cases[where v=v])
      case SimpleDef
      with snoc.prems(3) have False by simp
      thus ?thesis..
    next
      have step: "braun_ssa.liveVal g (lookupDef g m v) \<Longrightarrow> ?thesis"
      proof (rule snoc.IH)
        from snoc.prems(1) snoc.hyps(2) show "g \<turnstile> m-m#ms\<rightarrow>nUse" by auto
        from snoc.prems(3) snoc.hyps(1) show "\<forall>n\<in> set(ns @ m # ms). v \<notin> defs g n" by auto
      qed
      {
        case rec
        from snoc.hyps(2) rec(2) have[simp]: "predecessors g m' = [m]" by auto
        with rec snoc.prems(2) have "braun_ssa.liveVal g (lookupDef g m v)" by auto
        with step show ?thesis.
      next
        case PhiDef
        with snoc assms(2) have phiDefNode: "m' \<in> phiDefNodes g v" by -(rule phiDefNodesI, auto)
        from assms(2,4) have vars: "v \<in> vars g" by auto
        have "braun_ssa.liveVal g (lookupDef g m v)"
        proof (rule braun_ssa.livePhi)
          from PhiDef(3) snoc.prems(2) show "braun_ssa.liveVal g (v,m',PhiDef)" by simp
          from phiDefNode snoc.hyps(2) vars show "braun_ssa.phiArg g (v,m',PhiDef) (lookupDef g m v)"
            by (subst braun_ssa.phiArg_def, subst braun_ssa.phi_def, subst PhiDef_defNode_eq, auto simp: phis'_def)
        qed
        thus ?thesis by (rule step)
      }
    qed
  qed

  lemma phiDefNodes_aux_pruned:
    assumes "m \<in> phiDefNodes_aux g v (\<alpha>n g) n" "n \<in> set (\<alpha>n g)" "v \<in> uses g n"
    shows "braun_ssa.liveVal g (v, m, PhiDef)"
  proof-
    from assms(1,2) obtain ns where ns: "g \<turnstile> m-ns\<rightarrow>n" "\<forall>n \<in> set ns. v \<notin> defs g n" by (rule phiDefNodes_auxE)
    hence "v \<notin> defs g n" by (auto dest:path2_last simp: path2_not_Nil)
    with ns assms(1,3) show ?thesis
    apply-
    proof (rule phiDefNodes_aux_pruned_aux)
      from assms(2,3) show "braun_ssa.liveVal g (lookupDef g n v)" by -(rule braun_ssa.liveSimple, auto simp add:uses'_def)
    qed auto
  qed

  theorem phis'_pruned: "braun_ssa.pruned g"
  unfolding braun_ssa.pruned_def braun_ssa.phiDefs_def
  apply (subst phis'_def)
  by (auto split:prod.splits if_split_asm simp add:phiDefNodes_def elim!:fold_union_elem phiDefNodes_aux_pruned)

  declare var_def[simp del]

  declare no_disjoint_cycle [simp del]
  declare lookupDef_looksup [simp del]

  declare lookupDef.simps [code]
  declare phiDefNodes_aux.simps [code]
  declare phiDefNodes_def [code]
  declare defs'_def [code]
  declare uses'_def [code]
  declare phis'_def [code]
  declare predecessors_def [code]
end

end


section {* Basic Parametricity Reasoning *}
theory Param_Tool
imports "Relators"
begin

  subsection {* Auxiliary Lemmas *}
  lemma tag_both: "\<lbrakk> (Let x f,Let x' f')\<in>R \<rbrakk> \<Longrightarrow> (f x,f' x')\<in>R" by simp
  lemma tag_rhs: "\<lbrakk> (c,Let x f)\<in>R \<rbrakk> \<Longrightarrow> (c,f x)\<in>R" by simp
  lemma tag_lhs: "\<lbrakk> (Let x f,a)\<in>R \<rbrakk> \<Longrightarrow> (f x,a)\<in>R" by simp

  lemma tagged_fun_relD_both:
    "\<lbrakk> (f,f')\<in>A\<rightarrow>B; (x,x')\<in>A \<rbrakk> \<Longrightarrow> (Let x f,Let x' f')\<in>B"
    and tagged_fun_relD_rhs: "\<lbrakk> (f,f')\<in>A\<rightarrow>B; (x,x')\<in>A \<rbrakk> \<Longrightarrow> (f x,Let x' f')\<in>B"
    and tagged_fun_relD_lhs: "\<lbrakk> (f,f')\<in>A\<rightarrow>B; (x,x')\<in>A \<rbrakk> \<Longrightarrow> (Let x f,f' x')\<in>B"
    and tagged_fun_relD_none: "\<lbrakk> (f,f')\<in>A\<rightarrow>B; (x,x')\<in>A \<rbrakk> \<Longrightarrow> (f x,f' x')\<in>B"
    by (simp_all add: fun_relD)

  subsection {* ML-Setup*}

  ML {*
    signature PARAMETRICITY = sig
      type param_ruleT = {
        lhs: term,
        rhs: term,
        R: term,
        rhs_head: term,
        arity: int
      }

      val dest_param_term: term -> param_ruleT
      val dest_param_rule: thm -> param_ruleT
      val dest_param_goal: int -> thm -> param_ruleT

      val safe_fun_relD_tac: Proof.context -> tactic'

      val adjust_arity: int -> thm -> thm
      val adjust_arity_tac: int -> Proof.context -> tactic'
      val unlambda_tac: Proof.context -> tactic'
      val prepare_tac: Proof.context -> tactic'

      val fo_rule: thm -> thm

      (*** Basic tactics ***)
      val param_rule_tac: Proof.context -> thm -> tactic'
      val param_rules_tac: Proof.context -> thm list -> tactic'
      val asm_param_tac: Proof.context -> tactic'

      (*** Nets of parametricity rules ***)
      type param_net
      val net_empty: param_net
      val net_add: thm -> param_net -> param_net
      val net_del: thm -> param_net -> param_net
      val net_add_int: Context.generic -> thm -> param_net -> param_net
      val net_del_int: Context.generic -> thm -> param_net -> param_net
      val net_tac: param_net -> Proof.context -> tactic'

      (*** Default parametricity rules ***)
      val add_dflt: thm -> Context.generic -> Context.generic
      val add_dflt_attr: attribute
      val del_dflt: thm -> Context.generic -> Context.generic
      val del_dflt_attr: attribute
      val get_dflt: Proof.context -> param_net

      (** Configuration **)
      val cfg_use_asm: bool Config.T
      val cfg_single_step: bool Config.T

      (** Setup **)
      val setup: theory -> theory
    end

    structure Parametricity : PARAMETRICITY = struct
      type param_ruleT = {
        lhs: term,
        rhs: term,
        R: term,
        rhs_head: term,
        arity: int
      }

      fun dest_param_term t =
        case
          strip_all_body t |> Logic.strip_imp_concl |> HOLogic.dest_Trueprop
        of
          @{mpat "(?lhs,?rhs):?R"} => let
            val (rhs_head,arity) =
              case strip_comb rhs of
                (c as Const _,l) => (c,length l)
              | (c as Free _,l) => (c,length l)
              | (c as Abs _,l) => (c,length l)
              | _ => raise TERM ("dest_param_term: Head",[t])
          in
            { lhs = lhs, rhs = rhs, R=R, rhs_head = rhs_head, arity = arity }
          end
        | t => raise TERM ("dest_param_term: Expected (_,_):_",[t])

      val dest_param_rule = dest_param_term o Thm.prop_of
      fun dest_param_goal i st =
        if i > Thm.nprems_of st then
          raise THM ("dest_param_goal",i,[st])
        else
          dest_param_term (Logic.concl_of_goal (Thm.prop_of st) i)

      fun safe_fun_relD_tac ctxt = let
        fun t a b = fo_resolve_tac [a] ctxt THEN' resolve_tac ctxt [b]
      in
        DETERM o (
          t @{thm tag_both} @{thm tagged_fun_relD_both} ORELSE'
          t @{thm tag_rhs} @{thm tagged_fun_relD_rhs} ORELSE'
          t @{thm tag_lhs} @{thm tagged_fun_relD_lhs} ORELSE'
          resolve_tac ctxt @{thms tagged_fun_relD_none}
        )
      end

      fun adjust_arity i thm =
        if i = 0 then thm
        else if i<0 then funpow (~i) (fn thm => thm RS @{thm fun_relI}) thm
        else funpow i (fn thm => thm RS @{thm fun_relD}) thm

      fun NTIMES k tac =
        if k <= 0 then K all_tac
        else tac THEN' NTIMES (k-1) tac

      fun adjust_arity_tac n ctxt i st =
        (if n = 0 then K all_tac
        else if n>0 then NTIMES n (DETERM o resolve_tac ctxt @{thms fun_relI})
        else NTIMES (~n) (safe_fun_relD_tac ctxt)) i st

      fun unlambda_tac ctxt i st =
        case try (dest_param_goal i) st of
          NONE => Seq.empty
        | SOME g => let
            val n = Term.strip_abs (#rhs_head g) |> #1 |> length
          in NTIMES n (resolve_tac ctxt @{thms fun_relI}) i st end

      fun prepare_tac ctxt =
        Subgoal.FOCUS (K (PRIMITIVE (Drule.eta_contraction_rule))) ctxt
        THEN' unlambda_tac ctxt

      fun could_param_rl rl i st =
        if i > Thm.nprems_of st then NONE
        else (
          case (try (dest_param_goal i) st, try dest_param_term rl) of
            (SOME g, SOME r) =>
              if Term.could_unify (#rhs_head g, #rhs_head r) then
                SOME (#arity r - #arity g)
              else NONE
          | _ => NONE
        )

      fun param_rule_tac_aux ctxt rl i st =
        case could_param_rl (Thm.prop_of rl) i st of
          SOME adj => (adjust_arity_tac adj ctxt THEN' resolve_tac ctxt [rl]) i st
        | _ => Seq.empty

      fun param_rule_tac ctxt rl =
        prepare_tac ctxt THEN' param_rule_tac_aux ctxt rl

      fun param_rules_tac ctxt rls =
        prepare_tac ctxt THEN' FIRST' (map (param_rule_tac_aux ctxt) rls)

      fun asm_param_tac_aux ctxt i st =
        if i > Thm.nprems_of st then Seq.empty
        else let
          val prems = Logic.prems_of_goal (Thm.prop_of st) i |> tag_list 1

          fun tac (n,t) i st = case could_param_rl t i st of
            SOME adj => (adjust_arity_tac adj ctxt THEN' rprem_tac n ctxt) i st
          | NONE => Seq.empty
        in
          FIRST' (map tac prems) i st
        end

      fun asm_param_tac ctxt = prepare_tac ctxt THEN' asm_param_tac_aux ctxt

      type param_net = (param_ruleT * thm) Item_Net.T

      local
        val param_get_key = single o #rhs_head o #1
      in
        val net_empty = Item_Net.init (Thm.eq_thm o apply2 #2) param_get_key
      end

      fun wrap_pr_op f context thm = case try (`dest_param_rule) thm of
        NONE =>
          let
            val msg = "Ignoring invalid parametricity theorem: "
              ^ Thm.string_of_thm (Context.proof_of context) thm
            val _ = warning msg
          in I end
      | SOME p => f p

      val net_add_int = wrap_pr_op Item_Net.update
      val net_del_int = wrap_pr_op Item_Net.remove

      val net_add = Item_Net.update o `dest_param_rule
      val net_del = Item_Net.remove o `dest_param_rule

      fun net_tac_aux net ctxt i st =
        if i > Thm.nprems_of st then
          Seq.empty
        else
          let
            val g = dest_param_goal i st
            val rls = Item_Net.retrieve net (#rhs_head g)

            fun tac (r,thm) =
              adjust_arity_tac (#arity r - #arity g) ctxt
              THEN' DETERM o resolve_tac ctxt [thm]
          in
            FIRST' (map tac rls) i st
          end

      fun net_tac net ctxt = prepare_tac ctxt THEN' net_tac_aux net ctxt

      structure dflt_rules = Generic_Data (
        type T = param_net
        val empty = net_empty
        val extend = I
        val merge = Item_Net.merge
      )

      fun add_dflt thm context = dflt_rules.map (net_add_int context thm) context
      fun del_dflt thm context = dflt_rules.map (net_del_int context thm) context
      val add_dflt_attr = Thm.declaration_attribute add_dflt
      val del_dflt_attr = Thm.declaration_attribute del_dflt

      val get_dflt = dflt_rules.get o Context.Proof

      val cfg_use_asm =
        Attrib.setup_config_bool @{binding param_use_asm} (K true)
      val cfg_single_step =
        Attrib.setup_config_bool @{binding param_single_step} (K false)

      local
        open Refine_Util

        val param_modifiers =
          [Args.add -- Args.colon >> K (Method.modifier add_dflt_attr @{here}),
           Args.del -- Args.colon >> K (Method.modifier del_dflt_attr @{here}),
           Args.$$$ "only" -- Args.colon >>
            K {init = Context.proof_map (dflt_rules.map (K net_empty)),
                attribute = add_dflt_attr, pos = @{here}}]

        val param_flags =
           parse_bool_config "use_asm" cfg_use_asm
        || parse_bool_config "single_step" cfg_single_step

      in

        val parametricity_method =
          parse_paren_lists param_flags |-- Method.sections param_modifiers >>
          (fn _ => fn ctxt =>
            let
              val net2 = get_dflt ctxt
              val asm_tac =
                if Config.get ctxt cfg_use_asm then
                  asm_param_tac ctxt
                else K no_tac

              val RPT =
                if Config.get ctxt cfg_single_step then I
                else REPEAT_ALL_NEW_FWD

            in
              SIMPLE_METHOD' (
                RPT (
                  (assume_tac ctxt
                    ORELSE' net_tac net2 ctxt
                    ORELSE' asm_tac)
                )
              )
            end
          )
      end

      fun fo_rule thm = case Thm.concl_of thm of
            @{mpat "Trueprop ((_,_)\<in>_\<rightarrow>_)"} => fo_rule (thm RS @{thm fun_relD})
          | _ => thm

      val param_fo_attr = Scan.succeed (Thm.rule_attribute [] (K fo_rule))

      val setup = I
        #> Attrib.setup @{binding param}
            (Attrib.add_del add_dflt_attr del_dflt_attr)
            "declaration of parametricity theorem"
        #> Global_Theory.add_thms_dynamic (@{binding param},
             map #2 o Item_Net.content o dflt_rules.get)
        #> Method.setup @{binding parametricity} parametricity_method
             "Parametricity solver"
        #> Attrib.setup @{binding param_fo} param_fo_attr
             "Parametricity: Rule in first-order form"

    end
    *}

  setup Parametricity.setup

  subsection \<open>Convenience Tools\<close>

  ML {*
    (* Prefix p_ or wrong type supresses generation of relAPP *)

    fun cnv_relAPP t = let
      fun consider (Var ((name,_),T)) =
        if String.isPrefix "p_" name then false
        else (
          case T of
            Type(@{type_name set},[Type(@{type_name prod},_)]) => true
          | _ => false)
      | consider _ = true

      fun strip_rcomb u : term * term list =
        let
          fun stripc (x as (f$t, ts)) =
            if consider t then stripc (f, t::ts) else x
          | stripc  x =  x
        in  stripc(u,[])  end;

      val (f,a) = strip_rcomb t
    in
      Relators.list_relAPP a f
    end

    fun to_relAPP_conv ctxt = Refine_Util.f_tac_conv ctxt
      cnv_relAPP
      (ALLGOALS (simp_tac
        (put_simpset HOL_basic_ss ctxt addsimps @{thms relAPP_def})))

    val to_relAPP_attr = Thm.rule_attribute [] (fn context => let
      val ctxt = Context.proof_of context
    in
      Conv.fconv_rule (Conv.arg1_conv (to_relAPP_conv ctxt))
    end)
  *}

  attribute_setup to_relAPP = {* Scan.succeed (to_relAPP_attr) *}
    "Convert relator definition to prefix-form"

end


theory Prelude_ListNoNumbers
imports "$HETS_LIB/Isabelle/MainHC"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"Comp1\", \"IdDef\", \"FlipDef\", \"FstDef\", \"SndDef\",
     \"CurryDef\", \"UncurryDef\", \"NotFalse\", \"NotTrue\",
     \"AndFalse\", \"AndTrue\", \"AndSym\", \"OrDef\", \"OtherwiseDef\",
     \"NotFalse1\", \"NotTrue1\", \"notNot1\", \"notNot2\",
     \"EqualTDef\", \"EqualSymDef\", \"EqualReflex\", \"EqualTransT\",
     \"DiffDef\", \"DiffSymDef\", \"DiffTDef\", \"DiffFDef\", \"TE1\",
     \"TE2\", \"TE3\", \"TE4\", \"IBE1\", \"IBE2\", \"IBE3\", \"IBE4\",
     \"IBE5\", \"IBE6\", \"IBE7\", \"IBE8\", \"IUE1\", \"IUE2\",
     \"IOE01\", \"IOE02\", \"IOE03\", \"IOE04\", \"IOE05\", \"IOE06\",
     \"IOE07\", \"IOE08\", \"IOE09\", \"LeIrreflexivity\",
     \"LeTAsymmetry\", \"LeTTransitive\", \"LeTTotal\", \"GeDef\",
     \"GeIrreflexivity\", \"GeTAsymmetry\", \"GeTTransitive\",
     \"GeTTotal\", \"LeqDef\", \"LeqReflexivity\", \"LeqTTransitive\",
     \"LeqTTotal\", \"GeqDef\", \"GeqReflexivity\", \"GeqTTransitive\",
     \"GeqTTotal\", \"EqTSOrdRel\", \"EqFSOrdRel\", \"EqTOrdRel\",
     \"EqFOrdRel\", \"EqTOrdTSubstE\", \"EqTOrdFSubstE\",
     \"EqTOrdTSubstD\", \"EqTOrdFSubstD\", \"LeTGeFEqFRel\",
     \"LeFGeTEqTRel\", \"LeTGeTRel\", \"LeFGeFRel\", \"LeqTGetTRel\",
     \"LeqFGetFRel\", \"GeTLeTRel\", \"GeFLeFRel\", \"GeqTLeqTRel\",
     \"GeqFLeqFRel\", \"LeqTGeFRel\", \"LeqFGeTRel\", \"GeTLeFEqFRel\",
     \"GeFLeTEqTRel\", \"GeqTLeFRel\", \"GeqFLeTRel\",
     \"LeqTLeTEqTRel\", \"LeqFLeFEqFRel\", \"GeqTGeTEqTRel\",
     \"GeqFGeFEqFRel\", \"LeTGeqFRel\", \"GeTLeqFRel\", \"LeLeqDiff\",
     \"CmpLTDef\", \"CmpEQDef\", \"CmpGTDef\", \"MaxYDef\", \"MaxXDef\",
     \"MinXDef\", \"MinYDef\", \"MaxSym\", \"MinSym\", \"TO1\", \"TO2\",
     \"TO3\", \"TO4\", \"TO5\", \"TO6\", \"TO7\", \"IOO13\", \"IOO14\",
     \"IOO15\", \"IOO16\", \"IOO17\", \"IOO18\", \"IOO19\", \"IOO20\",
     \"IOO21\", \"IOO22\", \"IOO23\", \"IOO24\", \"IOO25\", \"IOO26\",
     \"IOO27\", \"IOO28\", \"IOO29\", \"IOO30\", \"IOO31\", \"IOO32\",
     \"IOO33\", \"IBO5\", \"IBO6\", \"IBO7\", \"IBO8\", \"IBO9\",
     \"IBO10\", \"IBO11\", \"IBO12\", \"IUO01\", \"IUO02\", \"IUO03\",
     \"IUO04\", \"IUO05\", \"IUO06\", \"IUO07\", \"NotDefHead\",
     \"HeadDef\", \"NotDefTail\", \"TailDef\", \"FoldrNil\",
     \"FoldrCons\", \"FoldlNil\", \"FoldlCons\", \"MapNil\",
     \"MapCons\", \"XPlusXPlusNil\", \"XPlusXPlusCons\", \"FilterNil\",
     \"FilterConsT\", \"FilterConsF\", \"ZipNil\", \"ZipConsNil\",
     \"ZipConsCons\", \"UnzipNil\", \"UnzipCons\", \"ILE01\", \"ILE02\",
     \"ILO01\", \"ILO02\", \"ILO03\", \"ILO04\", \"ILO05\", \"ILO06\",
     \"ILO07\", \"ILO08\", \"ILO09\", \"ILO10\", \"ILO11\", \"ILO12\",
     \"ILO13\", \"ILO14\", \"ILO15\", \"ILO16\", \"ILO17\", \"ILO18\",
     \"ILO19\", \"ILO20\", \"ILO21\", \"ILO22\", \"FoldlDecomp\",
     \"MapDecomp\", \"MapFunctor\", \"FilterProm\", \"InitNil\",
     \"InitConsNil\", \"InitConsCons\", \"LastNil\", \"LastConsNil\",
     \"LastConsCons\", \"NullNil\", \"NullCons\", \"ReverseNil\",
     \"ReverseCons\", \"Foldr1Nil\", \"Foldr1ConsNil\",
     \"Foldr1ConsCons\", \"Foldl1Nil\", \"Foldl1ConsNil\",
     \"Foldl1ConsCons\", \"ScanlNil\", \"ScanlCons\", \"Scanl1Nil\",
     \"Scanl1Cons\", \"ScanrNil\", \"ScanrCons\", \"Scanr1Nil\",
     \"Scanr1ConsNil\", \"Scanr1ConsCons\", \"ScanlProperty\",
     \"ScanrProperty\", \"AndLNil\", \"AndLCons\", \"OrLNil\",
     \"OrLCons\", \"AnyDef\", \"AllDef\", \"ConcatDef\",
     \"ConcatMapDef\", \"MaximunNil\", \"MaximumDef\", \"MinimunNil\",
     \"MinimumDef\", \"TakeWhileNil\", \"TakeWhileConsT\",
     \"TakeWhileConsF\", \"DropWhileNil\", \"DropWhileConsT\",
     \"DropWhileConsF\", \"SpanNil\", \"SpanConsT\", \"SpanConsF\",
     \"SpanThm\", \"BreakDef\", \"BreakThm\", \"InsertNil\",
     \"InsertCons1\", \"InsertCons2\", \"DeleteNil\", \"DeleteConsT\",
     \"DeleteConsF\", \"SelectT\", \"SelectF\", \"Partition\",
     \"PartitionProp\"]"

typedecl Unit

datatype Bool = X_False ("False''") | X_True ("True''")
datatype Ordering = EQ | GT | LT
datatype 'a List = X_Cons 'a "'a List" | X_Nil ("Nil''")

consts
Not__X :: "Bool => Bool" ("(Not''/ _)" [56] 56)
X__XAmpXAmp__X :: "Bool => Bool => Bool" ("(_/ &&/ _)" [54,54] 52)
X__XEqXEq__X :: "'a => 'a => Bool" ("(_/ ==''/ _)" [54,54] 52)
X__XGtXEq__X :: "'a => 'a => Bool" ("(_/ >=''/ _)" [54,54] 52)
X__XGt__X :: "'a => 'a => Bool" ("(_/ >''/ _)" [54,54] 52)
X__XLtXEq__X :: "'a => 'a => Bool" ("(_/ <=''/ _)" [54,54] 52)
X__XLt__X :: "'a => 'a => Bool" ("(_/ <''/ _)" [54,54] 52)
X__XPlusXPlus__X :: "'a List => 'a List => 'a List" ("(_/ ++''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a => 'a => Bool" ("(_/ '/=/ _)" [54,54] 52)
X__XVBarXVBar__X :: "Bool => Bool => Bool" ("(_/ ||/ _)" [54,54] 52)
X__o__X :: "('b => 'c) * ('a => 'b) => 'a => 'c"
X_all :: "('a => Bool) => 'a List => Bool"
X_andL :: "Bool List => Bool" ("andL/'(_')" [3] 999)
X_any :: "('a => Bool) => 'a List => Bool"
X_concat :: "'a List List => 'a List" ("concat''/'(_')" [3] 999)
X_curry :: "('a * 'b => 'c) => 'a => 'b => 'c"
X_dropWhile :: "('a => Bool) => 'a List => 'a List"
X_filter :: "('a => Bool) => 'a List => 'a List"
X_flip :: "('a => 'b => 'c) => 'b => 'a => 'c"
X_foldl :: "('a => 'b => 'a) => 'a => 'b List => 'a"
X_foldr :: "('a => 'b => 'b) => 'b => 'a List => 'b"
X_fst :: "'a => 'b => 'a" ("fst''/'(_,/ _')" [3,3] 999)
X_head :: "'a List => 'a partial" ("head/'(_')" [3] 999)
X_id :: "'a => 'a" ("id''/'(_')" [3] 999)
X_init :: "'a List => 'a List partial" ("init/'(_')" [3] 999)
X_insert :: "'d => 'd List => 'd List"
X_last :: "'a List => 'a partial" ("last''/'(_')" [3] 999)
X_map :: "('a => 'b) => 'a List => 'b List"
X_max :: "'a => 'a => 'a"
X_maximum :: "'d List => 'd partial" ("maximum/'(_')" [3] 999)
X_min :: "'a => 'a => 'a"
X_minimum :: "'d List => 'd partial" ("minimum/'(_')" [3] 999)
X_null :: "'a List => Bool" ("null''/'(_')" [3] 999)
X_orL :: "Bool List => Bool" ("orL/'(_')" [3] 999)
X_reverse :: "'a List => 'a List" ("reverse/'(_')" [3] 999)
X_snd :: "'a => 'b => 'b" ("snd''/'(_,/ _')" [3,3] 999)
X_tail :: "'a List => 'a List partial" ("tail/'(_')" [3] 999)
X_takeWhile :: "('a => Bool) => 'a List => 'a List"
X_unzip :: "('a * 'b) List => 'a List * 'b List" ("unzip/'(_')" [3] 999)
X_zip :: "'a List => 'b List => ('a * 'b) List"
break :: "('a => Bool) => 'a List => 'a List * 'a List"
compare :: "'a => 'a => Ordering"
concatMap :: "('a => 'b List) => 'a List => 'b List"
delete :: "'e => 'e List => 'e List"
foldl1 :: "('a => 'a => 'a) => 'a List => 'a partial"
foldr1 :: "('a => 'a => 'a) => 'a List => 'a partial"
otherwiseH :: "Bool"
partition :: "('a => Bool) => 'a List => 'a List * 'a List"
scanl :: "('a => 'b => 'a) => 'a => 'b List => 'a List"
scanl1 :: "('a => 'a => 'a) => 'a List => 'a List"
scanr :: "('a => 'b => 'b) => 'b => 'a List => 'b List"
scanr1 :: "('a => 'a => 'a) => 'a List => 'a List"
select :: "('a => Bool) => 'a => 'a List * 'a List => 'a List * 'a List"
span :: "('a => Bool) => 'a List => 'a List * 'a List"
uncurry :: "('a => 'b => 'c) => 'a * 'b => 'c"

axioms
Comp1 [rule_format] :
"ALL f. ALL g. ALL y. X__o__X (f, g) y = f (g y)"

IdDef [rule_format] : "ALL x. id'(x) = x"

FlipDef [rule_format] : "ALL f. ALL x. ALL y. X_flip f y x = f x y"

FstDef [rule_format] : "ALL x. ALL y. fst'(x, y) = x"

SndDef [rule_format] : "ALL x. ALL y. snd'(x, y) = y"

CurryDef [rule_format] :
"ALL g. ALL x. ALL y. X_curry g x y = g (x, y)"

UncurryDef [rule_format] :
"ALL f. ALL x. ALL y. uncurry f (x, y) = f x y"

NotFalse [rule_format] : "Not' False' = True'"

NotTrue [rule_format] : "Not' True' = False'"

AndFalse [rule_format] : "ALL x. False' && x = False'"

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

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

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

OtherwiseDef [rule_format] : "otherwiseH = True'"

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

NotTrue1 [rule_format] : "ALL x. Not' x = False' = (x = True')"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

IBE1 [rule_format] : "True' ==' True' = True'"

IBE2 [rule_format] : "False' ==' False' = True'"

IBE3 [rule_format] : "False' ==' True' = False'"

IBE4 [rule_format] : "True' ==' False' = False'"

IBE5 [rule_format] : "True' /= False' = True'"

IBE6 [rule_format] : "False' /= True' = True'"

IBE7 [rule_format] : "Not' (True' ==' False') = True'"

IBE8 [rule_format] : "Not' Not' (True' ==' False') = False'"

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

IUE2 [rule_format] : "() /= () = False'"

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

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

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

IOE04 [rule_format] : "LT ==' EQ = False'"

IOE05 [rule_format] : "LT ==' GT = False'"

IOE06 [rule_format] : "EQ ==' GT = False'"

IOE07 [rule_format] : "LT /= EQ = True'"

IOE08 [rule_format] : "LT /= GT = True'"

IOE09 [rule_format] : "EQ /= GT = True'"

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

LeTAsymmetry [rule_format] :
"ALL x. ALL y. x <' y = True' --> y <' x = False'"

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

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

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

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

GeTAsymmetry [rule_format] :
"ALL x. ALL y. x >' y = True' --> y >' x = False'"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

IOO13 [rule_format] : "LT <' EQ = True'"

IOO14 [rule_format] : "EQ <' GT = True'"

IOO15 [rule_format] : "LT <' GT = True'"

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

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

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

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

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

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

IOO22 [rule_format] : "EQ >' LT = True'"

IOO23 [rule_format] : "GT >' EQ = True'"

IOO24 [rule_format] : "GT >' LT = True'"

IOO25 [rule_format] : "X_max LT EQ ==' EQ = True'"

IOO26 [rule_format] : "X_max EQ GT ==' GT = True'"

IOO27 [rule_format] : "X_max LT GT ==' GT = True'"

IOO28 [rule_format] : "X_min LT EQ ==' LT = True'"

IOO29 [rule_format] : "X_min EQ GT ==' EQ = True'"

IOO30 [rule_format] : "X_min LT GT ==' LT = True'"

IOO31 [rule_format] : "compare LT LT ==' EQ = True'"

IOO32 [rule_format] : "compare EQ EQ ==' EQ = True'"

IOO33 [rule_format] : "compare GT GT ==' EQ = True'"

IBO5 [rule_format] : "False' <' True' = True'"

IBO6 [rule_format] : "False' >=' True' = False'"

IBO7 [rule_format] : "True' >=' False' = True'"

IBO8 [rule_format] : "True' <' False' = False'"

IBO9 [rule_format] : "X_max False' True' ==' True' = True'"

IBO10 [rule_format] : "X_min False' True' ==' False' = True'"

IBO11 [rule_format] : "compare True' True' ==' EQ = True'"

IBO12 [rule_format] : "compare False' False' ==' EQ = True'"

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

IUO02 [rule_format] : "() <' () = False'"

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

IUO04 [rule_format] : "() >' () = False'"

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

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

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

NotDefHead [rule_format] : "~ defOp (head(Nil'))"

HeadDef [rule_format] :
"ALL x. ALL xs. head(X_Cons x xs) = makePartial x"

NotDefTail [rule_format] : "~ defOp (tail(Nil'))"

TailDef [rule_format] :
"ALL x. ALL xs. tail(X_Cons x xs) = makePartial xs"

FoldrNil [rule_format] : "ALL f. ALL s. X_foldr f s Nil' = s"

FoldrCons [rule_format] :
"ALL f.
 ALL s.
 ALL x. ALL xs. X_foldr f s (X_Cons x xs) = f x (X_foldr f s xs)"

FoldlNil [rule_format] : "ALL g. ALL t. X_foldl g t Nil' = t"

FoldlCons [rule_format] :
"ALL g.
 ALL t.
 ALL z. ALL zs. X_foldl g t (X_Cons z zs) = X_foldl g (g t z) zs"

MapNil [rule_format] : "ALL h. X_map h Nil' = Nil'"

MapCons [rule_format] :
"ALL h.
 ALL x. ALL xs. X_map h (X_Cons x xs) = X_Cons (h x) (X_map h xs)"

XPlusXPlusNil [rule_format] : "ALL l. Nil' ++' l = l"

XPlusXPlusCons [rule_format] :
"ALL l. ALL x. ALL xs. X_Cons x xs ++' l = X_Cons x (xs ++' l)"

FilterNil [rule_format] : "ALL p. X_filter p Nil' = Nil'"

FilterConsT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x = True' -->
 X_filter p (X_Cons x xs) = X_Cons x (X_filter p xs)"

FilterConsF [rule_format] :
"ALL p.
 ALL x.
 ALL xs. p x = False' --> X_filter p (X_Cons x xs) = X_filter p xs"

ZipNil [rule_format] : "ALL l. X_zip Nil' l = Nil'"

ZipConsNil [rule_format] :
"ALL l. ALL x. ALL xs. l = Nil' --> X_zip (X_Cons x xs) l = Nil'"

ZipConsCons [rule_format] :
"ALL l.
 ALL x.
 ALL xs.
 ALL y.
 ALL ys.
 l = X_Cons y ys -->
 X_zip (X_Cons x xs) l = X_Cons (x, y) (X_zip xs ys)"

UnzipNil [rule_format] : "unzip(Nil') = (Nil', Nil')"

UnzipCons [rule_format] :
"ALL ps.
 ALL x.
 ALL z.
 unzip(X_Cons (x, z) ps) =
 (let (ys, zs) = unzip(ps) in (X_Cons x ys, X_Cons z zs))"

ILE01 [rule_format] : "Nil' ==' Nil' = True'"

ILE02 [rule_format] :
"ALL x.
 ALL xs.
 ALL y.
 ALL ys. X_Cons x xs ==' X_Cons y ys = (x ==' y) && (xs ==' ys)"

ILO01 [rule_format] : "Nil' <' Nil' = False'"

ILO02 [rule_format] : "Nil' <=' Nil' = True'"

ILO03 [rule_format] : "Nil' >' Nil' = False'"

ILO04 [rule_format] : "Nil' >=' Nil' = True'"

ILO05 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs. z <' w = True' --> X_Cons z zs <' X_Cons w ws = True'"

ILO06 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs. z ==' w = True' --> X_Cons z zs <' X_Cons w ws = zs <' ws"

ILO07 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 z <' w = False' & z ==' w = False' -->
 X_Cons z zs <' X_Cons w ws = False'"

ILO08 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 X_Cons z zs <=' X_Cons w ws =
 (X_Cons z zs <' X_Cons w ws) || (X_Cons z zs ==' X_Cons w ws)"

ILO09 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs. X_Cons z zs >' X_Cons w ws = X_Cons w ws <' X_Cons z zs"

ILO10 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 X_Cons z zs >=' X_Cons w ws =
 (X_Cons z zs >' X_Cons w ws) || (X_Cons z zs ==' X_Cons w ws)"

ILO11 [rule_format] : "compare Nil' Nil' ==' EQ = Nil' ==' Nil'"

ILO12 [rule_format] : "compare Nil' Nil' ==' LT = Nil' <' Nil'"

ILO13 [rule_format] : "compare Nil' Nil' ==' GT = Nil' >' Nil'"

ILO14 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 compare (X_Cons z zs) (X_Cons w ws) ==' EQ =
 X_Cons z zs ==' X_Cons w ws"

ILO15 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 compare (X_Cons z zs) (X_Cons w ws) ==' LT =
 X_Cons z zs <' X_Cons w ws"

ILO16 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 compare (X_Cons z zs) (X_Cons w ws) ==' GT =
 X_Cons z zs >' X_Cons w ws"

ILO17 [rule_format] : "X_max Nil' Nil' ==' Nil' = Nil' <=' Nil'"

ILO18 [rule_format] : "X_min Nil' Nil' ==' Nil' = Nil' <=' Nil'"

ILO19 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 X_Cons z zs <=' X_Cons w ws =
 X_max (X_Cons z zs) (X_Cons w ws) ==' X_Cons w ws"

ILO20 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 X_Cons w ws <=' X_Cons z zs =
 X_max (X_Cons z zs) (X_Cons w ws) ==' X_Cons z zs"

ILO21 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 X_Cons z zs <=' X_Cons w ws =
 X_min (X_Cons z zs) (X_Cons w ws) ==' X_Cons z zs"

ILO22 [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs.
 X_Cons w ws <=' X_Cons z zs =
 X_min (X_Cons z zs) (X_Cons w ws) ==' X_Cons w ws"

FoldlDecomp [rule_format] :
"ALL e.
 ALL i.
 ALL ts.
 ALL ys. X_foldl i e (ys ++' ts) = X_foldl i (X_foldl i e ys) ts"

MapDecomp [rule_format] :
"ALL f.
 ALL xs. ALL zs. X_map f (xs ++' zs) = X_map f xs ++' X_map f zs"

MapFunctor [rule_format] :
"ALL f.
 ALL g. ALL xs. X_map (X__o__X (g, f)) xs = X_map g (X_map f xs)"

FilterProm [rule_format] :
"ALL f.
 ALL p.
 ALL xs.
 X_filter p (X_map f xs) = X_map f (X_filter (X__o__X (p, f)) xs)"

InitNil [rule_format] : "~ defOp (init(Nil'))"

InitConsNil [rule_format] :
"ALL x. init(X_Cons x Nil') = makePartial Nil'"

InitConsCons [rule_format] :
"ALL x.
 ALL xs.
 init(X_Cons x xs) =
 restrictOp (makePartial (X_Cons x (makeTotal (init(xs)))))
 (defOp (init(xs)))"

LastNil [rule_format] : "~ defOp (last'(Nil'))"

LastConsNil [rule_format] :
"ALL x. last'(X_Cons x Nil') = makePartial x"

LastConsCons [rule_format] :
"ALL x. ALL xs. last'(X_Cons x xs) = last'(xs)"

NullNil [rule_format] : "null'(Nil') = True'"

NullCons [rule_format] :
"ALL x. ALL xs. null'(X_Cons x xs) = False'"

ReverseNil [rule_format] : "reverse(Nil') = Nil'"

ReverseCons [rule_format] :
"ALL x.
 ALL xs. reverse(X_Cons x xs) = reverse(xs) ++' X_Cons x Nil'"

Foldr1Nil [rule_format] : "ALL f. ~ defOp (foldr1 f Nil')"

Foldr1ConsNil [rule_format] :
"ALL f. ALL x. foldr1 f (X_Cons x Nil') = makePartial x"

Foldr1ConsCons [rule_format] :
"ALL f.
 ALL x.
 ALL xs.
 foldr1 f (X_Cons x xs) =
 restrictOp (makePartial (f x (makeTotal (foldr1 f xs))))
 (defOp (foldr1 f xs))"

Foldl1Nil [rule_format] : "ALL f. ~ defOp (foldl1 f Nil')"

Foldl1ConsNil [rule_format] :
"ALL f. ALL x. foldl1 f (X_Cons x Nil') = makePartial x"

Foldl1ConsCons [rule_format] :
"ALL f.
 ALL x.
 ALL xs.
 foldl1 f (X_Cons x xs) =
 restrictOp (makePartial (f x (makeTotal (foldr1 f xs))))
 (defOp (foldr1 f xs))"

ScanlNil [rule_format] :
"ALL g. ALL q. ALL ys. ys = Nil' --> scanl g q ys = X_Cons q Nil'"

ScanlCons [rule_format] :
"ALL g.
 ALL q.
 ALL ys.
 ALL z.
 ALL zs.
 ys = X_Cons z zs --> scanl g q ys = X_Cons q (scanl g (g q z) zs)"

Scanl1Nil [rule_format] : "ALL f. scanl1 f Nil' = Nil'"

Scanl1Cons [rule_format] :
"ALL f. ALL x. ALL xs. scanl1 f (X_Cons x xs) = scanl f x xs"

ScanrNil [rule_format] :
"ALL h. ALL z. scanr h z Nil' = X_Cons z Nil'"

ScanrCons [rule_format] :
"ALL h.
 ALL x.
 ALL xs.
 ALL y.
 ALL ys.
 ALL z.
 X_Cons y ys = scanr h z xs -->
 scanr h z (X_Cons x xs) = X_Cons (h x y) (X_Cons y ys)"

Scanr1Nil [rule_format] : "ALL f. scanr1 f Nil' = Nil'"

Scanr1ConsNil [rule_format] :
"ALL f. ALL x. scanr1 f (X_Cons x Nil') = X_Cons x Nil'"

Scanr1ConsCons [rule_format] :
"ALL f.
 ALL q.
 ALL qs.
 ALL x.
 ALL xs.
 X_Cons q qs = scanr1 f xs -->
 scanr1 f (X_Cons x xs) = X_Cons (f x q) (X_Cons q qs)"

ScanlProperty [rule_format] :
"ALL g.
 ALL x. ALL ys. last'(scanl g x ys) = makePartial (X_foldl g x ys)"

ScanrProperty [rule_format] :
"ALL h.
 ALL xs. ALL y. head(scanr h y xs) = makePartial (X_foldr h y xs)"

AndLNil [rule_format] : "andL(Nil') = True'"

AndLCons [rule_format] :
"ALL b1. ALL bs. andL(X_Cons b1 bs) = b1 && andL(bs)"

OrLNil [rule_format] : "orL(Nil') = False'"

OrLCons [rule_format] :
"ALL b1. ALL bs. orL(X_Cons b1 bs) = b1 || orL(bs)"

AnyDef [rule_format] :
"ALL p. ALL xs. X_any p xs = orL(X_map p xs)"

AllDef [rule_format] :
"ALL p. ALL xs. X_all p xs = andL(X_map p xs)"

ConcatDef [rule_format] :
"ALL xxs.
 concat'(xxs) =
 X_foldr (X_curry (uncurryOp X__XPlusXPlus__X)) Nil' xxs"

ConcatMapDef [rule_format] :
"ALL g. ALL xs. concatMap g xs = concat'(X_map g xs)"

MaximunNil [rule_format] : "~ defOp (maximum(Nil'))"

MaximumDef [rule_format] : "ALL ds. maximum(ds) = foldl1 X_max ds"

MinimunNil [rule_format] : "~ defOp (minimum(Nil'))"

MinimumDef [rule_format] : "ALL ds. minimum(ds) = foldl1 X_min ds"

TakeWhileNil [rule_format] : "ALL p. X_takeWhile p Nil' = Nil'"

TakeWhileConsT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x = True' -->
 X_takeWhile p (X_Cons x xs) = X_Cons x (X_takeWhile p xs)"

TakeWhileConsF [rule_format] :
"ALL p.
 ALL x. ALL xs. p x = False' --> X_takeWhile p (X_Cons x xs) = Nil'"

DropWhileNil [rule_format] : "ALL p. X_dropWhile p Nil' = Nil'"

DropWhileConsT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x = True' --> X_dropWhile p (X_Cons x xs) = X_dropWhile p xs"

DropWhileConsF [rule_format] :
"ALL p.
 ALL x.
 ALL xs. p x = False' --> X_dropWhile p (X_Cons x xs) = X_Cons x xs"

SpanNil [rule_format] : "ALL p. span p Nil' = (Nil', Nil')"

SpanConsT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x = True' -->
 span p (X_Cons x xs) =
 (let (ys, zs) = span p xs in (X_Cons x ys, zs))"

SpanConsF [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 p x = False' -->
 span p (X_Cons x xs) =
 (let (ys, zs) = span p xs in (Nil', X_Cons x xs))"

SpanThm [rule_format] :
"ALL p. ALL xs. span p xs = (X_takeWhile p xs, X_dropWhile p xs)"

BreakDef [rule_format] :
"ALL p.
 ALL xs. break p xs = (let q = X__o__X (Not__X, p) in span q xs)"

BreakThm [rule_format] :
"ALL p. ALL xs. break p xs = span (X__o__X (Not__X, p)) xs"

InsertNil [rule_format] : "ALL q. X_insert q Nil' = X_Cons q Nil'"

InsertCons1 [rule_format] :
"ALL q.
 ALL r.
 ALL rs.
 q <=' r = True' -->
 X_insert q (X_Cons r rs) = X_Cons q (X_Cons r rs)"

InsertCons2 [rule_format] :
"ALL q.
 ALL r.
 ALL rs.
 q >' r = True' -->
 X_insert q (X_Cons r rs) = X_Cons r (X_insert q rs)"

DeleteNil [rule_format] : "ALL s. delete s Nil' = Nil'"

DeleteConsT [rule_format] :
"ALL s.
 ALL t. ALL ts. s ==' t = True' --> delete s (X_Cons t ts) = ts"

DeleteConsF [rule_format] :
"ALL s.
 ALL t.
 ALL ts.
 s ==' t = False' -->
 delete s (X_Cons t ts) = X_Cons t (delete s ts)"

SelectT [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 ALL ys. p x = True' --> select p x (xs, ys) = (X_Cons x xs, ys)"

SelectF [rule_format] :
"ALL p.
 ALL x.
 ALL xs.
 ALL ys. p x = False' --> select p x (xs, ys) = (xs, X_Cons x ys)"

Partition [rule_format] :
"ALL p.
 ALL xs. partition p xs = X_foldr (select p) (Nil', Nil') xs"

declare Comp1 [simp]
declare IdDef [simp]
declare FlipDef [simp]
declare FstDef [simp]
declare SndDef [simp]
declare CurryDef [simp]
declare UncurryDef [simp]
declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare EqualReflex [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare IOE01 [simp]
declare IOE02 [simp]
declare IOE03 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare IOE07 [simp]
declare IOE08 [simp]
declare IOE09 [simp]
declare LeIrreflexivity [simp]
declare LeTAsymmetry [simp]
declare GeIrreflexivity [simp]
declare GeTAsymmetry [simp]
declare GeTTransitive [simp]
declare GeTTotal [simp]
declare LeqReflexivity [simp]
declare LeqTTransitive [simp]
declare LeqTTotal [simp]
declare GeqReflexivity [simp]
declare GeqTTransitive [simp]
declare GeqTTotal [simp]
declare CmpLTDef [simp]
declare CmpEQDef [simp]
declare CmpGTDef [simp]
declare MaxYDef [simp]
declare MaxXDef [simp]
declare MinXDef [simp]
declare MinYDef [simp]
declare TO2 [simp]
declare TO4 [simp]
declare TO6 [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IOO16 [simp]
declare IOO17 [simp]
declare IOO18 [simp]
declare IOO19 [simp]
declare IOO20 [simp]
declare IOO21 [simp]
declare IOO22 [simp]
declare IOO23 [simp]
declare IOO24 [simp]
declare IOO25 [simp]
declare IOO26 [simp]
declare IOO27 [simp]
declare IOO28 [simp]
declare IOO29 [simp]
declare IOO30 [simp]
declare IOO31 [simp]
declare IOO32 [simp]
declare IOO33 [simp]
declare IBO5 [simp]
declare IBO6 [simp]
declare IBO7 [simp]
declare IBO8 [simp]
declare IBO9 [simp]
declare IBO10 [simp]
declare IBO11 [simp]
declare IBO12 [simp]
declare IUO05 [simp]
declare IUO06 [simp]
declare IUO07 [simp]
declare NotDefHead [simp]
declare HeadDef [simp]
declare NotDefTail [simp]
declare TailDef [simp]
declare FoldrNil [simp]
declare FoldlNil [simp]
declare MapNil [simp]
declare XPlusXPlusNil [simp]
declare FilterNil [simp]
declare FilterConsF [simp]
declare ZipNil [simp]
declare ILE01 [simp]
declare ILO01 [simp]
declare ILO02 [simp]
declare ILO03 [simp]
declare ILO04 [simp]
declare ILO05 [simp]
declare ILO06 [simp]
declare ILO11 [simp]
declare ILO12 [simp]
declare ILO13 [simp]
declare ILO14 [simp]
declare ILO15 [simp]
declare ILO16 [simp]
declare ILO17 [simp]
declare ILO18 [simp]
declare InitNil [simp]
declare InitConsNil [simp]
declare LastNil [simp]
declare LastConsNil [simp]
declare LastConsCons [simp]
declare NullNil [simp]
declare NullCons [simp]
declare ReverseNil [simp]
declare Foldr1Nil [simp]
declare Foldr1ConsNil [simp]
declare Foldl1Nil [simp]
declare Foldl1ConsNil [simp]
declare Scanl1Nil [simp]
declare Scanl1Cons [simp]
declare ScanrNil [simp]
declare Scanr1Nil [simp]
declare Scanr1ConsNil [simp]
declare AndLNil [simp]
declare OrLNil [simp]
declare MaximunNil [simp]
declare MinimunNil [simp]
declare TakeWhileNil [simp]
declare TakeWhileConsF [simp]
declare DropWhileNil [simp]
declare DropWhileConsT [simp]
declare DropWhileConsF [simp]
declare SpanNil [simp]
declare DeleteNil [simp]
declare DeleteConsT [simp]
declare SelectT [simp]
declare SelectF [simp]

theorem PartitionProp :
"ALL p.
 ALL xs.
 partition p xs =
 (X_filter p xs, X_filter (X__o__X (Not__X, p)) xs)"
apply(auto)
apply(simp only: Partition)
apply(induct_tac xs)
apply(case_tac "p a")
apply(simp only: FoldrCons)
apply(simp only: FilterConsF)
apply(auto)
apply(simp add: FilterConsT)
apply(simp add: FoldrCons)
apply(simp only: FilterConsT)
done

ML "Header.record \"PartitionProp\""

end