theory Chapter36_1_Language
imports DeBruijnEnvironment
begin

datatype type =
  Nat
| Arrow type type
| Unit
| Prod type type
| Void
| Sum type type
| Command type

datatype expr =
  Var var
| Zero
| Suc expr
| IsZ expr expr expr
| Lam type expr
| Appl expr expr
| Triv
| Pair expr expr
| ProjL expr
| ProjR expr
| Abort type expr
| Case expr expr expr
| InL type type expr
| InR type type expr
| Fix type expr
| Cmd cmnd
and cmnd =
  Return expr
| Bind expr cmnd
| Declare expr cmnd
| Get var
| Set var expr

primrec insert :: "var => expr => expr"
    and insert_cmd :: "var => cmnd => cmnd"
where "insert n (Var v) = Var (incr n v)"
    | "insert n Zero = Zero"
    | "insert n (Suc e) = Suc (insert n e)"
    | "insert n (IsZ et e0 es) =
            IsZ (insert n et) (insert n e0) (insert (next n) es)"
    | "insert n (Lam t e) = Lam t (insert (next n) e)"
    | "insert n (Appl e1 e2) = Appl (insert n e1) (insert n e2)"
    | "insert n Triv = Triv"
    | "insert n (Pair e1 e2) = Pair (insert n e1) (insert n e2)"
    | "insert n (ProjL e) = ProjL (insert n e)"
    | "insert n (ProjR e) = ProjR (insert n e)"
    | "insert n (Abort t e) = Abort t (insert n e)"
    | "insert n (Case et el er) =
            Case (insert n et) (insert (next n) el) (insert (next n) er)"
    | "insert n (InL t1 t2 e) = InL t1 t2 (insert n e)"
    | "insert n (InR t1 t2 e) = InR t1 t2 (insert n e)"
    | "insert n (Fix t e) = Fix t (insert (next n) e)"
    | "insert n (Cmd c) = Cmd (insert_cmd n c)"
    | "insert_cmd n (Return e) = Return (insert n e)"
    | "insert_cmd n (Bind e c) = Bind (insert n e) (insert_cmd (next n) c)"
    | "insert_cmd n (Declare e c) = Declare (insert n e) (insert_cmd n c)"
    | "insert_cmd n (Get v) = Get v"
    | "insert_cmd n (Set v e) = Set v (insert n e)"

primrec remove :: "var => expr => expr"
    and remove_cmd :: "var => cmnd => cmnd"
where "remove n (Var v) = Var (subr n v)"
    | "remove n Zero = Zero"
    | "remove n (Suc e) = Suc (remove n e)"
    | "remove n (IsZ et e0 es) =
            IsZ (remove n et) (remove n e0) (remove (next n) es)"
    | "remove n (Lam t e) = Lam t (remove (next n) e)"
    | "remove n (Appl e1 e2) = Appl (remove n e1) (remove n e2)"
    | "remove n Triv = Triv"
    | "remove n (Pair e1 e2) = Pair (remove n e1) (remove n e2)"
    | "remove n (ProjL e) = ProjL (remove n e)"
    | "remove n (ProjR e) = ProjR (remove n e)"
    | "remove n (Abort t e) = Abort t (remove n e)"
    | "remove n (Case et el er) =
            Case (remove n et) (remove (next n) el) (remove (next n) er)"
    | "remove n (InL t1 t2 e) = InL t1 t2 (remove n e)"
    | "remove n (InR t1 t2 e) = InR t1 t2 (remove n e)"
    | "remove n (Fix t e) = Fix t (remove (next n) e)"
    | "remove n (Cmd c) = Cmd (remove_cmd n c)"
    | "remove_cmd n (Return e) = Return (remove n e)"
    | "remove_cmd n (Bind e c) = Bind (remove n e) (remove_cmd (next n) c)"
    | "remove_cmd n (Declare e c) = Declare (remove n e) (remove_cmd n c)"
    | "remove_cmd n (Get v) = Get v"
    | "remove_cmd n (Set v e) = Set v (remove n e)"

