section \<open>Examples for WS1S (Minimum Semantics)\<close>

(*<*)
theory WS1S_Examples
imports Formula_Derivatives.WS1S_Formula
begin
(*>*)

abbreviation (input) FImp where "FImp \<phi> \<psi> \<equiv> FOr (FNot \<phi>) \<psi>"
abbreviation FIff where "FIff \<phi> \<psi> \<equiv> FAnd (FImp \<phi> \<psi>) (FImp \<psi> \<phi>)"
abbreviation FBall where "FBall X \<phi> \<equiv> FAll FO (FImp (FBase (In False 0 X)) \<phi>)"

abbreviation SUBSET where "SUBSET X Y \<equiv> FBall X (FBase (In False 0 Y))"
abbreviation EQ where "EQ X Y \<equiv> FAnd (SUBSET X Y) (SUBSET Y X)"
abbreviation First where "First x \<equiv> FNot (FEx FO (FBase (Less None 0 (x+1))))"
abbreviation Last where "Last x \<equiv> FNot (FEx FO (FBase (Less None (x+1) 0)))"
abbreviation Succ where "Succ sucx x \<equiv> FAnd (FBase (Less None x sucx)) (FNot (FEx FO (FAnd (FBase (Less None (x+1) 0)) (FBase (Less None 0 (sucx+1))))))"

definition "Thm idx \<phi> = check_eqv idx \<phi> (FBool True)"

abbreviation FTrue ("\<top>") where "FTrue \<equiv> FBool True"
abbreviation FFalse ("\<bottom>") where "FFalse \<equiv> FBool False"

notation FImp (infixr "-->" 25)
notation (output) FO ("1")
notation (output) SO ("2")
notation FEx ("\<exists>\<^sub>_ _" [10] 10)
notation FAll ("\<forall>\<^sub>_ _" [10] 10)
notation FNot ("\<not> _" [40] 40)
notation FOr (infixr "\<or>" 30)
notation FAnd (infixr "\<and>" 35)
abbreviation FLess ("x\<^sub>_ < x\<^sub>_" [65, 66] 65) where "FLess m1 m2 \<equiv> FBase (Less None m1 m2)"
abbreviation FIn ("x\<^sub>_ \<in> X\<^bsub>_\<^esub>" [65, 66] 65) where "FIn m M \<equiv> FBase (In False m M)"
abbreviation FEq_Const ("x\<^sub>_ = _" [65, 66] 65) where "FEq_Const m n \<equiv> FBase (Eq_Const None m n)"
abbreviation FEq_Plus ("x\<^sub>_ = x\<^sub>_ + _" [65, 66] 65) where "FEq_Plus m n i \<equiv> FBase (Plus_FO None m n i)"
abbreviation FSuc_SO ("X\<^sub>_ = X\<^sub>_ + 1" [65, 66] 65) where "FSuc_SO m n \<equiv> FBase (Suc_SO False False m n)"
abbreviation FQ ("[x\<^sub>_]" [66] 65) where "FQ m \<equiv> FBase (Fo m)"

lemma "check_eqv (Abs_idx (1, 0)) (FAnd (FEq_Const 0 100000) (FEq_Const 0 0)) FFalse"
  by check_equiv

lemma "check_eqv (Abs_idx (1, 0)) (FEq_Plus 0 0 1) FFalse"
  by check_equiv

lemma "check_eqv (Abs_idx (0, 1)) (FSuc_SO 0 0) (FBase (Empty 0))"
  by check_equiv

lemma "check_eqv (Abs_idx (0, 2))
  (FEx SO (FAnd (FBase (Subset 1 0)) (FSuc_SO 0 2)))
  (FAll FO (FImp (FIn 0 0) (FEx FO (FAnd (FEq_Plus 1 0 1) (FIn 0 1)))))"
  by check_equiv

value "automaton (\<sigma> (Abs_idx (0, 1))) (FBase (Eq_Presb None 0 (2 ^ 32)))"
value "automaton (\<sigma> (Abs_idx (1, 0))) (nFAnd (FEq_Const 0 100000) (FEq_Const 0 42))"
value "automaton (\<sigma> (Abs_idx (1, 0))) (nFAnd (FOr (FEq_Const 0 100000) (FEx FO (FBase (Eq_FO False 1 0)))) (FEq_Const 0 42))"

(*true in M2L, false in WS1S*)
definition "M2L = (FEx SO (FAll FO (FBase (In False 0 0))) :: formula)"
(*false in M2L, true in WS1S*)
definition "\<Phi> = (FAll FO (FEx FO (FBase (Less None 1 0))) :: formula)"

lemma "Thm (Abs_idx (0, 1)) (FNot M2L)"
  by (simp add: Thm_def M2L_def) check_equiv

lemma "Thm (Abs_idx (0, 0)) \<Phi>"
  by (simp add: Thm_def \<Phi>_def) check_equiv

abbreviation Globally ("\<box>_" [40] 40) where "Globally P == %n. FAll FO (FImp (FNot (FBase (Less None (n+1) 0))) (P 0))"
abbreviation Future ("\<diamond>_" [40] 40) where "Future P == %n. FEx FO (FAnd (FNot (FBase (Less None (n+1) 0))) (P 0))"
abbreviation IMP (infixr "\<rightarrow>" 50) where "IMP P1 P2 == %n. FImp (P1 n) (P2 n)"

definition \<Psi> :: "nat \<Rightarrow> formula" where
  "\<Psi> n = FAll FO (((\<box>(foldr (\<lambda>i \<phi>. (\<lambda>m. FBase (In False m i)) \<rightarrow> \<phi>) [0..<n] (\<lambda>m. FBase (In False m n)))) \<rightarrow>
     foldr (\<lambda>i \<phi>. (\<box>(\<lambda>m. FBase (In False m i))) \<rightarrow> \<phi>) [0..<n] (\<box>(\<lambda>m. FBase (In False m n)))) 0)"

lemma "Thm (Abs_idx (0, 1)) (\<Psi> 0)"
  by (simp add: Thm_def \<Psi>_def) check_equiv

lemma "Thm (Abs_idx (0, 2)) (\<Psi> 1)"
  by (simp add: Thm_def \<Psi>_def) check_equiv

lemma "Thm (Abs_idx (0, 3)) (\<Psi> 2)"
  by (simp add: Thm_def \<Psi>_def numeral_nat) check_equiv

lemma "Thm (Abs_idx (0, 4)) (\<Psi> 3)"
  by (simp add: Thm_def \<Psi>_def numeral_nat) check_equiv

lemma "Thm (Abs_idx (0, 5)) (\<Psi> 4)"
  by (simp add: Thm_def \<Psi>_def numeral_nat) check_equiv

lemma "Thm (Abs_idx (0, 6)) (\<Psi> 5)"
  by (simp add: Thm_def \<Psi>_def numeral_nat) check_equiv

lemma "Thm (Abs_idx (0, 11)) (\<Psi> 10)"
  by (simp add: Thm_def \<Psi>_def numeral_nat) check_equiv

lemma "Thm (Abs_idx (0, 16)) (\<Psi> 15)"
  by (simp add: Thm_def \<Psi>_def numeral_nat) check_equiv

(*<*)
(*
definition "Thm1 n = (\<lambda>(ws,X). (ws = [], int (card X), X)) (the (WS1S.closure (Abs_idx (0, n + 1)) (norm (\<Psi> n), FBool True)))"

value "Thm1 0"
value "Thm1 1"
value "Thm1 2"
value "Thm1 3"
value "Thm1 4"
value "Thm1 5"
value "Thm1 6"
value "Thm1 7"
value "Thm1 8"
value "Thm1 9"
value "Thm1 10"
value "Thm1 11"
value "Thm1 12"
value "Thm1 13"
value "Thm1 14"
value "Thm1 15"

definition "mod_two a b c d = FIff a (FIff b (FIff c d))"
definition "at_least_two a b c d = FIff d (FOr (FAnd a b) (FOr (FAnd b c) (FAnd a c)))"

definition "ADD S A B = FEx SO (FAnd (FAll FO (FImp (First 0) (FNot (FBase (In 0 0)))))
  (FAll FO (FAnd (mod_two (FBase (In 0 (A+1))) (FBase (In 0 (B+1))) (FBase (In 0 0)) (FBase (In 0 (S+1))))
       ((FImp (FEx FO (FAnd (Last 0) (FBase (Less 1 0)))))
            (at_least_two (FBase (In 0 (A+1))) (FBase (In 0 (B+1))) (FBase (In 0 0)) (FAll FO (FImp (Succ 0 1) (FBase (In 0 0)))))))))"

lemma Comm_Test: "check_eqv (Abs_idx (0, 3)) (ADD 0 1 2) (ADD 1 0 2)"
  by eval

abbreviation transition ("\"_\" -> \"_\" [label=\"_\"];")
  where "transition from to lab \<equiv> ((from, lab), to)"

value "WS1S.automaton (\<sigma> (Abs_idx (0, 0))) M2L"
*)
end
(*>*)


