(*  Title:      Sequents/ILL.thy
    Author:     Sara Kalvala and Valeria de Paiva
    Copyright   1995  University of Cambridge
*)

theory ILL
imports Sequents
begin

consts
  Trueprop       :: "two_seqi"

  tens :: "[o, o] \<Rightarrow> o"        (infixr "><" 35)
  limp :: "[o, o] \<Rightarrow> o"        (infixr "-o" 45)
  FShriek :: "o \<Rightarrow> o"          ("! _" [100] 1000)
  lconj :: "[o, o] \<Rightarrow> o"       (infixr "&&" 35)
  ldisj :: "[o, o] \<Rightarrow> o"       (infixr "++" 35)
  zero :: "o"                  ("0")
  top :: "o"                   ("1")
  eye :: "o"                   ("I")

  (* context manipulation *)

 Context      :: "two_seqi"

  (* promotion rule *)

  PromAux :: "three_seqi"

syntax
  "_Trueprop" :: "single_seqe" ("((_)/ \<turnstile> (_))" [6,6] 5)
  "_Context"  :: "two_seqe"   ("((_)/ :=: (_))" [6,6] 5)
  "_PromAux"  :: "three_seqe" ("promaux {_||_||_}")

parse_translation \<open>
  [(@{syntax_const "_Trueprop"}, K (single_tr @{const_syntax Trueprop})),
   (@{syntax_const "_Context"}, K (two_seq_tr @{const_syntax Context})),
   (@{syntax_const "_PromAux"}, K (three_seq_tr @{const_syntax PromAux}))]
\<close>

