theory Prelude_ExamplePrograms
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\", \"Comp1\", \"IdDef\", \"FlipDef\",
     \"FstDef\", \"SndDef\", \"CurryDef\", \"UncurryDef\", \"NotFalse\",
     \"NotTrue\", \"AndFalse\", \"AndTrue\", \"AndSym\", \"OrDef\",
     \"OtherwiseDef\", \"AndPrefixDef\", \"OrPrefixDef\", \"NotFalse1\",
     \"NotTrue1\", \"notNot1\", \"notNot2\", \"EqualTDef\",
     \"EqualSymDef\", \"EqualReflex\", \"EqualTransT\", \"DiffDef\",
     \"DiffSymDef\", \"DiffTDef\", \"DiffFDef\", \"TE1\", \"TE2\",
     \"TE3\", \"TE4\", \"IBE1\", \"IBE2\", \"IBE3\", \"IBE4\", \"IBE5\",
     \"IBE6\", \"IBE7\", \"IBE8\", \"IUE1\", \"IUE2\", \"IOE01\",
     \"IOE02\", \"IOE03\", \"IOE04\", \"IOE05\", \"IOE06\", \"IOE07\",
     \"IOE08\", \"IOE09\", \"LeIrreflexivity\", \"LeTAsymmetry\",
     \"LeTTransitive\", \"LeTTotal\", \"GeDef\", \"GeIrreflexivity\",
     \"GeTAsymmetry\", \"GeTTransitive\", \"GeTTotal\", \"LeqDef\",
     \"LeqReflexivity\", \"LeqTTransitive\", \"LeqTTotal\", \"GeqDef\",
     \"GeqReflexivity\", \"GeqTTransitive\", \"GeqTTotal\",
     \"EqTSOrdRel\", \"EqFSOrdRel\", \"EqTOrdRel\", \"EqFOrdRel\",
     \"EqTOrdTSubstE\", \"EqTOrdFSubstE\", \"EqTOrdTSubstD\",
     \"EqTOrdFSubstD\", \"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\", \"XPlusXPlusPrefixDef\", \"FilterNil\",
     \"FilterConsT\", \"FilterConsF\", \"ZipNil\", \"ZipConsNil\",
     \"ZipConsCons\", \"UnzipNil\", \"UnzipCons\", \"EqualListNilDef\",
     \"EqualListDef\", \"LeListNilFalse\", \"LeListDef\",
     \"FoldlDecomp\", \"MapDecomp\", \"MapFunctor\", \"FilterProm\",
     \"LengthNil1\", \"LengthEqualNil\", \"LengthEqualCons\",
     \"ZipSpec\", \"InitNil\", \"InitConsNil\", \"InitConsCons\",
     \"LastNil\", \"LastConsNil\", \"LastConsCons\", \"NullNil\",
     \"NullCons\", \"ReverseNil\", \"ReverseCons\", \"Foldr1Nil\",
     \"Foldr1ConsNil\", \"Foldr1ConsCons\", \"Foldl1Nil\",
     \"Foldl1ConsNil\", \"Foldl1ConsCons\", \"AndLDef\", \"OrLDef\",
     \"AnyDef\", \"AllDef\", \"ConcatDef\", \"ConcatMapDef\",
     \"MaximumDef\", \"MinimumDef\", \"TakeWhileNil\",
     \"TakeWhileConsT\", \"TakeWhileConsF\", \"DropWhileNil\",
     \"DropWhileConsT\", \"DropWhileConsF\", \"SpanNil\", \"SpanConsT\",
     \"SpanConsF\", \"SpanThm\", \"BreakDef\", \"BreakThm\",
     \"QsortNil\", \"QsortCons\", \"Program01\", \"Program02\"]"

typedecl Unit

datatype Nat = X0 ("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
Not__X :: "Bool => Bool" ("(Not''/ _)" [56] 56)
X1 :: "Nat" ("1''")
X2 :: "Nat" ("2''")
X3 :: "Nat" ("3''")
X4 :: "Nat" ("4''")
X5 :: "Nat" ("5''")
X6 :: "Nat" ("6''")
X7 :: "Nat" ("7''")
X8 :: "Nat" ("8''")
X9 :: "Nat" ("9''")
XLtXAmpXAmpXGt :: "Bool => Bool => Bool"
XLtXPlusXPlusXGt :: "'a List => 'a List => 'a List"
XLtXVBarXVBarXGt :: "Bool => Bool => Bool"
X__XAmpXAmp__X :: "Bool => Bool => Bool" ("(_/ &&/ _)" [54,54] 52)
X__XAtXAt__X :: "Nat => Nat => Nat" ("(_/ @@/ _)" [54,54] 52)
X__XCaret__X :: "Nat => Nat => Nat" ("(_/ ^''/ _)" [54,54] 52)
X__XEqXEq__X :: "'a => 'a => Bool" ("(_/ ==''/ _)" [54,54] 52)
X__XExclam :: "Nat => Nat" ("(_/ !'')" [58] 58)
X__XGtXEq__XX1 :: "Nat => Nat => bool" ("(_/ >=''/ _)" [44,44] 42)
X__XGtXEq__XX2 :: "'a => 'a => Bool" ("(_/ >=''''/ _)" [54,54] 52)
X__XGt__XX1 :: "Nat => Nat => bool" ("(_/ >''/ _)" [44,44] 42)
X__XGt__XX2 :: "'a => 'a => Bool" ("(_/ >''''/ _)" [54,54] 52)
X__XLtXEq__XX1 :: "Nat => Nat => bool" ("(_/ <=''/ _)" [44,44] 42)
X__XLtXEq__XX2 :: "'a => 'a => Bool" ("(_/ <=''''/ _)" [54,54] 52)
X__XLt__XX1 :: "Nat => Nat => bool" ("(_/ <''/ _)" [44,44] 42)
X__XLt__XX2 :: "'a => 'a => Bool" ("(_/ <''''/ _)" [54,54] 52)
X__XMinusXExclam__X :: "Nat => Nat => Nat" ("(_/ -!/ _)" [54,54] 52)
X__XMinusXQuest__X :: "Nat => Nat => Nat partial" ("(_/ -?/ _)" [54,54] 52)
X__XPlusXPlus__X :: "'a List => 'a List => 'a List" ("(_/ ++''/ _)" [54,54] 52)
X__XPlus__X :: "Nat => Nat => Nat" ("(_/ +''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a => 'a => Bool" ("(_/ '/=/ _)" [54,54] 52)
X__XSlashXQuest__X :: "Nat => Nat => Nat partial" ("(_/ '/?/ _)" [54,54] 52)
X__XVBarXVBar__X :: "Bool => Bool => Bool" ("(_/ ||/ _)" [54,54] 52)
X__Xx__X :: "Nat => Nat => Nat" ("(_/ *''/ _)" [54,54] 52)
X__div__X :: "Nat => Nat => Nat partial" ("(_/ div''/ _)" [54,54] 52)
X__mod__X :: "Nat => Nat => Nat partial" ("(_/ mod''/ _)" [54,54] 52)
X__o__X :: "('b => 'c) * ('a => 'b) => 'a => 'c"
X_all :: "('a => Bool) => 'a List => Bool"
X_andL :: "Bool List => Bool" ("andL/'(_')" [3] 999)
X_any :: "('a => Bool) => 'a List => Bool"
X_concat :: "'a List List => 'a List" ("concat''/'(_')" [3] 999)
X_curry :: "('a * 'b => 'c) => 'a => 'b => 'c"
X_dropWhile :: "('a => Bool) => 'a List => 'a List"
X_even :: "Nat => bool" ("even''/'(_')" [3] 999)
X_filter :: "('a => Bool) => 'a List => 'a List"
X_flip :: "('a => 'b => 'c) => 'b => 'a => 'c"
X_foldl :: "('a => 'b => 'a) => 'a => 'b List => 'a"
X_foldr :: "('a => 'b => 'b) => 'b => 'a List => 'b"
X_fst :: "'a => 'b => 'a" ("fst''/'(_,/ _')" [3,3] 999)
X_head :: "'a List => 'a partial" ("head/'(_')" [3] 999)
X_id :: "'a => 'a" ("id''/'(_')" [3] 999)
X_init :: "'a List => 'a List partial" ("init/'(_')" [3] 999)
X_last :: "'a List => 'a partial" ("last''/'(_')" [3] 999)
X_length :: "'a List => Nat" ("length''/'(_')" [3] 999)
X_map :: "('a => 'b) => 'a List => 'b List"
X_maxX1 :: "Nat => Nat => Nat" ("max''/'(_,/ _')" [3,3] 999)
X_maxX2 :: "'a => 'a => 'a"
X_maximum :: "'d List => 'd" ("maximum/'(_')" [3] 999)
X_minX1 :: "Nat => Nat => Nat" ("min''/'(_,/ _')" [3,3] 999)
X_minX2 :: "'a => 'a => 'a"
X_minimum :: "'d List => 'd" ("minimum/'(_')" [3] 999)
X_null :: "'a List => Bool" ("null''/'(_')" [3] 999)
X_odd :: "Nat => bool" ("odd''/'(_')" [3] 999)
X_orL :: "Bool List => Bool" ("orL/'(_')" [3] 999)
X_pre :: "Nat => Nat partial" ("pre/'(_')" [3] 999)
X_qsort :: "'a List => 'a List" ("qsort/'(_')" [3] 999)
X_reverse :: "'a List => 'a List" ("reverse/'(_')" [3] 999)
X_snd :: "'a => 'b => 'b" ("snd''/'(_,/ _')" [3,3] 999)
X_tail :: "'a List => 'a List partial" ("tail/'(_')" [3] 999)
X_takeWhile :: "('a => Bool) => 'a List => 'a List"
X_unzip :: "('a * 'b) List => 'a List * 'b List" ("unzip/'(_')" [3] 999)
X_zip :: "'a List => 'b List => ('a * 'b) List"
break :: "('a => Bool) => 'a List => 'a List * 'a List"
compare :: "'a => 'a => Ordering"
concatMap :: "('a => 'b List) => 'a List => 'b List"
foldl1 :: "('a => 'a => 'a) => 'a List => 'a partial"
foldr1 :: "('a => 'a => 'a) => 'a List => 'a partial"
otherwiseH :: "Bool"
span :: "('a => Bool) => 'a List => 'a List * 'a List"
uncurry :: "('a => 'b => 'c) => 'a * 'b => 'c"

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)"

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

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

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

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

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

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

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

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

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

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

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

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

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

OtherwiseDef [rule_format] : "otherwiseH = True'"

AndPrefixDef [rule_format] :
"ALL x. ALL y. XLtXAmpXAmpXGt x y = x && y"

OrPrefixDef [rule_format] :
"ALL x. ALL y. XLtXVBarXVBarXGt x y = x || y"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

IUO06 [rule_format] : "X_minX2 () () ==' () = 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) = suc(length'(xs))"

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

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

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

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

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

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

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

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

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

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

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

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

XPlusXPlusPrefixDef [rule_format] :
"ALL xs. ALL ys. XLtXPlusXPlusXGt xs ys = xs ++' ys"

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

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

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

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

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

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

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

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

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)"

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

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

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

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

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

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

LengthNil1 [rule_format] : "ALL xs. length'(xs) = 0' = (xs = Nil')"

LengthEqualNil [rule_format] :
"ALL ys. length'(Nil') = length'(ys) --> ys = Nil'"

LengthEqualCons [rule_format] :
"ALL x.
 ALL xs.
 ALL y.
 ALL ys.
 length'(X_Cons x xs) = length'(X_Cons y ys) -->
 length'(xs) = length'(ys)"

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

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

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