theory Prelude_List
imports "$HETS_LIB/Isabelle/MainHCPairs"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"ga_selector_pre\", \"ga_injective_suc\", \"ga_disjoint_0_suc\",
     \"ga_selector_undef_pre_0\", \"X1_def_Nat\", \"X2_def_Nat\",
     \"X3_def_Nat\", \"X4_def_Nat\", \"X5_def_Nat\", \"X6_def_Nat\",
     \"X7_def_Nat\", \"X8_def_Nat\", \"X9_def_Nat\", \"decimal_def\",
     \"ga_comm___XPlus__\", \"ga_assoc___XPlus__\",
     \"ga_right_unit___XPlus__\", \"ga_left_unit___XPlus__\",
     \"ga_left_comm___XPlus__\", \"ga_comm___Xx__\",
     \"ga_assoc___Xx__\", \"ga_right_unit___Xx__\",
     \"ga_left_unit___Xx__\", \"ga_left_comm___Xx__\", \"ga_comm_min\",
     \"ga_assoc_min\", \"ga_left_comm_min\", \"ga_comm_max\",
     \"ga_assoc_max\", \"ga_right_unit_max\", \"ga_left_unit_max\",
     \"ga_left_comm_max\", \"leq_def1_Nat\", \"leq_def2_Nat\",
     \"leq_def3_Nat\", \"geq_def_Nat\", \"less_def_Nat\",
     \"greater_def_Nat\", \"even_0_Nat\", \"even_suc_Nat\",
     \"odd_def_Nat\", \"factorial_0\", \"factorial_suc\", \"add_0_Nat\",
     \"add_suc_Nat\", \"mult_0_Nat\", \"mult_suc_Nat\", \"power_0_Nat\",
     \"power_suc_Nat\", \"min_def_Nat\", \"max_def_Nat\",
     \"subTotal_def1_Nat\", \"subTotal_def2_Nat\", \"sub_dom_Nat\",
     \"sub_def_Nat\", \"divide_dom_Nat\", \"divide_0_Nat\",
     \"divide_Pos_Nat\", \"div_dom_Nat\", \"div_Nat\", \"mod_dom_Nat\",
     \"mod_Nat\", \"distr1_Nat\", \"distr2_Nat\", \"min_0\",
     \"div_mod_Nat\", \"power_Nat\", \"equality_Int\", \"NatToInt\",
     \"IntToNat\", \"ga_comm___XPlus___1\", \"ga_assoc___XPlus___1\",
     \"ga_right_unit___XPlus___1\", \"ga_left_unit___XPlus___1\",
     \"ga_left_comm___XPlus___1\", \"ga_comm___Xx___1\",
     \"ga_assoc___Xx___1\", \"ga_right_unit___Xx___1\",
     \"ga_left_unit___Xx___1\", \"ga_left_comm___Xx___1\",
     \"ga_comm_min_1\", \"ga_comm_max_1\", \"ga_assoc_min_1\",
     \"ga_assoc_max_1\", \"ga_left_comm_min_1\", \"ga_left_comm_max_1\",
     \"geq_def_Int\", \"less_def_Int\", \"greater_def_Int\",
     \"even_def_Int\", \"odd_def_Int\", \"odd_alt_Int\",
     \"neg_def_Int\", \"sign_def_Int\", \"abs_def_Int\",
     \"add_def_Int\", \"mult_def_Int\", \"sub_def_Int\",
     \"min_def_Int\", \"max_def_Int\", \"power_neg1_Int\",
     \"power_others_Int\", \"divide_dom2_Int\", \"divide_alt_Int\",
     \"divide_Int\", \"div_dom_Int\", \"div_Int\", \"quot_dom_Int\",
     \"quot_neg_Int\", \"quot_nonneg_Int\", \"rem_dom_Int\",
     \"quot_rem_Int\", \"rem_nonneg_Int\", \"mod_dom_Int\", \"mod_Int\",
     \"distr1_Int\", \"distr2_Int\", \"Int_Nat_sub_compat\",
     \"abs_decomp_Int\", \"mod_abs_Int\", \"div_mod_Int\",
     \"quot_abs_Int\", \"rem_abs_Int\", \"quot_rem_Int_1\",
     \"power_Int\", \"NotFalse\", \"NotTrue\", \"AndFalse\",
     \"AndTrue\", \"AndSym\", \"OrDef\", \"OtherwiseDef\",
     \"NotFalse1\", \"NotTrue1\", \"notNot1\", \"notNot2\", \"Comp\",
     \"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\", \"LeTGeTRel\", \"LeFGeFRel\",
     \"LeqTGetTRel\", \"LeqFGetFRel\", \"GeTLeTRel\", \"GeFLeFRel\",
     \"GeqTLeqTRel\", \"GeqFLeqFRel\", \"LeTGeFEqFRel\",
     \"LeFGeTEqTRel\", \"LeqTGeFRel\", \"LeqFGeTRel\", \"GeTLeFEqFRel\",
     \"GeFLeTEqTRel\", \"GeqTLeFRel\", \"GeqFLeTRel\",
     \"LeqTLeTEqTRel\", \"LeqFLeFEqFRel\", \"GeqTGeTEqTRel\",
     \"GeqFGeFEqFRel\", \"LeTGeqFRel\", \"GeTLeqFRel\", \"LeLeqDiff\",
     \"CmpLTDef\", \"CmpEQDef\", \"CmpGTDef\", \"MaxYDef\", \"MaxXDef\",
     \"MinXDef\", \"MinYDef\", \"MaxSym\", \"MinSym\", \"TO1\", \"TO2\",
     \"TO3\", \"TO4\", \"TO5\", \"TO6\", \"TO7\", \"IOO13\", \"IOO14\",
     \"IOO15\", \"IOO16\", \"IOO17\", \"IOO18\", \"IOO19\", \"IOO20\",
     \"IOO21\", \"IOO22\", \"IOO23\", \"IOO24\", \"IOO25\", \"IOO26\",
     \"IOO27\", \"IOO28\", \"IOO29\", \"IOO30\", \"IOO31\", \"IOO32\",
     \"IOO33\", \"IBO5\", \"IBO6\", \"IBO7\", \"IBO8\", \"IBO9\",
     \"IBO10\", \"IBO11\", \"IBO12\", \"IUO01\", \"IUO02\", \"IUO03\",
     \"IUO04\", \"IUO05\", \"IUO06\", \"IUO07\", \"LengthNil\",
     \"LengthCons\", \"NotDefHead\", \"HeadDef\", \"NotDefTail\",
     \"TailDef\", \"FoldrNil\", \"FoldrCons\", \"FoldlNil\",
     \"FoldlCons\", \"MapNil\", \"MapCons\", \"XPlusXPlusNil\",
     \"XPlusXPlusCons\", \"FilterNil\", \"FilterConsT\",
     \"FilterConsF\", \"ZipNil\", \"ZipConsNil\", \"ZipConsCons\",
     \"UnzipNil\", \"UnzipCons\", \"FoldlDecomp\", \"MapDecomp\",
     \"MapFunctor\", \"FilterProm\", \"ZipSpec\", \"EqualListNilDef\",
     \"EqualListDef\", \"LeListDef\", \"LeListNilFalse\"]"

typedecl Unit
typedecl X_Int