primrec subst' :: "var => expr => expr => expr"
    and subst_cmd' :: "var => expr => cmnd => cmnd"
where "subst' n e' (Var v) = (if v = n then e' else Var v)"
    | "subst' n e' Zero = Zero"
    | "subst' n e' (Suc e) = Suc (subst' n e' e)"
    | "subst' n e' (IsZ et e0 es) =
            IsZ (subst' n e' et) (subst' n e' e0) (subst' (next n) (insert first e') es)"
    | "subst' n e' (Lam t e) = Lam t (subst' (next n) (insert first e') e)"
    | "subst' n e' (Appl e1 e2) = Appl (subst' n e' e1) (subst' n e' e2)"
    | "subst' n e' Triv = Triv"
    | "subst' n e' (Pair e1 e2) = Pair (subst' n e' e1) (subst' n e' e2)"
    | "subst' n e' (ProjL e) = ProjL (subst' n e' e)"
    | "subst' n e' (ProjR e) = ProjR (subst' n e' e)"
    | "subst' n e' (Abort t e) = Abort t (subst' n e' e)"
    | "subst' n e' (Case et el er) =
                      Case (subst' n e' et)
                           (subst' (next n) (insert first e') el)
                           (subst' (next n) (insert first e') er)"
    | "subst' n e' (InL t1 t2 e) = InL t1 t2 (subst' n e' e)"
    | "subst' n e' (InR t1 t2 e) = InR t1 t2 (subst' n e' e)"
    | "subst' n e' (Fix t e) = Fix t (subst' (next n) (insert first e') e)"
    | "subst' n e' (Cmd c) = Cmd (subst_cmd' n e' c)"
    | "subst_cmd' n e' (Return e) = Return (subst' n e' e)"
    | "subst_cmd' n e' (Bind e c) = Bind (subst' n e' e) (subst_cmd' (next n) (insert first e') c)"
    | "subst_cmd' n e' (Declare e c) = Declare (subst' n e' e) (subst_cmd' n e' c)"
    | "subst_cmd' n e' (Get v) = Get v"
    | "subst_cmd' n e' (Set v e) = Set v (subst' n e' e)"

definition subst :: "expr => expr => expr"
where "subst e' e = remove first (subst' first (insert first e') e)"

definition subst_cmd :: "expr => cmnd => cmnd"
where "subst_cmd e' c = remove_cmd first (subst_cmd' first (insert first e') c)"

lemma [simp]: "canswap m n ==> insert m (insert n e) = insert (next n) (insert m e)"
  and [simp]: "canswap m n ==> insert_cmd m (insert_cmd n c) = insert_cmd (next n) (insert_cmd m c)"
by (induction e and c arbitrary: n m and n m, simp_all)

lemma [simp]: "canswap m n ==> insert m (remove n e) = remove (next n) (insert m e)"
  and [simp]: "canswap m n ==> insert_cmd m (remove_cmd n c) = remove_cmd (next n) (insert_cmd m c)"
by (induction e and c arbitrary: n m and n m, simp_all)

lemma [simp]: "canswap m n ==> insert m (subst' n e' e) = subst' (next n) (insert m e') (insert m e)"
  and [simp]: "canswap m n ==> insert_cmd m (subst_cmd' n e' c) = subst_cmd' (next n) (insert m e') (insert_cmd m c)"
by (induction e and c arbitrary: n m e' and n m e', simp_all)

end


theory Graph
  imports
    "/Users/mitjakrebs/Documents/4_archives/2022_idp/thys/Graph/Undirected_Graph/Undirected_Graph"
begin

subsection \<open>\<close>

(* TODO Rename. *)
(* TODO Generalize to arbitrary edges? *)
definition idk :: "'a graph \<Rightarrow> 'a set \<Rightarrow> 'a set \<Rightarrow> 'a graph" where
  "idk G U V \<equiv> {{u, v} |u v. {u, v} \<in> G \<and> u \<in> U \<and> v \<in> V}"

subsubsection \<open>\<close>

lemma mem_idkD:
  assumes "{u, v} \<in> idk G U V"
  shows
    "{u, v} \<in> G"
    "u \<in> U \<or> v \<in> U"
    "u \<in> V \<or> v \<in> V"
  using assms
  by (auto simp add: idk_def insert_commute)