InitConsCons [rule_format] :
"ALL x.
 ALL xs.
 init(X_Cons x xs) =
 (let (Xb1, Xc0) = init(xs)
  in if Xb1 then makePartial (X_Cons x Xc0) else noneOp)"

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

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

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

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

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

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

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

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

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

Foldr1ConsCons [rule_format] :
"ALL f.
 ALL x.
 ALL xs.
 foldr1 f (X_Cons x xs) =
 (let (Xb1, Xc0) = foldr1 f xs
  in if Xb1 then makePartial (f x Xc0) else noneOp)"

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

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

Foldl1ConsCons [rule_format] :
"ALL f.
 ALL x.
 ALL xs.
 foldl1 f (X_Cons x xs) =
 (let (Xb1, Xc0) = foldr1 f xs
  in if Xb1 then makePartial (f x Xc0) else noneOp)"

AndLDef [rule_format] :
"ALL bs. andL(bs) = X_foldr XLtXAmpXAmpXGt True' bs"

OrLDef [rule_format] :
"ALL bs. orL(bs) = X_foldr XLtXVBarXVBarXGt False' bs"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

QsortNil [rule_format] : "qsort(Nil') = Nil'"

QsortCons [rule_format] :
"ALL x.
 ALL xs.
 qsort(X_Cons x xs) =
 (qsort(X_filter (% y. y <'' x) xs) ++' X_Cons x Nil') ++'
 qsort(X_filter (% y. y >='' x) xs)"

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 Comp1 [simp]
declare IdDef [simp]
declare FlipDef [simp]
declare FstDef [simp]
declare SndDef [simp]
declare CurryDef [simp]
declare UncurryDef [simp]
declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare EqualReflex [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare IOE01 [simp]
declare IOE02 [simp]
declare IOE03 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare IOE07 [simp]
declare IOE08 [simp]
declare IOE09 [simp]
declare LeIrreflexivity [simp]
declare LeTAsymmetry [simp]
declare GeIrreflexivity [simp]
declare GeTAsymmetry [simp]
declare GeTTransitive [simp]
declare GeTTotal [simp]
declare LeqReflexivity [simp]
declare LeqTTransitive [simp]
declare LeqTTotal [simp]
declare GeqReflexivity [simp]
declare GeqTTransitive [simp]
declare GeqTTotal [simp]
declare CmpLTDef [simp]
declare CmpEQDef [simp]
declare CmpGTDef [simp]
declare MaxYDef [simp]
declare MaxXDef [simp]
declare MinXDef [simp]
declare MinYDef [simp]
declare TO2 [simp]
declare TO4 [simp]
declare TO6 [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IOO16 [simp]
declare IOO17 [simp]
declare IOO18 [simp]
declare IOO19 [simp]
declare IOO20 [simp]
declare IOO21 [simp]
declare IOO22 [simp]
declare IOO23 [simp]
declare IOO24 [simp]
declare IOO25 [simp]
declare IOO26 [simp]
declare IOO27 [simp]
declare IOO28 [simp]
declare IOO29 [simp]
declare IOO30 [simp]
declare IOO31 [simp]
declare IOO32 [simp]
declare IOO33 [simp]
declare IBO5 [simp]
declare IBO6 [simp]
declare IBO7 [simp]
declare IBO8 [simp]
declare IBO9 [simp]
declare IBO10 [simp]
declare IBO11 [simp]
declare IBO12 [simp]
declare IUO05 [simp]
declare IUO06 [simp]
declare IUO07 [simp]
declare LengthNil [simp]
declare LengthCons [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]
declare LeListNilFalse [simp]
declare InitNil [simp]
declare InitConsNil [simp]
declare LastNil [simp]
declare LastConsNil [simp]
declare LastConsCons [simp]
declare NullNil [simp]
declare NullCons [simp]
declare ReverseNil [simp]
declare Foldr1Nil [simp]
declare Foldr1ConsNil [simp]
declare Foldl1Nil [simp]
declare Foldl1ConsNil [simp]
declare TakeWhileNil [simp]
declare TakeWhileConsF [simp]
declare DropWhileNil [simp]
declare DropWhileConsT [simp]
declare DropWhileConsF [simp]
declare SpanNil [simp]
declare QsortNil [simp]

theorem Program01 :
"andL(X_Cons True' (X_Cons True' (X_Cons True' Nil'))) = True'"
apply(simp only: AndLDef)
apply(simp only: FoldrCons)
apply(simp only: FoldrNil)
apply(simp add: AndPrefixDef)
done

ML "Header.record \"Program01\""

theorem Program02 :
"qsort(X_Cons True' (X_Cons False' Nil')) =
 X_Cons False' (X_Cons True' Nil')"
apply(simp only: QsortCons)
apply(case_tac "(%y. y <'' True') False'")
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QsortNil)
apply(simp only: XPlusXPlusNil)
apply(simp only: XPlusXPlusCons)
apply(simp only: XPlusXPlusNil)
apply(case_tac "(%y. y >='' True') False'")
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QsortNil)
apply(simp add: LeFGeTEqTRel)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QsortCons)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QsortNil)
apply(simp only: XPlusXPlusNil)
apply(simp only: XPlusXPlusCons)
apply(simp only: XPlusXPlusNil)
apply(simp only: IBO5)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QsortCons)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QsortNil)
apply(simp only: XPlusXPlusNil)
apply(simp only: XPlusXPlusCons)
apply(simp only: XPlusXPlusNil)
apply(case_tac "(%y. y >='' True') False'")
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QsortNil)
apply(simp only: XPlusXPlusCons)
apply(simp only: XPlusXPlusNil)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QsortCons)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QsortNil)
apply(simp only: XPlusXPlusNil)
apply(simp only: XPlusXPlusCons)
apply(simp only: XPlusXPlusNil)
apply(simp add: LeFGeTEqTRel)
done

ML "Header.record \"Program02\""

end


theory Balance_Opt_LR_Ext
  imports
    "../../Free_Ext"
    "../../Insert/Alloc_Optimized/Balance_Opt_Ext"
    Balance_Opt_LR

begin

context rbt_impl
begin

lemma balance_left_opt_ext_correct':
  "
  llvm_htriple
  (
    \<upharpoonleft>ll_bpto (RBT_NODE ci li ki vi ri) n_p **
    rbt_assn_ext l {} li **
    \<upharpoonleft>key_assn k ki **
    \<upharpoonleft>value_assn v vi **
    rbt_assn_ext r {} ri **
    color_assn c ci **
    \<up>(rbt_sorted (Branch c (rbt_of l) k v (rbt_of r))) **

    \<up>(matches_rbt (RP_Branch CP_B RP_Var RP_Var) l_pre) **
    \<up>(inv1 (Branch c l_pre k v (rbt_of r))) **
    \<up>(inv2 (Branch c l_pre k v (rbt_of r)))
  )
  (balance_left_opt n_p)
  (\<lambda>ti_res. EXS t_res.
    rbt_assn_ext t_res {} ti_res **
    \<up>(rbt_of t_res = rbt_balance_left (rbt_of l) k v (rbt_of r)) **
    ctx(rbt_sorted (rbt_of t_res)) **
    \<up>(ptr_of_key t_res ti_res = ptr_of_key (ATBranch c k v ci li ki vi ri l r) n_p) **
    \<up>(value_of_key t_res = value_of_key (ATBranch c k v ci li ki vi ri l r))
  )
  "
  unfolding
    balance_left_opt_def
    bl_opt_case_1_def
    bl_opt_case_2_def
    bl_opt_case_3_def
    rotate_left_def
    rotate_right_def
    left_def
    right_def
  supply sep_context_pureI[fri_red_rules]
  apply vcg
  subgoal (*case 1*)
    apply (cases "(rbt_of l, k, v, rbt_of r)" rule: RBT_Impl.balance_left.cases, auto)
     apply vcg_vok
    done
  subgoal (*case 2+*)
    apply vcg

    subgoal (*case 2*)
      apply (cases "(rbt_of l, k, v, rbt_of r)" rule: RBT_Impl.balance_left.cases, auto)
      subgoal by vcg_vok
      subgoal by vcg_vok
      subgoal by vcg_vok
      subgoal by vcg_vok

      done
    subgoal (*case 3+*)
      apply vcg
      subgoal (*case 3*)
        apply (cases "(rbt_of l, k, v, rbt_of r)" rule: RBT_Impl.balance_left.cases, auto)
         supply rbt_greater_trans[intro]
         supply rbt_less_trans[intro]

        subgoal
          apply vcg
          apply vcg_compat
          subgoal
            apply (sepEwith \<open>solves auto | solves pok_solver | solves vok_solver\<close>)
            apply simp
            apply sep
            done
          done

        subgoal
          apply vcg
          apply vcg_compat
          subgoal
            apply (sepEwith \<open>solves auto | solves pok_solver | solves vok_solver\<close>)
            apply simp
            apply sep
            done
          done
        done
      subgoal (*case 4*)
        apply (cases "(rbt_of l, k, v, rbt_of r)" rule: RBT_Impl.balance_left.cases)
                  apply (auto elim: matches_rbt.elims)
        done
      done
    done
  done

lemmas balance_left_opt_ext_correct[vcg_rules] = balance_left_opt_ext_correct'[simplified ctx_def]

lemma balance_right_opt_ext_correct':
  "
  llvm_htriple
  (
    \<upharpoonleft>ll_bpto (RBT_NODE ci li ki vi ri) n_p **
    rbt_assn_ext l {} li **
    \<upharpoonleft>key_assn k ki **
    \<upharpoonleft>value_assn v vi **
    rbt_assn_ext r {} ri **
    color_assn c ci **
    \<up>(rbt_sorted (Branch c (rbt_of l) k v (rbt_of r))) **

    \<up>(matches_rbt (RP_Branch CP_B RP_Var RP_Var) r_pre) **
    \<up>(inv1 (Branch c (rbt_of l) k v r_pre)) **
    \<up>(inv2 (Branch c (rbt_of l) k v r_pre))
  )
  (balance_right_opt n_p)
  (\<lambda>ti_res. EXS t_res.
    rbt_assn_ext t_res {} ti_res **
    \<up>(rbt_of t_res = rbt_balance_right (rbt_of l) k v (rbt_of r)) **
    ctx(rbt_sorted (rbt_of t_res)) **
    \<up>(ptr_of_key t_res ti_res = ptr_of_key (ATBranch c k v ci li ki vi ri l r) n_p) **
    \<up>(value_of_key t_res = value_of_key (ATBranch c k v ci li ki vi ri l r))
  )
  "
  unfolding
    balance_right_opt_def
    br_opt_case_1_def
    br_opt_case_2_def
    br_opt_case_3_def
    rotate_left_def
    rotate_right_def
    left_def
    right_def
  apply vcg
  subgoal (*case 1*)
    apply (cases "(rbt_of l, k, v, rbt_of r)" rule: RBT_Impl.balance_right.cases, auto)
     apply vcg_vok
    done
  subgoal (*case 2+*)
    apply vcg

    subgoal (*case 2*)
      apply (cases "(rbt_of l, k, v, rbt_of r)" rule: RBT_Impl.balance_right.cases, auto)
      subgoal by vcg_vok
      subgoal by vcg_vok
      subgoal by vcg_vok
      subgoal by vcg_vok
      done
    subgoal (*case 3+*)
      apply vcg
      subgoal (*case 3*)
        apply (cases "(rbt_of l, k, v, rbt_of r)" rule: RBT_Impl.balance_right.cases, auto)
         supply rbt_greater_trans[intro]
         supply rbt_less_trans[intro]

        subgoal
          apply vcg
          apply vcg_compat
          subgoal
            apply (sepEwith \<open>solves auto | solves pok_solver | solves vok_solver\<close>)
            apply simp
            apply sep
            done
          done

        subgoal
          apply vcg
          apply vcg_compat
          subgoal
            apply (sepEwith \<open>solves auto | solves pok_solver | solves vok_solver\<close>)
            apply simp
            apply sep
            done
          done
        done
      subgoal (*case 4*)
        apply (cases "(rbt_of l, k, v, rbt_of r)" rule: RBT_Impl.balance_right.cases)
        by (auto elim: matches_rbt.elims)
      done
    done
  done

