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

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

typedecl Unit

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

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

axioms
Comp1 [rule_format] :
"ALL (f :: 'b => 'c).
 ALL (g :: 'a => 'b). ALL (y :: 'a). X__o__X (f, g) y = f (g y)"

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

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

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

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

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

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

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

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

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

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

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

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

OtherwiseDef [rule_format] : "otherwiseH = True'"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

FoldlDecomp [rule_format] :
"ALL (e :: 'a).
 ALL (i :: 'a => 'b => 'a).
 ALL (ts :: 'b List).
 ALL (ys :: 'b List).
 X_foldl i e (ys ++' ts) =
 restrictOp (X_foldl i (makeTotal (X_foldl i e ys)) ts)
 (defOp (X_foldl i e ys))"

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

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

FilterProm [rule_format] :
"ALL (f :: 'a => 'b).
 ALL (p :: 'b => Bool).
 ALL (xs :: 'a List).
 X_filter p (X_map f xs) = X_map f (X_filter (X__o__X (p, f)) xs)"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

ScanlProperty [rule_format] :
"ALL (g :: 'a => 'b => 'a).
 ALL (x :: 'a).
 ALL (ys :: 'b List). last'(scanl g x ys) = X_foldl g x ys"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

SpanThm [rule_format] :
"ALL (p :: 'a => Bool).
 ALL (xs :: 'a List).
 span p xs = (X_takeWhile p xs, X_dropWhile p xs)"

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

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

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

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

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

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

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

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

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

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

Partition [rule_format] :
"ALL (p :: 'a => Bool).
 ALL (xs :: 'a List).
 makePartial (partition p xs) = X_foldr (select p) (Nil', Nil') xs"

PartitionProp [rule_format] :
"ALL (p :: 'a => Bool).
 ALL (xs :: 'a List).
 partition p xs =
 (X_filter p xs, X_filter (X__o__X (notH__X, p)) xs)"

PartialTest [rule_format] :
"ALL (x :: 'a).
 ALL (xs :: 'a List).
 makePartial (X_Cons x xs) =
 restrictOp
 (makePartial
  (X_Cons (makeTotal (head(X_Cons x xs)))
   (makeTotal (tail(X_Cons x xs)))))
 (defOp (head(X_Cons x xs)) & defOp (tail(X_Cons x xs)))"

QuickSortNil [rule_format] : "quickSort(Nil') = Nil'"

QuickSortCons [rule_format] :
"ALL (x :: 'a).
 ALL (xs :: 'a List).
 quickSort(X_Cons x xs) =
 (quickSort(X_filter (% y. y <' x) xs) ++' X_Cons x Nil') ++'
 quickSort(X_filter (% y. y >=' x) xs)"

InsertionSortNil [rule_format] : "insertionSort(Nil') = Nil'"

InsertionSortConsCons [rule_format] :
"ALL (x :: 'a).
 ALL (xs :: 'a List).
 insertionSort(X_Cons x xs) = X_insert x (insertionSort(xs))"

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

theorem InsertionSortConsNil :
"ALL (x :: 'a). insertionSort(X_Cons x Nil') = X_Cons x Nil'"
apply(auto)
apply(simp add: InsertionSortConsCons)
apply(simp add: InsertNil)
done

setup "Header.record \"InsertionSortConsNil\""

theorem Program01 :
"andL(X_Cons True' (X_Cons True' (X_Cons True' Nil'))) = True'"
apply(simp add: AndLCons AndLNil)
done

setup "Header.record \"Program01\""

theorem Program02 :
"quickSort(X_Cons True' (X_Cons False' Nil')) =
 X_Cons False' (X_Cons True' Nil')"
apply(simp only: QuickSortCons)
apply(case_tac "(%y. y <' True') False'")
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QuickSortNil)
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: QuickSortNil)
apply(simp add: LeFGeTEqTRel)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QuickSortCons)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QuickSortNil)
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: QuickSortCons)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QuickSortNil)
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: QuickSortNil)
apply(simp only: XPlusXPlusCons)
apply(simp only: XPlusXPlusNil)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QuickSortCons)
apply(simp only: FilterNil FilterConsT FilterConsF)
apply(simp only: QuickSortNil)
apply(simp only: XPlusXPlusNil)
apply(simp only: XPlusXPlusCons)
apply(simp only: XPlusXPlusNil)
apply(simp add: LeFGeTEqTRel)
done

setup "Header.record \"Program02\""

theorem Program03 :
"insertionSort(X_Cons True' (X_Cons False' Nil')) =
 X_Cons False' (X_Cons True' Nil')"
apply(simp only: InsertionSortConsCons)
apply(simp only: InsertionSortNil)
apply(simp only: InsertNil)
apply(case_tac "True' >' False'")
apply(simp only: GeFLeTEqTRel)
apply(simp add: LeqTLeTEqTRel)
apply(simp only: InsertCons2)
apply(simp only: InsertNil)
done

setup "Header.record \"Program03\""

theorem Program04 :
"ALL (xs :: 'a List). insertionSort(xs) = quickSort(xs)"
apply(auto)
apply(case_tac xs)
prefer 2
apply(simp only: InsertionSortNil QuickSortNil)
(* general case*)
(*
apply(auto)
apply(simp only: InsertionSortConsCons)
apply(simp only: QuickSortCons)
apply(induct_tac List)
apply(case_tac "y <' a")
apply(simp)
apply(simp only: FilterConsF)
apply(case_tac "aa >=' a")
apply(simp only: FilterConsF)
apply(simp only:InsertionSortConsCons)
apply(induct_tac Lista)
apply(case_tac "(ab <' a)")
apply(simp only: FilterConsF)
apply(case_tac "ab >=' a")
apply(simp only: FilterConsF)
apply(simp only:InsertionSortConsCons)
oops

apply(simp only: LeFGeTEqTRel)
apply(simp only: GeqFGeFEqFRel)
apply (erule disjE)

apply(simp only:  LeqFGeTRel InsertCons2)

apply(induct_tac List)
apply(case_tac "quickSort(List)")
apply(auto)
apply(case_tac "a <='' aa")
apply(simp only:  LeqFGeTRel InsertCons2)
apply(simp only: QuickSortCons)
apply(induct_tac List)
apply(case_tac "ab <'' a")
apply(simp only: FilterConsT FilterConsF)
apply(case_tac "ab >='' a")
apply(simp only: FilterConsT FilterConsF)
apply(simp only: FilterConsT)
apply(case_tac "quickSort(X_filter (%y. y <'' a) Listb)")
apply(simp only: XPlusXPlusCons)+

apply(case_tac List)
(*Cons x Nil*)
prefer 2
apply(simp only: InsertionSortConsNil)
apply(simp only: QuickSortCons)
apply(simp only: FilterNil)
apply(simp only: QuickSortNil)
apply(simp only: XPlusXPlusNil)
apply(simp only: XPlusXPlusCons)
apply(simp only: XPlusXPlusNil)
(*Cons x xx*)
apply(induct_tac Lista)
apply(simp only: QuickSortCons)
apply(simp only: QuickSortCons)
apply(simp only: InsertionSortConsCons)
apply(case_tac "(insertionSort(Lista))")
apply(simp only: InsertionSortConsCons)
apply(case_tac "aa <'' a")
apply(case_tac "aa >='' a")
apply(simp only: FilterConsF)
apply(simp only: GeqFLeTRel)
apply(simp add: IBE3)
apply(auto)
*)
oops

setup "Header.record \"Program04\""

end


(******************************************************************************)
(* Project: The Isabelle/UTP Proof System                                     *)
(* File: utp_event.thy                                                        *)
(* Authors: Simon Foster and Frank Zeyda (University of York, UK)             *)
(* Emails: simon.foster@york.ac.uk frank.zeyda@york.ac.uk                     *)
(******************************************************************************)
(* LAST REVIEWED: 30 Jan 2017 *)

section {* UTP Events *}

theory utp_event
imports utp_pred
begin

subsection {* Events *}

text {* Events of some type @{typ "'\<theta>"} are just the elements of that type. *}

type_synonym '\<theta> event = "'\<theta>"

subsection {* Channels *}

text {*
  Typed channels are modelled as functions. Below, @{typ "'a"} determines the
  channel type and @{typ "'\<theta>"} the underlying event type. As with values, it
  is difficult to introduce channels as monomorphic types due to the fact that
  they can have arbitrary parametrisations in term of @{typ "'a"}. Applying a
  channel to an element of its type yields an event, as we may expect. Though
  this is not formalised here, we may also sensibly assume that all channel-
  representing functions are injective. Note: is there benefit in formalising
  this here?
*}

type_synonym ('a, '\<theta>) chan = "'a \<Rightarrow> '\<theta> event"

text {*
  A downside of the approach is that the event type @{typ "'\<theta>"} must be able
  to encode \emph{all} events of a process model, and hence cannot be fixed
  upfront for a single channel or channel set. To do so, we actually require
  a notion of `extensible' datatypes, in analogy to extensible record types.
  Another solution is to encode a notion of channel scoping that namely uses
  @{type sum} types to lift channel types into extensible ones, that is using
  channel-set specific scoping operators. This is a current work in progress.
*}

subsubsection {* Operators *}

text {*
  The Z type of a channel corresponds to the entire carrier of the underlying
  HOL type of that channel. Strictly, the function is redundant but was added
  to mirror the mathematical account in [?]. (TODO: Ask Simon Foster for [?])
*}

definition chan_type :: "('a, '\<theta>) chan \<Rightarrow> 'a set" ("\<delta>\<^sub>u") where
[upred_defs]: "\<delta>\<^sub>u c = UNIV"

text {*
  The next lifted function creates an expression that yields a channel event,
  from an expression on the channel type @{typ "'a"}.
*}

definition chan_apply ::
  "('a, '\<theta>) chan \<Rightarrow> ('a, '\<alpha>) uexpr \<Rightarrow> ('\<theta> event, '\<alpha>) uexpr" ("'(_\<cdot>/_')\<^sub>u") where
[upred_defs]: "(c\<cdot>e)\<^sub>u = \<guillemotleft>c\<guillemotright>(e)\<^sub>a"

lemma unrest_chan_apply [unrest]: "x \<sharp> e \<Longrightarrow> x \<sharp> (c\<cdot>e)\<^sub>u"
  by (rel_auto)

lemma usubst_chan_apply [usubst]: "\<sigma> \<dagger> (c\<cdot>v)\<^sub>u = (c\<cdot>\<sigma> \<dagger> v)\<^sub>u"
  by (rel_auto)

end


theory NFAGA
imports NFASpec
begin

subsection \<open> Construction hierarchy \<close>

lemma nfa_dfa_construct_default :
assumes label_set_OK: "nfa_dfa_construct_label_sets \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar (\<lambda>x. {x}) (\<lambda>_. True) construct"
shows "nfa_dfa_construct \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar construct"
proof (intro nfa_dfa_construct.intro nfa_dfa_construct_axioms.intro)
  from label_set_OK show "nfa \<alpha> invar" unfolding nfa_dfa_construct_label_sets_def by simp
next
  fix \<A>::"('f, 'c) NFA_rec" and det and f::"'f \<Rightarrow> 'g" and ff I A FP and D_it::"'e \<Rightarrow> ('h \<Rightarrow> bool) \<Rightarrow> ('c \<times> 'e \<Rightarrow> 'h \<Rightarrow> 'h) \<Rightarrow> 'h \<Rightarrow> 'h"
  assume assms: "NFA \<A>" "det \<Longrightarrow> DFA \<A>" "inj_on f (\<Q> \<A>)" "\<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> ff q = f (q2_\<alpha> q)" "distinct (map q2_\<alpha> I)" "\<And>q. q \<in> set I \<Longrightarrow> q2_invar q"
    "q2_\<alpha> ` set I = \<I> \<A>" "invar_s A" "\<alpha>_s A = \<Sigma> \<A>" "\<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> FP q = (q2_\<alpha> q \<in> \<F> \<A>)"
    "\<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> set_iterator_abs (\<lambda>(a, q'). (a, q2_\<alpha> q')) (\<lambda>(a, q'). q2_invar q') (D_it q) {(a, q'). (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>}"

  note label_set_rule = nfa_dfa_construct_label_sets.nfa_dfa_construct_label_sets_correct[OF label_set_OK,
      where DS_q = "\<lambda>q. {({a}, q') | a q'. (q, a, q') \<in> \<Delta> \<A>}"]
  note label_set_rule' = label_set_rule [of \<A> det f ff I A FP D_it, OF assms(1-9)]

  show "invar (construct det ff I A FP D_it) \<and> NFA_isomorphic_wf (\<alpha> (construct det ff I A FP D_it)) (NFA_remove_unreachable_states \<A>)"
  proof (rule label_set_rule')
    fix q
    assume pre: "q2_invar q" "q2_\<alpha> q \<in> \<Q> \<A>"

    from assms(10)[OF pre] show "FP q = (q2_\<alpha> q \<in> \<F> \<A>)" by simp

    from assms(11)[OF pre]
    obtain lc where lc_props: "\<forall>(a, y)\<in>set lc. q2_invar y"
         "distinct (map (\<lambda>(a, q'). (a, q2_\<alpha> q')) lc)"
         "{(a, q'). (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>} = (\<lambda>(a, q'). (a, q2_\<alpha> q')) ` set lc"
         "D_it q = foldli lc"
      by (auto simp add: set_iterator_abs_def set_iterator_abs_genord_def)
    show "set_iterator_abs (\<lambda>(as, q). ({as}, q2_\<alpha> q))
           (\<lambda>(as, q). True \<and> q2_invar q) (D_it q)
           {({a}, q') |a q'. (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>}"
      unfolding set_iterator_abs_def set_iterator_abs_genord_def
      proof (rule_tac exI [where x = lc], intro conjI)
        from lc_props(2)
        show "distinct (map (\<lambda>(as, q). ({as}, q2_\<alpha> q)) lc)"
          by (simp add: distinct_map inj_on_def Ball_def)
      next
        from lc_props(3)
        show "{({a}, q') |a q'. (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>} =
              set (map (\<lambda>(as, q). ({as}, q2_\<alpha> q)) lc)"
          unfolding set_eq_iff
          apply (simp add: image_iff Bex_def del: ex_simps add: ex_simps[symmetric])
          apply metis
        done
    qed (simp_all add: lc_props)
  qed auto
qed

lemma nfa_construct_default :
assumes label_set_OK: "nfa_construct_label_sets \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar (\<lambda>x. {x}) (\<lambda>_. True) construct"
shows "nfa_construct \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar construct"
proof (intro nfa_construct.intro nfa_construct_axioms.intro)
  from label_set_OK show "nfa \<alpha> invar" unfolding nfa_construct_label_sets_def by simp
next
  fix \<A>::"('f, 'c) NFA_rec" and det and f::"'f \<Rightarrow> 'g" and ff I A FP and D_it::"'e \<Rightarrow> ('h \<Rightarrow> bool) \<Rightarrow> ('c \<times> 'e \<Rightarrow> 'h \<Rightarrow> 'h) \<Rightarrow> 'h \<Rightarrow> 'h"
  assume assms: "NFA \<A>" "inj_on f (\<Q> \<A>)" "\<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> ff q = f (q2_\<alpha> q)" "distinct (map q2_\<alpha> I)"
    "\<And>q. q \<in> set I \<Longrightarrow> q2_invar q" "q2_\<alpha> ` set I = \<I> \<A>" "invar_s A" "\<alpha>_s A = \<Sigma> \<A>"
    "\<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> FP q = (q2_\<alpha> q \<in> \<F> \<A>)"
    "\<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> set_iterator_abs (\<lambda>(a, q'). (a, q2_\<alpha> q')) (\<lambda>(a, q'). q2_invar q') (D_it q) {(a, q'). (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>}"
  note label_set_rule = nfa_construct_label_sets.nfa_construct_label_sets_correct[OF label_set_OK,
     where DS_q = "\<lambda>q. {({a}, q') | a q'. (q, a, q') \<in> \<Delta> \<A>}"]
  note label_set_rule' = label_set_rule [of \<A> f ff I A FP D_it, OF assms(1-9)]

  show "invar (construct ff I A FP D_it) \<and> NFA_isomorphic_wf (\<alpha> (construct ff I A FP D_it)) (NFA_remove_unreachable_states \<A>)"
  proof (rule label_set_rule')
    fix q
    assume "q2_invar q" "q2_\<alpha> q \<in> \<Q> \<A>"

    from assms(10)[OF this]
    obtain lc where lc_props: "\<forall>(a, y)\<in>set lc. q2_invar y"
         "distinct (map (\<lambda>(a, q'). (a, q2_\<alpha> q')) lc)"
         "{(a, q'). (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>} = (\<lambda>(a, q'). (a, q2_\<alpha> q')) ` set lc"
         "D_it q = foldli lc"
      by (auto simp add: set_iterator_abs_def set_iterator_abs_genord_def)
    show "set_iterator_abs (\<lambda>(as, q). ({as}, q2_\<alpha> q))
           (\<lambda>(as, q). True \<and> q2_invar q) (D_it q)
           {({a}, q') |a q'. (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>}"
      unfolding set_iterator_abs_def set_iterator_abs_genord_def
      proof (rule_tac exI [where x = lc], intro conjI)
        from lc_props(2)
        show "distinct (map (\<lambda>(as, q). ({as}, q2_\<alpha> q)) lc)"
          by (simp add: distinct_map inj_on_def Ball_def)
      next
        from lc_props(3)
        show "{({a}, q') |a q'. (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>} =
              set (map (\<lambda>(as, q). ({as}, q2_\<alpha> q)) lc)"
          unfolding set_eq_iff
          apply (simp add: image_iff Bex_def del: ex_simps add: ex_simps[symmetric])
          apply metis
        done
    qed (simp_all add: lc_props)
  qed auto
qed

lemma dfa_construct_default :
assumes label_set_OK: "dfa_construct_label_sets \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar (\<lambda>x. {x}) (\<lambda>_. True) construct"
shows "dfa_construct \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar construct"
proof (intro dfa_construct.intro dfa_construct_axioms.intro)
  from label_set_OK show "nfa \<alpha> invar" unfolding dfa_construct_label_sets_def by simp
next
  fix \<A>::"('f, 'c) NFA_rec" and det and f::"'f \<Rightarrow> 'g" and ff I A FP and D_it::"'e \<Rightarrow> ('h \<Rightarrow> bool) \<Rightarrow> ('c \<times> 'e \<Rightarrow> 'h \<Rightarrow> 'h) \<Rightarrow> 'h \<Rightarrow> 'h"
  assume assms: "DFA \<A>" "inj_on f (\<Q> \<A>)" "\<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> ff q = f (q2_\<alpha> q)"
    "distinct (map q2_\<alpha> I)" "\<And>q. q \<in> set I \<Longrightarrow> q2_invar q" "q2_\<alpha> ` set I = \<I> \<A>" "invar_s A" "\<alpha>_s A = \<Sigma> \<A>"
    "\<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> FP q = (q2_\<alpha> q \<in> \<F> \<A>)"
    "\<And>q. \<lbrakk>q2_invar q; q2_\<alpha> q \<in> \<Q> \<A>\<rbrakk> \<Longrightarrow> set_iterator_abs (\<lambda>(a, q'). (a, q2_\<alpha> q')) (\<lambda>(a, q'). q2_invar q') (D_it q) {(a, q'). (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>}"
  note label_set_rule = dfa_construct_label_sets.dfa_construct_label_sets_correct[OF label_set_OK,
     where DS_q = "\<lambda>q. {({a}, q') | a q'. (q, a, q') \<in> \<Delta> \<A>}"]
  note label_set_rule' = label_set_rule [of \<A> f ff I A FP D_it, OF assms(1-9)]

  show "invar (construct ff I A FP D_it) \<and> NFA_isomorphic_wf (\<alpha> (construct ff I A FP D_it)) (NFA_remove_unreachable_states \<A>)"
  proof (rule label_set_rule')
    fix q
    assume "q2_invar q" "q2_\<alpha> q \<in> \<Q> \<A>"

    from assms(10)[OF this]
    obtain lc where lc_props: "\<forall>(a, y)\<in>set lc. q2_invar y"
         "distinct (map (\<lambda>(a, q'). (a, q2_\<alpha> q')) lc)"
         "{(a, q'). (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>} = (\<lambda>(a, q'). (a, q2_\<alpha> q')) ` set lc"
         "D_it q = foldli lc"
      by (auto simp add: set_iterator_abs_def set_iterator_abs_genord_def)
    show "set_iterator_abs (\<lambda>(as, q). ({as}, q2_\<alpha> q))
           (\<lambda>(as, q). True \<and> q2_invar q) (D_it q)
           {({a}, q') |a q'. (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>}"
      unfolding set_iterator_abs_def set_iterator_abs_genord_def
      proof (rule_tac exI [where x = lc], intro conjI)
        from lc_props(2)
        show "distinct (map (\<lambda>(as, q). ({as}, q2_\<alpha> q)) lc)"
          by (simp add: distinct_map inj_on_def Ball_def)
      next
        from lc_props(3)
        show "{({a}, q') |a q'. (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>} =
              set (map (\<lambda>(as, q). ({as}, q2_\<alpha> q)) lc)"
          unfolding set_eq_iff
          apply (simp add: image_iff Bex_def del: ex_simps add: ex_simps[symmetric])
          apply metis
        done
    qed (simp_all add: lc_props)
  qed auto
qed

lemma nfa_dfa_construct_no_enc_default :
  "nfa_dfa_construct \<alpha> invar \<alpha>_s invar_s id (\<lambda>_. True) construct \<Longrightarrow>
   nfa_dfa_construct_no_enc \<alpha> invar \<alpha>_s invar_s construct"
by (simp add: nfa_dfa_construct_def nfa_dfa_construct_no_enc_def nfa_dfa_construct_no_enc_axioms_def
                nfa_dfa_construct_axioms_def)

lemma nfa_construct_no_enc_default :
  "nfa_construct \<alpha> invar \<alpha>_s invar_s id (\<lambda>_. True) construct \<Longrightarrow>
   nfa_construct_no_enc \<alpha> invar \<alpha>_s invar_s construct"
by (simp add: nfa_construct_def nfa_construct_no_enc_def nfa_construct_no_enc_axioms_def
                nfa_construct_axioms_def)

lemma dfa_construct_no_enc_default :
  "dfa_construct \<alpha> invar \<alpha>_s invar_s id (\<lambda>_. True) construct \<Longrightarrow>
   dfa_construct_no_enc \<alpha> invar \<alpha>_s invar_s construct"
 by (simp add: dfa_construct_def dfa_construct_no_enc_def dfa_construct_no_enc_axioms_def
               dfa_construct_axioms_def)

lemma dfa_construct_no_enc_fun_default :
  "dfa_construct_fun \<alpha> invar \<alpha>_s invar_s id (\<lambda>_. True) construct \<Longrightarrow>
   dfa_construct_no_enc_fun \<alpha> invar \<alpha>_s invar_s construct"
  by (simp add: dfa_construct_fun_def dfa_construct_no_enc_fun_def
                dfa_construct_no_enc_fun_axioms_def
                dfa_construct_fun_axioms_def)

subsection \<open> Construct with functions \<close>

definition construct_by_fun ::
  "('q2_rep,'i,'a,'a_set,'\<sigma>,'nfa) nfa_construct \<Rightarrow>
   ('a_set \<Rightarrow> ('a,'\<sigma>) set_iterator) \<Rightarrow>
   ('q2_rep,'i,'a,'a_set,'nfa) nfa_construct_fun" where
  "construct_by_fun const it_A ff I A FP D_fun =
   const ff [I] A FP
   (\<lambda>q. set_iterator_image (\<lambda>a. (a, D_fun q a)) (it_A A))"

lemma construct_by_fun_alt_def :
  "construct_by_fun const it_A ff I A FP D_fun =
   const ff [I] A FP (\<lambda>q c f. it_A A c (\<lambda>x. f (x, D_fun q x)))"
   unfolding construct_by_fun_def[abs_def] set_iterator_image_alt_def
   by simp

 term "poly_set_iteratei \<alpha> invar_s it_A"
 term "poly_set_iteratei_defs.iteratei"

lemma construct_by_fun_correct :
fixes const :: "('q2_rep,'i,'a,'a_set,'a list,'nfa) nfa_construct"
  and \<alpha> :: "'nfa \<Rightarrow> ('q, 'a) NFA_rec"
  and q2_\<alpha> :: "'q2_rep \<Rightarrow> 'q2"
assumes const_OK: "dfa_construct \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar const"
    and it_A: "poly_set_iteratei \<alpha>_s invar_s it_A"
shows "dfa_construct_fun \<alpha> invar \<alpha>_s invar_s q2_\<alpha> q2_invar (construct_by_fun const it_A)"
proof (intro dfa_construct_fun.intro dfa_construct_fun_axioms.intro)
  from const_OK show "nfa \<alpha> invar" unfolding dfa_construct_def by simp

  fix \<A> :: "('q2, 'a) NFA_rec" and
      f :: "'q2 \<Rightarrow> 'i" and ff I A FP D_fun
  assume wf_A: "DFA \<A>"
     and inj_f: "inj_on f (\<Q> \<A>)"
     and ff_OK: "\<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> ff q = f (q2_\<alpha> q)"
     and invar_I: "q2_invar I"
     and I_in: "q2_\<alpha> I \<in> \<I> \<A>"
     and invar_A: "invar_s A"
     and A_OK: "\<alpha>_s A = \<Sigma> \<A>"
     and FP_OK: "\<And>q. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> FP q = (q2_\<alpha> q \<in> \<F> \<A>)"
     and D_fun_OK: "\<And>q a. q2_invar q \<Longrightarrow> q2_\<alpha> q \<in> \<Q> \<A> \<Longrightarrow> a \<in> \<Sigma> \<A> \<Longrightarrow>
                (q2_\<alpha> q, a, q2_\<alpha> (D_fun q a)) \<in> \<Delta> \<A> \<and> q2_invar (D_fun q a)"

  interpret DFA \<A> by fact
  note const_rule = dfa_construct.dfa_construct_correct [OF const_OK wf_A inj_f, of ff "[I]",
        OF ff_OK _ _ _ invar_A A_OK FP_OK]

  show "invar (construct_by_fun const it_A ff I A FP D_fun) \<and>
       NFA_isomorphic_wf (\<alpha> (construct_by_fun const it_A ff I A FP D_fun)) (NFA_remove_unreachable_states \<A>)"
    unfolding construct_by_fun_def
  proof (rule const_rule)
    from I_in \<I>_is_set_\<i> show "q2_\<alpha> ` set [I] = \<I> \<A>" by auto
  next
    fix q
    assume invar_q: "q2_invar q" and q_in_Q: "q2_\<alpha> q \<in> \<Q> \<A>"

    with D_fun_OK[of q] have
      D_fun_in_D: "\<And>a. a \<in> \<Sigma> \<A> \<Longrightarrow> (q2_\<alpha> q, a, q2_\<alpha> (D_fun q a)) \<in> \<Delta> \<A>" and
      D_fun_invar: "\<And>a. a \<in> \<Sigma> \<A> \<Longrightarrow> q2_invar (D_fun q a)" by simp_all

    let ?DS_q = "{(a,  D_fun q a) |a. a \<in> \<Sigma> \<A>}"

    from poly_set_iteratei.list_it_correct[OF it_A, OF invar_A] have
      it_A_OK': "set_iterator (it_A A) (\<alpha>_s A)" .

    from set_iterator_image_correct [OF it_A_OK', of "\<lambda>a. (a, D_fun q a)"]
    have "set_iterator (set_iterator_image (\<lambda>a. (a, D_fun q a)) (it_A A))
           ((\<lambda>a. (a, D_fun q a)) ` \<alpha>_s A)" by (simp add: inj_on_def)
    moreover have "((\<lambda>a. (a, D_fun q a)) ` \<alpha>_s A) = {(a,  D_fun q a) |a. a \<in> \<Sigma> \<A>}"
      unfolding A_OK by auto
    ultimately have it_OK:
        "set_iterator (set_iterator_image (\<lambda>a. (a, D_fun q a)) (it_A A)) ?DS_q"
        by simp

    show "set_iterator_abs (\<lambda>(a, q'). (a, q2_\<alpha> q'))
         (\<lambda>(a, q'). q2_invar q')
         (set_iterator_image (\<lambda>a. (a, D_fun q a)) (it_A A))
         {(a, q'). (q2_\<alpha> q, a, q') \<in> \<Delta> \<A>}"
      apply (rule set_iterator_abs_I2)
      apply (rule it_OK)
      apply (auto simp add: it_OK D_fun_invar image_iff D_fun_in_D \<Delta>_consistent)
      apply (metis D_fun_in_D \<Delta>_consistent LTS_is_deterministic_def deterministic_LTS)
    done
  qed (simp_all add: invar_I)
qed

subsection\<open> Brzozowski \<close>

definition Brzozowski_impl :: "('nfa \<Rightarrow> 'nfa) \<Rightarrow> ('nfa \<Rightarrow> 'nfa) \<Rightarrow> 'nfa \<Rightarrow> 'nfa" where
  "Brzozowski_impl r d A = d (r (d (r A)))"

lemma Brzozowski_impl_correct :
assumes r_OK: "nfa_reverse \<alpha> invar \<alpha> invar r"
    and d_OK: "nfa_determinise \<alpha> invar \<alpha> invar d"
shows "nfa_minimise \<alpha> invar \<alpha> invar (Brzozowski_impl r d)"
unfolding Brzozowski_impl_def[abs_def]
proof (intro nfa_minimise.intro nfa_minimise_axioms.intro conjI)
  from r_OK show nfa_OK: "nfa \<alpha> invar" and "nfa \<alpha> invar" unfolding nfa_reverse_def by simp_all

  note nfa_correct = nfa.nfa_is_wellformed [OF nfa_OK]
  note r_correct = nfa_reverse.reverse_correct___isomorphic [OF r_OK]
  note d_correct = nfa_determinise.determinise_correct___isomorphic [OF d_OK]

  fix n
  assume invar_n: "invar n"
  hence wf_n: "NFA (\<alpha> n)" by (simp add: nfa_correct)

  show "invar (d (r (d (r n))))"
    by (intro d_correct(1) r_correct(1) invar_n)

  have "NFA_isomorphic_wf (\<alpha> (d (r (d (r n))))) (Brzozowski (\<alpha> n))"
    unfolding Brzozowski_def Brzozowski_halfway_def
    by (intro d_correct r_correct invar_n NFA_isomorphic_wf_refl wf_n)
  with Brzozowski___minimise[OF wf_n]
  show "NFA_isomorphic_wf (\<alpha> (d (r (d (r n))))) (NFA_minimise (\<alpha> n))"
    by (metis NFA_isomorphic_wf_trans)
qed

subsection\<open> Minimisation combined with determinisation \<close>

lemma NFAGA_minimisation_with_determinisation :
fixes \<alpha>1::"'nfa1 \<Rightarrow> ('q1::{automaton_states}, 'a) NFA_rec"
  and \<alpha>2::"'nfa2 \<Rightarrow> ('q2::{automaton_states}, 'a) NFA_rec"
  and \<alpha>3::"'nfa3 \<Rightarrow> ('q3, 'a) NFA_rec"
assumes d_OK: "nfa_determinise \<alpha>1 invar1 \<alpha>2 invar2 d"
    and m_OK: "dfa_minimise \<alpha>2 invar2 \<alpha>3 invar3 m"
shows "nfa_minimise \<alpha>1 invar1 \<alpha>3 invar3 (m \<circ> d)"
proof (intro nfa_minimise.intro nfa_minimise_axioms.intro conjI)
  from d_OK show nfa1_OK: "nfa \<alpha>1 invar1" unfolding nfa_determinise_def by simp
  from m_OK show "nfa \<alpha>3 invar3" unfolding dfa_minimise_def by simp

  fix a
  assume invar_a: "invar1 a"

  from nfa1_OK invar_a have NFA_a: "NFA (\<alpha>1 a)" unfolding nfa_def by simp

  let ?da = "NFA_determinise (\<alpha>1 a)"

  from nfa_determinise.determinise_correct___same [OF d_OK, OF invar_a]
  have invar_da: "invar2 (d a)" and
       iso_da: "NFA_isomorphic_wf (\<alpha>2 (d a)) ?da"
    by (simp_all add: NFA_isomorphic_wf___NFA_normalise_states_cong)

  have DFA_da : "DFA ?da" by (simp add: NFA_determinise_is_DFA NFA_a)
  have con_da: "SemiAutomaton_is_initially_connected ?da"
    unfolding NFA_determinise_def
    by (intro SemiAutomaton_is_initially_connected___normalise_states
              efficient_determinise_NFA___is_initially_connected)

  from dfa_minimise.dfa_minimise_correct___isomorphic
         [OF m_OK, OF invar_da, OF DFA_da con_da iso_da]
  have invar_mda: "invar3 ((m \<circ> d) a)" and
       iso_mda: "NFA_isomorphic_wf (\<alpha>3 ((m \<circ> d) a)) (NFA_minimise ?da)"
    by simp_all

  from invar_mda show "invar3 ((m \<circ> d) a)" .

  from iso_mda NFA_a DFA_da DFA_implies_NFA[OF DFA_da]
  show "NFA_isomorphic_wf (\<alpha>3 ((m \<circ> d) a)) (NFA_minimise (\<alpha>1 a))"
    by (simp add: NFA_isomorphic_wf___minimise DFA_alt_def
                  NFA_determinise_\<L>)
qed

subsection\<open> Language Operations \<close>

definition NFAGA_language_is_univ :: "('nfa \<Rightarrow> 'nfa) \<Rightarrow> ('nfa \<Rightarrow> 'nfa) \<Rightarrow> ('nfa \<Rightarrow> bool) \<Rightarrow> 'nfa \<Rightarrow> bool" where
  "NFAGA_language_is_univ d c is_emp A =  is_emp (c (d A))"

lemma NFAGA_language_is_univ_correct :
assumes c_OK: "nfa_complement \<alpha> invar c"
    and d_OK: "nfa_determinise \<alpha> invar \<alpha> invar d"
    and is_emp_OK: "nfa_language_is_empty \<alpha> invar is_emp"
shows "nfa_language_is_univ \<alpha> invar (NFAGA_language_is_univ d c is_emp)"
proof (intro nfa_language_is_univ.intro nfa_language_is_univ_axioms.intro)
  from c_OK show nfa_OK: "nfa \<alpha> invar" unfolding nfa_complement_def by simp_all

  fix n
  assume invar_n: "invar n"

  from invar_n nfa_OK have NFA_n: "NFA (\<alpha> n)"
    unfolding nfa_def by simp

  from nfa_determinise.determinise_correct___same[OF d_OK, OF invar_n]
  have invar_dn: "invar (d n)" and
       iso_dn: "NFA_isomorphic_wf (\<alpha> (d n)) (NFA_determinise (\<alpha> n))" by simp_all

  from nfa_complement.complement_correct___isomorphic[OF c_OK, OF invar_dn] iso_dn
  have invar_cdn: "invar (c (d n))" and
       iso_cdn: "NFA_isomorphic_wf (\<alpha> (c (d n))) (DFA_complement (NFA_determinise (\<alpha> n)))" by simp_all

  from nfa_language_is_empty.language_is_empty_correct [OF is_emp_OK, OF invar_cdn]
  have emp_eq: "is_emp (c (d n)) = (\<L> (\<alpha> (c (d n))) = {})" by simp

  from iso_cdn have "\<L> (\<alpha> (c (d n))) = \<L> (DFA_complement (NFA_determinise (\<alpha> n)))"
    by (metis NFA_isomorphic_wf_\<L>)
  hence L_cdn_eq: "\<L> (\<alpha> (c (d n))) = lists (\<Sigma> (\<alpha> n)) - \<L> (\<alpha> n)"
    using  DFA.DFA_complement_\<L>[OF NFA_determinise_is_DFA[OF NFA_n]]
           NFA_determinise_\<L>[OF NFA_n]
    by simp

   have L_n_subset: "\<L> (\<alpha> n) \<subseteq> lists (\<Sigma> (\<alpha> n))"
     using NFA.NFA_\<L>___lists_\<Sigma>[OF NFA_n] by simp

  show "NFAGA_language_is_univ d c is_emp n =
        (\<L> (\<alpha> n) = lists (\<Sigma> (\<alpha> n)))"
    unfolding NFAGA_language_is_univ_def emp_eq L_cdn_eq
    using L_n_subset by auto
qed

definition NFAGA_language_is_subset :: "('nfa \<Rightarrow> 'nfa) \<Rightarrow> ('nfa \<Rightarrow> 'nfa) \<Rightarrow> ('nfa \<Rightarrow> 'nfa \<Rightarrow> 'nfa) \<Rightarrow> ('nfa \<Rightarrow> bool) \<Rightarrow> 'nfa \<Rightarrow> 'nfa \<Rightarrow> bool" where
  "NFAGA_language_is_subset d c p is_emp A1 A2 =
   is_emp (p A1 (c (d A2)))"

lemma NFAGA_language_is_subset_correct :
assumes c_OK: "nfa_complement \<alpha> invar c"
    and d_OK: "nfa_determinise \<alpha> invar \<alpha> invar d"
    and bc_OK: "nfa_bool_comb_same \<alpha> invar bc"
    and is_emp_OK: "nfa_language_is_empty \<alpha> invar is_emp"
shows "nfa_language_is_subset \<alpha> invar (NFAGA_language_is_subset d c (bc (\<and>)) is_emp)"
proof (intro nfa_language_is_subset.intro nfa_language_is_subset_axioms.intro)
  from c_OK show nfa_OK: "nfa \<alpha> invar" unfolding nfa_complement_def by simp_all

  fix n1 n2
  assume invar_n1: "invar n1"
     and invar_n2: "invar n2"
     and \<Sigma>_eq: "\<Sigma> (\<alpha> n1) = \<Sigma> (\<alpha> n2)"

  from invar_n1 nfa_OK have NFA_n1: "NFA (\<alpha> n1)"
    unfolding nfa_def by simp

  from invar_n2 nfa_OK have NFA_n2: "NFA (\<alpha> n2)"
    unfolding nfa_def by simp

  from nfa_determinise.determinise_correct___same[OF d_OK, OF invar_n2]
  have invar_dn2: "invar (d n2)" and
       iso_dn: "NFA_isomorphic_wf (\<alpha> (d n2)) (NFA_determinise (\<alpha> n2))" by simp_all

  from nfa_complement.complement_correct___isomorphic[OF c_OK, OF invar_dn2] iso_dn
  have invar_cdn2: "invar (c (d n2))" and
       iso_cdn2: "NFA_isomorphic_wf (\<alpha> (c (d n2))) (DFA_complement (NFA_determinise (\<alpha> n2)))" by simp_all

  have \<Sigma>_eq': "\<Sigma> (\<alpha> n1) = \<Sigma> (\<alpha> (c (d n2)))"
    using NFA_isomorphic_wf_\<Sigma>[OF iso_cdn2] \<Sigma>_eq
    by simp

  note bc_props_aux = nfa_bool_comb_same.bool_comb_correct___same_isomorphic[OF bc_OK, OF invar_n1 invar_cdn2 \<Sigma>_eq',
    where ?bc = "(\<and>)"]

  from bc_props_aux(1) bc_props_aux(2)[OF NFA_isomorphic_wf_refl[OF NFA_n1] iso_cdn2]
  have invar_res: "invar (bc (\<and>) n1 (c (d n2)))"
   and iso_res: "NFA_isomorphic_wf (\<alpha> (bc (\<and>) n1 (c (d n2))))
     (NFA_product (\<alpha> n1) (DFA_complement (NFA_determinise (\<alpha> n2))))"
        unfolding NFA_product_def by simp_all

  have L_cdn2_eq: "\<L> (DFA_complement (NFA_determinise (\<alpha> n2))) = lists (\<Sigma> (\<alpha> n2)) - \<L> (\<alpha> n2)"
    using  DFA.DFA_complement_\<L>[OF NFA_determinise_is_DFA[OF NFA_n2]]
           NFA_determinise_\<L>[OF NFA_n2]
    by simp

  from iso_cdn2 have NFA_cdn2: "NFA (DFA_complement (NFA_determinise (\<alpha> n2)))"
    unfolding NFA_isomorphic_wf_alt_def by simp

  have "\<L> (\<alpha> (bc (\<and>) n1 (c (d n2)))) = \<L> (NFA_product (\<alpha> n1) (DFA_complement (NFA_determinise (\<alpha> n2))))"
    using NFA_isomorphic_wf_\<L>[OF iso_res] .
  with NFA_product_\<L> [OF NFA_n1 NFA_cdn2] L_cdn2_eq
  have L_res_eq: "\<L> (\<alpha> (bc (\<and>) n1 (c (d n2)))) = \<L> (\<alpha> n1) \<inter> (lists (\<Sigma> (\<alpha> n2)) - \<L> (\<alpha> n2))" by simp

  from nfa_language_is_empty.language_is_empty_correct [OF is_emp_OK, OF invar_res]
  have emp_eq: "is_emp (bc (\<and>) n1 (c (d n2))) = (\<L> (\<alpha> (bc (\<and>) n1 (c (d n2)))) = {})" by simp

  have L_n1_subset: "\<L> (\<alpha> n1) \<subseteq> lists (\<Sigma> (\<alpha> n1))"
     using NFA.NFA_\<L>___lists_\<Sigma>[OF NFA_n1] by simp
  have L_n2_subset: "\<L> (\<alpha> n2) \<subseteq> lists (\<Sigma> (\<alpha> n2))"
     using NFA.NFA_\<L>___lists_\<Sigma>[OF NFA_n2] by simp

  show "NFAGA_language_is_subset d c (bc (\<and>)) is_emp n1 n2 =
       (\<L> (\<alpha> n1) \<subseteq> \<L> (\<alpha> n2))"
    using L_n2_subset L_n1_subset
    unfolding NFAGA_language_is_subset_def emp_eq L_res_eq \<Sigma>_eq
    by auto
qed

definition NFAGA_language_is_eq :: "('nfa \<Rightarrow> 'nfa \<Rightarrow> bool) \<Rightarrow> 'nfa \<Rightarrow> 'nfa \<Rightarrow> bool" where
  "NFAGA_language_is_eq is_sub A1 A2 = (is_sub A1 A2 \<and> is_sub A2 A1)"

lemma NFAGA_language_is_eq_correct :
assumes is_sub_OK: "nfa_language_is_subset \<alpha> invar is_sub"
shows "nfa_language_is_eq \<alpha> invar (NFAGA_language_is_eq is_sub)"
using assms
unfolding nfa_language_is_subset_def nfa_language_is_subset_axioms_def
          nfa_language_is_eq_def nfa_language_is_eq_axioms_def
          NFAGA_language_is_eq_def by auto

end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)
theory Strengthen_Demo

imports "Strengthen"

begin

text \<open>Here's a complicated predicate transformer. You don't need
to understand this, it just makes it easy to set up some complicated
example goals below.\<close>
definition
  "predt f g h P x y = (\<exists>x'. (\<exists>y' \<in> f y. x' \<in> g y' ` h y) \<and> P x x')"

text \<open>Strengthen performs the same kinds of steps as
intro/elim rules, but it can perform them within complex
conclusions. Here's an example where we replace Q with P
(strengthening the goal) deep within some quantifiers.\<close>

lemma predt_double_mono:
  assumes PQ: "\<And>x y. P x y \<longrightarrow> Q x y"
  assumes P: "predt f g h (predt f g h' P) x y"
  shows "predt f g h (predt f g h' Q) x y"
  using P
  apply (simp add: predt_def)
  apply (strengthen PQ)
  apply assumption
  done

text \<open>Here's a more conventional monotonicity proof.
Once the clarsimp has finished, the goal becomes a bit
difficult to prove. Let's use some fancy strengthen
features to address this. The rest of this demo will
explain what the attribute and fancy features are doing,
and thus how this proof works.\<close>

lemma predt_double_mono2:
  assumes PQ: "\<And>x y. P x y \<longrightarrow> Q x y"
  assumes P: "predt f g h (predt f g' h P) x y"
  shows "predt f g h (predt f g' h Q) x y"
  using P
  apply (clarsimp simp: predt_def)
  apply (strengthen bexI[mk_strg I _ A])
  apply (strengthen image_eqI[mk_strg I _ A])
  apply simp
  apply (strengthen bexI[mk_strg I _ O], assumption)
  apply (strengthen image_eqI[mk_strg I _ E])
  apply simp
  apply (simp add: PQ)
  done

text \<open>The @{attribute mk_strg} controls the way that
strengthen applies a rule. By default, strengthen will
use a rule as an introduction rule, trying to replace
the rule's conclusion with its premises.

Once the @{attribute mk_strg} attribute has applied, the
rule is formatted showing how strengthen will try to
transform components of a goal. The syntax of the
second theorem is reversed, showing that strengthen will
attempt to replace instances of the subset predicate
with instances of the proper subset predicate.
\<close>
thm psubset_imp_subset psubset_imp_subset[mk_strg]

text \<open>Rules can have any number of premises, or none,
and still be used as strengthen rules.\<close>
thm subset_UNIV subset_UNIV[mk_strg]
    equalityI equalityI[mk_strg]

text \<open>Rules which would introduce schematics are
adjusted by @{attribute mk_strg} to introduce quantifiers
instead. The argument I to mk_strg prevents this step.
\<close>
thm subsetD subsetD[mk_strg I] subsetD[mk_strg]

text \<open>The first argument to mk_strg controls the way
the rule will be applied.
  I: use rule in introduction style, matching its conclusion.
  D: use rule in destruction (forward) style, matching its first premise.
  I': like I, replace new schematics with existential quantifiers.
  D': like D, replace new schematics with universal quantifiers.

The default is I'.
\<close>
thm subsetD subsetD[mk_strg I] subsetD[mk_strg I']
  subsetD[mk_strg D] subsetD[mk_strg D']

text \<open>Note that I and D rules will be applicable at different
sites.\<close>
lemma
  assumes PQ: "P \<Longrightarrow> Q"
  shows "{x. Suc 0 < x \<and> P} \<subseteq> {x. Suc 0 < x \<and> Q}"
  (* adjust Q into P on rhs *)
  apply (strengthen PQ[mk_strg I])
  (* adjust P into Q on lhs *)
  apply (strengthen PQ[mk_strg D])
  (* oops, overdid it *)
  oops

text \<open>Subsequent arguments to mk_strg capture premises for
special treatment. The 'A' argument (synonym 'E') specifies that
a premise should be solved by assumption. Our fancy proof above
used a strengthen rule bexI[mk_strg I _ A], which tells strengthen
to do approximately the same thing as
\<open>apply (rule bexI) prefer 2 apply assumption\<close>

This is a useful way to apply a rule, picking the premise which
will cause unknowns to be instantiated correctly.
\<close>
thm eq_mem_trans eq_mem_trans[mk_strg I _ _] eq_mem_trans[mk_strg I A _]
    eq_mem_trans[mk_strg I _ A] eq_mem_trans[mk_strg I A A]

text \<open>The 'O' argument ("obligation") picks out premises of
a rule for immediate attention as new subgoals.

The step
\<open>apply (strengthen bexI[mk_strg I _ O], assumption)\<close>
in our proof above had the same effect as strengthening with
@{thm bexI[mk_strg I _ A]}.

This option suits special cases where a particular premise is best
handled by a specialised method.
\<close>
thm eq_mem_trans eq_mem_trans[mk_strg I _ _] eq_mem_trans[mk_strg I O _]
    eq_mem_trans[mk_strg I _ O] eq_mem_trans[mk_strg I O O]

end


theory Proof_5_2
  imports Requirements VCTheoryLemmas
begin

abbreviation s where "s s0 requestButton_value \<equiv> (toEnv
          (setPstate (setVarBool (setVarAny s0 requestButton_value) redAfterMinimalRed PRESSED) Ctrl
            redAfterMinimalRed))"

lemma VC2_R5_aux1: "toEnvP s2 \<and> toEnvP s0 \<and> substate s2 s0 \<and> toEnvNum s2 s3 < T1 \<and> s3 = s s0 requestButton_value \<Longrightarrow>
toEnvNum s2 s0 < T1"
  apply auto
  apply(simp split: if_splits)
  using substate_refl substate_asym[of s0 "s s0 requestButton_value"] by  auto

lemma VC2_R5: " (toEnvP s0 \<and>
        (\<forall>s1 s2 s3.
            substate s1 s2 \<and>
            substate s2 s3 \<and>
            substate s3 s0 \<and>
            toEnvP s1 \<and>
            toEnvP s2 \<and>
            toEnvP s3 \<and>
            toEnvNum s1 s2 = Ctrl \<and>
            toEnvNum s2 s3 < T1 \<and> getVarBool s1 minimalRed \<noteq> NOT_PRESSED \<and> getVarBool s2 minimalRed = NOT_PRESSED \<longrightarrow>
            getVarBool s3 minimalRed = NOT_PRESSED)) \<and>
       env (setVarAny s0 requestButton_value) requestButton_value \<and>
       getPstate (setVarAny s0 requestButton_value) Ctrl = minimalRed \<and>
       getVarBool (setVarAny s0 requestButton_value) Ctrl \<and>
       MINIMAL_RED_TIME_LIMIT
       \<le> ltimeEnv (setVarBool (setVarAny s0 requestButton_value) redAfterMinimalRed PRESSED) Ctrl \<Longrightarrow>
       substate s1 s2 \<and>
       substate s2 s3 \<and>
       substate s3 (s s0 requestButton_value) \<and>
       toEnvP s1 \<and>
       toEnvP s2 \<and>
       toEnvP s3 \<and>
       toEnvNum s1 s2 = Ctrl \<and>
       toEnvNum s2 s3 < T1 \<and> getVarBool s1 minimalRed \<noteq> NOT_PRESSED \<and> getVarBool s2 minimalRed = NOT_PRESSED \<Longrightarrow>
       getVarBool s3 minimalRed = NOT_PRESSED"
  apply(cases "s3 = s s0 requestButton_value")
   apply(cases "s2 = s s0 requestButton_value")
    apply blast
   apply(rule cut_rl[of "substate s2 s0"])
    apply(rule cut_rl[of "getVarBool s0 trafficLight = RED"])
  apply (metis getVarBool.simps(2) getVarBool.simps(4) getVarBool.simps(6) getVarBool.simps(7) numeral_eq_iff one_eq_numeral_iff semiring_norm(85) semiring_norm(89))
    apply(drule conjE)
     prefer 2
     apply assumption
apply(drule conjE)
     prefer 2
     apply assumption
apply(drule conjE)
     prefer 2
     apply assumption
apply(drule allE[of _ s1])
     prefer 2
  apply assumption
   apply(drule allE[of _ s2])
     prefer 2
     apply assumption
apply(drule allE[of _ s0])
     prefer 2
     apply assumption
    apply(rule cut_rl[of "toEnvNum s2 s0 < T1"])
  using substate_refl apply fast
    apply((rule VC2_R5_aux1);fast)
  apply (metis substate.simps(2) substate.simps(4) substate.simps(6) substate.simps(7) toEnvP.simps(4) toEnvP.simps(6) toEnvP.simps(7))
  apply(rule cut_rl [of "substate s3 s0"])
   apply blast
  by (metis substate.simps(2) substate.simps(4) substate.simps(6) substate.simps(7) toEnvP.simps(4) toEnvP.simps(6) toEnvP.simps(7))

theorem proof_5_2: "VC2 R5 s0 requestButton_value"
  apply(simp only: VC2_def R5_def)
  apply(rule impI)
  apply(rule conjI)
   apply simp
  apply((rule allI);(rule allI);(rule allI))
  apply(rule impI)
  by ((rule VC2_R5);assumption)