print_translation \<open>
  [(@{const_syntax Trueprop}, K (single_tr' @{syntax_const "_Trueprop"})),
   (@{const_syntax Context}, K (two_seq_tr' @{syntax_const "_Context"})),
   (@{const_syntax PromAux}, K (three_seq_tr' @{syntax_const "_PromAux"}))]
\<close>

definition liff :: "[o, o] \<Rightarrow> o"  (infixr "o-o" 45)
  where "P o-o Q == (P -o Q) >< (Q -o P)"

definition aneg :: "o\<Rightarrow>o"  ("~_")
  where "~A == A -o 0"

axiomatization where

identity:        "P \<turnstile> P" and

zerol:           "$G, 0, $H \<turnstile> A" and

  (* RULES THAT DO NOT DIVIDE CONTEXT *)

derelict:   "$F, A, $G \<turnstile> C \<Longrightarrow> $F, !A, $G \<turnstile> C" and
  (* unfortunately, this one removes !A  *)

contract:  "$F, !A, !A, $G \<turnstile> C \<Longrightarrow> $F, !A, $G \<turnstile> C" and

weaken:     "$F, $G \<turnstile> C \<Longrightarrow> $G, !A, $F \<turnstile> C" and
  (* weak form of weakening, in practice just to clean context *)
  (* weaken and contract not needed (CHECK)  *)

promote2:        "promaux{ || $H || B} \<Longrightarrow> $H \<turnstile> !B" and
promote1:        "promaux{!A, $G || $H || B}
                  \<Longrightarrow> promaux {$G || $H, !A || B}" and
promote0:        "$G \<turnstile> A \<Longrightarrow> promaux {$G || || A}" and

tensl:     "$H, A, B, $G \<turnstile> C \<Longrightarrow> $H, A >< B, $G \<turnstile> C" and

impr:      "A, $F \<turnstile> B \<Longrightarrow> $F \<turnstile> A -o B" and

conjr:           "\<lbrakk>$F \<turnstile> A ;
                 $F \<turnstile> B\<rbrakk>
                \<Longrightarrow> $F \<turnstile> (A && B)" and

conjll:          "$G, A, $H \<turnstile> C \<Longrightarrow> $G, A && B, $H \<turnstile> C" and

conjlr:          "$G, B, $H \<turnstile> C \<Longrightarrow> $G, A && B, $H \<turnstile> C" and

disjrl:          "$G \<turnstile> A \<Longrightarrow> $G \<turnstile> A ++ B" and
disjrr:          "$G \<turnstile> B \<Longrightarrow> $G \<turnstile> A ++ B" and
disjl:           "\<lbrakk>$G, A, $H \<turnstile> C ;
                   $G, B, $H \<turnstile> C\<rbrakk>
                 \<Longrightarrow> $G, A ++ B, $H \<turnstile> C" and

      (* RULES THAT DIVIDE CONTEXT *)

tensr:           "\<lbrakk>$F, $J :=: $G;
                   $F \<turnstile> A ;
                   $J \<turnstile> B\<rbrakk>
                     \<Longrightarrow> $G \<turnstile> A >< B" and

impl:            "\<lbrakk>$G, $F :=: $J, $H ;
                   B, $F \<turnstile> C ;
                   $G \<turnstile> A\<rbrakk>
                     \<Longrightarrow> $J, A -o B, $H \<turnstile> C" and

cut: "\<lbrakk> $J1, $H1, $J2, $H3, $J3, $H2, $J4, $H4 :=: $F ;
        $H1, $H2, $H3, $H4 \<turnstile> A ;
        $J1, $J2, A, $J3, $J4 \<turnstile> B\<rbrakk> \<Longrightarrow> $F \<turnstile> B" and

  (* CONTEXT RULES *)

context1:     "$G :=: $G" and
context2:     "$F, $G :=: $H, !A, $G \<Longrightarrow> $F, A, $G :=: $H, !A, $G" and
context3:     "$F, $G :=: $H, $J \<Longrightarrow> $F, A, $G :=: $H, A, $J" and
context4a:    "$F :=: $H, $G \<Longrightarrow> $F :=: $H, !A, $G" and
context4b:    "$F, $H :=: $G \<Longrightarrow> $F, !A, $H :=: $G" and
context5:     "$F, $G :=: $H \<Longrightarrow> $G, $F :=: $H"

text "declarations for lazy classical reasoning:"
lemmas [safe] =
  context3
  context2
  promote0
  disjl
  conjr
  tensl
lemmas [unsafe] =
  context4b
  context4a
  context1
  promote2
  promote1
  weaken
  derelict
  impl
  tensr
  impr
  disjrr
  disjrl
  conjlr
  conjll
  zerol
  identity

lemma aux_impl: "$F, $G \<turnstile> A \<Longrightarrow> $F, !(A -o B), $G \<turnstile> B"
  apply (rule derelict)
  apply (rule impl)
  apply (rule_tac [2] identity)
  apply (rule context1)
  apply assumption
  done

lemma conj_lemma: " $F, !A, !B, $G \<turnstile> C \<Longrightarrow> $F, !(A && B), $G \<turnstile> C"
  apply (rule contract)
  apply (rule_tac A = " (!A) >< (!B) " in cut)
  apply (rule_tac [2] tensr)
  prefer 3
  apply (subgoal_tac "! (A && B) \<turnstile> !A")
  apply assumption
  apply best
  prefer 3
  apply (subgoal_tac "! (A && B) \<turnstile> !B")
  apply assumption
  apply best
  apply (rule_tac [2] context1)
  apply (rule_tac [2] tensl)
  prefer 2 apply assumption
  apply (rule context3)
  apply (rule context3)
  apply (rule context1)
  done

lemma impr_contract: "!A, !A, $G \<turnstile> B \<Longrightarrow> $G \<turnstile> (!A) -o B"
  apply (rule impr)
  apply (rule contract)
  apply assumption
  done

lemma impr_contr_der: "A, !A, $G \<turnstile> B \<Longrightarrow> $G \<turnstile> (!A) -o B"
  apply (rule impr)
  apply (rule contract)
  apply (rule derelict)
  apply assumption
  done

lemma contrad1: "$F, (!B) -o 0, $G, !B, $H \<turnstile> A"
  apply (rule impl)
  apply (rule_tac [3] identity)
  apply (rule context3)
  apply (rule context1)
  apply (rule zerol)
  done

lemma contrad2: "$F, !B, $G, (!B) -o 0, $H \<turnstile> A"
  apply (rule impl)
  apply (rule_tac [3] identity)
  apply (rule context3)
  apply (rule context1)
  apply (rule zerol)
  done

lemma ll_mp: "A -o B, A \<turnstile> B"
  apply (rule impl)
  apply (rule_tac [2] identity)
  apply (rule_tac [2] identity)
  apply (rule context1)
  done

lemma mp_rule1: "$F, B, $G, $H \<turnstile> C \<Longrightarrow> $F, A, $G, A -o B, $H \<turnstile> C"
  apply (rule_tac A = "B" in cut)
  apply (rule_tac [2] ll_mp)
  prefer 2 apply (assumption)
  apply (rule context3)
  apply (rule context3)
  apply (rule context1)
  done

lemma mp_rule2: "$F, B, $G, $H \<turnstile> C \<Longrightarrow> $F, A -o B, $G, A, $H \<turnstile> C"
  apply (rule_tac A = "B" in cut)
  apply (rule_tac [2] ll_mp)
  prefer 2 apply (assumption)
  apply (rule context3)
  apply (rule context3)
  apply (rule context1)
  done

lemma or_to_and: "!((!(A ++ B)) -o 0) \<turnstile> !( ((!A) -o 0) && ((!B) -o 0))"
  by best

lemma o_a_rule: "$F, !( ((!A) -o 0) && ((!B) -o 0)), $G \<turnstile> C \<Longrightarrow>
          $F, !((!(A ++ B)) -o 0), $G \<turnstile> C"
  apply (rule cut)
  apply (rule_tac [2] or_to_and)
  prefer 2 apply (assumption)
  apply (rule context3)
  apply (rule context1)
  done

lemma conj_imp: "((!A) -o C) ++ ((!B) -o C) \<turnstile> (!(A && B)) -o C"
  apply (rule impr)
  apply (rule conj_lemma)
  apply (rule disjl)
  apply (rule mp_rule1, best)+
  done

lemma not_imp: "!A, !((!B) -o 0) \<turnstile> (!((!A) -o B)) -o 0"
  by best

lemma a_not_a: "!A -o (!A -o 0) \<turnstile> !A -o 0"
  apply (rule impr)
  apply (rule contract)
  apply (rule impl)
  apply (rule_tac [3] identity)
  apply (rule context1)
  apply best
  done

lemma a_not_a_rule: "$J1, !A -o 0, $J2 \<turnstile> B \<Longrightarrow> $J1, !A -o (!A -o 0), $J2 \<turnstile> B"
  apply (rule_tac A = "!A -o 0" in cut)
  apply (rule_tac [2] a_not_a)
  prefer 2 apply assumption
  apply best
  done

ML \<open>
  val safe_pack =
    @{context}
    |> fold_rev Cla.add_safe @{thms conj_lemma ll_mp contrad1
        contrad2 mp_rule1 mp_rule2 o_a_rule a_not_a_rule}
    |> Cla.add_unsafe @{thm aux_impl}
    |> Cla.get_pack;

  val power_pack =
    Cla.put_pack safe_pack @{context}
    |> Cla.add_unsafe @{thm impr_contr_der}
    |> Cla.get_pack;
\<close>

method_setup best_safe =
  \<open>Scan.succeed (fn ctxt => SIMPLE_METHOD' (Cla.best_tac (Cla.put_pack safe_pack ctxt)))\<close>

method_setup best_power =
  \<open>Scan.succeed (fn ctxt => SIMPLE_METHOD' (Cla.best_tac (Cla.put_pack power_pack ctxt)))\<close>

(* Some examples from Troelstra and van Dalen *)

lemma "!((!A) -o ((!B) -o 0)) \<turnstile> (!(A && B)) -o 0"
  by best_safe

lemma "!((!(A && B)) -o 0) \<turnstile> !((!A) -o ((!B) -o 0))"
  by best_safe

lemma "!( (!((! ((!A) -o B) ) -o 0)) -o 0) \<turnstile>
        (!A) -o ( (!  ((!B) -o 0)) -o 0)"
  by best_safe

lemma "!(  (!A) -o ( (!  ((!B) -o 0)) -o 0) ) \<turnstile>
          (!((! ((!A) -o B) ) -o 0)) -o 0"
  by best_power

end


theory IICF_List
imports
  "../../Sepref"
  "List-Index.List_Index"
begin

lemma param_index[param]:
  "\<lbrakk>single_valued A; single_valued (A\<inverse>)\<rbrakk> \<Longrightarrow> (index,index) \<in> \<langle>A\<rangle>list_rel \<rightarrow> A \<rightarrow> nat_rel"
  unfolding index_def[abs_def] find_index_def
  apply (subgoal_tac "(((=), (=)) \<in> A \<rightarrow> A \<rightarrow> bool_rel)")
  apply parametricity
  by (simp add: pres_eq_iff_svb)

(* TODO: Move? *)

lemma swap_param[param]: "\<lbrakk> i<length l; j<length l; (l',l)\<in>\<langle>A\<rangle>list_rel; (i',i)\<in>nat_rel; (j',j)\<in>nat_rel\<rbrakk>
  \<Longrightarrow> (swap l' i' j', swap l i j)\<in>\<langle>A\<rangle>list_rel"
  unfolding swap_def
  by parametricity

lemma swap_param_fref: "(uncurry2 swap,uncurry2 swap) \<in>
  [\<lambda>((l,i),j). i<length l \<and> j<length l]\<^sub>f (\<langle>A\<rangle>list_rel \<times>\<^sub>r nat_rel) \<times>\<^sub>r nat_rel \<rightarrow> \<langle>A\<rangle>list_rel"
  apply rule apply clarsimp
  unfolding swap_def
  apply parametricity
  by simp_all

lemma param_list_null[param]: "(List.null,List.null) \<in> \<langle>A\<rangle>list_rel \<rightarrow> bool_rel"
proof -
  have 1: "List.null = (\<lambda>[] \<Rightarrow> True | _ \<Rightarrow> False)"
    apply (rule ext) subgoal for l by (cases l) (auto simp: List.null_def)
    done
  show ?thesis unfolding 1 by parametricity
qed

subsection \<open>Operations\<close>

find_theorems INTF_OF_REL

sepref_decl_op list_empty: "[]" :: "\<langle>A\<rangle>list_rel" .
context notes [simp] = eq_Nil_null begin
  sepref_decl_op list_is_empty: "\<lambda>l. l=[]" :: "\<langle>A\<rangle>list_rel \<rightarrow>\<^sub>f bool_rel" .
end

sepref_decl_op list_replicate: replicate :: "nat_rel \<rightarrow> A \<rightarrow> \<langle>A\<rangle>list_rel" .

definition op_list_copy :: "'a list \<Rightarrow> 'a list" where [simp]:  "op_list_copy l \<equiv> l"
sepref_decl_op (no_def) list_copy: "op_list_copy" :: "\<langle>A\<rangle>list_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
sepref_decl_op list_prepend: "(#)" :: "A \<rightarrow> \<langle>A\<rangle>list_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
sepref_decl_op list_append: "\<lambda>xs x. xs@[x]" :: "\<langle>A\<rangle>list_rel \<rightarrow> A \<rightarrow> \<langle>A\<rangle>list_rel" .
sepref_decl_op list_concat: "(@)" :: "\<langle>A\<rangle>list_rel \<rightarrow> \<langle>A\<rangle>list_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
sepref_decl_op list_take: take :: "[\<lambda>(i,l). i\<le>length l]\<^sub>f nat_rel \<times>\<^sub>r \<langle>A\<rangle>list_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
sepref_decl_op list_drop: drop :: "[\<lambda>(i,l). i\<le>length l]\<^sub>f nat_rel \<times>\<^sub>r \<langle>A\<rangle>list_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
sepref_decl_op list_length: length :: "\<langle>A\<rangle>list_rel \<rightarrow> nat_rel" .
sepref_decl_op list_get: nth :: "[\<lambda>(l,i). i<length l]\<^sub>f \<langle>A\<rangle>list_rel \<times>\<^sub>r nat_rel \<rightarrow> A" .
sepref_decl_op list_set: list_update :: "[\<lambda>((l,i),_). i<length l]\<^sub>f (\<langle>A\<rangle>list_rel \<times>\<^sub>r nat_rel) \<times>\<^sub>r A \<rightarrow> \<langle>A\<rangle>list_rel" .
context notes [simp] = eq_Nil_null begin
  sepref_decl_op list_hd: hd :: "[\<lambda>l. l\<noteq>[]]\<^sub>f \<langle>A\<rangle>list_rel \<rightarrow> A" .
  sepref_decl_op list_tl: tl :: "[\<lambda>l. l\<noteq>[]]\<^sub>f \<langle>A\<rangle>list_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
  sepref_decl_op list_last: last :: "[\<lambda>l. l\<noteq>[]]\<^sub>f \<langle>A\<rangle>list_rel \<rightarrow> A" .
  sepref_decl_op list_butlast: butlast :: "[\<lambda>l. l\<noteq>[]]\<^sub>f \<langle>A\<rangle>list_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
  sepref_decl_op list_pop_last: "(\<lambda>l. (last l, butlast l))" :: "[\<lambda>l. l\<noteq>[]]\<^sub>f \<langle>A\<rangle>list_rel \<rightarrow> A \<times>\<^sub>r \<langle>A\<rangle>list_rel" .
end
sepref_decl_op list_contains: "\<lambda>x l. x\<in>set l" :: "A \<rightarrow> \<langle>A\<rangle>list_rel \<rightarrow> bool_rel"
  where "single_valued A" "single_valued (A\<inverse>)" .
sepref_decl_op list_swap: swap :: "[\<lambda>((l,i),j). i<length l \<and> j<length l]\<^sub>f (\<langle>A\<rangle>list_rel \<times>\<^sub>r nat_rel) \<times>\<^sub>r nat_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
sepref_decl_op list_rotate1: rotate1 :: "\<langle>A\<rangle>list_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
sepref_decl_op list_rev: rev :: "\<langle>A\<rangle>list_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
sepref_decl_op list_index: index :: "\<langle>A\<rangle>list_rel \<rightarrow> A \<rightarrow> nat_rel"
  where "single_valued A" "single_valued (A\<inverse>)" .

subsection \<open>Patterns\<close>

text \<open>Standard preconditions are preserved by list-relation. These lemmas are used for
  simplification of preconditions after composition.\<close>
lemma list_rel_pres_neq_nil[fcomp_prenorm_simps]: "(x',x)\<in>\<langle>A\<rangle>list_rel \<Longrightarrow> x'\<noteq>[] \<longleftrightarrow> x\<noteq>[]" by auto
lemma list_rel_pres_length[fcomp_prenorm_simps]: "(x',x)\<in>\<langle>A\<rangle>list_rel \<Longrightarrow> length x' = length x" by (rule list_rel_imp_same_length)

declare list_rel_imp_same_length[sepref_bounds_dest]

locale list_custom_empty =
  fixes rel empty and op_custom_empty :: "'a list"
  assumes customize_hnr_aux: "(uncurry0 empty,uncurry0 (RETURN (op_list_empty::'a list))) \<in> unit_assn\<^sup>k \<rightarrow>\<^sub>a rel"
  assumes op_custom_empty_def: "op_custom_empty = op_list_empty"
begin
  sepref_register op_custom_empty :: "'c list"

  lemma fold_custom_empty:
    "[] = op_custom_empty"
    "op_list_empty = op_custom_empty"
    "mop_list_empty = RETURN op_custom_empty"
    unfolding op_custom_empty_def by simp_all

  lemmas custom_hnr[sepref_fr_rules] = customize_hnr_aux[folded op_custom_empty_def]
end

lemma gen_swap: "swap xs i j = (let
  xi = op_list_get xs i;
  xj = op_list_get xs j;
  xs = op_list_set xs i xj;
  xs = op_list_set xs j xi
  in xs)"
  by (auto simp: swap_def)

lemma gen_mop_list_swap: "mop_list_swap l i j = do {
    xi \<leftarrow> mop_list_get l i;
    xj \<leftarrow> mop_list_get l j;
    l \<leftarrow> mop_list_set l i xj;
    l \<leftarrow> mop_list_set l j xi;
    RETURN l
  }"
  unfolding mop_list_swap_def
  by (auto simp: pw_eq_iff refine_pw_simps gen_swap)

lemmas gen_op_list_swap = gen_swap[folded op_list_swap_def]

end


(* Author: Gerwin Klein *)

section \<open>Compiler Correctness, Reverse Direction\<close>

theory Compiler2
imports Compiler
begin

text \<open>
The preservation of the source code semantics is already shown in the
parent theory \<open>Compiler\<close>. This here shows the second direction.
\<close>

subsection \<open>Definitions\<close>

text \<open>Execution in \<^term>\<open>n\<close> steps for simpler induction\<close>
primrec
  exec_n :: "instr list \<Rightarrow> config \<Rightarrow> nat \<Rightarrow> config \<Rightarrow> bool"
  ("_/ \<turnstile> (_ \<rightarrow>^_/ _)" [65,0,1000,55] 55)
where
  "P \<turnstile> c \<rightarrow>^0 c' = (c'=c)" |
  "P \<turnstile> c \<rightarrow>^(Suc n) c'' = (\<exists>c'. (P \<turnstile> c \<rightarrow> c') \<and> P \<turnstile> c' \<rightarrow>^n c'')"

text \<open>The possible successor PCs of an instruction at position \<^term>\<open>n\<close>\<close>
text_raw\<open>\snip{isuccsdef}{0}{1}{%\<close>
definition isuccs :: "instr \<Rightarrow> int \<Rightarrow> int set" where
"isuccs i n = (case i of
  JMP j \<Rightarrow> {n + 1 + j} |
  JMPLESS j \<Rightarrow> {n + 1 + j, n + 1} |
  JMPGE j \<Rightarrow> {n + 1 + j, n + 1} |
  _ \<Rightarrow> {n +1})"
text_raw\<open>}%endsnip\<close>

text \<open>The possible successors PCs of an instruction list\<close>
definition succs :: "instr list \<Rightarrow> int \<Rightarrow> int set" where
"succs P n = {s. \<exists>i::int. 0 \<le> i \<and> i < size P \<and> s \<in> isuccs (P!!i) (n+i)}"

text \<open>Possible exit PCs of a program\<close>
definition exits :: "instr list \<Rightarrow> int set" where
"exits P = succs P 0 - {0..< size P}"

subsection \<open>Basic properties of \<^term>\<open>exec_n\<close>\<close>

lemma exec_n_exec:
  "P \<turnstile> c \<rightarrow>^n c' \<Longrightarrow> P \<turnstile> c \<rightarrow>* c'"
  by (induct n arbitrary: c) (auto intro: star.step)

lemma exec_0 [intro!]: "P \<turnstile> c \<rightarrow>^0 c" by simp

lemma exec_Suc:
  "\<lbrakk> P \<turnstile> c \<rightarrow> c'; P \<turnstile> c' \<rightarrow>^n c'' \<rbrakk> \<Longrightarrow> P \<turnstile> c \<rightarrow>^(Suc n) c''"
  by (fastforce simp del: split_paired_Ex)

lemma exec_exec_n:
  "P \<turnstile> c \<rightarrow>* c' \<Longrightarrow> \<exists>n. P \<turnstile> c \<rightarrow>^n c'"
  by (induct rule: star.induct) (auto intro: exec_Suc)

lemma exec_eq_exec_n:
  "(P \<turnstile> c \<rightarrow>* c') = (\<exists>n. P \<turnstile> c \<rightarrow>^n c')"
  by (blast intro: exec_exec_n exec_n_exec)

lemma exec_n_Nil [simp]:
  "[] \<turnstile> c \<rightarrow>^k c' = (c' = c \<and> k = 0)"
  by (induct k) (auto simp: exec1_def)

lemma exec1_exec_n [intro!]:
  "P \<turnstile> c \<rightarrow> c' \<Longrightarrow> P \<turnstile> c \<rightarrow>^1 c'"
  by (cases c') simp

subsection \<open>Concrete symbolic execution steps\<close>

lemma exec_n_step:
  "n \<noteq> n' \<Longrightarrow>
  P \<turnstile> (n,stk,s) \<rightarrow>^k (n',stk',s') =
  (\<exists>c. P \<turnstile> (n,stk,s) \<rightarrow> c \<and> P \<turnstile> c \<rightarrow>^(k - 1) (n',stk',s') \<and> 0 < k)"
  by (cases k) auto

lemma exec1_end:
  "size P <= fst c \<Longrightarrow> \<not> P \<turnstile> c \<rightarrow> c'"
  by (auto simp: exec1_def)

lemma exec_n_end:
  "size P <= (n::int) \<Longrightarrow>
  P \<turnstile> (n,s,stk) \<rightarrow>^k (n',s',stk') = (n' = n \<and> stk'=stk \<and> s'=s \<and> k =0)"
  by (cases k) (auto simp: exec1_end)

lemmas exec_n_simps = exec_n_step exec_n_end

subsection \<open>Basic properties of \<^term>\<open>succs\<close>\<close>

lemma succs_simps [simp]:
  "succs [ADD] n = {n + 1}"
  "succs [LOADI v] n = {n + 1}"
  "succs [LOAD x] n = {n + 1}"
  "succs [STORE x] n = {n + 1}"
  "succs [JMP i] n = {n + 1 + i}"
  "succs [JMPGE i] n = {n + 1 + i, n + 1}"
  "succs [JMPLESS i] n = {n + 1 + i, n + 1}"
  by (auto simp: succs_def isuccs_def)

lemma succs_empty [iff]: "succs [] n = {}"
  by (simp add: succs_def)

lemma succs_Cons:
  "succs (x#xs) n = isuccs x n \<union> succs xs (1+n)" (is "_ = ?x \<union> ?xs")
proof
  let ?isuccs = "\<lambda>p P n i::int. 0 \<le> i \<and> i < size P \<and> p \<in> isuccs (P!!i) (n+i)"
  have "p \<in> ?x \<union> ?xs" if assm: "p \<in> succs (x#xs) n" for p
  proof -
    from assm obtain i::int where isuccs: "?isuccs p (x#xs) n i"
      unfolding succs_def by auto
    show ?thesis
    proof cases
      assume "i = 0" with isuccs show ?thesis by simp
    next
      assume "i \<noteq> 0"
      with isuccs
      have "?isuccs p xs (1+n) (i - 1)" by auto
      hence "p \<in> ?xs" unfolding succs_def by blast
      thus ?thesis ..
    qed
  qed
  thus "succs (x#xs) n \<subseteq> ?x \<union> ?xs" ..

  have "p \<in> succs (x#xs) n" if assm: "p \<in> ?x \<or> p \<in> ?xs" for p
  proof -
    from assm show ?thesis
    proof
      assume "p \<in> ?x" thus ?thesis by (fastforce simp: succs_def)
    next
      assume "p \<in> ?xs"
      then obtain i where "?isuccs p xs (1+n) i"
        unfolding succs_def by auto
      hence "?isuccs p (x#xs) n (1+i)"
        by (simp add: algebra_simps)
      thus ?thesis unfolding succs_def by blast
    qed
  qed
  thus "?x \<union> ?xs \<subseteq> succs (x#xs) n" by blast
qed

lemma succs_iexec1:
  assumes "c' = iexec (P!!i) (i,s,stk)" "0 \<le> i" "i < size P"
  shows "fst c' \<in> succs P 0"
  using assms by (auto simp: succs_def isuccs_def split: instr.split)

lemma succs_shift:
  "(p - n \<in> succs P 0) = (p \<in> succs P n)"
  by (fastforce simp: succs_def isuccs_def split: instr.split)

lemma inj_op_plus [simp]:
  "inj ((+) (i::int))"
  by (metis add_minus_cancel inj_on_inverseI)

lemma succs_set_shift [simp]:
  "(+) i ` succs xs 0 = succs xs i"
  by (force simp: succs_shift [where n=i, symmetric] intro: set_eqI)

lemma succs_append [simp]:
  "succs (xs @ ys) n = succs xs n \<union> succs ys (n + size xs)"
  by (induct xs arbitrary: n) (auto simp: succs_Cons algebra_simps)

lemma exits_append [simp]:
  "exits (xs @ ys) = exits xs \<union> ((+) (size xs)) ` exits ys -
                     {0..<size xs + size ys}"
  by (auto simp: exits_def image_set_diff)

lemma exits_single:
  "exits [x] = isuccs x 0 - {0}"
  by (auto simp: exits_def succs_def)

lemma exits_Cons:
  "exits (x # xs) = (isuccs x 0 - {0}) \<union> ((+) 1) ` exits xs -
                     {0..<1 + size xs}"
  using exits_append [of "[x]" xs]
  by (simp add: exits_single)

lemma exits_empty [iff]: "exits [] = {}" by (simp add: exits_def)

lemma exits_simps [simp]:
  "exits [ADD] = {1}"
  "exits [LOADI v] = {1}"
  "exits [LOAD x] = {1}"
  "exits [STORE x] = {1}"
  "i \<noteq> -1 \<Longrightarrow> exits [JMP i] = {1 + i}"
  "i \<noteq> -1 \<Longrightarrow> exits [JMPGE i] = {1 + i, 1}"
  "i \<noteq> -1 \<Longrightarrow> exits [JMPLESS i] = {1 + i, 1}"
  by (auto simp: exits_def)

lemma acomp_succs [simp]:
  "succs (acomp a) n = {n + 1 .. n + size (acomp a)}"
  by (induct a arbitrary: n) auto

lemma acomp_size:
  "(1::int) \<le> size (acomp a)"
  by (induct a) auto

lemma acomp_exits [simp]:
  "exits (acomp a) = {size (acomp a)}"
  by (auto simp: exits_def acomp_size)

lemma bcomp_succs:
  "0 \<le> i \<Longrightarrow>
  succs (bcomp b f i) n \<subseteq> {n .. n + size (bcomp b f i)}
                           \<union> {n + i + size (bcomp b f i)}"
proof (induction b arbitrary: f i n)
  case (And b1 b2)
  from And.prems
  show ?case
    by (cases f)
       (auto dest: And.IH(1) [THEN subsetD, rotated]
                   And.IH(2) [THEN subsetD, rotated])
qed auto

lemmas bcomp_succsD [dest!] = bcomp_succs [THEN subsetD, rotated]

lemma bcomp_exits:
  fixes i :: int
  shows
  "0 \<le> i \<Longrightarrow>
  exits (bcomp b f i) \<subseteq> {size (bcomp b f i), i + size (bcomp b f i)}"
  by (auto simp: exits_def)

lemma bcomp_exitsD [dest!]:
  "p \<in> exits (bcomp b f i) \<Longrightarrow> 0 \<le> i \<Longrightarrow>
  p = size (bcomp b f i) \<or> p = i + size (bcomp b f i)"
  using bcomp_exits by auto

lemma ccomp_succs:
  "succs (ccomp c) n \<subseteq> {n..n + size (ccomp c)}"
proof (induction c arbitrary: n)
  case SKIP thus ?case by simp
next
  case Assign thus ?case by simp
next
  case (Seq c1 c2)
  from Seq.prems
  show ?case
    by (fastforce dest: Seq.IH [THEN subsetD])
next
  case (If b c1 c2)
  from If.prems
  show ?case
    by (auto dest!: If.IH [THEN subsetD] simp: isuccs_def succs_Cons)
next
  case (While b c)
  from While.prems
  show ?case by (auto dest!: While.IH [THEN subsetD])
qed

lemma ccomp_exits:
  "exits (ccomp c) \<subseteq> {size (ccomp c)}"
  using ccomp_succs [of c 0] by (auto simp: exits_def)

lemma ccomp_exitsD [dest!]:
  "p \<in> exits (ccomp c) \<Longrightarrow> p = size (ccomp c)"
  using ccomp_exits by auto

subsection \<open>Splitting up machine executions\<close>

lemma exec1_split:
  fixes i j :: int
  shows
  "P @ c @ P' \<turnstile> (size P + i, s) \<rightarrow> (j,s') \<Longrightarrow> 0 \<le> i \<Longrightarrow> i < size c \<Longrightarrow>
  c \<turnstile> (i,s) \<rightarrow> (j - size P, s')"
  by (auto split: instr.splits simp: exec1_def)

lemma exec_n_split:
  fixes i j :: int
  assumes "P @ c @ P' \<turnstile> (size P + i, s) \<rightarrow>^n (j, s')"
          "0 \<le> i" "i < size c"
          "j \<notin> {size P ..< size P + size c}"
  shows "\<exists>s'' (i'::int) k m.
                   c \<turnstile> (i, s) \<rightarrow>^k (i', s'') \<and>
                   i' \<in> exits c \<and>
                   P @ c @ P' \<turnstile> (size P + i', s'') \<rightarrow>^m (j, s') \<and>
                   n = k + m"
using assms proof (induction n arbitrary: i j s)
  case 0
  thus ?case by simp
next
  case (Suc n)
  have i: "0 \<le> i" "i < size c" by fact+
  from Suc.prems
  have j: "\<not> (size P \<le> j \<and> j < size P + size c)" by simp
  from Suc.prems
  obtain i0 s0 where
    step: "P @ c @ P' \<turnstile> (size P + i, s) \<rightarrow> (i0,s0)" and
    rest: "P @ c @ P' \<turnstile> (i0,s0) \<rightarrow>^n (j, s')"
    by clarsimp

  from step i
  have c: "c \<turnstile> (i,s) \<rightarrow> (i0 - size P, s0)" by (rule exec1_split)

  have "i0 = size P + (i0 - size P) " by simp
  then obtain j0::int where j0: "i0 = size P + j0"  ..

  note split_paired_Ex [simp del]

  have ?case if assm: "j0 \<in> {0 ..< size c}"
  proof -
    from assm j0 j rest c show ?case
      by (fastforce dest!: Suc.IH intro!: exec_Suc)
  qed
  moreover
  have ?case if assm: "j0 \<notin> {0 ..< size c}"
  proof -
    from c j0 have "j0 \<in> succs c 0"
      by (auto dest: succs_iexec1 simp: exec1_def simp del: iexec.simps)
    with assm have "j0 \<in> exits c" by (simp add: exits_def)
    with c j0 rest show ?case by fastforce
  qed
  ultimately
  show ?case by cases
qed

lemma exec_n_drop_right:
  fixes j :: int
  assumes "c @ P' \<turnstile> (0, s) \<rightarrow>^n (j, s')" "j \<notin> {0..<size c}"
  shows "\<exists>s'' i' k m.
          (if c = [] then s'' = s \<and> i' = 0 \<and> k = 0
           else c \<turnstile> (0, s) \<rightarrow>^k (i', s'') \<and>
           i' \<in> exits c) \<and>
           c @ P' \<turnstile> (i', s'') \<rightarrow>^m (j, s') \<and>
           n = k + m"
  using assms
  by (cases "c = []")
     (auto dest: exec_n_split [where P="[]", simplified])

text \<open>
  Dropping the left context of a potentially incomplete execution of \<^term>\<open>c\<close>.
\<close>

lemma exec1_drop_left:
  fixes i n :: int
  assumes "P1 @ P2 \<turnstile> (i, s, stk) \<rightarrow> (n, s', stk')" and "size P1 \<le> i"
  shows "P2 \<turnstile> (i - size P1, s, stk) \<rightarrow> (n - size P1, s', stk')"
proof -
  have "i = size P1 + (i - size P1)" by simp
  then obtain i' :: int where "i = size P1 + i'" ..
  moreover
  have "n = size P1 + (n - size P1)" by simp
  then obtain n' :: int where "n = size P1 + n'" ..
  ultimately
  show ?thesis using assms
    by (clarsimp simp: exec1_def simp del: iexec.simps)
qed

lemma exec_n_drop_left:
  fixes i n :: int
  assumes "P @ P' \<turnstile> (i, s, stk) \<rightarrow>^k (n, s', stk')"
          "size P \<le> i" "exits P' \<subseteq> {0..}"
  shows "P' \<turnstile> (i - size P, s, stk) \<rightarrow>^k (n - size P, s', stk')"
using assms proof (induction k arbitrary: i s stk)
  case 0 thus ?case by simp
next
  case (Suc k)
  from Suc.prems
  obtain i' s'' stk'' where
    step: "P @ P' \<turnstile> (i, s, stk) \<rightarrow> (i', s'', stk'')" and
    rest: "P @ P' \<turnstile> (i', s'', stk'') \<rightarrow>^k (n, s', stk')"
    by auto
  from step \<open>size P \<le> i\<close>
  have *: "P' \<turnstile> (i - size P, s, stk) \<rightarrow> (i' - size P, s'', stk'')"
    by (rule exec1_drop_left)
  then have "i' - size P \<in> succs P' 0"
    by (fastforce dest!: succs_iexec1 simp: exec1_def simp del: iexec.simps)
  with \<open>exits P' \<subseteq> {0..}\<close>
  have "size P \<le> i'" by (auto simp: exits_def)
  from rest this \<open>exits P' \<subseteq> {0..}\<close>
  have "P' \<turnstile> (i' - size P, s'', stk'') \<rightarrow>^k (n - size P, s', stk')"
    by (rule Suc.IH)
  with * show ?case by auto
qed

lemmas exec_n_drop_Cons =
  exec_n_drop_left [where P="[instr]", simplified] for instr

definition
  "closed P \<longleftrightarrow> exits P \<subseteq> {size P}"

lemma ccomp_closed [simp, intro!]: "closed (ccomp c)"
  using ccomp_exits by (auto simp: closed_def)

lemma acomp_closed [simp, intro!]: "closed (acomp c)"
  by (simp add: closed_def)

lemma exec_n_split_full:
  fixes j :: int
  assumes exec: "P @ P' \<turnstile> (0,s,stk) \<rightarrow>^k (j, s', stk')"
  assumes P: "size P \<le> j"
  assumes closed: "closed P"
  assumes exits: "exits P' \<subseteq> {0..}"
  shows "\<exists>k1 k2 s'' stk''. P \<turnstile> (0,s,stk) \<rightarrow>^k1 (size P, s'', stk'') \<and>
                           P' \<turnstile> (0,s'',stk'') \<rightarrow>^k2 (j - size P, s', stk')"
proof (cases "P")
  case Nil with exec
  show ?thesis by fastforce
next
  case Cons
  hence "0 < size P" by simp
  with exec P closed
  obtain k1 k2 s'' stk'' where
    1: "P \<turnstile> (0,s,stk) \<rightarrow>^k1 (size P, s'', stk'')" and
    2: "P @ P' \<turnstile> (size P,s'',stk'') \<rightarrow>^k2 (j, s', stk')"
    by (auto dest!: exec_n_split [where P="[]" and i=0, simplified]
             simp: closed_def)
  moreover
  have "j = size P + (j - size P)" by simp
  then obtain j0 :: int where "j = size P + j0" ..
  ultimately
  show ?thesis using exits
    by (fastforce dest: exec_n_drop_left)
qed

subsection \<open>Correctness theorem\<close>

lemma acomp_neq_Nil [simp]:
  "acomp a \<noteq> []"
  by (induct a) auto

lemma acomp_exec_n [dest!]:
  "acomp a \<turnstile> (0,s,stk) \<rightarrow>^n (size (acomp a),s',stk') \<Longrightarrow>
  s' = s \<and> stk' = aval a s#stk"
proof (induction a arbitrary: n s' stk stk')
  case (Plus a1 a2)
  let ?sz = "size (acomp a1) + (size (acomp a2) + 1)"
  from Plus.prems
  have "acomp a1 @ acomp a2 @ [ADD] \<turnstile> (0,s,stk) \<rightarrow>^n (?sz, s', stk')"
    by (simp add: algebra_simps)

  then obtain n1 s1 stk1 n2 s2 stk2 n3 where
    "acomp a1 \<turnstile> (0,s,stk) \<rightarrow>^n1 (size (acomp a1), s1, stk1)"
    "acomp a2 \<turnstile> (0,s1,stk1) \<rightarrow>^n2 (size (acomp a2), s2, stk2)"
       "[ADD] \<turnstile> (0,s2,stk2) \<rightarrow>^n3 (1, s', stk')"
    by (auto dest!: exec_n_split_full)

  thus ?case by (fastforce dest: Plus.IH simp: exec_n_simps exec1_def)
qed (auto simp: exec_n_simps exec1_def)

lemma bcomp_split:
  fixes i j :: int
  assumes "bcomp b f i @ P' \<turnstile> (0, s, stk) \<rightarrow>^n (j, s', stk')"
          "j \<notin> {0..<size (bcomp b f i)}" "0 \<le> i"
  shows "\<exists>s'' stk'' (i'::int) k m.
           bcomp b f i \<turnstile> (0, s, stk) \<rightarrow>^k (i', s'', stk'') \<and>
           (i' = size (bcomp b f i) \<or> i' = i + size (bcomp b f i)) \<and>
           bcomp b f i @ P' \<turnstile> (i', s'', stk'') \<rightarrow>^m (j, s', stk') \<and>
           n = k + m"
  using assms by (cases "bcomp b f i = []") (fastforce dest!: exec_n_drop_right)+

lemma bcomp_exec_n [dest]:
  fixes i j :: int
  assumes "bcomp b f j \<turnstile> (0, s, stk) \<rightarrow>^n (i, s', stk')"
          "size (bcomp b f j) \<le> i" "0 \<le> j"
  shows "i = size(bcomp b f j) + (if f = bval b s then j else 0) \<and>
         s' = s \<and> stk' = stk"
using assms proof (induction b arbitrary: f j i n s' stk')
  case Bc thus ?case
    by (simp split: if_split_asm add: exec_n_simps exec1_def)
next
  case (Not b)
  from Not.prems show ?case
    by (fastforce dest!: Not.IH)
next
  case (And b1 b2)

  let ?b2 = "bcomp b2 f j"
  let ?m  = "if f then size ?b2 else size ?b2 + j"
  let ?b1 = "bcomp b1 False ?m"

  have j: "size (bcomp (And b1 b2) f j) \<le> i" "0 \<le> j" by fact+

  from And.prems
  obtain s'' stk'' and i'::int and k m where
    b1: "?b1 \<turnstile> (0, s, stk) \<rightarrow>^k (i', s'', stk'')"
        "i' = size ?b1 \<or> i' = ?m + size ?b1" and
    b2: "?b2 \<turnstile> (i' - size ?b1, s'', stk'') \<rightarrow>^m (i - size ?b1, s', stk')"
    by (auto dest!: bcomp_split dest: exec_n_drop_left)
  from b1 j
  have "i' = size ?b1 + (if \<not>bval b1 s then ?m else 0) \<and> s'' = s \<and> stk'' = stk"
    by (auto dest!: And.IH)
  with b2 j
  show ?case
    by (fastforce dest!: And.IH simp: exec_n_end split: if_split_asm)
next
  case Less
  thus ?case by (auto dest!: exec_n_split_full simp: exec_n_simps exec1_def) (* takes time *)
qed

lemma ccomp_empty [elim!]:
  "ccomp c = [] \<Longrightarrow> (c,s) \<Rightarrow> s"
  by (induct c) auto

declare assign_simp [simp]

lemma ccomp_exec_n:
  "ccomp c \<turnstile> (0,s,stk) \<rightarrow>^n (size(ccomp c),t,stk')
  \<Longrightarrow> (c,s) \<Rightarrow> t \<and> stk'=stk"
proof (induction c arbitrary: s t stk stk' n)
  case SKIP
  thus ?case by auto
next
  case (Assign x a)
  thus ?case
    by simp (fastforce dest!: exec_n_split_full simp: exec_n_simps exec1_def)
next
  case (Seq c1 c2)
  thus ?case by (fastforce dest!: exec_n_split_full)
next
  case (If b c1 c2)
  note If.IH [dest!]

  let ?if = "IF b THEN c1 ELSE c2"
  let ?cs = "ccomp ?if"
  let ?bcomp = "bcomp b False (size (ccomp c1) + 1)"

  from \<open>?cs \<turnstile> (0,s,stk) \<rightarrow>^n (size ?cs,t,stk')\<close>
  obtain i' :: int and k m s'' stk'' where
    cs: "?cs \<turnstile> (i',s'',stk'') \<rightarrow>^m (size ?cs,t,stk')" and
        "?bcomp \<turnstile> (0,s,stk) \<rightarrow>^k (i', s'', stk'')"
        "i' = size ?bcomp \<or> i' = size ?bcomp + size (ccomp c1) + 1"
    by (auto dest!: bcomp_split)

  hence i':
    "s''=s" "stk'' = stk"
    "i' = (if bval b s then size ?bcomp else size ?bcomp+size(ccomp c1)+1)"
    by auto

  with cs have cs':
    "ccomp c1@JMP (size (ccomp c2))#ccomp c2 \<turnstile>
       (if bval b s then 0 else size (ccomp c1)+1, s, stk) \<rightarrow>^m
       (1 + size (ccomp c1) + size (ccomp c2), t, stk')"
    by (fastforce dest: exec_n_drop_left simp: exits_Cons isuccs_def algebra_simps)

  show ?case
  proof (cases "bval b s")
    case True with cs'
    show ?thesis
      by simp
         (fastforce dest: exec_n_drop_right
                   split: if_split_asm
                   simp: exec_n_simps exec1_def)
  next
    case False with cs'
    show ?thesis
      by (auto dest!: exec_n_drop_Cons exec_n_drop_left
               simp: exits_Cons isuccs_def)
  qed
next
  case (While b c)

  from While.prems
  show ?case
  proof (induction n arbitrary: s rule: nat_less_induct)
    case (1 n)

    have ?case if assm: "\<not> bval b s"
    proof -
      from assm "1.prems"
      show ?case
        by simp (fastforce dest!: bcomp_split simp: exec_n_simps)
    qed
    moreover
    have ?case if b: "bval b s"
    proof -
      let ?c0 = "WHILE b DO c"
      let ?cs = "ccomp ?c0"
      let ?bs = "bcomp b False (size (ccomp c) + 1)"
      let ?jmp = "[JMP (-((size ?bs + size (ccomp c) + 1)))]"

      from "1.prems" b
      obtain k where
        cs: "?cs \<turnstile> (size ?bs, s, stk) \<rightarrow>^k (size ?cs, t, stk')" and
        k:  "k \<le> n"
        by (fastforce dest!: bcomp_split)

      show ?case
      proof cases
        assume "ccomp c = []"
        with cs k
        obtain m where
          "?cs \<turnstile> (0,s,stk) \<rightarrow>^m (size (ccomp ?c0), t, stk')"
          "m < n"
          by (auto simp: exec_n_step [where k=k] exec1_def)
        with "1.IH"
        show ?case by blast
      next
        assume "ccomp c \<noteq> []"
        with cs
        obtain m m' s'' stk'' where
          c: "ccomp c \<turnstile> (0, s, stk) \<rightarrow>^m' (size (ccomp c), s'', stk'')" and
          rest: "?cs \<turnstile> (size ?bs + size (ccomp c), s'', stk'') \<rightarrow>^m
                       (size ?cs, t, stk')" and
          m: "k = m + m'"
          by (auto dest: exec_n_split [where i=0, simplified])
        from c
        have "(c,s) \<Rightarrow> s''" and stk: "stk'' = stk"
          by (auto dest!: While.IH)
        moreover
        from rest m k stk
        obtain k' where
          "?cs \<turnstile> (0, s'', stk) \<rightarrow>^k' (size ?cs, t, stk')"
          "k' < n"
          by (auto simp: exec_n_step [where k=m] exec1_def)
        with "1.IH"
        have "(?c0, s'') \<Rightarrow> t \<and> stk' = stk" by blast
        ultimately
        show ?case using b by blast
      qed
    qed
    ultimately show ?case by cases
  qed
qed

theorem ccomp_exec:
  "ccomp c \<turnstile> (0,s,stk) \<rightarrow>* (size(ccomp c),t,stk') \<Longrightarrow> (c,s) \<Rightarrow> t"
  by (auto dest: exec_exec_n ccomp_exec_n)

corollary ccomp_sound:
  "ccomp c \<turnstile> (0,s,stk) \<rightarrow>* (size(ccomp c),t,stk)  \<longleftrightarrow>  (c,s) \<Rightarrow> t"
  by (blast intro!: ccomp_exec ccomp_bigstep)

end


theory Prelude_ListNoNumbers
imports "$HETS_ISABELLE_LIB/MainHC"
uses "$HETS_ISABELLE_LIB/prelude"
begin

setup "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\", \"TO3\",
        \"TO4\", \"TO5\", \"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\", \"PartialTest\"]"

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
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 partial"
X_foldr :: "('a => 'b => 'b) => 'b => 'a List => 'b partial"
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"
notH__X :: "Bool => Bool" ("(notH/ _)" [56] 56)
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 :: 'b => 'c).
 ALL (g :: 'a => 'b). ALL (y :: 'a). X__o__X (f, g) y = f (g y)"

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

FlipDef [rule_format] :
"ALL (f :: 'a => 'b => 'c).
 ALL (x :: 'a). ALL (y :: 'b). X_flip f y x = f x y"

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

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

CurryDef [rule_format] :
"ALL (g :: 'a * 'b => 'c).
 ALL (x :: 'a). ALL (y :: 'b). X_curry g x y = g (x, y)"

UncurryDef [rule_format] :
"ALL (f :: 'a => 'b => 'c).
 ALL (x :: 'a). ALL (y :: 'b). uncurry f (x, y) = f x y"

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

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

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

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

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

OrDef [rule_format] :
"ALL (x :: Bool).
 ALL (y :: Bool). x || y = notH (notH x && notH y)"

OtherwiseDef [rule_format] : "otherwiseH = True'"

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

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

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

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

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

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

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

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

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

DiffSymDef [rule_format] :
"ALL (x :: 'a). ALL (y :: 'a). x /= y = y /= x"

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

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

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

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

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

TE4 [rule_format] :
"ALL (x :: 'a).
 ALL (y :: 'a). (~ 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] : "notH (True' ==' False') = True'"

IBE8 [rule_format] : "notH notH (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 :: 'a). ALL (y :: 'a). x ==' y = True' --> x <' y = False'"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

TO5 [rule_format] :
"ALL (w :: 'a).
 ALL (x :: 'a).
 ALL (y :: 'a).
 ALL (z :: 'a).
 (x <' y = True' & y <' z = True') & z <' w = True' -->
 x <' w = 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 :: 'a).
 ALL (xs :: 'a List). head(X_Cons x xs) = makePartial x"

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

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

FoldrNil [rule_format] :
"ALL (f :: 'a => 'b => 'b).
 ALL (s :: 'b). X_foldr f s Nil' = makePartial s"

FoldrCons [rule_format] :
"ALL (f :: 'a => 'b => 'b).
 ALL (s :: 'b).
 ALL (x :: 'a).
 ALL (xs :: 'a List).
 X_foldr f s (X_Cons x xs) =
 restrictOp (makePartial (f x (makeTotal (X_foldr f s xs))))
 (defOp (X_foldr f s xs))"

FoldlNil [rule_format] :
"ALL (g :: 'a => 'b => 'a).
 ALL (t :: 'a). X_foldl g t Nil' = makePartial t"

FoldlCons [rule_format] :
"ALL (g :: 'a => 'b => 'a).
 ALL (t :: 'a).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 X_foldl g t (X_Cons z zs) = X_foldl g (g t z) zs"

MapNil [rule_format] : "ALL (h :: 'a => 'b). X_map h Nil' = Nil'"

MapCons [rule_format] :
"ALL (h :: 'a => 'b).
 ALL (x :: 'a).
 ALL (xs :: 'a List).
 X_map h (X_Cons x xs) = X_Cons (h x) (X_map h xs)"

XPlusXPlusNil [rule_format] : "ALL (l :: 'a List). Nil' ++' l = l"

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

FilterNil [rule_format] :
"ALL (p :: 'a => Bool). X_filter p Nil' = Nil'"

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

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

ZipNil [rule_format] : "ALL (l :: 'a List). X_zip Nil' l = Nil'"

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

ZipConsCons [rule_format] :
"ALL (l :: 'a List).
 ALL (x :: 'a).
 ALL (xs :: 'a List).
 ALL (y :: 'a).
 ALL (ys :: 'a List).
 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 :: ('a * 'b) List).
 ALL (x :: 'a).
 ALL (z :: 'b).
 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 :: 'a).
 ALL (xs :: 'a List).
 ALL (y :: 'a).
 ALL (ys :: 'a List).
 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 :: 'b).
 ALL (ws :: 'b List).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 z <' w = True' --> X_Cons z zs <' X_Cons w ws = True'"

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

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

ILO08 [rule_format] :
"ALL (w :: 'b).
 ALL (ws :: 'b List).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 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 :: 'b).
 ALL (ws :: 'b List).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 X_Cons z zs >' X_Cons w ws = X_Cons w ws <' X_Cons z zs"

ILO10 [rule_format] :
"ALL (w :: 'b).
 ALL (ws :: 'b List).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 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 :: 'b).
 ALL (ws :: 'b List).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 compare (X_Cons z zs) (X_Cons w ws) ==' EQ =
 X_Cons z zs ==' X_Cons w ws"

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

ILO16 [rule_format] :
"ALL (w :: 'b).
 ALL (ws :: 'b List).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 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 :: 'b).
 ALL (ws :: 'b List).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 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 :: 'b).
 ALL (ws :: 'b List).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 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 :: 'b).
 ALL (ws :: 'b List).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 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 :: 'b).
 ALL (ws :: 'b List).
 ALL (z :: 'b).
 ALL (zs :: 'b List).
 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 :: 'a).
 ALL (i :: 'a => 'b => 'a).
 ALL (ts :: 'b List).
 ALL (ys :: 'b List).
 X_foldl i e (ys ++' ts) =
 restrictOp (X_foldl i (makeTotal (X_foldl i e ys)) ts)
 (defOp (X_foldl i e ys))"

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

MapFunctor [rule_format] :
"ALL (f :: 'a => 'b).
 ALL (g :: 'b => 'c).
 ALL (xs :: 'a List).
 X_map (X__o__X (g, f)) xs = X_map g (X_map f xs)"

FilterProm [rule_format] :
"ALL (f :: 'a => 'b).
 ALL (p :: 'b => Bool).
 ALL (xs :: 'a List).
 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 :: 'a). init(X_Cons x Nil') = makePartial Nil'"

InitConsCons [rule_format] :
"ALL (x :: 'a).
 ALL (xs :: 'a List).
 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 :: 'a). last'(X_Cons x Nil') = makePartial x"

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

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

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

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

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

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

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

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

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

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

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

ScanlNil [rule_format] :
"ALL (g :: 'a => 'b => 'a).
 ALL (q :: 'a).
 ALL (ys :: 'b List). ys = Nil' --> scanl g q ys = X_Cons q Nil'"

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

Scanl1Nil [rule_format] :
"ALL (f :: 'a => 'a => 'a). scanl1 f Nil' = Nil'"

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

ScanrNil [rule_format] :
"ALL (h :: 'a => 'b => 'b).
 ALL (z :: 'b). scanr h z Nil' = X_Cons z Nil'"

ScanrCons [rule_format] :
"ALL (h :: 'a => 'b => 'b).
 ALL (x :: 'a).
 ALL (xs :: 'a List).
 ALL (y :: 'b).
 ALL (ys :: 'b List).
 ALL (z :: 'b).
 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 :: 'a => 'a => 'a). scanr1 f Nil' = Nil'"

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

Scanr1ConsCons [rule_format] :
"ALL (f :: 'a => 'a => 'a).
 ALL (q :: 'a).
 ALL (qs :: 'a List).
 ALL (x :: 'a).
 ALL (xs :: 'a List).
 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 :: 'a => 'b => 'a).
 ALL (x :: 'a).
 ALL (ys :: 'b List). last'(scanl g x ys) = X_foldl g x ys"

ScanrProperty [rule_format] :
"ALL (h :: 'a => 'b => 'b).
 ALL (xs :: 'a List).
 ALL (y :: 'b). head(scanr h y xs) = X_foldr h y xs"

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

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

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

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

AnyDef [rule_format] :
"ALL (p :: 'a => Bool).
 ALL (xs :: 'a List). X_any p xs = orL(X_map p xs)"

AllDef [rule_format] :
"ALL (p :: 'a => Bool).
 ALL (xs :: 'a List). X_all p xs = andL(X_map p xs)"

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

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

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

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

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

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

TakeWhileNil [rule_format] :
"ALL (p :: 'a => Bool). X_takeWhile p Nil' = Nil'"

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

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

DropWhileNil [rule_format] :
"ALL (p :: 'a => Bool). X_dropWhile p Nil' = Nil'"

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

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

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

SpanConsT [rule_format] :
"ALL (p :: 'a => Bool).
 ALL (x :: 'a).
 ALL (xs :: 'a List).
 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 :: 'a => Bool).
 ALL (x :: 'a).
 ALL (xs :: 'a List).
 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 :: 'a => Bool).
 ALL (xs :: 'a List).
 span p xs = (X_takeWhile p xs, X_dropWhile p xs)"

BreakDef [rule_format] :
"ALL (p :: 'a => Bool).
 ALL (xs :: 'a List).
 break p xs = (let q = X__o__X (notH__X, p) in span q xs)"

BreakThm [rule_format] :
"ALL (p :: 'a => Bool).
 ALL (xs :: 'a List). break p xs = span (X__o__X (notH__X, p)) xs"

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

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

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

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

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

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

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

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

Partition [rule_format] :
"ALL (p :: 'a => Bool).
 ALL (xs :: 'a List).
 makePartial (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 TO4 [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 ScanlProperty [simp]
declare ScanrProperty [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 :: 'a => Bool).
 ALL (xs :: 'a List).
 partition p xs =
 (X_filter p xs, X_filter (X__o__X (notH__X, p)) xs)"
(*
apply(auto)
apply(induct_tac xs)
apply(simp add: Comp1)
apply(auto)
apply(case_tac "p a")
apply(case_tac "(%a. Not' p a) a")
apply(simp add: FilterConsT FilterConsF)
apply(simp add: NotTrue NotFalse notNot1 notNot2 NotTrue1 NotFalse1)
apply(auto)
thm Partition
apply(simp add: FilterConsT FilterConsF)
apply(simp add: Partition SelectT SelectF)
apply(simp add: NotTrue1 NotFalse1)
apply(auto)
apply(simp add: FilterConsT)
apply(simp add: FoldrCons)
apply(simp only: FilterConsT)
done
*)
oops

setup "Header.record \"PartitionProp\""

theorem PartialTest :
"ALL (x :: 'a).
 ALL (xs :: 'a List).
 makePartial (X_Cons x xs) =
 restrictOp
 (makePartial
  (X_Cons (makeTotal (head(X_Cons x xs)))
   (makeTotal (tail(X_Cons x xs)))))
 (defOp (head(X_Cons x xs)) & defOp (tail(X_Cons x xs)))"
apply(auto)
apply (simp add: makePartial_def makeTotal_def restrictOp_def)
done

setup "Header.record \"PartialTest\""

end


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

datatype Nat = Z | S "Nat"

fun le :: "Nat => Nat => bool" where
"le (Z) y = True"
| "le (S z) (Z) = False"
| "le (S z) (S x2) = le z x2"

theorem property0 :
  "((let y2 :: Nat = (if le y z then z else y)
     in (if le x y2 then y2 else x)) =
      ((let x2 :: Nat = (if le x y then y else x)
        in % (y3 :: Nat) => (if le x2 y3 then y3 else x2))
       z))"
  oops

end


section \<open>Contexts and Subsumption\<close>
text\<open>This theory uses contexts to extend the idea of transition subsumption from \<^cite>\<open>"lorenzoli2008"\<close> to
EFSM transitions with register update functions. The \emph{subsumption in context} relation is the
main contribution of \<^cite>\<open>"foster2018"\<close>.\<close>

theory Subsumption
  imports
    "Extended_Finite_State_Machines.EFSM"
begin

definition posterior_separate :: "nat \<Rightarrow> vname gexp list \<Rightarrow> update_function list \<Rightarrow> inputs \<Rightarrow> registers \<Rightarrow> registers option" where
  "posterior_separate a g u i r = (if can_take a g i r then Some (apply_updates u (join_ir i r) r) else None)"

definition posterior :: "transition \<Rightarrow> inputs \<Rightarrow> registers \<Rightarrow> registers option" where
  "posterior t i r = posterior_separate (Arity t) (Guards t) (Updates t) i r"

definition subsumes :: "transition \<Rightarrow> registers \<Rightarrow> transition \<Rightarrow> bool" where
  "subsumes t2 r t1 = (Label t1 = Label t2 \<and> Arity t1 = Arity t2 \<and>
                       (\<forall>i. can_take_transition t1 i r \<longrightarrow> can_take_transition t2 i r) \<and>
                       (\<forall>i. can_take_transition t1 i r \<longrightarrow>
                            evaluate_outputs t1 i r = evaluate_outputs t2 i r) \<and>
                       (\<forall>p1 p2 i. posterior_separate (Arity t1) (Guards t1) (Updates t2) i r = Some p2 \<longrightarrow>
                                  posterior_separate (Arity t1) (Guards t1) (Updates t1) i r = Some p1 \<longrightarrow>
                                  (\<forall>P r'. (p1 $ r' = None) \<or> (P (p2 $ r') \<longrightarrow> P (p1 $ r'))))
                      )"

lemma no_functionality_subsumed:
  "Label t1 = Label t2 \<Longrightarrow>
   Arity t1 = Arity t2 \<Longrightarrow>
   \<nexists>i. can_take_transition t1 i c \<Longrightarrow>
   subsumes t2 c t1"
  by (simp add: subsumes_def posterior_separate_def can_take_transition_def)

lemma subsumes_updates:
  "subsumes t2 r t1 \<Longrightarrow>
   can_take_transition t1 i r \<Longrightarrow>
   evaluate_updates t1 i r $ a = Some x \<Longrightarrow>
   evaluate_updates t2 i r $ a = Some x"
  apply (simp add: subsumes_def posterior_separate_def can_take_transition_def[symmetric])
  apply clarsimp
  apply (erule_tac x=i in allE)+
  apply (erule_tac x="evaluate_updates t1 i r" in allE)
  apply (erule_tac x="evaluate_updates t2 i r" in allE)
  apply (erule_tac x=i in allE)
  apply simp
  apply (simp add: all_comm[of "\<lambda>P r'.
            P (evaluate_updates t2 i r $ r') \<longrightarrow> evaluate_updates t1 i r $ r' = None \<or> P (evaluate_updates t1 i r $ r')"])
  apply (erule_tac x=a in allE)
  by auto

lemma subsumption:
  "(Label t1 = Label t2 \<and> Arity t1 = Arity t2) \<Longrightarrow>
   (\<forall>i. can_take_transition t1 i r \<longrightarrow> can_take_transition t2 i r) \<Longrightarrow>
   (\<forall>i. can_take_transition t1 i r \<longrightarrow>
        evaluate_outputs t1 i r = evaluate_outputs t2 i r) \<Longrightarrow>

   (\<forall>p1 p2 i. posterior_separate (Arity t1) (Guards t1) (Updates t2) i r = Some p2 \<longrightarrow>
              posterior_separate (Arity t1) (Guards t1) (Updates t1) i r = Some p1 \<longrightarrow>
              (\<forall>P r'. (p1 $ r' = None) \<or> (P (p2 $ r') \<longrightarrow> P (p1 $ r')))) \<Longrightarrow>
   subsumes t2 r t1"
  by (simp add: subsumes_def)

lemma bad_guards:
  "\<exists>i. can_take_transition t1 i r \<and> \<not> can_take_transition t2 i r \<Longrightarrow>
   \<not> subsumes t2 r t1"
  by (simp add: subsumes_def)

lemma inconsistent_updates:
  "\<exists>p2 p1. (\<exists>i. posterior_separate (Arity t1) (Guards t1) (Updates t2) i r = Some p2 \<and>
                posterior_separate (Arity t1) (Guards t1) (Updates t1) i r = Some p1) \<and>
           (\<exists>r' P. P (p2 $ r') \<and> (\<exists>y. p1 $ r' = Some y) \<and> \<not> P (p1 $ r')) \<Longrightarrow>

    \<not> subsumes t2 r t1"
  by (metis (no_types, opaque_lifting) option.simps(3) subsumes_def)

lemma bad_outputs:
  "\<exists>i. can_take_transition t1 i r \<and> evaluate_outputs t1 i r \<noteq> evaluate_outputs t2 i r \<Longrightarrow>
   \<not> subsumes t2 r t1"
  by (simp add: subsumes_def)

lemma no_choice_no_subsumption: "Label t = Label t' \<Longrightarrow>
   Arity t = Arity t' \<Longrightarrow>
   \<not> choice t t' \<Longrightarrow>
   \<exists>i. can_take_transition t' i c \<Longrightarrow>
  \<not> subsumes t c t'"
  by (meson bad_guards can_take_def can_take_transition_def choice_def)

lemma subsumption_def_alt: "subsumes t1 c t2 = (Label t2 = Label t1 \<and>
    Arity t2 = Arity t1 \<and>
    (\<forall>i. can_take_transition t2 i c \<longrightarrow> can_take_transition t1 i c) \<and>
    (\<forall>i. can_take_transition t2 i c \<longrightarrow> evaluate_outputs t2 i c = evaluate_outputs t1 i c) \<and>
    (\<forall>i. can_take_transition t2 i c \<longrightarrow>
         (\<forall>r' P.
             P (evaluate_updates t1 i c $ r') \<longrightarrow>
             evaluate_updates t2 i c $ r' = None \<or> P (evaluate_updates t2 i c $ r'))))"
  apply (simp add: subsumes_def posterior_separate_def can_take_transition_def[symmetric])
  by blast

text_raw\<open>\snip{subsumptionReflexive}{1}{2}{%\<close>
lemma subsumes_reflexive: "subsumes t c t"
text_raw\<open>$\langle\isa{proof}\rangle$}%endsnip\<close>
  by (simp add: subsumes_def)

text_raw\<open>\snip{subsumptionTransitive}{1}{2}{%\<close>
lemma subsumes_transitive:
  assumes p1: "subsumes t1 c t2"
      and p2: "subsumes t2 c t3"
  shows "subsumes t1 c t3"
text_raw\<open>}%endsnip\<close>
  using p1 p2
  apply (simp add: subsumes_def)
  by (metis subsumes_update_equality p1 p2 can_take_transition_def option.distinct(1) option.sel posterior_separate_def)

lemma subsumes_possible_steps_replace:
  "(s2', t2') |\<in>| possible_steps e2 s2 r2 l i \<Longrightarrow>
   subsumes t2 r2 t1 \<Longrightarrow>
   ((s2, s2'), t2') = ((ss2, ss2'), t1) \<Longrightarrow>
   (s2', t2) |\<in>| possible_steps (replace e2 ((ss2, ss2'), t1) ((ss2, ss2'), t2)) s2 r2 l i"
proof(induct e2)
  case empty
  then show ?case
    by (simp add: no_outgoing_transitions)
next
  case (insert x e2)
  then show ?case
    apply (simp add: fmember_possible_steps subsumes_def)
    apply standard
    apply (simp add: replace_def)
     apply auto[1]
    by (simp add: can_take)
qed

subsection\<open>Direct Subsumption\<close>
text\<open>When merging EFSM transitions, one must \emph{account for} the behaviour of the other. The
\emph{subsumption in context} relation formalises the intuition that, in certain contexts, a
transition $t_2$ reproduces the behaviour of, and updates the data state in a manner consistent
with, another transition $t_1$, meaning that $t_2$ can be used in place of $t_1$ with no observable
difference in behaviour.

The subsumption in context relation requires us to supply a context in which to test subsumption,
but there is a problem when we try to apply this to inference: Which context should we use? The
\emph{direct subsumption} relation works at EFSM level to determine when and whether one transition
is able to account for the behaviour of another such that we can use one in place of another without
adversely effecting observable behaviour.\<close>

text_raw\<open>\snip{directlySubsumes}{1}{2}{%\<close>
definition directly_subsumes :: "transition_matrix \<Rightarrow> transition_matrix \<Rightarrow> cfstate \<Rightarrow> cfstate \<Rightarrow> transition \<Rightarrow> transition \<Rightarrow> bool" where
  "directly_subsumes e1 e2 s1 s2 t1 t2 \<equiv> (\<forall>c1 c2 t. (obtains s1 c1 e1 0 <> t \<and> obtains s2 c2 e2 0 <> t) \<longrightarrow> subsumes t1 c2 t2)"
text_raw\<open>}%endsnip\<close>

text_raw\<open>\snip{subsumesAllContexts}{1}{2}{%\<close>
lemma subsumes_in_all_contexts_directly_subsumes:
  "(\<And>c. subsumes t2 c t1) \<Longrightarrow> directly_subsumes e1 e2 s s' t2 t1"
text_raw\<open>}%endsnip\<close>
  by (simp add: directly_subsumes_def)

text_raw\<open>\snip{directSubsumption}{1}{2}{%\<close>
lemma direct_subsumption:
  "(\<And>t c1 c2. obtains s1 c1 e1 0 <> t \<Longrightarrow> obtains s2 c2 e2 0 <> t \<Longrightarrow> f c2) \<Longrightarrow>
   (\<And>c. f c \<Longrightarrow> subsumes t1 c t2) \<Longrightarrow>
   directly_subsumes e1 e2 s1 s2 t1 t2"
   text_raw\<open>}%endsnip\<close>
  apply (simp add: directly_subsumes_def)
  by auto

text_raw\<open>\snip{obtainableNoSubsumption}{1}{2}{%\<close>
lemma visits_and_not_subsumes:
  "(\<exists>c1 c2 t. obtains s1 c1 e1 0 <> t \<and> obtains s2 c2 e2 0 <> t \<and> \<not> subsumes t1 c2 t2) \<Longrightarrow>
   \<not> directly_subsumes e1 e2 s1 s2 t1 t2"
text_raw\<open>}%endsnip\<close>
  apply (simp add: directly_subsumes_def)
  by auto

text_raw\<open>\snip{directSubsumptionReflexive}{1}{2}{%\<close>
lemma directly_subsumes_reflexive: "directly_subsumes e1 e2 s1 s2 t t"
text_raw\<open>}%endsnip\<close>
  apply (simp add: directly_subsumes_def)
  by (simp add: subsumes_reflexive)

text_raw\<open>\snip{directSubsumptionTransitive}{1}{2}{%\<close>
lemma directly_subsumes_transitive:
  assumes p1: "directly_subsumes e1 e2 s1 s2 t1 t2"
      and p2: "directly_subsumes e1 e2 s1 s2 t2 t3"
  shows "directly_subsumes e1 e2 s1 s2 t1 t3"
  text_raw\<open>}%endsnip\<close>
  using p1 p2
  apply (simp add: directly_subsumes_def)
  using subsumes_transitive by blast

end


theory ClassInstance
  imports
    Main
    "Ecore-GROOVE-Mapping.Instance_Model_Graph_Mapping"
    ClassType
begin

section "Definition of an instance model which introduces an object typed by a regular class"

definition imod_class :: "'t Id \<Rightarrow> 'o set \<Rightarrow> ('o \<Rightarrow> 't) \<Rightarrow> ('o, 't) instance_model" where
  "imod_class name objects fid = \<lparr>
    Tm = tmod_class name,
    Object = objects,
    ObjectClass = (\<lambda>x. if x \<in> objects then name else undefined),
    ObjectId = (\<lambda>x. if x \<in> objects then fid x else undefined),
    FieldValue = (\<lambda>x. undefined),
    DefaultValue = (\<lambda>x. undefined)
  \<rparr>"

lemma imod_class_correct:
  assumes unique_ids: "\<And>o1 o2. o1 \<in> objects \<Longrightarrow> o2 \<in> objects \<Longrightarrow> fid o1 = fid o2 \<Longrightarrow> o1 = o2"
  shows "instance_model (imod_class name objects fid)"
proof (intro instance_model.intro)
  show "type_model (Tm (imod_class name objects fid))"
    unfolding imod_class_def
    using tmod_class_correct
    by simp
qed (simp_all add: assms imod_class_def tmod_class_def)

lemma imod_class_combine_correct:
  assumes "instance_model Imod"
  assumes new_class: "name \<notin> Class (Tm Imod) \<union> Enum (Tm Imod) \<union> UserDataType (Tm Imod)"
  assumes valid_identifier: "\<And>x. x \<in> Class (Tm Imod) \<union> Enum (Tm Imod) \<union> UserDataType (Tm Imod) \<Longrightarrow> \<not>id_in_ns name (Identifier x) \<and> \<not>id_in_ns x (Identifier name)"
  assumes new_objects: "objects \<inter> Object Imod = {}"
  assumes unique_ids: "\<And>o1 o2. o1 \<in> objects \<Longrightarrow> o2 \<in> objects \<Longrightarrow> fid o1 = fid o2 \<Longrightarrow> o1 = o2"
  assumes new_ids: "\<And>o1 o2. o1 \<in> Object Imod \<Longrightarrow> o2 \<in> objects \<Longrightarrow> ObjectId Imod o1 \<noteq> fid o2"
  shows "instance_model (imod_combine Imod (imod_class name objects fid))"
proof (intro imod_combine_distinct_correct)
  show "instance_model (imod_class name objects fid)"
    using unique_ids
    by (fact imod_class_correct)
next
  show "Class (Tm Imod) \<inter> Class (Tm (imod_class name objects fid)) = {}"
    unfolding imod_class_def tmod_class_def
    using new_class
    by simp
next
  fix ob
  assume "ob \<in> Object Imod"
  then have ob_not_in_objects: "ob \<notin> Object (imod_class name objects fid)"
    unfolding imod_class_def
    using new_objects
    by fastforce
  assume "ob \<in> Object (imod_class name objects fid)"
  then show "ObjectClass Imod ob = ObjectClass (imod_class name objects fid) ob"
    using ob_not_in_objects
    by blast
next
  fix o1 o2
  assume o1_def: "o1 \<in> Object Imod - Object (imod_class name objects fid)"
  assume "o2 \<in> Object (imod_class name objects fid) - Object Imod"
  then have o2_def: "o2 \<in> objects"
    unfolding imod_class_def
    by simp
  then have "ObjectId Imod o1 \<noteq> fid o2"
    using new_ids o1_def
    by simp
  then show "ObjectId Imod o1 \<noteq> ObjectId (imod_class name objects fid) o2"
    unfolding imod_class_def
    by (simp add: o2_def)
next
  have "type_model (tmod_combine (Tm Imod) (tmod_class name))"
    using tmod_class_combine_correct assms(1) instance_model.validity_type_model_consistent new_class valid_identifier
    by blast
  then show "type_model (tmod_combine (Tm Imod) (Tm (imod_class name objects fid)))"
    unfolding imod_class_def
    by simp
qed (simp_all add: assms imod_class_def tmod_class_def)

section "Encoding of a Class as Node Type in GROOVE"

definition ig_class_as_node_type :: "'t Id \<Rightarrow> 'o set \<Rightarrow> ('o \<Rightarrow> 't) \<Rightarrow> ('o, 't list, 't) instance_graph" where
  "ig_class_as_node_type name objects fid = \<lparr>
    TG = tg_class_as_node_type name,
    Id = fid ` objects,
    N = typed (type (id_to_list name)) ` objects,
    E = {},
    ident = (\<lambda>x. if x \<in> fid ` objects then typed (type (id_to_list name)) (THE y. fid y = x) else undefined)
  \<rparr>"

lemma ig_class_as_node_type_correct:
  assumes unique_ids: "\<And>o1 o2. o1 \<in> objects \<Longrightarrow> fid o1 = fid o2 \<Longrightarrow> o1 = o2"
  shows "instance_graph (ig_class_as_node_type name objects fid)"
proof (intro instance_graph.intro)
  fix n
  assume "n \<in> N (ig_class_as_node_type name objects fid)"
  then have "n \<in> typed (type (id_to_list name)) ` objects"
    unfolding ig_class_as_node_type_def
    by simp
  then have "n \<in> Node\<^sub>t"
    using Lab\<^sub>t.rule_type_labels Node\<^sub>t.rule_typed_nodes
    by fastforce
  then show "n \<in> Node"
    unfolding Node_def
    by simp
next
  fix i
  assume "i \<in> Id (ig_class_as_node_type name objects fid)"
  then have i_in_id: "i \<in> fid ` objects"
    unfolding ig_class_as_node_type_def
    by simp
  then show "ident (ig_class_as_node_type name objects fid) i \<in> N (ig_class_as_node_type name objects fid) \<and> type\<^sub>n (ident (ig_class_as_node_type name objects fid) i) \<in> Lab\<^sub>t"
  proof (intro conjI)
    assume "i \<in> fid ` objects"
    then have "(THE y. fid y = i) \<in> objects"
    proof
      fix x
      assume i_def: "i = fid x"
      assume x_is_object: "x \<in> objects"
      have "(THE y. fid y = fid x) \<in> objects"
      proof (rule the1I2)
        show "\<exists>!y. fid y = fid x"
          using unique_ids x_is_object
          by metis
      next
        fix y
        assume "fid y = fid x"
        then show "y \<in> objects"
          using unique_ids x_is_object
          by metis
      qed
      then show "(THE y. fid y = i) \<in> objects"
        by (simp add: i_def)
    qed
    then have "typed (type (id_to_list name)) (THE y. fid y = i) \<in> typed (type (id_to_list name)) ` objects"
      by simp
    then show "ident (ig_class_as_node_type name objects fid) i \<in> N (ig_class_as_node_type name objects fid)"
      unfolding ig_class_as_node_type_def
      using i_in_id
      by simp
  next
    have "type\<^sub>n (typed (type (id_to_list name)) (THE y. fid y = i)) = type (id_to_list name)"
      by simp
    then have "type\<^sub>n (typed (type (id_to_list name)) (THE y. fid y = i)) \<in> Lab\<^sub>t"
      by (simp add: Lab\<^sub>t.rule_type_labels)
    then show "type\<^sub>n (ident (ig_class_as_node_type name objects fid) i) \<in> Lab\<^sub>t"
      unfolding ig_class_as_node_type_def
      using i_in_id
      by simp
  qed
next
  show "type_graph (TG (ig_class_as_node_type name objects fid))"
    unfolding ig_class_as_node_type_def
    using tg_class_as_node_type_correct
    by simp
next
  fix n
  assume "n \<in> N (ig_class_as_node_type name objects fid)"
  then have "n \<in> typed (type (id_to_list name)) ` objects"
    unfolding ig_class_as_node_type_def
    by simp
  then have "type\<^sub>n n = type (id_to_list name)"
    by auto
  then show "type\<^sub>n n \<in> NT (TG (ig_class_as_node_type name objects fid))"
    unfolding ig_class_as_node_type_def tg_class_as_node_type_def
    by simp
next
  fix p
  show "\<not>pre_digraph.cycle (instance_graph_containment_proj (ig_class_as_node_type name objects fid)) p"
    unfolding ig_class_as_node_type_def instance_graph_containment_proj_def pre_digraph.cycle_def pre_digraph.awalk_def
    by simp
qed (simp_all add: assms ig_class_as_node_type_def tg_class_as_node_type_def)

lemma ig_class_as_node_type_combine_correct:
  assumes "instance_graph IG"
  assumes new_node_type: "type (id_to_list name) \<notin> NT (TG IG)"
  assumes unique_ids: "\<And>o1 o2. o1 \<in> objects \<Longrightarrow> fid o1 = fid o2 \<Longrightarrow> o1 = o2"
  assumes new_ids: "Id IG \<inter> fid ` objects = {}"
  shows "instance_graph (ig_combine IG (ig_class_as_node_type name objects fid))"
proof (intro ig_combine_distinct_correct)
  show "instance_graph (ig_class_as_node_type name objects fid)"
    using unique_ids
    by (fact ig_class_as_node_type_correct)
next
  fix i
  assume "i \<in> Id IG"
  then have i_not_in_ids: "i \<notin> fid ` objects"
    using new_ids
    by auto
  assume "i \<in> Id (ig_class_as_node_type name objects fid)"
  then have "i \<in> fid ` objects"
    unfolding ig_class_as_node_type_def
    by simp
  then show "ident IG i = ident (ig_class_as_node_type name objects fid) i"
    using i_not_in_ids
    by blast
qed (simp_all add: ig_class_as_node_type_def tg_class_as_node_type_def assms)

subsection "Transformation functions"

definition imod_class_to_ig_class_as_node_type :: "'t Id \<Rightarrow> ('o \<Rightarrow> 't) \<Rightarrow> ('o, 't) instance_model \<Rightarrow> ('o, 't list, 't) instance_graph" where
  "imod_class_to_ig_class_as_node_type name fid Imod = \<lparr>
    TG = tg_class_as_node_type name,
    Id = fid ` Object Imod,
    N = typed (type (id_to_list name)) ` Object Imod,
    E = {},
    ident = (\<lambda>x. if x \<in> fid ` Object Imod then typed (type (id_to_list name)) (THE y. fid y = x) else undefined)
  \<rparr>"

lemma imod_class_to_ig_class_as_node_type_proj:
  shows "imod_class_to_ig_class_as_node_type name fid (imod_class name objects fid) = ig_class_as_node_type name objects fid"
  unfolding imod_class_to_ig_class_as_node_type_def ig_class_as_node_type_def imod_class_def
  by simp

lemma imod_class_to_ig_class_as_node_type_func:
  shows "ig_combine_mapping_function (imod_class_to_ig_class_as_node_type name fid) (imod_class name objects fid) (ig_class_as_node_type name objects fid)"
  by (intro ig_combine_mapping_function.intro)
    (auto simp add: imod_class_to_ig_class_as_node_type_def imod_class_def ig_class_as_node_type_def imod_combine_def)

definition ig_class_as_node_type_to_imod_class :: "'t Id \<Rightarrow> ('o \<Rightarrow> 't) \<Rightarrow> ('o, 't list, 't) instance_graph \<Rightarrow> ('o, 't) instance_model" where
  "ig_class_as_node_type_to_imod_class name fid IG = \<lparr>
    Tm = tmod_class name,
    Object = nodeId ` N IG,
    ObjectClass = (\<lambda>x. if x \<in> nodeId ` N IG then name else undefined),
    ObjectId = (\<lambda>x. if x \<in> nodeId ` N IG then fid x else undefined),
    FieldValue = (\<lambda>x. undefined),
    DefaultValue = (\<lambda>x. undefined)
  \<rparr>"

lemma ig_class_as_node_type_to_imod_class_proj:
  shows "ig_class_as_node_type_to_imod_class name fid (ig_class_as_node_type name objects fid) = imod_class name objects fid"
proof-
  have "nodeId ` typed (LabDef.type (id_to_list name)) ` objects = objects"
    by force
  then show "ig_class_as_node_type_to_imod_class name fid (ig_class_as_node_type name objects fid) = imod_class name objects fid"
    unfolding ig_class_as_node_type_to_imod_class_def imod_class_def ig_class_as_node_type_def
    by simp
qed

lemma ig_class_as_node_type_to_imod_class_func:
  shows "imod_combine_mapping_function (ig_class_as_node_type_to_imod_class name fid) (ig_class_as_node_type name objects fid) (imod_class name objects fid)"
proof-
  have "nodeId ` typed (LabDef.type (id_to_list name)) ` objects = objects"
    by force
  then show "imod_combine_mapping_function (ig_class_as_node_type_to_imod_class name fid) (ig_class_as_node_type name objects fid) (imod_class name objects fid)"
    by (intro imod_combine_mapping_function.intro)
      (auto simp add: ig_class_as_node_type_to_imod_class_def imod_class_def ig_class_as_node_type_def ig_combine_def)
qed

end