lemmas balance_right_opt_ext_correct[vcg_rules] = balance_right_opt_ext_correct'[simplified ctx_def]

lemma balance_left_opt_ext_combine_correct':
  "
  llvm_htriple
  (
    \<upharpoonleft>ll_bpto (RBT_NODE ci li ki vi ri) n_p **
    rbt_assn_ext l {} li **
    \<upharpoonleft>key_assn k ki **
    \<upharpoonleft>value_assn v vi **
    rbt_assn_ext r {} ri **
    color_assn c ci **
    \<up>(rbt_sorted (Branch c (rbt_of l) k v (rbt_of r))) **
    \<up>(matches_rbt (RP_Branch CP_B RP_Var RP_Var) (rbt_of r))
  )
  (balance_left_opt n_p)
  (\<lambda>ti_res. EXS t_res.
    rbt_assn_ext t_res {} ti_res **
    \<up>(rbt_of t_res = rbt_balance_left (rbt_of l) k v (rbt_of r)) **
    ctx(rbt_sorted (rbt_of t_res)) **
    \<up>(ptr_of_key t_res ti_res = ptr_of_key (ATBranch c k v ci li ki vi ri l r) n_p) **
    \<up>(value_of_key t_res = value_of_key (ATBranch c k v ci li ki vi ri l r))
  )
  "
  unfolding
    balance_left_opt_def
    bl_opt_case_1_def
    bl_opt_case_2_def
    bl_opt_case_3_def
    rotate_left_def
    rotate_right_def
    left_def
    right_def
  apply vcg
  subgoal (*case 1*)
    apply (cases "(rbt_of l, k, v, rbt_of r)" rule: RBT_Impl.balance_left.cases, auto)
    apply vcg_vok
    done
  subgoal (*case 2+*)
    apply vcg

    subgoal (*case 2*)
      apply (cases "(rbt_of l, k, v, rbt_of r)" rule: RBT_Impl.balance_left.cases, auto)
       apply vcg_vok
      done
    apply vcg (*all other cases unreachable*)
    done
  done

lemmas balance_left_opt_ext_combine_correct[vcg_rules] =
  balance_left_opt_ext_combine_correct'[simplified ctx_def]

end

end


section \<open>Execution\<close>

text \<open>
  \file{Execution} introduces a locale for executions within asynchronous systems.
\<close>

theory Execution
imports AsynchronousSystem ListUtilities
begin

subsection \<open>Execution locale definition\<close>

text \<open>
  A (finite) execution within a system is a list of configurations \isb{exec}
  accompanied by a list of messages \isb{trace} such that the first configuration
  is initial and every next state can be reached processing the messages
  in \isb{trace}.
\<close>
locale execution =
  asynchronousSystem trans sends start
for
  trans :: "'p \<Rightarrow> 's \<Rightarrow> 'v messageValue \<Rightarrow> 's" and
  sends :: "'p \<Rightarrow> 's \<Rightarrow> 'v messageValue \<Rightarrow> ('p, 'v) message multiset" and
  start :: "'p \<Rightarrow> 's"
+
fixes
  exec :: "('p, 'v, 's ) configuration list" and
  trace :: "('p, 'v) message list"
assumes
  notEmpty: "length exec \<ge> 1" and
  length: "length exec - 1 = length trace" and
  base: "initial (hd exec)" and
  step: "\<lbrakk> i < length exec - 1 ; cfg1 = exec ! i ; cfg2 = exec ! (i + 1) \<rbrakk>
      \<Longrightarrow> ((cfg1 \<turnstile> trace ! i \<mapsto> cfg2)) "
begin

abbreviation execMsg ::
  "nat \<Rightarrow> ('p,'v) message"
where
  "execMsg n \<equiv> (trace ! n)"

abbreviation execConf ::
  "nat \<Rightarrow> ('p, 'v, 's) configuration"
where
  "execConf n  \<equiv> (exec ! n)"

subsection \<open>Enabledness and occurrence in the execution\<close>

definition minimalEnabled ::
  "('p, 'v) message \<Rightarrow> bool"