lemma mem_idkI:
  assumes "{u, v} \<in> G"
  assumes "u \<in> U"
  assumes "v \<in> V"
  shows "{u, v} \<in> idk G U V"
  using assms
  by (auto simp add: idk_def)

lemma idk_subsetI:
  assumes "\<And>x y. {x, y} \<in> idk G U V \<Longrightarrow> {x, y} \<in> S"
  shows "idk G U V \<subseteq> S"
  using assms
  by (auto simp add: idk_def)

subsubsection \<open>\<close>

lemma idk_subset:
  shows "idk G U V \<subseteq> G"
  by (auto simp add: idk_def)

subsection \<open>Incidence\<close>

definition incidence :: "'a graph \<Rightarrow> 'a set \<Rightarrow> 'a graph" where
  "incidence G V \<equiv> {e. e \<in> G \<and> e \<inter> V \<noteq> {}}"

subsubsection \<open>\<close>

lemma Vs_minus_incidence_subset:
  shows "Vs (G - incidence G V) \<subseteq> Vs G - V"
proof
  fix v
  assume assm: "v \<in> Vs (G - incidence G V)"
  hence "v \<in> Vs G"
    by (auto intro: vs_transport)
  moreover have "v \<notin> V"
  proof
    obtain e where
      "e \<in> G - incidence G V"
      "v \<in> e"
      using assm
      by (elim vs_member_elim)
    moreover assume "v \<in> V"
    ultimately show False
      by (auto simp add: incidence_def)
  qed
  ultimately show "v \<in> Vs G - V"
    by blast
qed

(*
definition incidence :: "'a graph \<Rightarrow> 'a set \<Rightarrow> 'a graph" where
  "incidence G V \<equiv> idk G V (Vs G)"

lemma mem_incidenceI:
  assumes "{u, v} \<in> G"
  assumes "u \<in> V"
  assumes "v \<in> Vs G"
  shows "{u, v} \<in> incidence G V"
  using assms
  by (auto simp add: incidence_def intro: mem_idkI)

lemma (in graph) Vs_minus_incidence_subset:
  shows "Vs (G - incidence G V) \<subseteq> Vs G - V"
proof
  fix v
  assume assm: "v \<in> Vs (G - incidence G V)"
  hence "v \<in> Vs G"
    by (auto intro: vs_transport)
  moreover have "v \<notin> V"
  proof
    obtain w where
      "{v, w} \<in> G - incidence G V"
      using Diff_subset assm
      by (metis graph_subset graph.mem_VsE)
    moreover assume "v \<in> V"
    ultimately show False
      by (fastforce simp add: insert_commute intro: edges_are_Vs[of w v] mem_incidenceI)
  qed
  ultimately show "v \<in> Vs G - V"
    by blast
qed
*)

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_propositional_AndImplication
  imports "../../Test_Base"
begin

datatype ('a, 'b) pair = pair2 "'a" "'b"

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Form = x "Form" "Form" | Not "Form" | Var "int"

fun y :: "'a list => 'a list => 'a list" where
  "y (nil2) y2 = y2"
| "y (cons2 z2 xs) y2 = cons2 z2 (y xs y2)"

fun or2 :: "bool list => bool" where
  "or2 (nil2) = False"
| "or2 (cons2 y2 xs) = (y2 | (or2 xs))"

fun models7 :: "int => ((int, bool) pair) list =>
                ((int, bool) pair) list" where
  "models7 z (nil2) = nil2"
| "models7 z (cons2 z2 xs) =
     (if (z ~= (case z2 of pair2 x2 y22 => x2)) then
        cons2 z2 (models7 z xs)
        else
        models7 z xs)"

fun models6 :: "int => ((int, bool) pair) list => bool list" where
  "models6 z (nil2) = nil2"
| "models6 z (cons2 (pair2 y22 True) x2) = models6 z x2"
| "models6 z (cons2 (pair2 y22 False) x2) =
     cons2 (z = y22) (models6 z x2)"