datatype Nat = X0X2 ("0''''") | X_suc "Nat" ("suc/'(_')" [3] 999)
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
IntToNat__X :: "X_Int => Nat partial" ("(IntToNat/ _)" [56] 56)
NatToInt__X :: "Nat => X_Int" ("(NatToInt/ _)" [56] 56)
Not__X :: "Bool => Bool" ("(Not''/ _)" [56] 56)
X0X1 :: "X_Int" ("0''")
X1X1 :: "X_Int" ("1''")
X1X2 :: "Nat" ("1''''")
X2X1 :: "X_Int" ("2''")
X2X2 :: "Nat" ("2''''")
X3X1 :: "X_Int" ("3''")
X3X2 :: "Nat" ("3''''")
X4X1 :: "X_Int" ("4''")
X4X2 :: "Nat" ("4''''")
X5X1 :: "X_Int" ("5''")
X5X2 :: "Nat" ("5''''")
X6X1 :: "X_Int" ("6''")
X6X2 :: "Nat" ("6''''")
X7X1 :: "X_Int" ("7''")
X7X2 :: "Nat" ("7''''")
X8X1 :: "X_Int" ("8''")
X8X2 :: "Nat" ("8''''")
X9X1 :: "X_Int" ("9''")
X9X2 :: "Nat" ("9''''")
XMinus__X :: "X_Int => X_Int" ("(-''/ _)" [56] 56)
X__XAmpXAmp__X :: "Bool => Bool => Bool" ("(_/ &&/ _)" [54,54] 52)
X__XAtXAt__X :: "Nat => Nat => Nat" ("(_/ @@/ _)" [54,54] 52)
X__XCaret__XX1 :: "X_Int => Nat => X_Int" ("(_/ ^''/ _)" [54,54] 52)
X__XCaret__XX2 :: "Nat => Nat => Nat" ("(_/ ^''''/ _)" [54,54] 52)
X__XEqXEq__X :: "'a => 'a => Bool" ("(_/ ==''/ _)" [54,54] 52)
X__XExclam :: "Nat => Nat" ("(_/ !'')" [58] 58)
X__XGtXEq__XX1 :: "X_Int => X_Int => bool" ("(_/ >=''/ _)" [44,44] 42)
X__XGtXEq__XX2 :: "Nat => Nat => bool" ("(_/ >=''''/ _)" [44,44] 42)
X__XGtXEq__XX3 :: "'a => 'a => Bool" ("(_/ >='_3/ _)" [54,54] 52)
X__XGt__XX1 :: "X_Int => X_Int => bool" ("(_/ >''/ _)" [44,44] 42)
X__XGt__XX2 :: "Nat => Nat => bool" ("(_/ >''''/ _)" [44,44] 42)
X__XGt__XX3 :: "'a => 'a => Bool" ("(_/ >'_3/ _)" [54,54] 52)
X__XLtXEq__XX1 :: "X_Int => X_Int => bool" ("(_/ <=''/ _)" [44,44] 42)
X__XLtXEq__XX2 :: "Nat => Nat => bool" ("(_/ <=''''/ _)" [44,44] 42)
X__XLtXEq__XX3 :: "'a => 'a => Bool" ("(_/ <='_3/ _)" [54,54] 52)
X__XLt__XX1 :: "X_Int => X_Int => bool" ("(_/ <''/ _)" [44,44] 42)
X__XLt__XX2 :: "Nat => Nat => bool" ("(_/ <''''/ _)" [44,44] 42)
X__XLt__XX3 :: "'a => 'a => Bool" ("(_/ <'_3/ _)" [54,54] 52)
X__XMinusXExclam__X :: "Nat => Nat => Nat" ("(_/ -!/ _)" [54,54] 52)
X__XMinusXQuest__X :: "Nat => Nat => Nat partial" ("(_/ -?/ _)" [54,54] 52)
X__XMinus__XX1 :: "X_Int => X_Int => X_Int" ("(_/ -''/ _)" [54,54] 52)
X__XMinus__XX2 :: "Nat => Nat => X_Int" ("(_/ -''''/ _)" [54,54] 52)
X__XPlusXPlus__X :: "'a List => 'a List => 'a List" ("(_/ ++''/ _)" [54,54] 52)
X__XPlus__XX1 :: "X_Int => X_Int => X_Int" ("(_/ +''/ _)" [54,54] 52)
X__XPlus__XX2 :: "Nat => Nat => Nat" ("(_/ +''''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a => 'a => Bool" ("(_/ '/=/ _)" [54,54] 52)
X__XSlashXQuest__XX1 :: "X_Int => X_Int => X_Int partial" ("(_/ '/?''/ _)" [54,54] 52)
X__XSlashXQuest__XX2 :: "Nat => Nat => Nat partial" ("(_/ '/?''''/ _)" [54,54] 52)
X__XVBarXVBar__X :: "Bool => Bool => Bool" ("(_/ ||/ _)" [54,54] 52)
X__Xx__XX1 :: "X_Int => X_Int => X_Int" ("(_/ *''/ _)" [54,54] 52)
X__Xx__XX2 :: "Nat => Nat => Nat" ("(_/ *''''/ _)" [54,54] 52)
X__div__XX1 :: "X_Int => X_Int => X_Int partial" ("(_/ div''/ _)" [54,54] 52)
X__div__XX2 :: "Nat => Nat => Nat partial" ("(_/ div''''/ _)" [54,54] 52)
X__mod__XX1 :: "X_Int => X_Int => Nat partial" ("(_/ mod''/ _)" [54,54] 52)
X__mod__XX2 :: "Nat => Nat => Nat partial" ("(_/ mod''''/ _)" [54,54] 52)
X__o__X :: "('b => 'c) * ('a => 'b) => 'a => 'c"
X__quot__X :: "X_Int => X_Int => X_Int partial" ("(_/ quot/ _)" [54,54] 52)
X__rem__X :: "X_Int => X_Int => X_Int partial" ("(_/ rem/ _)" [54,54] 52)
X_abs :: "X_Int => Nat" ("abs''/'(_')" [3] 999)
X_evenX1 :: "X_Int => bool" ("even''/'(_')" [3] 999)
X_evenX2 :: "Nat => bool" ("even''''/'(_')" [3] 999)
X_filter :: "('a => Bool) => 'a List => 'a List" ("filter''/'(_,/ _')" [3,3] 999)
X_foldl :: "('a * 'b => 'a) => 'a => 'b List => 'a" ("foldl''/'(_,/ _,/ _')" [3,3,3] 999)
X_foldr :: "('a * 'b => 'b) => 'b => 'a List => 'b" ("foldr''/'(_,/ _,/ _')" [3,3,3] 999)
X_head :: "'a List => 'a partial" ("head/'(_')" [3] 999)
X_length :: "'a List => X_Int" ("length''/'(_')" [3] 999)
X_map :: "('a => 'b) => 'a List => 'b List" ("map''/'(_,/ _')" [3,3] 999)
X_maxX1 :: "X_Int => X_Int => X_Int" ("max''/'(_,/ _')" [3,3] 999)
X_maxX2 :: "Nat => Nat => Nat" ("max''''/'(_,/ _')" [3,3] 999)
X_maxX3 :: "'a => 'a => 'a"
X_minX1 :: "X_Int => X_Int => X_Int" ("min''/'(_,/ _')" [3,3] 999)
X_minX2 :: "Nat => Nat => Nat" ("min''''/'(_,/ _')" [3,3] 999)
X_minX3 :: "'a => 'a => 'a"
X_oddX1 :: "X_Int => bool" ("odd''/'(_')" [3] 999)
X_oddX2 :: "Nat => bool" ("odd''''/'(_')" [3] 999)
X_pre :: "Nat => Nat partial" ("pre/'(_')" [3] 999)
X_sign :: "X_Int => X_Int" ("sign/'(_')" [3] 999)
X_tail :: "'a List => 'a List partial" ("tail/'(_')" [3] 999)
X_unzip :: "('a * 'b) List => 'a List * 'b List" ("unzip/'(_')" [3] 999)
X_zip :: "'a List => 'b List => ('a * 'b) List" ("zip''/'(_,/ _')" [3,3] 999)
compare :: "'a => 'a => Ordering"
otherwiseH :: "Bool"

axioms
ga_selector_pre [rule_format] :
"ALL XX1. pre(suc(XX1)) = makePartial XX1"

ga_injective_suc [rule_format] :
"ALL XX1. ALL Y1. suc(XX1) = suc(Y1) = (XX1 = Y1)"

ga_disjoint_0_suc [rule_format] : "ALL Y1. ~ 0'' = suc(Y1)"

ga_selector_undef_pre_0 [rule_format] : "~ defOp (pre(0''))"

X1_def_Nat [rule_format] : "1'' = suc(0'')"

X2_def_Nat [rule_format] : "2'' = suc(1'')"

X3_def_Nat [rule_format] : "3'' = suc(2'')"

X4_def_Nat [rule_format] : "4'' = suc(3'')"

X5_def_Nat [rule_format] : "5'' = suc(4'')"

X6_def_Nat [rule_format] : "6'' = suc(5'')"

X7_def_Nat [rule_format] : "7'' = suc(6'')"

X8_def_Nat [rule_format] : "8'' = suc(7'')"

X9_def_Nat [rule_format] : "9'' = suc(8'')"

decimal_def [rule_format] :
"ALL m. ALL X_n. m @@ X_n = (m *'' suc(9'')) +'' X_n"

ga_comm___XPlus__ [rule_format] : "ALL x. ALL y. x +'' y = y +'' x"

ga_assoc___XPlus__ [rule_format] :
"ALL x. ALL y. ALL z. (x +'' y) +'' z = x +'' (y +'' z)"

ga_right_unit___XPlus__ [rule_format] : "ALL x. x +'' 0'' = x"

ga_left_unit___XPlus__ [rule_format] : "ALL x. 0'' +'' x = x"

ga_left_comm___XPlus__ [rule_format] :
"ALL x. ALL y. ALL z. x +'' (y +'' z) = y +'' (x +'' z)"

ga_comm___Xx__ [rule_format] : "ALL x. ALL y. x *'' y = y *'' x"

ga_assoc___Xx__ [rule_format] :
"ALL x. ALL y. ALL z. (x *'' y) *'' z = x *'' (y *'' z)"

ga_right_unit___Xx__ [rule_format] : "ALL x. x *'' 1'' = x"

ga_left_unit___Xx__ [rule_format] : "ALL x. 1'' *'' x = x"

ga_left_comm___Xx__ [rule_format] :
"ALL x. ALL y. ALL z. x *'' (y *'' z) = y *'' (x *'' z)"

ga_comm_min [rule_format] :
"ALL x. ALL y. min''(x, y) = min''(y, x)"

ga_assoc_min [rule_format] :
"ALL x.
 ALL y. ALL z. min''(min''(x, y), z) = min''(x, min''(y, z))"

ga_left_comm_min [rule_format] :
"ALL x.
 ALL y. ALL z. min''(x, min''(y, z)) = min''(y, min''(x, z))"

ga_comm_max [rule_format] :
"ALL x. ALL y. max''(x, y) = max''(y, x)"

ga_assoc_max [rule_format] :
"ALL x.
 ALL y. ALL z. max''(max''(x, y), z) = max''(x, max''(y, z))"

ga_right_unit_max [rule_format] : "ALL x. max''(x, 0'') = x"

ga_left_unit_max [rule_format] : "ALL x. max''(0'', x) = x"

ga_left_comm_max [rule_format] :
"ALL x.
 ALL y. ALL z. max''(x, max''(y, z)) = max''(y, max''(x, z))"

leq_def1_Nat [rule_format] : "ALL X_n. 0'' <='' X_n"

leq_def2_Nat [rule_format] : "ALL X_n. ~ suc(X_n) <='' 0''"

leq_def3_Nat [rule_format] :
"ALL m. ALL X_n. (suc(m) <='' suc(X_n)) = (m <='' X_n)"

geq_def_Nat [rule_format] :
"ALL m. ALL X_n. (m >='' X_n) = (X_n <='' m)"

less_def_Nat [rule_format] :
"ALL m. ALL X_n. (m <'' X_n) = (m <='' X_n & ~ m = X_n)"

greater_def_Nat [rule_format] :
"ALL m. ALL X_n. (m >'' X_n) = (X_n <'' m)"

even_0_Nat [rule_format] : "even''(0'')"

even_suc_Nat [rule_format] : "ALL m. even''(suc(m)) = odd''(m)"

odd_def_Nat [rule_format] : "ALL m. odd''(m) = (~ even''(m))"

factorial_0 [rule_format] : "0'' !' = 1''"

factorial_suc [rule_format] :
"ALL X_n. suc(X_n) !' = suc(X_n) *'' X_n !'"

add_0_Nat [rule_format] : "ALL m. 0'' +'' m = m"

add_suc_Nat [rule_format] :
"ALL m. ALL X_n. suc(X_n) +'' m = suc(X_n +'' m)"

mult_0_Nat [rule_format] : "ALL m. 0'' *'' m = 0''"

mult_suc_Nat [rule_format] :
"ALL m. ALL X_n. suc(X_n) *'' m = (X_n *'' m) +'' m"

power_0_Nat [rule_format] : "ALL m. m ^'' 0'' = 1''"

power_suc_Nat [rule_format] :
"ALL m. ALL X_n. m ^'' suc(X_n) = m *'' (m ^'' X_n)"

min_def_Nat [rule_format] :
"ALL m. ALL X_n. min''(m, X_n) = (if m <='' X_n then m else X_n)"

max_def_Nat [rule_format] :
"ALL m. ALL X_n. max''(m, X_n) = (if m <='' X_n then X_n else m)"

subTotal_def1_Nat [rule_format] :
"ALL m. ALL X_n. m >'' X_n --> X_n -! m = 0''"

subTotal_def2_Nat [rule_format] :
"ALL m. ALL X_n. m <='' X_n --> makePartial (X_n -! m) = X_n -? m"

sub_dom_Nat [rule_format] :
"ALL m. ALL X_n. defOp (m -? X_n) = (m >='' X_n)"

sub_def_Nat [rule_format] :
"ALL m. ALL X_n. ALL r. m -? X_n = makePartial r = (m = r +'' X_n)"

divide_dom_Nat [rule_format] :
"ALL m.
 ALL X_n.
 defOp (m /?'' X_n) = (~ X_n = 0'' & m mod'' X_n = makePartial 0'')"

divide_0_Nat [rule_format] : "ALL m. ~ defOp (m /?'' 0'')"

divide_Pos_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 X_n >'' 0'' --> m /?'' X_n = makePartial r = (m = r *'' X_n)"

div_dom_Nat [rule_format] :
"ALL m. ALL X_n. defOp (m div'' X_n) = (~ X_n = 0'')"

div_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 m div'' X_n = makePartial r =
 (EX s. m = (X_n *'' r) +'' s & s <'' X_n)"

mod_dom_Nat [rule_format] :
"ALL m. ALL X_n. defOp (m mod'' X_n) = (~ X_n = 0'')"

mod_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ALL s.
 m mod'' X_n = makePartial s =
 (EX r. m = (X_n *'' r) +'' s & s <'' X_n)"

distr1_Nat [rule_format] :
"ALL r. ALL s. ALL t. (r +'' s) *'' t = (r *'' t) +'' (s *'' t)"

distr2_Nat [rule_format] :
"ALL r. ALL s. ALL t. t *'' (r +'' s) = (t *'' r) +'' (t *'' s)"

min_0 [rule_format] : "ALL m. min''(m, 0'') = 0''"

div_mod_Nat [rule_format] :
"ALL m.
 ALL X_n.
 ~ X_n = 0'' -->
 makePartial m =
 (let (Xb5, Xc0) =
      let (Xb4, Xc3) = m div'' X_n
      in if Xb4 then makePartial (Xc3 *'' X_n) else noneOp
  in if Xb5
        then let (Xb2, Xc1) = m mod'' X_n
             in if Xb2 then makePartial (Xc0 +'' Xc1) else noneOp
        else noneOp)"

power_Nat [rule_format] :
"ALL m. ALL r. ALL s. m ^'' (r +'' s) = (m ^'' r) *'' (m ^'' s)"

equality_Int [rule_format] :
"ALL a.
 ALL b. ALL c. ALL d. a -'' b = c -'' d = (a +'' d = c +'' b)"

NatToInt [rule_format] : "ALL a. NatToInt a = a -'' 0''"

IntToNat [rule_format] :
"ALL a. ALL b. IntToNat (a -'' b) = makePartial (a -! b)"

ga_comm___XPlus___1 [rule_format] : "ALL x. ALL y. x +' y = y +' x"

ga_assoc___XPlus___1 [rule_format] :
"ALL x. ALL y. ALL z. (x +' y) +' z = x +' (y +' z)"

ga_right_unit___XPlus___1 [rule_format] : "ALL x. x +' 0' = x"

ga_left_unit___XPlus___1 [rule_format] : "ALL x. 0' +' x = x"

ga_left_comm___XPlus___1 [rule_format] :
"ALL x. ALL y. ALL z. x +' (y +' z) = y +' (x +' z)"

ga_comm___Xx___1 [rule_format] : "ALL x. ALL y. x *' y = y *' x"

ga_assoc___Xx___1 [rule_format] :
"ALL x. ALL y. ALL z. (x *' y) *' z = x *' (y *' z)"

ga_right_unit___Xx___1 [rule_format] : "ALL x. x *' 1' = x"

ga_left_unit___Xx___1 [rule_format] : "ALL x. 1' *' x = x"

ga_left_comm___Xx___1 [rule_format] :
"ALL x. ALL y. ALL z. x *' (y *' z) = y *' (x *' z)"

ga_comm_min_1 [rule_format] :
"ALL x. ALL y. min'(x, y) = min'(y, x)"

ga_comm_max_1 [rule_format] :
"ALL x. ALL y. max'(x, y) = max'(y, x)"

ga_assoc_min_1 [rule_format] :
"ALL x. ALL y. ALL z. min'(min'(x, y), z) = min'(x, min'(y, z))"

ga_assoc_max_1 [rule_format] :
"ALL x. ALL y. ALL z. max'(max'(x, y), z) = max'(x, max'(y, z))"

ga_left_comm_min_1 [rule_format] :
"ALL x. ALL y. ALL z. min'(x, min'(y, z)) = min'(y, min'(x, z))"

ga_left_comm_max_1 [rule_format] :
"ALL x. ALL y. ALL z. max'(x, max'(y, z)) = max'(y, max'(x, z))"

geq_def_Int [rule_format] :
"ALL m. ALL X_n. (m >=' X_n) = (X_n <=' m)"

less_def_Int [rule_format] :
"ALL m. ALL X_n. (m <' X_n) = (m <=' X_n & ~ m = X_n)"

greater_def_Int [rule_format] :
"ALL m. ALL X_n. (m >' X_n) = (X_n <' m)"

even_def_Int [rule_format] : "ALL m. even'(m) = even''(abs'(m))"

odd_def_Int [rule_format] : "ALL m. odd'(m) = (~ even'(m))"

odd_alt_Int [rule_format] : "ALL m. odd'(m) = odd''(abs'(m))"

neg_def_Int [rule_format] : "ALL a. ALL b. -' (a -'' b) = b -'' a"

sign_def_Int [rule_format] :
"ALL m.
 sign(m) = (if m = 0' then 0' else if m >' 0' then 1' else -' 1')"

abs_def_Int [rule_format] :
"ALL m.
 makePartial (abs'(m)) =
 (if m <' 0' then IntToNat -' m else IntToNat m)"

add_def_Int [rule_format] :
"ALL a.
 ALL b.
 ALL c. ALL d. (a -'' b) +' (c -'' d) = (a +'' c) -'' (b +'' d)"

mult_def_Int [rule_format] :
"ALL a.
 ALL b.
 ALL c.
 ALL d.
 (a -'' b) *' (c -'' d) =
 ((a *'' c) +'' (b *'' d)) -'' ((b *'' c) +'' (a *'' d))"

sub_def_Int [rule_format] :
"ALL m. ALL X_n. m -' X_n = m +' -' X_n"

min_def_Int [rule_format] :
"ALL m. ALL X_n. min'(m, X_n) = (if m <=' X_n then m else X_n)"

max_def_Int [rule_format] :
"ALL m. ALL X_n. max'(m, X_n) = (if m <=' X_n then X_n else m)"

power_neg1_Int [rule_format] :
"ALL a. -' 1' ^' a = (if even''(a) then 1' else -' 1')"

power_others_Int [rule_format] :
"ALL m.
 ALL a.
 ~ m = -' 1' --> m ^' a = (sign(m) ^' a) *' (NatToInt abs'(m) ^' a)"

divide_dom2_Int [rule_format] :
"ALL m.
 ALL X_n. defOp (m /?' X_n) = (m mod' X_n = makePartial 0'')"

divide_alt_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL r. m /?' X_n = makePartial r = (~ X_n = 0' & X_n *' r = m)"

divide_Int [rule_format] :
"ALL m.
 ALL X_n.
 m /?' X_n =
 (let (Xb1, Xc0) = NatToInt abs'(m) /?' NatToInt abs'(X_n)
  in if Xb1 then makePartial ((sign(m) *' sign(X_n)) *' Xc0)
        else noneOp)"

div_dom_Int [rule_format] :
"ALL m. ALL X_n. defOp (m div' X_n) = (~ X_n = 0')"

div_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 m div' X_n = makePartial r =
 (EX a. m = (X_n *' r) +' NatToInt a & a <'' abs'(X_n))"

quot_dom_Int [rule_format] :
"ALL m. ALL X_n. defOp (m quot X_n) = (~ X_n = 0')"

quot_neg_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 m <' 0' -->
 m quot X_n = makePartial r =
 (EX s.
  m = (X_n *' r) +' s & 0' >=' s & s >' -' NatToInt abs'(X_n))"

quot_nonneg_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 m >=' 0' -->
 m quot X_n = makePartial r =
 (EX s. m = (X_n *' r) +' s & 0' <=' s & s <' NatToInt abs'(X_n))"

rem_dom_Int [rule_format] :
"ALL m. ALL X_n. defOp (m rem X_n) = (~ X_n = 0')"

quot_rem_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL s.
 m <' 0' -->
 m rem X_n = makePartial s =
 (EX r.
  m = (X_n *' r) +' s & 0' >=' s & s >' -' NatToInt abs'(X_n))"

rem_nonneg_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL s.
 m >=' 0' -->
 m rem X_n = makePartial s =
 (EX r. m = (X_n *' r) +' s & 0' <=' s & s <' NatToInt abs'(X_n))"

mod_dom_Int [rule_format] :
"ALL m. ALL X_n. defOp (m mod' X_n) = (~ X_n = 0')"

mod_Int [rule_format] :
"ALL m.
 ALL X_n.
 ALL a.
 m mod' X_n = makePartial a =
 (EX r. m = (X_n *' r) +' NatToInt a & a <'' abs'(X_n))"

distr1_Int [rule_format] :
"ALL r. ALL s. ALL t. (r +' s) *' t = (r *' t) +' (s *' t)"

distr2_Int [rule_format] :
"ALL r. ALL s. ALL t. t *' (r +' s) = (t *' r) +' (t *' s)"

Int_Nat_sub_compat [rule_format] :
"ALL a. ALL b. defOp (a -? b) --> a -? b = IntToNat (a -'' b)"

abs_decomp_Int [rule_format] :
"ALL m. m = sign(m) *' NatToInt abs'(m)"

mod_abs_Int [rule_format] :
"ALL m. ALL X_n. m mod' X_n = m mod' NatToInt abs'(X_n)"

div_mod_Int [rule_format] :
"ALL m.
 ALL X_n.
 ~ X_n = 0' -->
 makePartial m =
 (let (Xb7, Xc0) =
      let (Xb6, Xc5) = m div' X_n
      in if Xb6 then makePartial (Xc5 *' X_n) else noneOp
  in if Xb7
        then let (Xb4, Xc1) =
                 let (Xb3, Xc2) = m mod' X_n
                 in if Xb3 then makePartial (NatToInt Xc2) else noneOp
             in if Xb4 then makePartial (Xc0 +' Xc1) else noneOp
        else noneOp)"

quot_abs_Int [rule_format] :
"ALL m.
 ALL X_n.
 (let (Xb3, Xc0) =
      let (Xb2, Xc1) = m quot X_n
      in if Xb2 then makePartial (abs'(Xc1)) else noneOp
  in if Xb3 then makePartial (NatToInt Xc0) else noneOp) =
 NatToInt abs'(m) quot NatToInt abs'(X_n)"

rem_abs_Int [rule_format] :
"ALL m.
 ALL X_n.
 (let (Xb3, Xc0) =
      let (Xb2, Xc1) = m rem X_n
      in if Xb2 then makePartial (abs'(Xc1)) else noneOp
  in if Xb3 then makePartial (NatToInt Xc0) else noneOp) =
 NatToInt abs'(m) rem NatToInt abs'(X_n)"

quot_rem_Int_1 [rule_format] :
"ALL m.
 ALL X_n.
 ~ X_n = 0' -->
 makePartial m =
 (let (Xb5, Xc0) =
      let (Xb4, Xc3) = m quot X_n
      in if Xb4 then makePartial (Xc3 *' X_n) else noneOp
  in if Xb5
        then let (Xb2, Xc1) = m rem X_n
             in if Xb2 then makePartial (Xc0 +' Xc1) else noneOp
        else noneOp)"

power_Int [rule_format] :
"ALL m. ALL a. ALL b. m ^' (a +'' b) = (m ^' a) *' (m ^' b)"

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

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

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

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

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

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

OtherwiseDef [rule_format] : "otherwiseH = True'"

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

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

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

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

Comp [rule_format] :
"ALL f.
 ALL g. makePartial o X__o__X (f, g) = makePartial o (% x. f (g x))"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

IOO30 [rule_format] : "X_minX3 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' <_3 True' = True'"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

LengthNil [rule_format] : "length'(Nil') = 0'"

LengthCons [rule_format] :
"ALL x. ALL xs. length'(X_Cons x xs) = length'(xs) +' 1'"

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

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

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

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

FoldrNil [rule_format] : "ALL f. ALL s. foldr'(f, s, Nil') = s"

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

FoldlNil [rule_format] : "ALL g. ALL t. foldl'(g, t, Nil') = t"

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

MapNil [rule_format] : "ALL h. map'(h, Nil') = Nil'"

MapCons [rule_format] :
"ALL h.
 ALL x. ALL xs. map'(h, X_Cons x xs) = X_Cons (h x) (map'(h, xs))"

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

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

FilterNil [rule_format] : "ALL p. filter'(p, Nil') = Nil'"

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

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

ZipNil [rule_format] : "ALL l. zip'(Nil', l) = Nil'"

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

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

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

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

FoldlDecomp [rule_format] :
"ALL e.
 ALL i.
 ALL xs.
 ALL zs. foldl'(i, e, xs ++' zs) = foldl'(i, foldl'(i, e, xs), zs)"

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

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

FilterProm [rule_format] :
"ALL f.
 ALL p.
 ALL xs.
 filter'(p, map'(f, xs)) = map'(f, filter'(X__o__X (p, f), xs))"

ZipSpec [rule_format] :
"ALL xs.
 ALL ys.
 length'(xs) = length'(ys) --> unzip(zip'(xs, ys)) = (xs, ys)"

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

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

LeListDef [rule_format] :
"ALL w.
 ALL ws.
 ALL z.
 ALL zs. X_Cons z zs <_3 X_Cons w ws = (z <_3 w) && (zs <_3 ws)"

declare ga_selector_pre [simp]
declare ga_selector_undef_pre_0 [simp]
declare ga_comm___XPlus__ [simp]
declare ga_assoc___XPlus__ [simp]
declare ga_right_unit___XPlus__ [simp]
declare ga_left_unit___XPlus__ [simp]
declare ga_left_comm___XPlus__ [simp]
declare ga_comm___Xx__ [simp]
declare ga_assoc___Xx__ [simp]
declare ga_right_unit___Xx__ [simp]
declare ga_left_unit___Xx__ [simp]
declare ga_left_comm___Xx__ [simp]
declare ga_comm_min [simp]
declare ga_assoc_min [simp]
declare ga_left_comm_min [simp]
declare ga_comm_max [simp]
declare ga_assoc_max [simp]
declare ga_right_unit_max [simp]
declare ga_left_unit_max [simp]
declare ga_left_comm_max [simp]
declare leq_def1_Nat [simp]
declare leq_def2_Nat [simp]
declare leq_def3_Nat [simp]
declare even_0_Nat [simp]
declare even_suc_Nat [simp]
declare factorial_0 [simp]
declare add_0_Nat [simp]
declare mult_0_Nat [simp]
declare power_0_Nat [simp]
declare subTotal_def1_Nat [simp]
declare subTotal_def2_Nat [simp]
declare sub_dom_Nat [simp]
declare divide_0_Nat [simp]
declare min_0 [simp]
declare ga_comm___XPlus___1 [simp]
declare ga_assoc___XPlus___1 [simp]
declare ga_right_unit___XPlus___1 [simp]
declare ga_left_unit___XPlus___1 [simp]
declare ga_left_comm___XPlus___1 [simp]
declare ga_comm___Xx___1 [simp]
declare ga_assoc___Xx___1 [simp]
declare ga_right_unit___Xx___1 [simp]
declare ga_left_unit___Xx___1 [simp]
declare ga_left_comm___Xx___1 [simp]
declare ga_comm_min_1 [simp]
declare ga_comm_max_1 [simp]
declare ga_assoc_min_1 [simp]
declare ga_assoc_max_1 [simp]
declare ga_left_comm_min_1 [simp]
declare ga_left_comm_max_1 [simp]
declare neg_def_Int [simp]
declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare EqualReflex [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare IOE01 [simp]
declare IOE02 [simp]
declare IOE03 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare IOE07 [simp]
declare IOE08 [simp]
declare IOE09 [simp]
declare LeIrreflexivity [simp]
declare LeTAsymmetry [simp]
declare GeIrreflexivity [simp]
declare GeTAsymmetry [simp]
declare GeTTransitive [simp]
declare GeTTotal [simp]
declare LeqReflexivity [simp]
declare LeqTTransitive [simp]
declare LeqTTotal [simp]
declare GeqReflexivity [simp]
declare GeqTTransitive [simp]
declare GeqTTotal [simp]
declare CmpLTDef [simp]
declare CmpEQDef [simp]
declare CmpGTDef [simp]
declare MaxYDef [simp]
declare MaxXDef [simp]
declare MinXDef [simp]
declare MinYDef [simp]
declare TO2 [simp]
declare TO4 [simp]
declare TO6 [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IOO16 [simp]
declare IOO17 [simp]
declare IOO18 [simp]
declare IOO19 [simp]
declare IOO20 [simp]
declare IOO21 [simp]
declare IOO22 [simp]
declare IOO23 [simp]
declare IOO24 [simp]
declare IOO25 [simp]
declare IOO26 [simp]
declare IOO27 [simp]
declare IOO28 [simp]
declare IOO29 [simp]
declare IOO30 [simp]
declare IOO31 [simp]
declare IOO32 [simp]
declare IOO33 [simp]
declare IBO5 [simp]
declare IBO6 [simp]
declare IBO7 [simp]
declare IBO8 [simp]
declare IBO9 [simp]
declare IBO10 [simp]
declare IBO11 [simp]
declare IBO12 [simp]
declare IUO05 [simp]
declare IUO06 [simp]
declare IUO07 [simp]
declare LengthNil [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 EqualListNilDef [simp]

theorem LeListNilFalse : "Nil' <_3 Nil' = False'"
using X1_def_Nat X2_def_Nat X3_def_Nat X4_def_Nat X5_def_Nat
      X6_def_Nat X7_def_Nat X8_def_Nat X9_def_Nat decimal_def
by auto

ML "Header.record \"LeListNilFalse\""

end


(*
    Author:      Norbert Schirmer
    Maintainer:  Norbert Schirmer, norbert.schirmer at web de
    License:     LGPL
*)

(*  Title:      VcgExTotal.thy
    Author:     Norbert Schirmer, TU Muenchen

Copyright (C) 2006-2008 Norbert Schirmer
Some rights reserved, TU Muenchen

This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2.1 of the
License, or (at your option) any later version.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA
*)

section \<open>Examples for Total Correctness\<close>

theory VcgExTotal imports "../HeapList" "../Vcg" begin

record 'g vars = "'g state" +
  A_' :: nat
  I_' :: nat
  M_' :: nat
  N_' :: nat
  R_' :: nat
  S_' :: nat
  Abr_':: string

lemma "\<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>M = 0 \<and> \<acute>S = 0\<rbrace>
          WHILE \<acute>M \<noteq> a
          INV \<lbrace>\<acute>S = \<acute>M * b \<and> \<acute>M \<le> a\<rbrace>
          VAR MEASURE a - \<acute>M
          DO \<acute>S :== \<acute>S + b;; \<acute>M :== \<acute>M + 1 OD
          \<lbrace>\<acute>S = a * b\<rbrace>"
apply vcg
apply (auto)
done

lemma "\<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>I \<le> 3\<rbrace>
     WHILE \<acute>I < 10 INV \<lbrace>\<acute>I\<le> 10\<rbrace> VAR MEASURE 10 - \<acute>I
     DO
       \<acute>I :== \<acute>I + 1
     OD
  \<lbrace>\<acute>I = 10\<rbrace>"
apply vcg
apply auto
done

text \<open>Total correctness of a nested loop. In the inner loop we have to
express that the loop variable of the outer loop is not changed. We use
\<open>FIX\<close> to introduce a new logical variable
\<close>

lemma "\<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>M=0 \<and> \<acute>N=0\<rbrace>
      WHILE (\<acute>M < i)
      INV \<lbrace>\<acute>M \<le> i \<and> (\<acute>M \<noteq> 0 \<longrightarrow> \<acute>N = j) \<and> \<acute>N \<le> j\<rbrace>
      VAR MEASURE (i - \<acute>M)
      DO
         \<acute>N :== 0;;
         WHILE (\<acute>N < j)
         FIX m.
         INV \<lbrace>\<acute>M=m \<and> \<acute>N \<le> j\<rbrace>
         VAR MEASURE (j - \<acute>N)
         DO
           \<acute>N :== \<acute>N + 1
         OD;;
       \<acute>M :== \<acute>M + 1
       OD
       \<lbrace>\<acute>M=i \<and> (\<acute>M\<noteq>0 \<longrightarrow> \<acute>N=j)\<rbrace>"
apply vcg
apply simp_all
apply arith
done

primrec fac:: "nat \<Rightarrow> nat"
where
"fac 0 = 1" |
"fac (Suc n) = (Suc n) * fac n"

lemma fac_simp [simp]: "0 < i \<Longrightarrow>  fac i = i * fac (i - 1)"
  by (cases i) simp_all

procedures
  Fac (N | R) = "IF \<acute>N = 0 THEN \<acute>R :== 1
                       ELSE CALL Fac(\<acute>N - 1,\<acute>R);;
                            \<acute>R :== \<acute>N * \<acute>R
                       FI"

lemma (in Fac_impl) Fac_spec:
  shows "\<forall>n. \<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>N=n\<rbrace> \<acute>R :== PROC Fac(\<acute>N) \<lbrace>\<acute>R = fac n\<rbrace>"
  apply (hoare_rule HoareTotal.ProcRec1 [where r="measure (\<lambda>(s,p). \<^bsup>s\<^esup>N)"])
  apply vcg
  apply simp
  done

procedures
  p91(R,N | R) = "IF 100 < \<acute>N THEN \<acute>R :== \<acute>N - 10
                      ELSE \<acute>R :== CALL p91(\<acute>R,\<acute>N+11);;
                           \<acute>R :== CALL p91(\<acute>R,\<acute>R) FI"

  p91_spec: "\<forall>n. \<Gamma>\<turnstile>\<^sub>t \<lbrace>\<acute>N=n\<rbrace> \<acute>R :== PROC p91(\<acute>R,\<acute>N)
                        \<lbrace>if 100 < n then \<acute>R = n - 10 else \<acute>R = 91\<rbrace>,{}"

lemma (in p91_impl) p91_spec:
  shows "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t {\<sigma>} \<acute>R :== PROC p91(\<acute>R,\<acute>N)
                       \<lbrace>if 100 < \<^bsup>\<sigma>\<^esup>N then \<acute>R = \<^bsup>\<sigma>\<^esup>N - 10 else \<acute>R = 91\<rbrace>,{}"
  apply (hoare_rule HoareTotal.ProcRec1 [where r="measure (\<lambda>(s,p). 101 - \<^bsup>s\<^esup>N)"])
  apply vcg
  apply clarsimp
  apply arith
  done

record globals_list =
  next_' :: "ref \<Rightarrow> ref"
  cont_' :: "ref \<Rightarrow> nat"

record 'g list_vars = "'g state" +
  p_'    :: "ref"
  q_'    :: "ref"
  r_'    :: "ref"
  root_' :: "ref"
  tmp_'  :: "ref"

procedures
  append(p,q|p) =
    "IF \<acute>p=Null THEN \<acute>p :== \<acute>q ELSE \<acute>p\<rightarrow>\<acute>next :== CALL append(\<acute>p\<rightarrow>\<acute>next,\<acute>q) FI"

lemma (in append_impl)
  shows
   "\<forall>\<sigma> Ps Qs. \<Gamma>\<turnstile>\<^sub>t
      \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<rbrace>
       \<acute>p :== PROC append(\<acute>p,\<acute>q)
      \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
   apply (hoare_rule HoareTotal.ProcRec1
            [where r="measure (\<lambda>(s,p). length (list \<^bsup>s\<^esup>p \<^bsup>s\<^esup>next))"])
   apply vcg
   apply (fastforce  simp add: List_list)
   done

lemma (in append_impl)
  shows
   "\<forall>\<sigma> Ps Qs. \<Gamma>\<turnstile>\<^sub>t
      \<lbrace>\<sigma>. List \<acute>p \<acute>next Ps \<and>  List \<acute>q \<acute>next Qs \<and> set Ps \<inter> set Qs = {} \<rbrace>
       \<acute>p :== PROC append(\<acute>p,\<acute>q)
      \<lbrace>List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
   apply (hoare_rule HoareTotal.ProcRec1
            [where r="measure (\<lambda>(s,p). length (list \<^bsup>s\<^esup>p \<^bsup>s\<^esup>next))"])
   apply vcg
   apply (fastforce  simp add: List_list)
   done

lemma (in append_impl)
  shows
  append_spec:
   "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^sub>t ({\<sigma>} \<inter> \<lbrace>islist \<acute>p \<acute>next\<rbrace>)  \<acute>p :== PROC append(\<acute>p,\<acute>q)
    \<lbrace>\<forall>Ps Qs. List \<^bsup>\<sigma>\<^esup>p \<^bsup>\<sigma>\<^esup>next Ps \<and>  List \<^bsup>\<sigma>\<^esup>q \<^bsup>\<sigma>\<^esup>next Qs \<and> set Ps \<inter> set Qs = {}
     \<longrightarrow>
     List \<acute>p \<acute>next (Ps@Qs) \<and> (\<forall>x. x\<notin>set Ps \<longrightarrow> \<acute>next x = \<^bsup>\<sigma>\<^esup>next x)\<rbrace>"
   apply (hoare_rule HoareTotal.ProcRec1
            [where r="measure (\<lambda>(s,p). length (list \<^bsup>s\<^esup>p \<^bsup>s\<^esup>next))"])
   apply vcg
   apply fastforce
   done

lemma "\<Gamma>\<turnstile>\<lbrace>List \<acute>p \<acute>next Ps\<rbrace>
       \<acute>q :== Null;;
       WHILE \<acute>p \<noteq> Null INV \<lbrace>\<exists>Ps' Qs'. List \<acute>p \<acute>next Ps' \<and> List \<acute>q \<acute>next Qs' \<and>
                             set Ps' \<inter> set Qs' = {} \<and>
                             rev Ps' @ Qs' = rev Ps\<rbrace>
        DO
         \<acute>r :== \<acute>p;; \<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
         \<acute>r\<rightarrow>\<acute>next :== \<acute>q;; \<acute>q :== \<acute>r
       OD;;
       \<acute>p :==\<acute>q
       \<lbrace>List \<acute>p \<acute>next (rev Ps)\<rbrace> "
apply vcg
apply   clarsimp
apply  clarsimp
apply force
apply simp
done

lemma conjI2: "\<lbrakk>Q; Q \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P \<and> Q"
by blast

procedures Rev(p|p) =
      "\<acute>q :== Null;;
       WHILE \<acute>p \<noteq> Null
       DO
         \<acute>r :== \<acute>p;; \<lbrace>\<acute>p \<noteq> Null\<rbrace>\<longmapsto> \<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
         \<lbrace>\<acute>r \<noteq> Null\<rbrace>\<longmapsto> \<acute>r\<rightarrow>\<acute>next :== \<acute>q;; \<acute>q :== \<acute>r
       OD;;
       \<acute>p :==\<acute>q"
 Rev_spec:
  "\<forall>Ps. \<Gamma>\<turnstile>\<^sub>t \<lbrace>List \<acute>p \<acute>next Ps\<rbrace> \<acute>p :== PROC Rev(\<acute>p) \<lbrace>List \<acute>p \<acute>next (rev Ps)\<rbrace>"
 Rev_modifies:
  "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} \<acute>p :== PROC Rev(\<acute>p) {t. t may_only_modify_globals \<sigma> in [next]}"

text \<open>We only need partial correctness of modifies clause!\<close>

lemma upd_hd_next:
  assumes p_ps: "List p next (p#ps)"
  shows "List (next p) (next(p := q)) ps"
proof -
  from p_ps
  have "p \<notin> set ps"
    by auto
  with p_ps show ?thesis
    by simp
qed

lemma (in Rev_impl) shows
 Rev_spec:
  "\<forall>Ps. \<Gamma>\<turnstile>\<^sub>t \<lbrace>List \<acute>p \<acute>next Ps\<rbrace> \<acute>p :== PROC Rev(\<acute>p) \<lbrace>List \<acute>p \<acute>next (rev Ps)\<rbrace>"
apply (hoare_rule HoareTotal.ProcNoRec1)
apply (hoare_rule anno =
       "\<acute>q :== Null;;
       WHILE \<acute>p \<noteq> Null INV \<lbrace>\<exists>Ps' Qs'. List \<acute>p \<acute>next Ps' \<and> List \<acute>q \<acute>next Qs' \<and>
                             set Ps' \<inter> set Qs' = {} \<and>
                             rev Ps' @ Qs' = rev Ps\<rbrace>
       VAR MEASURE (length (list \<acute>p \<acute>next) )
        DO
         \<acute>r :== \<acute>p;; \<lbrace>\<acute>p \<noteq> Null\<rbrace>\<longmapsto>\<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
         \<lbrace>\<acute>r \<noteq> Null\<rbrace>\<longmapsto>\<acute>r\<rightarrow>\<acute>next :== \<acute>q;; \<acute>q :== \<acute>r
       OD;;
       \<acute>p :==\<acute>q" in HoareTotal.annotateI)
apply vcg
apply   clarsimp
apply  clarsimp
apply  (rule conjI2)
apply   force
apply  clarsimp
apply  (subgoal_tac "List p next (p#ps)")
prefer 2 apply simp
apply  (frule_tac q=q in upd_hd_next)
apply  (simp only: List_list)
apply  simp
apply simp
done

lemma (in Rev_impl) shows
 Rev_modifies:
  "\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV \<^esub>{\<sigma>} \<acute>p :== PROC Rev(\<acute>p) {t. t may_only_modify_globals \<sigma> in [next]}"
apply (hoare_rule HoarePartial.ProcNoRec1)
apply (vcg spec=modifies)
done

lemma "\<Gamma>\<turnstile>\<^sub>t \<lbrace>List \<acute>p \<acute>next Ps\<rbrace>
       \<acute>q :== Null;;
       WHILE \<acute>p \<noteq> Null INV \<lbrace>\<exists>Ps' Qs'. List \<acute>p \<acute>next Ps' \<and> List \<acute>q \<acute>next Qs' \<and>
                             set Ps' \<inter> set Qs' = {} \<and>
                             rev Ps' @ Qs' = rev Ps\<rbrace>
       VAR MEASURE (length (list \<acute>p \<acute>next) )
        DO
         \<acute>r :== \<acute>p;; \<acute>p :== \<acute>p\<rightarrow>\<acute>next;;
         \<acute>r\<rightarrow>\<acute>next :== \<acute>q;; \<acute>q :== \<acute>r
       OD;;
       \<acute>p :==\<acute>q
       \<lbrace>List \<acute>p \<acute>next (rev Ps)\<rbrace> "
apply vcg
apply   clarsimp
apply  clarsimp
apply  (rule conjI2)
apply   force
apply  clarsimp
apply  (subgoal_tac "List p next (p#ps)")
prefer 2 apply simp
apply  (frule_tac q=q in upd_hd_next)
apply  (simp only: List_list)
apply  simp
apply simp
done

procedures
  pedal(N,M) = "IF 0 < \<acute>N THEN
                            IF 0 < \<acute>M THEN CALL coast(\<acute>N- 1,\<acute>M- 1) FI;;
                            CALL pedal(\<acute>N- 1,\<acute>M)
                         FI"

and

  coast(N,M) = "CALL pedal(\<acute>N,\<acute>M);;
                         IF 0 < \<acute>M THEN CALL coast(\<acute>N,\<acute>M- 1) FI"

ML \<open>ML_Thms.bind_thm ("HoareTotal_ProcRec2", Hoare.gen_proc_rec @{context} Hoare.Total 2)\<close>

lemma (in pedal_coast_clique)
  shows "(\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace>  PROC pedal(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>) \<and>
         (\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC coast(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>)"
  apply (hoare_rule HoareTotal_ProcRec2
          [where ?r= "inv_image (measure (\<lambda>m. m) <*lex*>
                                  measure (\<lambda>p. if p = coast_'proc then 1 else 0))
                      (\<lambda>(s,p). (\<^bsup>s\<^esup>N + \<^bsup>s\<^esup>M,p))"])
  apply simp_all
  apply  vcg
  apply  simp
  apply vcg
  apply simp
  done

lemma (in pedal_coast_clique)
  shows "(\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC pedal(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>) \<and>
         (\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC coast(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>)"
  apply (hoare_rule HoareTotal_ProcRec2
          [where ?r= "inv_image (measure (\<lambda>m. m) <*lex*>
                                  measure (\<lambda>p. if p = coast_'proc then 1 else 0))
                      (\<lambda>(s,p). (\<^bsup>s\<^esup>N + \<^bsup>s\<^esup>M,p))"])
  apply simp_all
  apply  vcg
  apply  simp
  apply vcg
  apply simp
  done

lemma (in pedal_coast_clique)
  shows "(\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC pedal(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>) \<and>
         (\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC coast(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>)"
  apply(hoare_rule HoareTotal_ProcRec2
     [where ?r= "measure (\<lambda>(s,p). \<^bsup>s\<^esup>N + \<^bsup>s\<^esup>M + (if p = coast_'proc then 1 else 0))"])
  apply simp_all
  apply  vcg
  apply  simp
  apply  arith
  apply vcg
  apply simp
  done

lemma (in pedal_coast_clique)
  shows "(\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC pedal(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>) \<and>
         (\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC coast(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>)"
  apply(hoare_rule HoareTotal_ProcRec2
     [where ?r= "(\<lambda>(s,p). \<^bsup>s\<^esup>N) <*mlex*> (\<lambda>(s,p). \<^bsup>s\<^esup>M) <*mlex*>
                 measure (\<lambda>(s,p). if p = coast_'proc then 1 else 0)"])
   apply  simp_all
   apply  vcg
   apply  simp
   apply vcg
   apply simp
   done

lemma (in pedal_coast_clique)
  shows "(\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC pedal(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>) \<and>
         (\<Gamma>\<turnstile>\<^sub>t \<lbrace>True\<rbrace> PROC coast(\<acute>N,\<acute>M) \<lbrace>True\<rbrace>)"
  apply(hoare_rule HoareTotal_ProcRec2
     [where ?r= "measure (\<lambda>s. \<^bsup>s\<^esup>N + \<^bsup>s\<^esup>M) <*lex*>
                 measure (\<lambda>p. if p = coast_'proc then 1 else 0)"])
   apply simp_all
   apply  vcg
   apply  simp
   apply vcg
   apply simp
   done

end


(* Title: thys/SemiIdTM.thy
   Author: Franz Regensburger (FABR) 02/2022
 *)

section \<open>SemiId: Turing machines acting as partial identity functions\<close>

theory SemiIdTM
  imports Turing_Hoare
begin

(* Cleanup the global simpset *)

declare adjust.simps[simp del]

declare seq_tm.simps [simp del]
declare shift.simps[simp del]
declare composable_tm.simps[simp del]
declare step.simps[simp del]
declare steps.simps[simp del]

subsection \<open>The Turing Machine tm\_semi\_id\_eq0\<close>

(* ---------------------------------------------------------- *)
(* Machine tm_semi_id_eq0                                     *)
(* ---------------------------------------------------------- *)
(*
The machine tm_semi_id_eq0
terminates on: Oc \<up> 1 with result Oc \<up> 1, which is the numeral <0>

     loops on: []      which is the empty input
     loops on: Oc \<up> n, where n \<ge> 2
*)

text \<open>
  If the input is @{term "Oc\<up>1"} the machine @{term "tm_semi_id_eq0"} will reach the
  final state in a standard configuration with output identical to its input.
  For other inputs @{term "Oc\<up>n"} with @{term "1 \<noteq> (n::nat)"} it will
  loop forever.

  Please note that our short notation  @{term "<n::nat>"} means @{term "Oc\<up>(n+1)"}
  where @{term "0 \<le> (n::nat)"}.
\<close>

definition tm_semi_id_eq0 :: "instr list"
  where
    "tm_semi_id_eq0 \<equiv> [(WB, 1), (R, 2), (L, 0), (L, 1)]"

(* ------ Important properties used in subsequent theories ------ *)

lemma composable_tm0_tm_semi_id_eq0[intro, simp]: "composable_tm0 tm_semi_id_eq0"
  by (auto simp: composable_tm.simps tm_semi_id_eq0_def)

lemma tm_semi_id_eq0_loops_aux:
  "(steps0 (1, [], [Oc, Oc]) tm_semi_id_eq0 stp = (1, [], [Oc, Oc])) \<or>
   (steps0 (1, [], [Oc, Oc]) tm_semi_id_eq0 stp = (2, Oc # [], [Oc]))"
  by (induct stp) (auto simp: steps.simps step.simps tm_semi_id_eq0_def numeral_eqs_upto_12)

lemma tm_semi_id_eq0_loops_aux':
  "(steps0 (1, [], [Oc, Oc] @ (Bk \<up> q)) tm_semi_id_eq0 stp = (1, [], [Oc,Oc] @ Bk \<up> q)) \<or>
   (steps0 (1, [], [Oc, Oc] @ (Bk \<up> q)) tm_semi_id_eq0 stp = (2, Oc # [], [Oc] @ (Bk \<up> q)))"
  by (induct stp) (auto simp: steps.simps step.simps tm_semi_id_eq0_def numeral_eqs_upto_12)

lemma tm_semi_id_eq0_loops_aux'':
  "(steps0 (1, [], [Oc, Oc] @ (Oc \<up> q) @ (Bk \<up> q)) tm_semi_id_eq0 stp = (1, [], [Oc,Oc] @ (Oc \<up> q) @ Bk \<up> q)) \<or>
   (steps0 (1, [], [Oc, Oc] @ (Oc \<up> q) @ (Bk \<up> q)) tm_semi_id_eq0 stp = (2, Oc # [], [Oc] @ (Oc \<up> q) @ (Bk \<up> q)))"
  by (induct stp) (auto simp: steps.simps step.simps tm_semi_id_eq0_def numeral_eqs_upto_12)

lemma tm_semi_id_eq0_loops_aux''':
  "(steps0 (1, [], []) tm_semi_id_eq0 stp = (1, [], [])) \<or>
   (steps0 (1, [], []) tm_semi_id_eq0 stp = (1, [], [Bk]))"
  by (induct stp) (auto simp: steps.simps step.simps tm_semi_id_eq0_def numeral_eqs_upto_12)

(* ------ Auxiliary properties for clarification           ------ *)

lemma "<0::nat> = [Oc]" by (simp add: tape_of_nat_def)
lemma "Oc\<up>(0+1) = [Oc]" by (simp)
lemma "<n::nat> = Oc\<up>(n+1)" by (auto simp add: tape_of_nat_def)
lemma "<1::nat> = [Oc, Oc]" by (simp add: tape_of_nat_def)

subsubsection \<open>The machine tm\_semi\_id\_eq0 in action\<close>

(* steps0 (1, [], []) tm_semi_id_eq0 n loops forever in state 1 *)
lemma "steps0 (1, [], []) tm_semi_id_eq0 0 = (1, [], [])"   by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_eq0_def)
lemma "steps0 (1, [], []) tm_semi_id_eq0 1 = (1, [], [Bk])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_eq0_def)
lemma "steps0 (1, [], []) tm_semi_id_eq0 2 = (1, [], [Bk])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_eq0_def)
lemma "steps0 (1, [], []) tm_semi_id_eq0 3 = (1, [], [Bk])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_eq0_def)

(*     steps0 (1, [], [Oc]) tm_semi_id_eq0 n terminates after 2 steps with final configuration "(0, [], [Oc])" *)
lemma "steps0 (1, [], [Oc]) tm_semi_id_eq0 0 = (1, [], [Oc])" by (simp add: step.simps steps.simps tm_semi_id_eq0_def)
lemma "steps0 (1, [], [Oc]) tm_semi_id_eq0 1 = (2, [Oc], [])" by (simp add: step.simps steps.simps tm_semi_id_eq0_def)
lemma "steps0 (1, [], [Oc]) tm_semi_id_eq0 2 = (0, [], [Oc])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_eq0_def)

(* steps0 (1, [], [Oc, Oc]) tm_semi_id_eq0 loops forever *)
lemma "steps0 (1, [], [Oc, Oc]) tm_semi_id_eq0 0 = (1, [], [Oc, Oc])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_eq0_def)
lemma "steps0 (1, [], [Oc, Oc]) tm_semi_id_eq0 1 = (2, [Oc], [Oc])"   by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_eq0_def)
lemma "steps0 (1, [], [Oc, Oc]) tm_semi_id_eq0 2 = (1, [], [Oc, Oc])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_eq0_def)
lemma "steps0 (1, [], [Oc, Oc]) tm_semi_id_eq0 3 = (2, [Oc], [Oc])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_eq0_def)
lemma "steps0 (1, [], [Oc, Oc]) tm_semi_id_eq0 4 = (1, [], [Oc, Oc])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_eq0_def)

subsection \<open>The Turing Machine tm\_semi\_id\_gt0\<close>

(* ---------------------------------------------------------- *)
(* Machine tm_semi_id_gt0                                     *)
(* ---------------------------------------------------------- *)
(*
The machine tm_semi_id_gt0 (aka dither) has behaviour that is complementary
to the behaviour of tm_semi_id_eq0.

The machine tm_semi_id_gt0
terminates on: Oc \<up> n  with result Oc \<up> n for 1 < n

     loops on: []     , which is the empty input
     loops on: Oc \<up> 1 , which is the numeral <0>
*)

text \<open>
  If the input is @{term "Oc\<up>0"} or @{term "Oc\<up>1"} the machine @{term "tm_semi_id_gt0"}
  (aka dither) will loop forever.
  For other non-blank inputs @{term "Oc\<up>n"} with @{term  "1 < (n::nat)"} it will
  reach the final state in a standard configuration with output identical to its input.

  Please note that our short notation  @{term "<n::nat>"} means @{term "Oc\<up>(n+1)"}
  where @{term "0 \<le> (n::nat)"}.
\<close>

definition tm_semi_id_gt0 :: "instr list"
  where
    "tm_semi_id_gt0 \<equiv> [(WB, 1), (R, 2), (L, 1), (L, 0)]"

(* ------ Important properties used in subsequent theories ------ *)

lemma tm_semi_id_gt0[intro, simp]: "composable_tm0 tm_semi_id_gt0"
  by (auto simp: composable_tm.simps tm_semi_id_gt0_def)

lemma tm_semi_id_gt0_loops_aux:
  "(steps0 (1, [], [Oc]) tm_semi_id_gt0 stp = (1, [], [Oc])) \<or>
   (steps0 (1, [], [Oc]) tm_semi_id_gt0 stp = (2, Oc # [], []))"
  by (induct stp) (auto simp: steps.simps step.simps tm_semi_id_gt0_def numeral_eqs_upto_12)

lemma tm_semi_id_gt0_loops_aux':
  "(steps0 (1, [], [Oc] @ Bk \<up> n) tm_semi_id_gt0 stp = (1, [], [Oc] @ Bk \<up> n)) \<or>
   (steps0 (1, [], [Oc] @ Bk \<up> n) tm_semi_id_gt0 stp = (2, Oc # [], Bk \<up> n))"
  by (induct stp) (auto simp: steps.simps step.simps tm_semi_id_gt0_def numeral_eqs_upto_12)

lemma tm_semi_id_gt0_loops_aux''':
  "(steps0 (1, [], []) tm_semi_id_gt0 stp = (1, [], [])) \<or>
   (steps0 (1, [], []) tm_semi_id_gt0 stp = (1, [], [Bk]))"
  by (induct stp) (auto simp: steps.simps step.simps tm_semi_id_gt0_def numeral_eqs_upto_12)

subsubsection \<open>The machine tm\_semi\_id\_gt0 in action\<close>

(* steps0 (1, [], []) tm_semi_id_gt0 n loops forever in state 1 *)
lemma "steps0 (1, [], []) tm_semi_id_gt0 0 = (1, [], [])"   by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)
lemma "steps0 (1, [], []) tm_semi_id_gt0 1 = (1, [], [Bk])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)
lemma "steps0 (1, [], []) tm_semi_id_gt0 2 = (1, [], [Bk])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)
lemma "steps0 (1, [], []) tm_semi_id_gt0 3 = (1, [], [Bk])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)

(* steps0 (1, [], [Oc]) tm_semi_id_gt0 n loops forever; it dithers between states 1 and 2 *)
lemma "steps0 (1, [], [Oc]) tm_semi_id_gt0 0 = (1, [], [Oc])" by (simp add: step.simps steps.simps tm_semi_id_gt0_def)
lemma "steps0 (1, [], [Oc]) tm_semi_id_gt0 1 = (2, [Oc], [])" by (simp add: step.simps steps.simps tm_semi_id_gt0_def)
lemma "steps0 (1, [], [Oc]) tm_semi_id_gt0 2 = (1, [], [Oc])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)
lemma "steps0 (1, [], [Oc]) tm_semi_id_gt0 3 = (2, [Oc], [])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)
lemma "steps0 (1, [], [Oc]) tm_semi_id_gt0 4 = (1, [], [Oc])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)

(* steps0 (1, [], [Oc, Oc]) tm_semi_id_gt0 n terminates after 2 steps with final configuration "(0, [], [Oc, Oc])" *)
lemma "steps0 (1, [], [Oc, Oc]) tm_semi_id_gt0 0 = (1, [], [Oc, Oc])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)
lemma "steps0 (1, [], [Oc, Oc]) tm_semi_id_gt0 1 = (2, [Oc], [Oc])"   by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)
lemma "steps0 (1, [], [Oc, Oc]) tm_semi_id_gt0 2 = (0, [], [Oc, Oc])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)
lemma "steps0 (1, [], [Oc, Oc]) tm_semi_id_gt0 3 = (0, [], [Oc, Oc])" by (simp add: step.simps steps.simps numeral_eqs_upto_12 tm_semi_id_gt0_def)

subsection \<open>Properties of the SemiId machines\<close>

(*
declare adjust.simps[simp del]

declare seq_tm.simps [simp del]
declare shift.simps[simp del]
declare composable_tm.simps[simp del]
declare step.simps[simp del]
declare steps.simps[simp del]
*)

text \<open>Using Hoare style rules is more elegant since they allow for compositional
 reasoning. Therefore, its preferable to use them, if the program that we reason about
 can be decomposed appropriately.\<close>

subsubsection \<open>Proving properties of tm\_semi\_id\_eq0 with Hoare Rules\<close>

lemma tm_semi_id_eq0_loops_Nil:
  shows "\<lbrace>\<lambda>tap. tap = ([], [])\<rbrace> tm_semi_id_eq0 \<up>"
  apply(rule Hoare_unhaltI)
  using tm_semi_id_eq0_loops_aux'''
  apply(auto simp add: numeral_eqs_upto_12 tape_of_nat_def)
  by (metis Suc_neq_Zero is_final_eq)

lemma tm_semi_id_eq0_loops:
  shows "\<lbrace>\<lambda>tap. tap = ([], <1::nat>)\<rbrace> tm_semi_id_eq0 \<up>"
  apply(rule Hoare_unhaltI)
  using tm_semi_id_eq0_loops_aux
  apply(auto simp add: numeral_eqs_upto_12 tape_of_nat_def)
  by (metis Suc_neq_Zero is_final_eq)

lemma tm_semi_id_eq0_loops':
  shows "\<lbrace>\<lambda>tap. \<exists>l. tap = ([], [Oc, Oc] @ Bk\<up> l)\<rbrace> tm_semi_id_eq0 \<up>"
  apply(rule Hoare_unhaltI)
  using tm_semi_id_eq0_loops_aux'
  apply(auto simp add: numeral_eqs_upto_12 tape_of_nat_def )
  by (metis Suc_neq_Zero is_final_eq)

lemma tm_semi_id_eq0_loops'':
  shows "\<lbrace>\<lambda>tap. \<exists>k l. tap = (Bk\<up>k, [Oc, Oc] @ Bk\<up> l)\<rbrace> tm_semi_id_eq0 \<up>"
  apply(rule Hoare_unhaltI)
  using tm_semi_id_eq0_loops_aux'
  apply(auto simp add: numeral_eqs_upto_12 tape_of_nat_def)
  by (metis is_final_del_Bks Zero_neq_Suc is_final_eq)

lemma tm_semi_id_eq0_halts_aux:
  shows "steps0 (1, Bk \<up> m, [Oc]) tm_semi_id_eq0 2 = (0, Bk \<up> m, [Oc])"
  unfolding tm_semi_id_eq0_def
  by (simp add: steps.simps step.simps numeral_eqs_upto_12)

lemma tm_semi_id_eq0_halts_aux':
  shows "steps0 (1, Bk \<up> m, [Oc]@Bk \<up> n) tm_semi_id_eq0 2 = (0, Bk \<up> m, [Oc]@Bk \<up> n)"
  unfolding tm_semi_id_eq0_def
  by (simp add: steps.simps step.simps numeral_eqs_upto_12)

lemma tm_semi_id_eq0_halts:
  shows "\<lbrace>\<lambda>tap. tap = ([], <0::nat>)\<rbrace> tm_semi_id_eq0 \<lbrace>\<lambda>tap. tap = ([], <0::nat>)\<rbrace>"
  apply(rule Hoare_haltI)
  using tm_semi_id_eq0_halts_aux
  apply(auto simp add: tape_of_nat_def)
  by (metis (full_types) holds_for.simps is_finalI  replicate_0)

lemma tm_semi_id_eq0_halts':
  shows "\<lbrace>\<lambda>tap. \<exists>l. tap = ([], [Oc] @ Bk\<up> l)\<rbrace> tm_semi_id_eq0 \<lbrace>\<lambda>tap. \<exists>l. tap = ([], [Oc] @ Bk\<up> l)\<rbrace>"
  apply(rule Hoare_haltI)
  using tm_semi_id_eq0_halts_aux'
  apply(auto simp add: tape_of_nat_def)
  by (metis (mono_tags, lifting) holds_for.simps is_finalI numeral_1_eq_Suc_0 numeral_One replicate_0)

lemma tm_semi_id_eq0_halts'':
  shows "\<lbrace> \<lambda>tap. \<exists>k l. tap = (Bk\<up> k, [Oc] @ Bk\<up> l) \<rbrace> tm_semi_id_eq0 \<lbrace> \<lambda>tap. \<exists>k l. tap = (Bk\<up> k, [Oc] @ Bk\<up> l) \<rbrace>"
  apply(rule Hoare_haltI)
  using tm_semi_id_eq0_halts_aux'
  apply(auto simp add: tape_of_nat_def)
  by (metis (mono_tags, lifting) holds_for.simps is_finalI numeral_1_eq_Suc_0 numeral_One)

subsubsection \<open>Proving properties of tm\_semi\_id\_gt0 with Hoare Rules\<close>

lemma tm_semi_id_gt0_loops_Nil:
  shows "\<lbrace>\<lambda>tap. tap = ([], [])\<rbrace> tm_semi_id_gt0 \<up>"
  apply(rule Hoare_unhaltI)
  using tm_semi_id_gt0_loops_aux'''
  apply(auto simp add: numeral_eqs_upto_12 tape_of_nat_def)
  by (metis Suc_neq_Zero is_final_eq)

lemma tm_semi_id_gt0_loops:
  shows "\<lbrace>\<lambda>tap. tap = ([], <0::nat>)\<rbrace> tm_semi_id_gt0 \<up>"
  apply(rule Hoare_unhaltI)
  using tm_semi_id_gt0_loops_aux
  apply(auto simp add: numeral_eqs_upto_12 tape_of_nat_def)
  by (metis Suc_neq_Zero is_final_eq)

lemma tm_semi_id_gt0_loops':
  shows "\<lbrace>\<lambda>tap. \<exists>l. tap = ([], [Oc] @ Bk\<up> l)\<rbrace> tm_semi_id_gt0 \<up>"
  apply(rule Hoare_unhaltI)
  using tm_semi_id_gt0_loops_aux'
  apply(auto simp add: numeral_eqs_upto_12 tape_of_nat_def)
  by (metis Suc_neq_Zero is_final_eq)

lemma tm_semi_id_gt0_loops'':
  shows "\<lbrace>\<lambda>tap. \<exists>k l. tap = (Bk\<up>k, [Oc] @ Bk\<up> l)\<rbrace> tm_semi_id_gt0 \<up>"
  apply(rule Hoare_unhaltI)
  using tm_semi_id_gt0_loops_aux'
  apply(auto simp add: numeral_eqs_upto_12 tape_of_nat_def)
  by (metis is_final_del_Bks Zero_neq_Suc is_final_eq)

lemma tm_semi_id_gt0_halts_aux:
  shows "steps0 (1, Bk \<up> m, [Oc, Oc]) tm_semi_id_gt0 2 = (0, Bk \<up> m, [Oc, Oc])"
  unfolding tm_semi_id_gt0_def
  by (simp add: steps.simps step.simps numeral_eqs_upto_12)

lemma tm_semi_id_gt0_halts_aux':
  shows "steps0 (1, Bk \<up> m, [Oc, Oc]@Bk \<up> n) tm_semi_id_gt0 2 = (0, Bk \<up> m, [Oc, Oc]@Bk \<up> n)"
  unfolding tm_semi_id_gt0_def
  by (simp add: steps.simps step.simps numeral_eqs_upto_12)

lemma tm_semi_id_gt0_halts:
  shows "\<lbrace>\<lambda>tap. tap = ([], <1::nat>)\<rbrace> tm_semi_id_gt0 \<lbrace>\<lambda>tap. tap = ([], <1::nat>)\<rbrace>"
  apply(rule Hoare_haltI)
  using tm_semi_id_gt0_halts_aux
  apply(auto simp add: tape_of_nat_def)
  by (metis (full_types) empty_replicate holds_for.simps is_final_eq numeral_2_eq_2)

lemma tm_semi_id_gt0_halts':
  shows "\<lbrace>\<lambda>tap. \<exists>l. tap = ([], [Oc, Oc] @ Bk\<up> l)\<rbrace> tm_semi_id_gt0 \<lbrace>\<lambda>tap. \<exists>l. tap = ([], [Oc, Oc] @ Bk\<up> l)\<rbrace>"
  apply(rule Hoare_haltI)
  using tm_semi_id_gt0_halts_aux'
  apply(auto simp add: tape_of_nat_def)
  by (metis (mono_tags, lifting) Suc_1 holds_for.simps is_finalI numeral_1_eq_Suc_0 numeral_One replicate_0)

lemma tm_semi_id_gt0_halts'':
  shows "\<lbrace> \<lambda>tap. \<exists>k l. tap = (Bk\<up> k, [Oc, Oc] @ Bk\<up> l)\<rbrace> tm_semi_id_gt0 \<lbrace>\<lambda>tap. \<exists>k l. tap = (Bk\<up> k, [Oc, Oc] @ Bk\<up> l)\<rbrace>"
  apply(rule Hoare_haltI)
  using tm_semi_id_gt0_halts_aux'
  apply(auto simp add: tape_of_nat_def)
  by (metis (mono_tags, lifting) Suc_1 holds_for.simps is_finalI numeral_1_eq_Suc_0 numeral_One)

end


section \<open> Timed Traces \<close>

theory tcircus_traces
  imports "UTP1-Reactive-Designs.utp_rea_designs" "../rcircus/Refusal_Tests"
begin recall_syntax

subsection \<open> Events and Traces \<close>

instantiation list :: (type) monoid_mult
begin
definition [simp]: "one_list = []"
definition [simp]: "times_list = (@)"
instance by (intro_classes; simp)
end

lemma power_replicate: "[x]^n = replicate n x"
  by (induct n; simp)

text \<open> We try and characterise a tock-CSP like model using the standard Circus pattern and adapting
  the CML model and bits of the refusal testing model. First we represent traces. \<close>

datatype 'e tev =
  Tock "'e set" \<comment> \<open> Passage of time, which we term and ``idle'' event \<close>
  | Evt 'e      \<comment> \<open> Other, ``active'' events \<close>

type_synonym 'e ttrace = "'e tev list"

subsection \<open> Idle Traces \<close>

definition tocks :: "'e set \<Rightarrow> 'e tev list set" where
"tocks X = {t. \<forall> e \<in> set(t). \<exists> Y. e = Tock Y \<and> Y \<subseteq> X}"

lemma tocks_Nil [simp]: "[] \<in> tocks X"
  by (simp add: tocks_def)

lemma tocks_Tock: "t \<in> tocks X \<Longrightarrow> set t \<subseteq> range Tock"
  by (auto simp add: tocks_def)

lemma tocks_Cons [intro]: "\<lbrakk> Y \<subseteq> X; t \<in> tocks X \<rbrakk> \<Longrightarrow> Tock Y # t \<in> tocks X"
  by (simp add: tocks_def)

lemma tocks_inter [intro!]: "\<lbrakk> t \<in> tocks X; t \<in> tocks Y \<rbrakk> \<Longrightarrow> t \<in> tocks (X \<inter> Y)"
  by (auto simp add: tocks_def, metis tev.inject(1))

lemma tocks_Evt [simp]: "Evt e # t \<in> tocks X = False"
  by (simp add: tocks_def)

lemma tocks_subset: "\<lbrakk> A \<subseteq> B; t \<in> tocks A\<rbrakk> \<Longrightarrow> t \<in> tocks B"
  by (auto simp add: tocks_def)

lemma tocks_append [simp]: "s @ t \<in> tocks X \<longleftrightarrow> (s \<in> tocks X \<and> t \<in> tocks X)"
  by (auto simp add: tocks_def)

lemma tocks_take [simp]: "s \<in> tocks X \<Longrightarrow> take n s \<in> tocks X"
  by (auto simp add: tocks_def, meson in_set_takeD)

lemma tocks_drop [simp]: "s \<in> tocks X \<Longrightarrow> drop n s \<in> tocks X"
  by (auto simp add: tocks_def, meson in_set_dropD)

lemma tocks_inter1 [dest]: "t \<in> tocks (X \<inter> Y) \<Longrightarrow> t \<in> tocks(X)"
  by (auto simp add: tocks_def)

lemma tocks_inter2 [dest]: "t \<in> tocks (X \<inter> Y) \<Longrightarrow> t \<in> tocks(Y)"
  by (auto simp add: tocks_def)

definition "mk_tocks n = replicate n (Tock {})"

lemma mk_tocks: "mk_tocks n \<in> tocks X"
  by (simp add: mk_tocks_def tocks_def)

lemma length_mk_tocks [simp]: "length (mk_tocks n) = n"
  by (simp add: mk_tocks_def)

subsubsection \<open> Tocks Order \<close>

text \<open> This order states that two traces have the same length, and agree on the order of events
  and tocks, but each tock can refuse fewer events. \<close>

definition tock_ord :: "'e tev list \<Rightarrow> 'e tev list \<Rightarrow> bool" (infix "\<subseteq>\<^sub>t" 50) where
"(t\<^sub>1 \<subseteq>\<^sub>t t\<^sub>2) = (length t\<^sub>1 = length t\<^sub>2 \<and> (\<forall> i<length t\<^sub>1. t\<^sub>1!i = t\<^sub>2!i \<or> (\<exists> X Y. X \<subseteq> Y \<and> t\<^sub>1!i = Tock X \<and> t\<^sub>2!i = Tock Y)))"

lemma tock_ord_refl: "x \<subseteq>\<^sub>t x"
  by (simp add: tock_ord_def)

lemma tock_ord_trans: "\<lbrakk> x \<subseteq>\<^sub>t y; y \<subseteq>\<^sub>t z \<rbrakk> \<Longrightarrow> x \<subseteq>\<^sub>t z"
  by (auto simp add: tock_ord_def, smt dual_order.trans tev.inject(1))

lemma tock_ord_antisym: "\<lbrakk> x \<subseteq>\<^sub>t y; y \<subseteq>\<^sub>t x \<rbrakk> \<Longrightarrow> x = y"
  by (auto simp add: tock_ord_def, metis nth_equalityI subset_antisym tev.inject(1))

lemma tock_ord_least [simp]: "t \<subseteq>\<^sub>t [] \<longleftrightarrow> t = []"
  by (auto simp add: tock_ord_def)

lemma tock_ord_Nil [simp]: "[] \<subseteq>\<^sub>t t \<longleftrightarrow> t = []"
  by (auto simp add: tock_ord_def)

lemma tock_ord_append: "\<lbrakk> x\<^sub>1 \<subseteq>\<^sub>t y\<^sub>1; x\<^sub>2 \<subseteq>\<^sub>t y\<^sub>2 \<rbrakk> \<Longrightarrow> x\<^sub>1 @ x\<^sub>2 \<subseteq>\<^sub>t y\<^sub>1 @ y\<^sub>2"
  apply (auto simp add: tock_ord_def)
  by (smt diff_add_cancel_left' nat_add_left_cancel_less not_less nth_append)

lemma tock_ord_decompose:
  assumes  "x \<subseteq>\<^sub>t y @ z"
  shows "take (length y) x \<subseteq>\<^sub>t y" "drop (length y) x \<subseteq>\<^sub>t z"
  using assms
  by (auto simp add: tock_ord_def)
     (metis add_leE not_less nth_append, metis nat_add_left_cancel_less nth_append_length_plus)

lemma tocks_order_power:
  assumes "t \<in> tocks A"
  shows "t \<subseteq>\<^sub>t [Tock A]^length t"
proof -
  from assms have "\<forall>i<length t. t ! i = Tock A \<or> (\<exists>X. X \<subseteq> A \<and> t ! i = Tock X)"
    by (simp add: tocks_def, meson in_set_conv_nth)
  thus ?thesis
    by (auto simp add: tock_ord_def power_replicate)
qed

lemma tock_power_in_tocks: "[Tock A]^n \<in> tocks A"
  by (simp add: tocks_def power_replicate)

lemma tocks_ord_closed:
  "\<lbrakk> t\<^sub>1 \<in> tocks A; t\<^sub>2 \<subseteq>\<^sub>t t\<^sub>1 \<rbrakk> \<Longrightarrow> t\<^sub>2 \<in> tocks A"
  by (auto simp add: tocks_def tock_ord_def in_set_conv_nth)
     (metis (no_types, opaque_lifting) nth_mem subset_trans tev.inject(1))

lemma tock_ord_Evt: "x \<subseteq>\<^sub>t Evt e # y \<Longrightarrow> (\<exists> t. x = Evt e # t \<and> t \<subseteq>\<^sub>t y)"
  apply (simp add: tock_ord_def)
  apply (rule_tac x="tl x" in exI)
  apply (auto)
  apply (metis hd_Cons_tl length_0_conv nat.simps(3) nth_Cons_0 tev.distinct(1) zero_less_Suc)
  apply (metis Nitpick.size_list_simp(2) Suc_less_eq nat.simps(3) nth_Cons_Suc nth_tl)
  done

lemma tock_ord_EvtE [elim!]: "\<lbrakk> x \<subseteq>\<^sub>t Evt e # y; \<And> t. \<lbrakk> x = Evt e # t; t \<subseteq>\<^sub>t y \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
  by (metis tock_ord_Evt)

lemma tock_ord_Evt_hd_eq [simp]: "Evt e # x \<subseteq>\<^sub>t Evt f # y \<longleftrightarrow> (e = f \<and> x \<subseteq>\<^sub>t y)"
  by (auto simp add: tock_ord_def)
     (smt One_nat_def add.commute diff_add_cancel_left' length_Cons less_Suc0 list.size(4) nat_add_left_cancel_less not_less nth_Cons')

subsubsection \<open> Other Functions \<close>

fun events :: "'e tev list \<Rightarrow> 'e tev list" where
"events [] = []" |
"events (Tock A # t) = events t" |
"events (Evt x # t) = (Evt x # events t)"

lemma events_append [simp]: "events (xs @ ys) = events(xs) @ events(ys)"
  apply (induct xs, simp_all)
  apply (rename_tac x xs)
  apply (case_tac x)
  apply (simp_all)
done

text \<open> This function is from CML. It extracts the prefix of a trace that consists of tocks only,
  that is before an active event has occurred. \<close>

fun idleprefix :: "'e tev list \<Rightarrow> 'e tev list" where
"idleprefix [] = []" |
"idleprefix (Tock A # t) = (Tock A # idleprefix t)" |
"idleprefix (Evt x # t) = []"

lemma idleprefix_tocks [simp]: "idleprefix t \<in> tocks UNIV"
  by (induct t, simp_all, metis idleprefix.elims list.sel(3) subset_UNIV tocks_Cons tocks_Nil)

text \<open> The dual function extracts the events following an active event. \<close>

fun activesuffix :: "'e tev list \<Rightarrow> 'e tev list" where
"activesuffix [] = []" |
"activesuffix (Tock A # t) = activesuffix t" |
"activesuffix (Evt x # t) = (Evt x # t)"

text \<open> If an active suffix has elements, then the first element must be an event. \<close>

lemma hd_activesuffix:
  "activesuffix t \<noteq> [] \<Longrightarrow> hd(activesuffix t) \<in> range(Evt)"
  apply (induct t, simp_all)
  apply (rename_tac a t)
  apply (case_tac a)
   apply (simp_all)
  done

text \<open> A trace can always be decomposed into an idle prefix and an active suffix. \<close>

lemma idle_active_decomp:
  "idleprefix t @ activesuffix t = t"
  apply (induct t, simp_all)
  apply (rename_tac a t)
  apply (case_tac a)
   apply (simp_all)
  done

lemma idleprefix_concat_Evt [simp]: "idleprefix (t @ Evt e # t') = idleprefix t"
  by ((induct t; simp), metis idleprefix.simps(2) idleprefix.simps(3) tev.exhaust)

lemma idleprefix_prefix: "idleprefix(t) \<le> t"
  by (metis Prefix_Order.prefixI idle_active_decomp)

lemma tocks_idleprefix_fp [simp]:
  "t \<in> tocks A \<Longrightarrow> idleprefix(t) = t"
  by (metis hd_Cons_tl hd_activesuffix idle_active_decomp rangeE self_append_conv tocks_Evt tocks_append)

lemma tocks_iff_idleprefix_fp: "t \<in> tocks UNIV \<longleftrightarrow> idleprefix t = t"
  by (metis idleprefix_tocks tocks_idleprefix_fp)

lemma idleprefix_idem [simp]: "idleprefix (idleprefix t) = idleprefix t"
  using idleprefix_tocks tocks_idleprefix_fp by blast

text \<open> If we have two equal traces with idle prefixes, @{term x} and @{term y}, followed by active
  events @{term a} and @{term b}, and then suffixes @{term as} and @{term bs}, then we can identify
  the prefixes, active events, and suffixes. \<close>

lemma tock_prefix_eq:
  assumes "x @ (Evt a # as) = y @ (Evt b # bs)" "x \<in> tocks X" "y \<in> tocks Y"
  shows "x = y \<and> a = b \<and> as = bs"
proof (safe)
  show 1:"x = y"
  proof (rule ccontr)
    assume neq: "x \<noteq> y"
    from assms(1) have "\<forall> i. (x @ (Evt a # as))!i = (y @ (Evt b # bs))!i"
      by simp
    show False
    proof (cases "length x" "length y" rule: linorder_cases)
      case less thus ?thesis
        by (metis assms(1) assms(3) less nth_append nth_append_length nth_mem rangeE subsetD tev.distinct(1) tocks_Tock)
    next
      case equal
      then show ?thesis
        by (metis append_eq_append_conv assms(1) neq)
    next
      case greater thus ?thesis
        by (metis assms(1) assms(2) nth_append nth_append_length nth_mem rangeE subsetD tev.distinct(1) tocks_Tock)
    qed
  qed
  show "a = b"
    by (metis "1" assms(1) nth_append_length tev.inject(2))
  show "as = bs"
    by (metis "1" assms(1) list.inject same_append_eq)
qed

text \<open> Generalised variant of the above \<close>

lemma tock_prefix_eq':
  assumes "x @ (Evt a # as) = y @ z" "x \<in> tocks X" "y \<in> tocks Y" "hd(z) \<in> range(Evt)"
  shows "x = y \<and> z = Evt a # as"
proof -
  obtain b bs where "z = Evt b # bs"
    by (metis append.right_neutral assms(1) assms(3) assms(4) hd_Cons_tl image_iff tocks_Evt tocks_append)
  thus ?thesis
    by (metis assms(1) assms(2) assms(3) tock_prefix_eq)
qed

end