where
  "minimalEnabled msg \<equiv> (\<exists> p . isReceiverOf p msg)
    \<and> (enabled (last exec) msg)
    \<and> (\<exists> n . n < length exec \<and> enabled (execConf n) msg
      \<and> (\<forall> n' \<ge> n . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n'))
    \<and> (\<forall> n' msg' . ((\<exists> p . isReceiverOf p msg')
      \<and> (enabled (last exec) msg')
      \<and> n' < length trace
      \<and> enabled (execConf n') msg'
      \<and> (\<forall> n'' \<ge> n' . n'' < length trace \<longrightarrow> msg' \<noteq>
                      (execMsg n''))) \<longrightarrow> n' \<ge> n))"

definition firstOccurrence ::
  "('p, 'v) message \<Rightarrow> nat \<Rightarrow> bool"
where
  "firstOccurrence msg n \<equiv> (\<exists> p . isReceiverOf p msg)
    \<and> (enabled (last exec) msg) \<and> n < (length exec)
    \<and> enabled (execConf n) msg
    \<and> (\<forall> n' \<ge> n . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n'))
    \<and> ( n \<noteq> 0 \<longrightarrow> (\<not> enabled (execConf (n - 1)) msg
      \<or> msg = execMsg (n - 1)))"

lemma FirstOccurrenceExists:
assumes
  "enabled (last exec) msg"
  "\<exists>p. isReceiverOf p msg"
shows
  "\<exists> n . firstOccurrence msg n"
proof-
  have "length exec - 1 < length exec
    \<and> (\<forall> n' \<ge> (length exec - 1) . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg)"
    using length
    by (metis diff_diff_cancel leD notEmpty zero_less_diff
      zero_less_one)
  hence NNotInTrace: "\<exists> n < length exec .
    (\<forall> n'\<ge>n . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg)" by blast
  hence "\<exists> n0 < length exec .
    (\<forall> n'\<ge>n0 . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg) \<and>
    ((n0 = 0)
      \<or> \<not> (\<forall> n' \<ge> (n0 - 1) . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg))"
    using MinPredicate2[of "\<lambda>x.(x < length exec
      \<and> (\<forall>n'\<ge>x.(n'<length trace \<longrightarrow> trace ! n' \<noteq> msg)))"]
    by auto
  hence "\<exists> n0. n0 < length exec
    \<and> (\<forall> n'\<ge>n0 . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg)
    \<and> ((n0 = 0)
      \<or> \<not> (\<forall> n' \<ge> (n0 - 1) . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg))"
    by simp
  from this obtain n0 where N0a: "n0 < length exec
    \<and> (\<forall> n'\<ge>n0 . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg)
    \<and> ((n0 = 0)
      \<or> \<not> (\<forall> n' \<ge> (n0 - 1) . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg))"
    by metis
  hence N0: "n0 < length exec"
    "(\<forall> n'\<ge>n0 . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg)"
    "((n0 = 0)
      \<or> \<not> (\<forall> n' \<ge> (n0 - 1) . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg))"
    using N0a by auto
  have N0': "n0 = 0 \<or> trace ! (n0 - 1) = msg"
  proof(cases "n0 = 0", auto)
    assume N0NotZero: "n0 > 0"
    hence "\<not> (\<forall> n' \<ge> (n0 - 1) . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg)"
      using N0(3) by blast
    moreover have "n0 - 1 < length trace"
      using N0(1) length N0NotZero
      by (metis calculation le_less_trans)
    ultimately show "execMsg (n0 - Suc 0) = msg" using N0(2)
      by (metis One_nat_def Suc_diff_Suc diff_Suc_eq_diff_pred
         diff_diff_cancel diff_is_0_eq leI nat_le_linear)
  qed
  have "\<exists> n1 < length exec .
    (\<forall> n'\<ge>n1 . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg)
    \<and> enabled (exec ! n1) msg
    \<and> (n1 = 0 \<or> \<not> enabled (exec ! (n1 - 1)) msg \<or> trace ! (n1 - 1) = msg)"
  proof(cases "enabled (exec ! n0) msg")
    assume "enabled (execConf n0) msg"
    hence "n0 < length exec"
      "(\<forall> n'\<ge>n0 . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg)"
      "enabled (exec ! n0) msg \<and>
      (n0 = 0 \<or> \<not> enabled (exec ! (n0 - 1)) msg \<or> trace ! (n0 - 1) = msg)"
    using N0 N0' by auto
    thus "\<exists>n1<length exec.
       (\<forall>n'\<ge>n1. n' < length trace \<longrightarrow> execMsg n' \<noteq> msg)
       \<and> enabled (execConf n1) msg
       \<and> (n1 = 0 \<or> \<not> enabled (execConf (n1 - 1)) msg
         \<or> execMsg (n1 - 1) = msg)"
      by metis
  next
    assume NotEnabled: "\<not> enabled (execConf n0) msg"
    have "last exec = exec ! (length exec - 1)" using last_conv_nth notEmpty
      by (metis NNotInTrace length_0_conv less_nat_zero_code)
    hence EnabledInLast: "enabled (exec ! (length exec - 1)) msg"
      using assms(1) by simp
    hence "n0 \<noteq> length exec - 1" using NotEnabled by auto
    hence N0Small: "n0 < length exec - 1" using N0(1) by simp
    hence "\<exists> k < length exec - 1 - n0  . \<not> enabled (execConf (n0 + k)) msg
      \<and> enabled (execConf (n0 + k + 1)) msg"
      using NatPredicateTippingPoint[of "length exec - 1 - n0"
        "\<lambda>x.\<not>(enabled (exec ! (n0 + x)) msg)"]
        assms(1) NotEnabled EnabledInLast by simp
    then obtain k where K: " k < length exec - 1 - n0"
      "\<not> enabled (execConf (n0 + k)) msg"
      "enabled (execConf (n0 + k + 1)) msg" by blast
    define n1 where "n1 = k + n0 + 1"
    hence N1: "n1 \<ge> n0" "\<not> enabled (execConf (n1 - 1)) msg"
      "enabled (execConf n1) msg" "n1 < length exec"
      unfolding n1_def using K
      by (auto simp add: add.commute)
    have "\<forall>n'\<ge>n1. n' < length trace \<longrightarrow> execMsg n' \<noteq> msg"
      using N1(1) N0(2) by (metis order_trans)
    thus "\<exists>n1<length exec.
        (\<forall>n'\<ge>n1. n' < length trace \<longrightarrow> execMsg n' \<noteq> msg)
        \<and> enabled (execConf n1) msg
        \<and> (n1 = 0 \<or> \<not> enabled (execConf (n1 - 1)) msg
          \<or> execMsg (n1 - 1) = msg)"
    using N1 by auto
  qed
  then obtain n1 where N1: "n1 < length exec"
    "\<forall> n'\<ge>n1 . n' < length trace \<longrightarrow> trace ! n' \<noteq> msg"
    "enabled (exec ! n1) msg"
    "n1 = 0 \<or> \<not> enabled (exec ! (n1 - 1)) msg \<or> trace ! (n1 - 1) = msg"
    by metis
  hence "firstOccurrence msg n1" using assms unfolding firstOccurrence_def
    by auto
  thus "\<exists>n. firstOccurrence msg n" by blast
qed

lemma ReachableInExecution:
assumes
  "i < length exec"
  "j \<le> i"
shows
  "reachable (execConf j) (execConf i)"
using assms proof(induct i, auto)
  show "reachable (execConf 0) (execConf 0)"
    using reachable.simps by blast
next
  fix ia
  assume
    IH: "(j \<le> ia \<Longrightarrow> reachable (execConf j) (execConf ia))"
    "Suc ia < length exec"
    "j \<le> Suc ia"
    "i < length exec"
    "j \<le> i"
  show "reachable (execConf j) (execConf (Suc ia))"
  proof(cases "j = Suc ia", auto)
    show "reachable (execConf (Suc ia)) (execConf (Suc ia))"
      using reachable.simps by metis
  next
    assume "j \<noteq> Suc ia"
    hence "j \<le> ia" using IH(3) by simp
    hence "reachable (execConf j) (execConf ia)" using IH(1) by simp
    moreover have "reachable (execConf ia) (execConf (Suc ia))"
      using reachable.simps
      by (metis IH(2) Suc_eq_plus1 less_diff_conv local.step)
    ultimately show "reachable (execConf j) (execConf (Suc ia))"
      using ReachableTrans by blast
  qed
qed

lemma LastPoint:
fixes
  msg::"('p, 'v) message"
assumes
  "enabled (last exec) msg"
obtains n where
  "n < length exec"
  "enabled (execConf n) msg"
  "\<forall> n' \<ge> n .
    n' < length trace \<longrightarrow> msg \<noteq> (execMsg n')"
  "\<forall> n0 .
      n0 < length exec
    \<and> enabled (execConf n0) msg
    \<and> (\<forall> n' \<ge> n0 .
        n' < length trace \<longrightarrow> msg \<noteq> (execMsg n'))
    \<longrightarrow> n0 \<ge> n"
proof (cases ?thesis, simp)
  case False
  define len where "len = length exec - 1"
  have
    "len < length exec"
    "enabled (execConf len) msg"
    "\<forall> n' \<ge> len . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n')"
    using assms notEmpty length unfolding len_def
    by (auto, metis One_nat_def last_conv_nth list.size(3) not_one_le_zero)
  hence "\<exists> n . n < length exec \<and> enabled (execConf n) msg
    \<and> (\<forall> n' \<ge> n . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n'))"
    by blast
  from MinPredicate[OF this]
    show ?thesis using that False by blast
qed

lemma ExistImpliesMinEnabled:
fixes
  msg :: "('p, 'v) message" and
  p :: 'p
assumes
  "isReceiverOf p msg"
  "enabled (last exec) msg"
shows
  "\<exists> msg' . minimalEnabled msg'"
proof-
  have MsgHasMinTime:"\<forall> msg . (enabled (last exec) msg
    \<and> (\<exists> p . isReceiverOf p msg))
    \<longrightarrow> (\<exists> n .  n < length exec \<and> enabled (execConf n) msg
        \<and> (\<forall> n' \<ge> n . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n'))
        \<and> (\<forall> n0 .  n0 < length exec \<and> enabled (execConf n0) msg
        \<and> (\<forall> n' \<ge> n0 . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n'))
        \<longrightarrow> n0 \<ge> n))" by (clarify, rule LastPoint, auto)
  let ?enabledTimes = "{n::nat . \<exists> msg . (enabled (last exec) msg
    \<and> (\<exists> p . isReceiverOf p msg))
    \<and>  n < length exec \<and> (enabled (execConf n) msg
    \<and> (\<forall> n' \<ge> n . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n')))}"
  have NotEmpty:"?enabledTimes \<noteq> {}" using assms MsgHasMinTime by blast
  hence "\<exists> n0 . n0 \<in> ?enabledTimes" by blast
  hence "\<exists> nMin \<in> ?enabledTimes . \<forall> x \<in> ?enabledTimes . x \<ge> nMin"
    using MinPredicate[of "\<lambda>n.(n \<in> ?enabledTimes)"] by simp
  then obtain nMin where NMin: "nMin \<in> ?enabledTimes"
    "\<forall> x \<in> ?enabledTimes . x \<ge> nMin" by blast
  hence "\<exists> msg . (enabled (last exec) msg \<and> (\<exists> p . isReceiverOf p msg))
    \<and>  nMin < length exec \<and> (enabled (execConf nMin) msg
    \<and> (\<forall> n' \<ge> nMin . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n'))
    \<and> (\<forall> n0 .  n0 < length exec \<and> enabled (execConf n0) msg
      \<and> (\<forall> n' \<ge> n0 . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n'))
      \<longrightarrow> n0 \<ge> nMin))" by blast
  then obtain msg where "(enabled (last exec) msg
    \<and> (\<exists> p . isReceiverOf p msg))
    \<and> nMin < length exec \<and>(enabled (execConf nMin) msg
    \<and> (\<forall> n' \<ge> nMin . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n'))
    \<and> (\<forall> n0 .  n0 < length exec \<and> enabled (execConf n0) msg
      \<and> (\<forall> n' \<ge> n0 . n' < length trace \<longrightarrow> msg \<noteq> (execMsg n'))
      \<longrightarrow> n0 \<ge> nMin))" by blast
  moreover have "(\<forall> n' msg' . ((\<exists> p . isReceiverOf p msg')
    \<and> (enabled (last exec) msg')
    \<and> n' < length trace \<and> enabled (execConf n') msg'
    \<and> (\<forall> n'' \<ge> n' . n'' < length trace \<longrightarrow> msg' \<noteq> (execMsg n'')))
      \<longrightarrow> n' \<ge> nMin)"
  proof(clarify)
    fix n' msg' p
    assume Assms:
      "isReceiverOf p msg'"
      "enabled (last exec) msg'"
      "n' < length trace"
      "enabled (execConf n') msg'"
      "\<forall>n'' \<ge> n'. (n'' < length trace) \<longrightarrow> (msg' \<noteq> execMsg n'')"
    from Assms(3) have "n' < length exec" using length by simp
    with Assms have "n' \<in> ?enabledTimes" by auto
    thus "nMin \<le> n'" using NMin(2) by simp
  qed
  ultimately have "minimalEnabled msg"
    using minimalEnabled_def by blast
  thus ?thesis by blast
qed

lemma StaysEnabledStep:
assumes
  En: "enabled cfg msg" and
  Cfg: "cfg = exec ! n" and
  N: "n < length exec"
shows
  "enabled (exec ! (n + 1)) msg
  \<or> n = (length exec - 1)
  \<or> msg = trace ! n"
proof(cases "n = length exec - 1")
  case True
  thus ?thesis by simp
next
  case False
  with N have N: "n < length exec - 1" by simp
  with Cfg have Step:  "cfg \<turnstile> trace ! n \<mapsto> (exec ! (n + 1))"
    using step by simp
  thus ?thesis proof(cases "enabled (exec ! (n + 1)) msg")
    case True
    thus ?thesis by simp
  next
    case False
    hence "\<not> enabled (exec ! (n + 1)) msg" by simp
    thus ?thesis using En enabled_def Step N OnlyOccurenceDisables by blast
  qed
qed

lemma StaysEnabledHelp:
assumes
  "enabled cfg msg" and
  "cfg = exec ! n" and
  "n < length exec"
shows
  "\<forall> i . i \<ge> n \<and> i < (length exec - 1) \<and> enabled (exec ! i) msg
  \<longrightarrow> msg = (trace ! i) \<or> (enabled (exec ! (i+1)) msg)"
proof(clarify)
  fix i
  assume "n \<le> i" "i < length exec - 1"
    "enabled (execConf i) msg" "\<not> enabled (execConf (i + 1)) msg"
  thus "msg = (trace ! i)"
    using assms StaysEnabledStep
    by (metis add.right_neutral add_strict_mono le_add_diff_inverse2
        nat_neq_iff notEmpty  zero_less_one)
qed

lemma StaysEnabled:
assumes En: "enabled cfg msg" and
  "cfg = exec ! n" and
  "n < length exec"
shows "enabled (last exec) msg \<or> (\<exists> i . i \<ge> n \<and> i < (length exec - 1)
  \<and> msg = trace ! i )"
proof(cases "enabled (last exec) msg")
  case True
  thus ?thesis by simp
next
  case False
  hence NotEnabled: "\<not> enabled (last exec) msg" by simp
  have "last exec = exec ! (length exec - 1)"
    by (metis last_conv_nth list.size(3) notEmpty not_one_le_zero)
  hence "\<exists> l . l \<ge> n \<and> last exec = exec ! l \<and> l = length exec - 1"
    using assms(3) by auto
  then obtain l where L: "l \<ge> n" "last exec = exec ! l"
    "l = length exec - 1" by blast
  have "(\<exists> i . i \<ge> n \<and> i < (length exec - 1) \<and> msg = trace ! i )"
  proof (rule ccontr)
    assume Ass: " \<not> (\<exists>i\<ge>n. i < length exec - 1 \<and> msg = execMsg i)"
    hence Not: "\<forall> i. i < n \<or> i \<ge> length exec - 1 \<or> msg \<noteq> execMsg i"
      by (metis leI)
    have "\<forall> i. i \<ge> n \<and> i \<le> length exec - 1 \<longrightarrow> enabled (exec ! i) msg"
    proof(clarify)
      fix i
      assume I: "n \<le> i" "i \<le> length exec - 1"
      thus "enabled (execConf i) msg"
        using StaysEnabledHelp[OF assms] assms(1,2) Ass
        by (induct i, auto, metis Suc_le_lessD le_Suc_eq)
    qed
    with NotEnabled L show False by simp
  qed
  thus ?thesis by simp
qed

end \<comment> \<open>end of locale Execution\<close>

subsection \<open>Expanding executions to longer executions\<close>

lemma (in asynchronousSystem) expandExecutionStep:
fixes
  cfg :: "('p, 'v, 's ) configuration"
assumes
  CfgIsReachable: "(last exec') \<turnstile> msg \<mapsto> cMsg" and
  ExecIsExecution: "execution trans sends start exec' trace'"
shows
  "\<exists> exec'' trace''. (execution trans sends start exec'' trace'')
  \<and> (prefixList exec' exec'')
  \<and> (prefixList trace' trace'')
  \<and> (last exec'') = cMsg
  \<and> (last trace'' = msg)"
proof -
  define execMsg where "execMsg = exec' @ [cMsg]"
  define traceMsg where "traceMsg = trace' @ [msg]"
  have ExecMsgEq: "\<forall> i < ((length execMsg) - 1) . execMsg ! i = exec'!i "
    using execMsg_def by (auto simp add: nth_append)
  have TraceMsgEq: "\<forall> i < ((length traceMsg) - 1) . traceMsg!i = trace'!i"
    using traceMsg_def
    by (auto simp add: nth_append)
  have ExecLen: "(length execMsg) \<ge> 1" using execMsg_def by auto
  have lessLessExec: "\<forall> i . i < (length exec') \<longrightarrow> i < (length execMsg )"
    unfolding execMsg_def by auto
  have ExecLenTraceLen: "length exec'- 1 = length trace'"
    using ExecIsExecution execution.length by auto
  have lessLessTrace: "\<forall> i . i < (length exec' - 1) \<longrightarrow> i < (length trace')"
    using ExecLenTraceLen by auto
  have Exec'Len: "length exec' \<ge> 1"
    using ExecIsExecution execution.notEmpty by blast
  hence "hd exec' = hd execMsg " using execMsg_def
    by (metis One_nat_def hd_append2 length_0_conv not_one_le_zero)
  moreover have "initial (hd exec')"
    using ExecIsExecution execution.base by blast
  ultimately have ExecInit: "initial (hd execMsg)" using execMsg_def by auto
  have ExecMsgLen: "length execMsg - 1 = length traceMsg"
    using ExecLenTraceLen unfolding execMsg_def traceMsg_def
    by (auto,metis Exec'Len Suc_pred length_greater_0_conv list.size(3)
       not_one_le_zero)
  have ExecSteps:"\<forall> i < length exec' - 1 .
    ((exec' ! i)  \<turnstile> trace' ! i \<mapsto> (exec' ! (i + 1)))"
    using ExecIsExecution execution.step by blast
  have "\<forall> i < length execMsg - 1.
    ((execMsg ! i) \<turnstile> traceMsg ! i \<mapsto> (execMsg ! (i + 1)))"
    unfolding execMsg_def traceMsg_def
  proof auto
    fix i
    assume IlessLen:"i < (length exec')"
    show "((exec' @ [cMsg]) ! i) \<turnstile> ((trace' @ [msg]) ! i)
      \<mapsto> ((exec' @ [cMsg]) ! (Suc i))"
    proof (cases "(i < (length exec') - 1)")
    case True
      hence IlessLen1: "(i < (length exec') - 1)" by auto
      hence "((exec' ! i)  \<turnstile> trace' ! i \<mapsto> (exec' ! (i + 1)))"
        using ExecSteps by auto
      with IlessLen1 ExecMsgEq lessLessExec execMsg_def
      have "((exec' @ [cMsg]) ! i) \<turnstile> ((trace') ! i)
        \<mapsto> ((exec' @ [cMsg]) ! (Suc i))" by auto
      thus "((exec' @ [cMsg]) ! i) \<turnstile> ((trace' @ [msg]) ! i)
        \<mapsto> ((exec' @ [cMsg]) ! (Suc i))"
        using IlessLen1 TraceMsgEq lessLessTrace traceMsg_def by auto
    next
    case False
      with IlessLen have IEqLen1: "(i = (length exec') - 1)" by auto
      thus "((exec' @ [cMsg]) ! i) \<turnstile> ((trace' @ [msg]) ! i)
        \<mapsto> ((exec' @ [cMsg]) ! (Suc i))"
        using  execMsg_def traceMsg_def  CfgIsReachable Exec'Len
               ExecLenTraceLen ExecMsgEq ExecMsgLen IlessLen
        by (metis One_nat_def Suc_eq_plus1 Suc_eq_plus1_left last_conv_nth
           le_add_diff_inverse length_append less_nat_zero_code list.size(3)
           list.size(4) nth_append_length)
    qed
  qed
  hence isExecution: "execution trans sends start execMsg traceMsg"
    using ExecLen ExecMsgLen ExecInit
    by (unfold_locales ,auto)
  moreover have "prefixList exec' execMsg" unfolding execMsg_def
    by (metis TailIsPrefixList not_Cons_self2)
  moreover have "prefixList trace' traceMsg" unfolding traceMsg_def
    by (metis TailIsPrefixList not_Cons_self2)
  ultimately show ?thesis using execMsg_def traceMsg_def by (metis last_snoc)
qed

lemma (in asynchronousSystem) expandExecutionReachable:
fixes
  cfg :: "('p, 'v, 's ) configuration" and
  cfgLast :: "('p, 'v, 's ) configuration"
assumes
  CfgIsReachable: "reachable (cfgLast) cfg" and
  ExecIsExecution: "execution trans sends start exec trace"  and
  ExecLast: "cfgLast = last exec"
shows
  "\<exists> exec' trace'. (execution trans sends start exec' trace')
  \<and> ((prefixList exec exec'
    \<and> prefixList trace trace')
    \<or> (exec = exec' \<and> trace = trace'))
  \<and> (last exec') = cfg"
using CfgIsReachable  ExecIsExecution ExecLast
proof (induct cfgLast cfg rule: reachable.induct, auto)
  fix msg cfg3 exec' trace'
  assume "(last exec') \<turnstile> msg \<mapsto> cfg3"
         "execution trans sends start exec' trace'"
  hence "\<exists> exec'' trace''. (execution trans sends start exec'' trace'')
    \<and> (prefixList exec' exec'')
    \<and> (prefixList trace' trace'') \<and> (last exec'') = cfg3
    \<and> (last trace'') = msg" by (simp add: expandExecutionStep)
  then obtain  exec'' trace'' where
    NewExec: "execution trans sends start exec'' trace''"
             "prefixList exec' exec''" "prefixList trace' trace''"
             "last exec'' = cfg3" by blast
  assume prefixLists: "prefixList exec exec'"
                      "prefixList trace trace'"
  from prefixLists(1) NewExec(2) have "prefixList exec exec''"
    using PrefixListTransitive by auto
  moreover from prefixLists(2) NewExec(3) have
    "prefixList trace trace''"  using PrefixListTransitive by auto
  ultimately show "\<exists> exec'' trace'' .
          execution trans sends start exec'' trace'' \<and>
          ((prefixList exec exec'' \<and> prefixList trace trace'')
          \<or> (exec = exec'' \<and> trace = trace'')) \<and>
          last exec'' = cfg3" using NewExec(1) NewExec(4) by blast
next
  fix msg cfg3
  assume "(last exec) \<turnstile> msg \<mapsto> cfg3" "execution trans sends start exec trace"
  then show
    "\<exists>exec' trace'. execution trans sends start exec' trace' \<and>
       (prefixList exec exec' \<and> prefixList trace trace'
        \<or> exec = exec' \<and> trace = trace') \<and> last exec' = cfg3"
    using expandExecutionStep by blast
qed

lemma (in asynchronousSystem) expandExecution:
fixes
  cfg :: "('p, 'v, 's ) configuration" and
  cfgLast :: "('p, 'v, 's ) configuration"
assumes
  CfgIsReachable: "stepReachable (last exec) msg cfg" and
  ExecIsExecution: "execution trans sends start exec trace"
shows
  "\<exists> exec' trace'. (execution trans sends start exec' trace')
  \<and> (prefixList exec exec')
  \<and> (prefixList trace trace') \<and> (last exec') = cfg
  \<and> (msg \<in> set (drop (length trace) trace'))"
proof -
  from CfgIsReachable obtain c' c'' where
    Step: "reachable (last exec) c'" "c' \<turnstile> msg \<mapsto> c''" "reachable c'' cfg"
    by (auto simp add: stepReachable_def)
  from Step(1) ExecIsExecution have "\<exists> exec' trace' .
    execution trans sends start exec' trace' \<and>
    ((prefixList exec exec' \<and> prefixList trace trace')
    \<or> (exec = exec' \<and> trace = trace')) \<and>
    last exec' = c'" by (auto simp add: expandExecutionReachable)
  then obtain  exec' trace' where Exec':
    "execution trans sends start exec' trace'"
    "(prefixList exec exec' \<and> prefixList trace trace')
      \<or> (exec = exec' \<and> trace = trace')"
    "last exec' = c'" by blast
  from Exec'(1) Exec'(3) Step(2) have "\<exists> exec'' trace'' .
    execution trans sends start exec'' trace'' \<and>
    prefixList exec' exec'' \<and> prefixList trace' trace''
    \<and> last exec'' = c'' \<and> last trace'' = msg"
    by (auto simp add: expandExecutionStep)
  then obtain exec'' trace'' where Exec'':
    "execution trans sends start exec'' trace''"
    "prefixList exec' exec''" "prefixList trace' trace''"
    "last exec'' = c''" "last trace'' = msg" by blast
  have PrefixLists: "prefixList exec exec'' \<and> prefixList trace trace''"
  proof(cases "exec = exec' \<and> trace = trace'")
  case True
    with Exec'' show "prefixList exec exec'' \<and> prefixList trace trace''"
    by auto
  next
  case False
    with Exec'(2) have Prefix: "prefixList exec exec'"
      "prefixList trace trace'" by auto
    from Prefix(1) Exec''(2) have "prefixList exec exec''"
      using PrefixListTransitive by auto
    with Prefix(2) Exec''(3) show  "prefixList exec exec''
      \<and> prefixList trace trace''"
      using PrefixListTransitive by auto
  qed
  with Exec''(5) have MsgInTrace'': "msg \<in> set (drop (length trace) trace'')"
    by (metis PrefixListMonotonicity drop_eq_Nil last_drop
      last_in_set not_le)
  from Step(3) Exec''(1) Exec''(4) have "\<exists> exec''' trace''' .
    execution trans sends start exec''' trace''' \<and>
    ((prefixList exec'' exec''' \<and> prefixList trace'' trace''')
    \<or> (exec'' = exec''' \<and> trace'' = trace''')) \<and>
    last exec''' = cfg"
    by (auto simp add: expandExecutionReachable)
  then obtain exec''' trace''' where Exec''':
    "execution trans sends start exec''' trace'''"
    "(prefixList exec'' exec''' \<and> prefixList trace'' trace''')
    \<or> (exec'' = exec''' \<and> trace'' = trace''')"
    "last exec''' = cfg" by blast
  have "prefixList exec exec''' \<and> prefixList trace trace'''
    \<and> msg \<in> set (drop (length trace) trace''')"
  proof(cases "exec'' = exec''' \<and> trace'' = trace'''")
  case True
    with PrefixLists MsgInTrace''
    show "prefixList exec exec''' \<and> prefixList trace trace'''
    \<and> msg \<in> set (drop (length trace) trace''')" by auto
  next
  case False
    with Exec'''(2) have Prefix: "prefixList exec'' exec'''"
      "prefixList trace'' trace'''" by auto
    from Prefix(1) PrefixLists have "prefixList exec exec'''"
      using PrefixListTransitive by auto
    with Prefix(2) PrefixLists have "prefixList exec exec'''
      \<and> prefixList trace trace'''"
      using PrefixListTransitive by auto
    moreover have "msg \<in> set (drop (length trace) trace''')"
      using Prefix(2) PrefixLists MsgInTrace''
      by (metis (hide_lams, no_types) PrefixListHasTail append_eq_conv_conj
         drop_take rev_subsetD set_take_subset)
    ultimately show ?thesis by auto
  qed
  with Exec'''(1) Exec'''(3) show ?thesis by blast
qed

subsection \<open>Infinite and fair executions\<close>

text \<open>
  Völzer does not give much attention to the definition of the
  infinite executions. We derive them from finite executions by considering
  infinite executions to be infinite sequence of finite executions increasing
  monotonically w.r.t. the list prefix relation.
\<close>

definition (in asynchronousSystem) infiniteExecution ::
  "(nat \<Rightarrow> (('p, 'v, 's) configuration list))
  \<Rightarrow> (nat \<Rightarrow> (('p, 'v) message list)) \<Rightarrow> bool"
where
  "infiniteExecution fe ft \<equiv>
    \<forall> n . execution trans sends start (fe n) (ft n) \<and>
      prefixList (fe n) (fe (n+1)) \<and>
      prefixList (ft n) (ft (n+1))"

definition (in asynchronousSystem) correctInfinite ::
  "(nat \<Rightarrow> (('p, 'v, 's) configuration list))
  \<Rightarrow> (nat \<Rightarrow> (('p, 'v) message list)) \<Rightarrow> 'p \<Rightarrow> bool"
where
  "correctInfinite fe ft p \<equiv>
    infiniteExecution fe ft
    \<and> (\<forall> n . \<forall> n0 < length (fe n). \<forall> msg .(enabled ((fe n) ! n0) msg)
    \<and> isReceiverOf p msg
    \<longrightarrow> (\<exists> msg' . \<exists> n' \<ge> n . \<exists> n0' \<ge> n0 .isReceiverOf p msg'
    \<and> n0' < length (fe n') \<and> (msg' = ((ft n') ! n0'))))"

definition (in asynchronousSystem) fairInfiniteExecution ::
  "(nat \<Rightarrow> (('p, 'v, 's) configuration list))
  \<Rightarrow> (nat \<Rightarrow> (('p, 'v) message list)) \<Rightarrow> bool"
where
  "fairInfiniteExecution fe ft \<equiv>
    infiniteExecution fe ft
    \<and> (\<forall> n . \<forall> n0 < length (fe n). \<forall> p . \<forall> msg .
      ((enabled ((fe n) ! n0) msg)
        \<and> isReceiverOf p msg \<and> correctInfinite fe ft p )
      \<longrightarrow> (\<exists> n' \<ge> n . \<exists> n0' \<ge> n0 . n0' < length (ft n')
        \<and> (msg = ((ft n') ! n0'))))"

end


(*
Title: WHATandWHERE-Security
Authors: Sylvia Grewe, Alexander Lux, Heiko Mantel, Jens Sauer
*)
theory Type_System
imports Language_Composition
begin

locale Type_System =
  WWP?: WHATWHERE_Secure_Programs "E" "BMap" "DA" "lH"
  for E :: "('exp, 'id, 'val) Evalfunction"
  and BMap :: "'val \<Rightarrow> bool"
  and DA :: "('id, 'd::order) DomainAssignment"
  and lH :: "('d, 'exp) lHatches"
+
fixes
AssignSideCondition :: "'id \<Rightarrow> 'exp \<Rightarrow> nat \<Rightarrow> bool"
and WhileSideCondition :: "'exp \<Rightarrow> bool"
and IfSideCondition ::
  "'exp \<Rightarrow> ('exp,'id) MWLsCom \<Rightarrow> ('exp,'id) MWLsCom \<Rightarrow> bool"
assumes semAssignSC: "AssignSideCondition x e \<iota> \<Longrightarrow>
  e \<equiv>\<^bsub>DA x,(htchLoc \<iota>)\<^esub> e \<and> (\<forall>m m' d \<iota>'. (m \<sim>\<^bsub>d,(htchLoc \<iota>')\<^esub> m' \<and>
  \<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m) =\<^bsub>d\<^esub> \<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m'))
  \<longrightarrow> \<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m) \<sim>\<^bsub>d,(htchLoc \<iota>')\<^esub> \<lbrakk>x :=\<^bsub>\<iota>\<^esub> e\<rbrakk>(m'))"
and semWhileSC: "WhileSideCondition e \<Longrightarrow> \<forall>d. e \<equiv>\<^bsub>d\<^esub> e"
and semIfSC: "IfSideCondition e c1 c2 \<Longrightarrow> \<forall>d. e \<equiv>\<^bsub>d\<^esub> e"
begin

\<comment> \<open>Security typing rules for the language commands\<close>
inductive
ComSecTyping :: "('exp, 'id) MWLsCom \<Rightarrow> bool"
  ("\<turnstile>\<^bsub>\<C>\<^esub> _")
and ComSecTypingL :: "('exp,'id) MWLsCom list \<Rightarrow> bool"
   ("\<turnstile>\<^bsub>\<V>\<^esub> _")
where
Skip: "\<turnstile>\<^bsub>\<C>\<^esub> skip\<^bsub>\<iota>\<^esub>" |
Assign: "\<lbrakk> AssignSideCondition x e \<iota> \<rbrakk> \<Longrightarrow> \<turnstile>\<^bsub>\<C>\<^esub> x :=\<^bsub>\<iota>\<^esub> e" |
Spawn: "\<lbrakk> \<turnstile>\<^bsub>\<V>\<^esub> V \<rbrakk> \<Longrightarrow> \<turnstile>\<^bsub>\<C>\<^esub> spawn\<^bsub>\<iota>\<^esub> V" |
Seq: "\<lbrakk> \<turnstile>\<^bsub>\<C>\<^esub> c1; \<turnstile>\<^bsub>\<C>\<^esub> c2 \<rbrakk> \<Longrightarrow> \<turnstile>\<^bsub>\<C>\<^esub> c1;c2" |
While: "\<lbrakk> \<turnstile>\<^bsub>\<C>\<^esub> c; WhileSideCondition b \<rbrakk>
     \<Longrightarrow> \<turnstile>\<^bsub>\<C>\<^esub> while\<^bsub>\<iota>\<^esub> b do c od" |
If: "\<lbrakk> \<turnstile>\<^bsub>\<C>\<^esub> c1; \<turnstile>\<^bsub>\<C>\<^esub> c2; IfSideCondition b c1 c2 \<rbrakk>
  \<Longrightarrow> \<turnstile>\<^bsub>\<C>\<^esub> if\<^bsub>\<iota>\<^esub> b then c1 else c2 fi" |
Parallel: "\<lbrakk> \<forall>i < length V. \<turnstile>\<^bsub>\<C>\<^esub> V!i \<rbrakk> \<Longrightarrow> \<turnstile>\<^bsub>\<V>\<^esub> V"

inductive_cases parallel_cases:
"\<turnstile>\<^bsub>\<V>\<^esub> V"

definition auxiliary_predicate
where
"auxiliary_predicate V \<equiv> unique_PPV V \<longrightarrow> WHATWHERE_Secure V"

\<comment> \<open>soundness proof of abstract type system\<close>
theorem ComSecTyping_single_is_sound:
"\<lbrakk> \<turnstile>\<^bsub>\<C>\<^esub> c; unique_PPc c \<rbrakk>
  \<Longrightarrow> WHATWHERE_Secure [c]"
proof (induct rule: ComSecTyping_ComSecTypingL.inducts(1)
    [of _ _ "auxiliary_predicate"], simp_all add: auxiliary_predicate_def)
  fix \<iota>
  show "WHATWHERE_Secure [skip\<^bsub>\<iota>\<^esub>]"
    by (metis WHATWHERE_Secure_Skip)
next
  fix x e \<iota>
  assume "AssignSideCondition x e \<iota>"
  thus "WHATWHERE_Secure [x :=\<^bsub>\<iota>\<^esub> e]"
    by (metis WHATWHERE_Secure_Assign semAssignSC)
next
  fix V \<iota>
  assume IH: "unique_PPV V \<longrightarrow> WHATWHERE_Secure V"
  assume uniPPspawn: "unique_PPc (spawn\<^bsub>\<iota>\<^esub> V)"
  hence "unique_PPV V"
    by (simp add: unique_PPV_def unique_PPc_def)
  with IH have "WHATWHERE_Secure V"
    ..
  with uniPPspawn show "WHATWHERE_Secure [spawn\<^bsub>\<iota>\<^esub> V]"
    by (metis Compositionality_Spawn)
next
  fix c1 c2
  assume IH1: "unique_PPc c1 \<Longrightarrow> WHATWHERE_Secure [c1]"
  assume IH2: "unique_PPc c2 \<Longrightarrow> WHATWHERE_Secure [c2]"
  assume uniPPc1c2: "unique_PPc (c1;c2)"
  from uniPPc1c2 have uniPPc1: "unique_PPc c1"
    by (simp add: unique_PPc_def)
  with IH1 have IS1: "WHATWHERE_Secure [c1]"
    .
  from uniPPc1c2 have uniPPc2: "unique_PPc c2"
    by (simp add: unique_PPc_def)
  with IH2 have IS2: "WHATWHERE_Secure [c2]"
    .

  from IS1 IS2 uniPPc1c2 show "WHATWHERE_Secure [c1;c2]"
    by (metis Compositionality_Seq)
next
  fix c b \<iota>
  assume SC: "WhileSideCondition b"
  assume IH: "unique_PPc c \<Longrightarrow> WHATWHERE_Secure [c]"
  assume uniPPwhile: "unique_PPc (while\<^bsub>\<iota>\<^esub> b do c od)"
  hence "unique_PPc c"
    by (simp add: unique_PPc_def)
  with IH have "WHATWHERE_Secure [c]"
    .
  with uniPPwhile SC show "WHATWHERE_Secure [while\<^bsub>\<iota>\<^esub> b do c od]"
    by (metis Compositionality_While semWhileSC)
next
  fix c1 c2 b \<iota>
  assume SC: "IfSideCondition b c1 c2"
  assume IH1: "unique_PPc c1 \<Longrightarrow> WHATWHERE_Secure [c1]"
  assume IH2: "unique_PPc c2 \<Longrightarrow> WHATWHERE_Secure [c2]"
  assume uniPPif: "unique_PPc (if\<^bsub>\<iota>\<^esub> b then c1 else c2 fi)"
  from uniPPif have "unique_PPc c1"
    by (simp add: unique_PPc_def)
  with IH1 have IS1: "WHATWHERE_Secure [c1]"
    .
  from uniPPif have "unique_PPc c2"
    by (simp add: unique_PPc_def)
  with IH2 have IS2: "WHATWHERE_Secure [c2]"
    .
  from IS1 IS2 SC uniPPif show
    "WHATWHERE_Secure [if\<^bsub>\<iota>\<^esub> b then c1 else c2 fi]"
    by (metis Compositionality_If semIfSC)
next
  fix V
  assume IH: "\<forall>i < length V. \<turnstile>\<^bsub>\<C>\<^esub> V ! i \<and>
    (unique_PPc (V!i) \<longrightarrow> WHATWHERE_Secure [V!i])"
  have "unique_PPV V \<longrightarrow> (\<forall>i < length V. unique_PPc (V!i))"
    by (metis uniPPV_uniPPc)
  with IH have "unique_PPV V \<longrightarrow> (\<forall>i < length V. WHATWHERE_Secure [V!i])"
    by auto
  thus uniPPV: "unique_PPV V \<longrightarrow> WHATWHERE_Secure V"
    by (metis parallel_composition)
qed

theorem ComSecTyping_list_is_sound:
"\<lbrakk> \<turnstile>\<^bsub>\<V>\<^esub> V; unique_PPV V \<rbrakk> \<Longrightarrow> WHATWHERE_Secure V"
by (metis ComSecTyping_single_is_sound parallel_cases
  parallel_composition uniPPV_uniPPc)

end

end


(*  Title:      HOL/BNF_Least_Fixpoint.thy
    Author:     Dmitriy Traytel, TU Muenchen
    Author:     Lorenz Panny, TU Muenchen
    Author:     Jasmin Blanchette, TU Muenchen
    Copyright   2012, 2013, 2014

Least fixpoint (datatype) operation on bounded natural functors.
*)

section {* Least Fixpoint (Datatype) Operation on Bounded Natural Functors *}

theory BNF_Least_Fixpoint
imports BNF_Fixpoint_Base
keywords
  "datatype" :: thy_decl and
  "datatype_compat" :: thy_decl
begin

lemma subset_emptyI: "(\<And>x. x \<in> A \<Longrightarrow> False) \<Longrightarrow> A \<subseteq> {}"
  by blast

lemma image_Collect_subsetI: "(\<And>x. P x \<Longrightarrow> f x \<in> B) \<Longrightarrow> f ` {x. P x} \<subseteq> B"
  by blast

lemma Collect_restrict: "{x. x \<in> X \<and> P x} \<subseteq> X"
  by auto

lemma prop_restrict: "\<lbrakk>x \<in> Z; Z \<subseteq> {x. x \<in> X \<and> P x}\<rbrakk> \<Longrightarrow> P x"
  by auto

lemma underS_I: "\<lbrakk>i \<noteq> j; (i, j) \<in> R\<rbrakk> \<Longrightarrow> i \<in> underS R j"
  unfolding underS_def by simp

lemma underS_E: "i \<in> underS R j \<Longrightarrow> i \<noteq> j \<and> (i, j) \<in> R"
  unfolding underS_def by simp

lemma underS_Field: "i \<in> underS R j \<Longrightarrow> i \<in> Field R"
  unfolding underS_def Field_def by auto

lemma FieldI2: "(i, j) \<in> R \<Longrightarrow> j \<in> Field R"
  unfolding Field_def by auto

lemma fst_convol': "fst (\<langle>f, g\<rangle> x) = f x"
  using fst_convol unfolding convol_def by simp

lemma snd_convol': "snd (\<langle>f, g\<rangle> x) = g x"
  using snd_convol unfolding convol_def by simp

lemma convol_expand_snd: "fst o f = g \<Longrightarrow> \<langle>g, snd o f\<rangle> = f"
  unfolding convol_def by auto

lemma convol_expand_snd':
  assumes "(fst o f = g)"
  shows "h = snd o f \<longleftrightarrow> \<langle>g, h\<rangle> = f"
proof -
  from assms have *: "\<langle>g, snd o f\<rangle> = f" by (rule convol_expand_snd)
  then have "h = snd o f \<longleftrightarrow> h = snd o \<langle>g, snd o f\<rangle>" by simp
  moreover have "\<dots> \<longleftrightarrow> h = snd o f" by (simp add: snd_convol)
  moreover have "\<dots> \<longleftrightarrow> \<langle>g, h\<rangle> = f" by (subst (2) *[symmetric]) (auto simp: convol_def fun_eq_iff)
  ultimately show ?thesis by simp
qed

lemma bij_betwE: "bij_betw f A B \<Longrightarrow> \<forall>a\<in>A. f a \<in> B"
  unfolding bij_betw_def by auto

lemma bij_betw_imageE: "bij_betw f A B \<Longrightarrow> f ` A = B"
  unfolding bij_betw_def by auto

lemma f_the_inv_into_f_bij_betw:
  "bij_betw f A B \<Longrightarrow> (bij_betw f A B \<Longrightarrow> x \<in> B) \<Longrightarrow> f (the_inv_into A f x) = x"
  unfolding bij_betw_def by (blast intro: f_the_inv_into_f)

lemma ex_bij_betw: "|A| \<le>o (r :: 'b rel) \<Longrightarrow> \<exists>f B :: 'b set. bij_betw f B A"
  by (subst (asm) internalize_card_of_ordLeq) (auto dest!: iffD2[OF card_of_ordIso ordIso_symmetric])

lemma bij_betwI':
  "\<lbrakk>\<And>x y. \<lbrakk>x \<in> X; y \<in> X\<rbrakk> \<Longrightarrow> (f x = f y) = (x = y);
    \<And>x. x \<in> X \<Longrightarrow> f x \<in> Y;
    \<And>y. y \<in> Y \<Longrightarrow> \<exists>x \<in> X. y = f x\<rbrakk> \<Longrightarrow> bij_betw f X Y"
  unfolding bij_betw_def inj_on_def by blast

lemma surj_fun_eq:
  assumes surj_on: "f ` X = UNIV" and eq_on: "\<forall>x \<in> X. (g1 o f) x = (g2 o f) x"
  shows "g1 = g2"
proof (rule ext)
  fix y
  from surj_on obtain x where "x \<in> X" and "y = f x" by blast
  thus "g1 y = g2 y" using eq_on by simp
qed

lemma Card_order_wo_rel: "Card_order r \<Longrightarrow> wo_rel r"
  unfolding wo_rel_def card_order_on_def by blast

lemma Cinfinite_limit: "\<lbrakk>x \<in> Field r; Cinfinite r\<rbrakk> \<Longrightarrow> \<exists>y \<in> Field r. x \<noteq> y \<and> (x, y) \<in> r"
  unfolding cinfinite_def by (auto simp add: infinite_Card_order_limit)

lemma Card_order_trans:
  "\<lbrakk>Card_order r; x \<noteq> y; (x, y) \<in> r; y \<noteq> z; (y, z) \<in> r\<rbrakk> \<Longrightarrow> x \<noteq> z \<and> (x, z) \<in> r"
  unfolding card_order_on_def well_order_on_def linear_order_on_def
    partial_order_on_def preorder_on_def trans_def antisym_def by blast

lemma Cinfinite_limit2:
  assumes x1: "x1 \<in> Field r" and x2: "x2 \<in> Field r" and r: "Cinfinite r"
  shows "\<exists>y \<in> Field r. (x1 \<noteq> y \<and> (x1, y) \<in> r) \<and> (x2 \<noteq> y \<and> (x2, y) \<in> r)"
proof -
  from r have trans: "trans r" and total: "Total r" and antisym: "antisym r"
    unfolding card_order_on_def well_order_on_def linear_order_on_def
      partial_order_on_def preorder_on_def by auto
  obtain y1 where y1: "y1 \<in> Field r" "x1 \<noteq> y1" "(x1, y1) \<in> r"
    using Cinfinite_limit[OF x1 r] by blast
  obtain y2 where y2: "y2 \<in> Field r" "x2 \<noteq> y2" "(x2, y2) \<in> r"
    using Cinfinite_limit[OF x2 r] by blast
  show ?thesis
  proof (cases "y1 = y2")
    case True with y1 y2 show ?thesis by blast
  next
    case False
    with y1(1) y2(1) total have "(y1, y2) \<in> r \<or> (y2, y1) \<in> r"
      unfolding total_on_def by auto
    thus ?thesis
    proof
      assume *: "(y1, y2) \<in> r"
      with trans y1(3) have "(x1, y2) \<in> r" unfolding trans_def by blast
      with False y1 y2 * antisym show ?thesis by (cases "x1 = y2") (auto simp: antisym_def)
    next
      assume *: "(y2, y1) \<in> r"
      with trans y2(3) have "(x2, y1) \<in> r" unfolding trans_def by blast
      with False y1 y2 * antisym show ?thesis by (cases "x2 = y1") (auto simp: antisym_def)
    qed
  qed
qed

lemma Cinfinite_limit_finite:
  "\<lbrakk>finite X; X \<subseteq> Field r; Cinfinite r\<rbrakk> \<Longrightarrow> \<exists>y \<in> Field r. \<forall>x \<in> X. (x \<noteq> y \<and> (x, y) \<in> r)"
proof (induct X rule: finite_induct)
  case empty thus ?case unfolding cinfinite_def using ex_in_conv[of "Field r"] finite.emptyI by auto
next
  case (insert x X)
  then obtain y where y: "y \<in> Field r" "\<forall>x \<in> X. (x \<noteq> y \<and> (x, y) \<in> r)" by blast
  then obtain z where z: "z \<in> Field r" "x \<noteq> z \<and> (x, z) \<in> r" "y \<noteq> z \<and> (y, z) \<in> r"
    using Cinfinite_limit2[OF _ y(1) insert(5), of x] insert(4) by blast
  show ?case
    apply (intro bexI ballI)
    apply (erule insertE)
    apply hypsubst
    apply (rule z(2))
    using Card_order_trans[OF insert(5)[THEN conjunct2]] y(2) z(3)
    apply blast
    apply (rule z(1))
    done
qed

lemma insert_subsetI: "\<lbrakk>x \<in> A; X \<subseteq> A\<rbrakk> \<Longrightarrow> insert x X \<subseteq> A"
  by auto

lemmas well_order_induct_imp = wo_rel.well_order_induct[of r "\<lambda>x. x \<in> Field r \<longrightarrow> P x" for r P]

lemma meta_spec2:
  assumes "(\<And>x y. PROP P x y)"
  shows "PROP P x y"
  by (rule assms)

lemma nchotomy_relcomppE:
  assumes "\<And>y. \<exists>x. y = f x" "(r OO s) a c" "\<And>b. r a (f b) \<Longrightarrow> s (f b) c \<Longrightarrow> P"
  shows P
proof (rule relcompp.cases[OF assms(2)], hypsubst)
  fix b assume "r a b" "s b c"
  moreover from assms(1) obtain b' where "b = f b'" by blast
  ultimately show P by (blast intro: assms(3))
qed

lemma predicate2D_vimage2p: "\<lbrakk>R \<le> vimage2p f g S; R x y\<rbrakk> \<Longrightarrow> S (f x) (g y)"
  unfolding vimage2p_def by auto

lemma id_transfer: "rel_fun A A id id"
  unfolding rel_fun_def by simp

lemma fst_transfer: "rel_fun (rel_prod A B) A fst fst"
  unfolding rel_fun_def by simp

lemma snd_transfer: "rel_fun (rel_prod A B) B snd snd"
  unfolding rel_fun_def by simp

lemma convol_transfer:
  "rel_fun (rel_fun R S) (rel_fun (rel_fun R T) (rel_fun R (rel_prod S T))) BNF_Def.convol BNF_Def.convol"
  unfolding rel_fun_def convol_def by auto

lemma ssubst_Pair_rhs: "\<lbrakk>(r, s) \<in> R; s' = s\<rbrakk> \<Longrightarrow> (r, s') \<in> R"
  by (rule ssubst)

lemma all_mem_range1:
  "(\<And>y. y \<in> range f \<Longrightarrow> P y) \<equiv> (\<And>x. P (f x)) "
  by (rule equal_intr_rule) fast+

lemma all_mem_range2:
  "(\<And>fa y. fa \<in> range f \<Longrightarrow> y \<in> range fa \<Longrightarrow> P y) \<equiv> (\<And>x xa. P (f x xa))"
  by (rule equal_intr_rule) fast+

lemma all_mem_range3:
  "(\<And>fa fb y. fa \<in> range f \<Longrightarrow> fb \<in> range fa \<Longrightarrow> y \<in> range fb \<Longrightarrow> P y) \<equiv> (\<And>x xa xb. P (f x xa xb))"
  by (rule equal_intr_rule) fast+

lemma all_mem_range4:
  "(\<And>fa fb fc y. fa \<in> range f \<Longrightarrow> fb \<in> range fa \<Longrightarrow> fc \<in> range fb \<Longrightarrow> y \<in> range fc \<Longrightarrow> P y) \<equiv>
   (\<And>x xa xb xc. P (f x xa xb xc))"
  by (rule equal_intr_rule) fast+

lemma all_mem_range5:
  "(\<And>fa fb fc fd y. fa \<in> range f \<Longrightarrow> fb \<in> range fa \<Longrightarrow> fc \<in> range fb \<Longrightarrow> fd \<in> range fc \<Longrightarrow>
     y \<in> range fd \<Longrightarrow> P y) \<equiv>
   (\<And>x xa xb xc xd. P (f x xa xb xc xd))"
  by (rule equal_intr_rule) fast+

lemma all_mem_range6:
  "(\<And>fa fb fc fd fe ff y. fa \<in> range f \<Longrightarrow> fb \<in> range fa \<Longrightarrow> fc \<in> range fb \<Longrightarrow> fd \<in> range fc \<Longrightarrow>
     fe \<in> range fd \<Longrightarrow> ff \<in> range fe \<Longrightarrow> y \<in> range ff \<Longrightarrow> P y) \<equiv>
   (\<And>x xa xb xc xd xe xf. P (f x xa xb xc xd xe xf))"
  by (rule equal_intr_rule) (fastforce, fast)

lemma all_mem_range7:
  "(\<And>fa fb fc fd fe ff fg y. fa \<in> range f \<Longrightarrow> fb \<in> range fa \<Longrightarrow> fc \<in> range fb \<Longrightarrow> fd \<in> range fc \<Longrightarrow>
     fe \<in> range fd \<Longrightarrow> ff \<in> range fe \<Longrightarrow> fg \<in> range ff \<Longrightarrow> y \<in> range fg \<Longrightarrow> P y) \<equiv>
   (\<And>x xa xb xc xd xe xf xg. P (f x xa xb xc xd xe xf xg))"
  by (rule equal_intr_rule) (fastforce, fast)

lemma all_mem_range8:
  "(\<And>fa fb fc fd fe ff fg fh y. fa \<in> range f \<Longrightarrow> fb \<in> range fa \<Longrightarrow> fc \<in> range fb \<Longrightarrow> fd \<in> range fc \<Longrightarrow>
     fe \<in> range fd \<Longrightarrow> ff \<in> range fe \<Longrightarrow> fg \<in> range ff \<Longrightarrow> fh \<in> range fg \<Longrightarrow> y \<in> range fh \<Longrightarrow> P y) \<equiv>
   (\<And>x xa xb xc xd xe xf xg xh. P (f x xa xb xc xd xe xf xg xh))"
  by (rule equal_intr_rule) (fastforce, fast)

lemmas all_mem_range = all_mem_range1 all_mem_range2 all_mem_range3 all_mem_range4 all_mem_range5
  all_mem_range6 all_mem_range7 all_mem_range8

ML_file "Tools/BNF/bnf_lfp_util.ML"
ML_file "Tools/BNF/bnf_lfp_tactics.ML"
ML_file "Tools/BNF/bnf_lfp.ML"
ML_file "Tools/BNF/bnf_lfp_compat.ML"
ML_file "Tools/BNF/bnf_lfp_rec_sugar_more.ML"
ML_file "Tools/BNF/bnf_lfp_size.ML"

end


(*  Title:      HOL/Library/Quotient_List.thy
    Author:     Cezary Kaliszyk and Christian Urban
*)

section \<open>Quotient infrastructure for the list type\<close>

theory Quotient_List
imports Quotient_Set Quotient_Product Quotient_Option
begin

subsection \<open>Rules for the Quotient package\<close>

lemma map_id [id_simps]:
  "map id = id"
  by (fact List.map.id)

lemma list_all2_eq [id_simps]:
  "list_all2 (op =) = (op =)"
proof (rule ext)+
  fix xs ys
  show "list_all2 (op =) xs ys \<longleftrightarrow> xs = ys"
    by (induct xs ys rule: list_induct2') simp_all
qed

lemma reflp_list_all2:
  assumes "reflp R"
  shows "reflp (list_all2 R)"
proof (rule reflpI)
  from assms have *: "\<And>xs. R xs xs" by (rule reflpE)
  fix xs
  show "list_all2 R xs xs"
    by (induct xs) (simp_all add: *)
qed

lemma list_symp:
  assumes "symp R"
  shows "symp (list_all2 R)"
proof (rule sympI)
  from assms have *: "\<And>xs ys. R xs ys \<Longrightarrow> R ys xs" by (rule sympE)
  fix xs ys
  assume "list_all2 R xs ys"
  then show "list_all2 R ys xs"
    by (induct xs ys rule: list_induct2') (simp_all add: *)
qed

lemma list_transp:
  assumes "transp R"
  shows "transp (list_all2 R)"
proof (rule transpI)
  from assms have *: "\<And>xs ys zs. R xs ys \<Longrightarrow> R ys zs \<Longrightarrow> R xs zs" by (rule transpE)
  fix xs ys zs
  assume "list_all2 R xs ys" and "list_all2 R ys zs"
  then show "list_all2 R xs zs"
    by (induct arbitrary: zs) (auto simp: list_all2_Cons1 intro: *)
qed

lemma list_equivp [quot_equiv]:
  "equivp R \<Longrightarrow> equivp (list_all2 R)"
  by (blast intro: equivpI reflp_list_all2 list_symp list_transp elim: equivpE)

lemma list_quotient3 [quot_thm]:
  assumes "Quotient3 R Abs Rep"
  shows "Quotient3 (list_all2 R) (map Abs) (map Rep)"
proof (rule Quotient3I)
  from assms have "\<And>x. Abs (Rep x) = x" by (rule Quotient3_abs_rep)
  then show "\<And>xs. map Abs (map Rep xs) = xs" by (simp add: comp_def)
next
  from assms have "\<And>x y. R (Rep x) (Rep y) \<longleftrightarrow> x = y" by (rule Quotient3_rel_rep)
  then show "\<And>xs. list_all2 R (map Rep xs) (map Rep xs)"
    by (simp add: list_all2_map1 list_all2_map2 list_all2_eq)
next
  fix xs ys
  from assms have "\<And>x y. R x x \<and> R y y \<and> Abs x = Abs y \<longleftrightarrow> R x y" by (rule Quotient3_rel)
  then show "list_all2 R xs ys \<longleftrightarrow> list_all2 R xs xs \<and> list_all2 R ys ys \<and> map Abs xs = map Abs ys"
    by (induct xs ys rule: list_induct2') auto
qed

declare [[mapQ3 list = (list_all2, list_quotient3)]]

lemma cons_prs [quot_preserve]:
  assumes q: "Quotient3 R Abs Rep"
  shows "(Rep ---> (map Rep) ---> (map Abs)) (op #) = (op #)"
  by (auto simp add: fun_eq_iff comp_def Quotient3_abs_rep [OF q])

lemma cons_rsp [quot_respect]:
  assumes q: "Quotient3 R Abs Rep"
  shows "(R ===> list_all2 R ===> list_all2 R) (op #) (op #)"
  by auto

lemma nil_prs [quot_preserve]:
  assumes q: "Quotient3 R Abs Rep"
  shows "map Abs [] = []"
  by simp

lemma nil_rsp [quot_respect]:
  assumes q: "Quotient3 R Abs Rep"
  shows "list_all2 R [] []"
  by simp

lemma map_prs_aux:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "(map abs2) (map ((abs1 ---> rep2) f) (map rep1 l)) = map f l"
  by (induct l)
     (simp_all add: Quotient3_abs_rep[OF a] Quotient3_abs_rep[OF b])

lemma map_prs [quot_preserve]:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "((abs1 ---> rep2) ---> (map rep1) ---> (map abs2)) map = map"
  and   "((abs1 ---> id) ---> map rep1 ---> id) map = map"
  by (simp_all only: fun_eq_iff map_prs_aux[OF a b] comp_def)
    (simp_all add: Quotient3_abs_rep[OF a] Quotient3_abs_rep[OF b])

lemma map_rsp [quot_respect]:
  assumes q1: "Quotient3 R1 Abs1 Rep1"
  and     q2: "Quotient3 R2 Abs2 Rep2"
  shows "((R1 ===> R2) ===> (list_all2 R1) ===> list_all2 R2) map map"
  and   "((R1 ===> op =) ===> (list_all2 R1) ===> op =) map map"
  unfolding list_all2_eq [symmetric] by (rule list.map_transfer)+

lemma foldr_prs_aux:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "abs2 (foldr ((abs1 ---> abs2 ---> rep2) f) (map rep1 l) (rep2 e)) = foldr f l e"
  by (induct l) (simp_all add: Quotient3_abs_rep[OF a] Quotient3_abs_rep[OF b])

lemma foldr_prs [quot_preserve]:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "((abs1 ---> abs2 ---> rep2) ---> (map rep1) ---> rep2 ---> abs2) foldr = foldr"
  apply (simp add: fun_eq_iff)
  by (simp only: fun_eq_iff foldr_prs_aux[OF a b])
     (simp)

lemma foldl_prs_aux:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "abs1 (foldl ((abs1 ---> abs2 ---> rep1) f) (rep1 e) (map rep2 l)) = foldl f e l"
  by (induct l arbitrary:e) (simp_all add: Quotient3_abs_rep[OF a] Quotient3_abs_rep[OF b])

lemma foldl_prs [quot_preserve]:
  assumes a: "Quotient3 R1 abs1 rep1"
  and     b: "Quotient3 R2 abs2 rep2"
  shows "((abs1 ---> abs2 ---> rep1) ---> rep1 ---> (map rep2) ---> abs1) foldl = foldl"
  by (simp add: fun_eq_iff foldl_prs_aux [OF a b])

lemma foldl_rsp[quot_respect]:
  assumes q1: "Quotient3 R1 Abs1 Rep1"
  and     q2: "Quotient3 R2 Abs2 Rep2"
  shows "((R1 ===> R2 ===> R1) ===> R1 ===> list_all2 R2 ===> R1) foldl foldl"
  by (rule foldl_transfer)

lemma foldr_rsp[quot_respect]:
  assumes q1: "Quotient3 R1 Abs1 Rep1"
  and     q2: "Quotient3 R2 Abs2 Rep2"
  shows "((R1 ===> R2 ===> R2) ===> list_all2 R1 ===> R2 ===> R2) foldr foldr"
  by (rule foldr_transfer)

lemma list_all2_rsp:
  assumes r: "\<forall>x y. R x y \<longrightarrow> (\<forall>a b. R a b \<longrightarrow> S x a = T y b)"
  and l1: "list_all2 R x y"
  and l2: "list_all2 R a b"
  shows "list_all2 S x a = list_all2 T y b"
  using l1 l2
  by (induct arbitrary: a b rule: list_all2_induct,
    auto simp: list_all2_Cons1 list_all2_Cons2 r)

lemma [quot_respect]:
  "((R ===> R ===> op =) ===> list_all2 R ===> list_all2 R ===> op =) list_all2 list_all2"
  by (rule list.rel_transfer)

lemma [quot_preserve]:
  assumes a: "Quotient3 R abs1 rep1"
  shows "((abs1 ---> abs1 ---> id) ---> map rep1 ---> map rep1 ---> id) list_all2 = list_all2"
  apply (simp add: fun_eq_iff)
  apply clarify
  apply (induct_tac xa xb rule: list_induct2')
  apply (simp_all add: Quotient3_abs_rep[OF a])
  done

lemma [quot_preserve]:
  assumes a: "Quotient3 R abs1 rep1"
  shows "(list_all2 ((rep1 ---> rep1 ---> id) R) l m) = (l = m)"
  by (induct l m rule: list_induct2') (simp_all add: Quotient3_rel_rep[OF a])

lemma list_all2_find_element:
  assumes a: "x \<in> set a"
  and b: "list_all2 R a b"
  shows "\<exists>y. (y \<in> set b \<and> R x y)"
  using b a by induct auto

lemma list_all2_refl:
  assumes a: "\<And>x y. R x y = (R x = R y)"
  shows "list_all2 R x x"
  by (induct x) (auto simp add: a)

end


theory "Arity-Nominal"
imports Arity "Launchbury.Nominal-HOLCF"
begin

lemma join_eqvt[eqvt]: "\<pi> \<bullet> (x \<squnion> (y :: 'a :: {Finite_Join_cpo, cont_pt})) = (\<pi> \<bullet> x) \<squnion> (\<pi> \<bullet> y)"
  by (rule is_joinI[symmetric]) (auto simp add: perm_below_to_right)

instantiation Arity :: pure
begin
  definition "p \<bullet> (a::Arity) = a"
instance
  apply standard
  apply (auto simp add: permute_Arity_def)
  done
end

instance Arity :: cont_pt by standard (simp add: pure_permute_id)
instance Arity :: pure_cont_pt ..

end