fun models5 :: "int => ((int, bool) pair) list =>
                ((int, bool) pair) list" where
  "models5 z (nil2) = nil2"
| "models5 z (cons2 z2 xs) =
     (if (z ~= (case z2 of pair2 x2 y22 => x2)) then
        cons2 z2 (models5 z xs)
        else
        models5 z xs)"

fun models4 :: "int => ((int, bool) pair) list => bool list" where
  "models4 z (nil2) = nil2"
| "models4 z (cons2 (pair2 y22 True) x2) =
     cons2 (z = y22) (models4 z x2)"
| "models4 z (cons2 (pair2 y22 False) x2) = models4 z x2"

function models :: "(((int, bool) pair) list) list => Form =>
                    (((int, bool) pair) list) list => (((int, bool) pair) list) list"
  and
  models2 :: "Form => (((int, bool) pair) list) list =>
                     (((int, bool) pair) list) list"
  and
  models3 :: "Form => ((int, bool) pair) list =>
                     (((int, bool) pair) list) list" where
  "models z q (nil2) = models2 q z"
| "models z q (cons2 z2 x2) = cons2 z2 (models z q x2)"
| "models2 q (nil2) = nil2"
| "models2 q (cons2 y2 z2) = models z2 q (models3 q y2)"
| "models3 (x p q) y2 = models2 q (models3 p y2)"
| "models3 (Not (x r q2)) y2 =
     y (models3 (Not r) y2) (models3 (x r (Not q2)) y2)"
| "models3 (Not (Not p2)) y2 = models3 p2 y2"
| "models3 (Not (Var x2)) y2 =
     (if (~ (or2 (models4 x2 y2))) then
        cons2 (cons2 (pair2 x2 False) (models5 x2 y2)) (nil2)
        else
        nil2)"
| "models3 (Var x3) y2 =
     (if (~ (or2 (models6 x3 y2))) then
        cons2 (cons2 (pair2 x3 True) (models7 x3 y2)) (nil2)
        else
        nil2)"
  by pat_completeness auto

fun valid :: "Form => bool" where
  "valid z =
   (case models3 (Not z) (nil2) of
      nil2 => True
      | cons2 y2 z2 => False)"

theorem property0 :
  "((valid (x p q)) ==> (valid q))"
  oops

end


(*  Title:      ZF/Bool.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1992  University of Cambridge
*)

section\<open>Booleans in Zermelo-Fraenkel Set Theory\<close>

theory Bool imports pair begin

abbreviation
  one  (\<open>1\<close>) where
  "1 == succ(0)"

abbreviation
  two  (\<open>2\<close>) where
  "2 == succ(1)"

text\<open>2 is equal to bool, but is used as a number rather than a type.\<close>

definition "bool == {0,1}"

definition "cond(b,c,d) == if(b=1,c,d)"

definition "not(b) == cond(b,0,1)"

definition
  "and"       :: "[i,i]=>i"      (infixl \<open>and\<close> 70)  where
    "a and b == cond(a,b,0)"

definition
  or          :: "[i,i]=>i"      (infixl \<open>or\<close> 65)  where
    "a or b == cond(a,1,b)"

definition
  xor         :: "[i,i]=>i"      (infixl \<open>xor\<close> 65) where
    "a xor b == cond(a,not(b),b)"

lemmas bool_defs = bool_def cond_def

lemma singleton_0: "{0} = 1"
by (simp add: succ_def)

(* Introduction rules *)

lemma bool_1I [simp,TC]: "1 \<in> bool"
by (simp add: bool_defs )

lemma bool_0I [simp,TC]: "0 \<in> bool"
by (simp add: bool_defs)

lemma one_not_0: "1\<noteq>0"
by (simp add: bool_defs )

(** 1=0 ==> R **)
lemmas one_neq_0 = one_not_0 [THEN notE]

lemma boolE:
    "[| c: bool;  c=1 ==> P;  c=0 ==> P |] ==> P"
by (simp add: bool_defs, blast)

(** cond **)

(*1 means true*)
lemma cond_1 [simp]: "cond(1,c,d) = c"
by (simp add: bool_defs )

(*0 means false*)
lemma cond_0 [simp]: "cond(0,c,d) = d"
by (simp add: bool_defs )

lemma cond_type [TC]: "[| b: bool;  c: A(1);  d: A(0) |] ==> cond(b,c,d): A(b)"
by (simp add: bool_defs, blast)

(*For Simp_tac and Blast_tac*)
lemma cond_simple_type: "[| b: bool;  c: A;  d: A |] ==> cond(b,c,d): A"
by (simp add: bool_defs )

lemma def_cond_1: "[| !!b. j(b)==cond(b,c,d) |] ==> j(1) = c"
by simp

lemma def_cond_0: "[| !!b. j(b)==cond(b,c,d) |] ==> j(0) = d"
by simp

lemmas not_1 = not_def [THEN def_cond_1, simp]
lemmas not_0 = not_def [THEN def_cond_0, simp]

lemmas and_1 = and_def [THEN def_cond_1, simp]
lemmas and_0 = and_def [THEN def_cond_0, simp]

lemmas or_1 = or_def [THEN def_cond_1, simp]
lemmas or_0 = or_def [THEN def_cond_0, simp]

lemmas xor_1 = xor_def [THEN def_cond_1, simp]
lemmas xor_0 = xor_def [THEN def_cond_0, simp]

lemma not_type [TC]: "a:bool ==> not(a) \<in> bool"
by (simp add: not_def)

lemma and_type [TC]: "[| a:bool;  b:bool |] ==> a and b \<in> bool"
by (simp add: and_def)

lemma or_type [TC]: "[| a:bool;  b:bool |] ==> a or b \<in> bool"
by (simp add: or_def)

lemma xor_type [TC]: "[| a:bool;  b:bool |] ==> a xor b \<in> bool"
by (simp add: xor_def)

lemmas bool_typechecks = bool_1I bool_0I cond_type not_type and_type
                         or_type xor_type

subsection\<open>Laws About 'not'\<close>

lemma not_not [simp]: "a:bool ==> not(not(a)) = a"
by (elim boolE, auto)

lemma not_and [simp]: "a:bool ==> not(a and b) = not(a) or not(b)"
by (elim boolE, auto)

lemma not_or [simp]: "a:bool ==> not(a or b) = not(a) and not(b)"
by (elim boolE, auto)

subsection\<open>Laws About 'and'\<close>

lemma and_absorb [simp]: "a: bool ==> a and a = a"
by (elim boolE, auto)

lemma and_commute: "[| a: bool; b:bool |] ==> a and b = b and a"
by (elim boolE, auto)

lemma and_assoc: "a: bool ==> (a and b) and c  =  a and (b and c)"
by (elim boolE, auto)

lemma and_or_distrib: "[| a: bool; b:bool; c:bool |] ==>
       (a or b) and c  =  (a and c) or (b and c)"
by (elim boolE, auto)

subsection\<open>Laws About 'or'\<close>

lemma or_absorb [simp]: "a: bool ==> a or a = a"
by (elim boolE, auto)

lemma or_commute: "[| a: bool; b:bool |] ==> a or b = b or a"
by (elim boolE, auto)

lemma or_assoc: "a: bool ==> (a or b) or c  =  a or (b or c)"
by (elim boolE, auto)

lemma or_and_distrib: "[| a: bool; b: bool; c: bool |] ==>
           (a and b) or c  =  (a or c) and (b or c)"
by (elim boolE, auto)

definition
  bool_of_o :: "o=>i" where
   "bool_of_o(P) == (if P then 1 else 0)"

lemma [simp]: "bool_of_o(False) = 0"
by (simp add: bool_of_o_def)

lemma [simp,TC]: "bool_of_o(P) \<in> bool"
by (simp add: bool_of_o_def)

lemma [simp]: "(bool_of_o(P) = 1) \<longleftrightarrow> P"
by (simp add: bool_of_o_def)

lemma [simp]: "(bool_of_o(P) = 0) \<longleftrightarrow> ~P"
by (simp add: bool_of_o_def)

end