(* VDM to Isabelle Translation @2022-05-26T11:45:34.996Z
   Copyright 2021, Leo Freitas, leo.freitas@newcastle.ac.uk

in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 12:5
files = [/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl]
*)
theory TestV2IFcns_PO
imports TestV2IFcns
begin

\<comment>\<open>VDM source: constS = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 12:5\<close>

definition
	PO_01_constS_FUNC_POST_CONDITION :: "\<bool>"
where
	"PO_01_constS_FUNC_POST_CONDITION  \<equiv> ((pre_constS ) \<longrightarrow> (post_constS (10::VDMNat1)))"

\<comment>\<open>VDM source: g = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 22:5\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_02_g_FUNC_POST_CONDITION :: "\<bool>"
where
	"PO_02_g_FUNC_POST_CONDITION  \<equiv> (\<forall> (x :: VDMNat)   (y :: VDMNat1)  . ((((inv_VDMNat x)))  \<and>  (((inv_VDMNat1 y))) \<longrightarrow> ((pre_g x  y) \<longrightarrow> (post_g x  y  (x + y)))))"

\<comment>\<open>VDM source: h = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 30:18\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_03_h_SUB_TYPE :: "\<bool>"
where
	"PO_03_h_SUB_TYPE  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> (x > (0::VDMNat))))"

\<comment>\<open>VDM source: h = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 28:5\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_04_h_FUNC_POST_CONDITION :: "\<bool>"
where
	"PO_04_h_FUNC_POST_CONDITION  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h x) \<longrightarrow> (post_h x  (g x  x)))))"

\<comment>\<open>VDM source: h = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 31:20\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_05_h_SUB_TYPE :: "\<bool>"
where
	"PO_05_h_SUB_TYPE  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h x) \<longrightarrow> (
		let
(RESULT::VDMNat) = (g x  x)
		in

			(if ((inv_VDMNat RESULT)) then
			(x > (0::VDMNat))
		 else
			undefined
		)
		))))"

\<comment>\<open>VDM source: h = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 31:23\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_06_h_SUB_TYPE :: "\<bool>"
where
	"PO_06_h_SUB_TYPE  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h x) \<longrightarrow> (
		let
(RESULT::VDMNat) = (g x  x)
		in

			(if ((inv_VDMNat RESULT)) then
			(RESULT > (0::VDMNat))
		 else
			undefined
		)
		))))"

\<comment>\<open>VDM source: h = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 29:13\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_07_h_FUNC_APPLY :: "\<bool>"
where
	"PO_07_h_FUNC_APPLY  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h x) \<longrightarrow> (pre_g x  x))))"

\<comment>\<open>VDM source: h = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 29:18\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_08_h_SUB_TYPE :: "\<bool>"
where
	"PO_08_h_SUB_TYPE  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h x) \<longrightarrow> (x > (0::VDMNat)))))"

\<comment>\<open>VDM source: h' = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 34:5\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_09_h'_FUNC_POST_CONDITION :: "\<bool>"
where
	"PO_09_h'_FUNC_POST_CONDITION  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h' x) \<longrightarrow> (post_h' x  (g x  x)))))"

\<comment>\<open>VDM source: h' = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 35:14\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_10_h'_FUNC_APPLY :: "\<bool>"
where
	"PO_10_h'_FUNC_APPLY  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h' x) \<longrightarrow> (pre_g x  x))))"

\<comment>\<open>VDM source: h' = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 35:19\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_11_h'_SUB_TYPE :: "\<bool>"
where
	"PO_11_h'_SUB_TYPE  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h' x) \<longrightarrow> (x > (0::VDMNat)))))"

\<comment>\<open>VDM source: h'' = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 40:5\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_12_h''_FUNC_POST_CONDITION :: "\<bool>"
where
	"PO_12_h''_FUNC_POST_CONDITION  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h'' x) \<longrightarrow> (post_h'' x  (g x  x)))))"

\<comment>\<open>VDM source: h'' = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 43:18\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_13_h''_SUB_TYPE :: "\<bool>"
where
	"PO_13_h''_SUB_TYPE  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h'' x) \<longrightarrow> (
		let
(RESULT::VDMNat) = (g x  x)
		in

			(if ((inv_VDMNat RESULT)) then
			(RESULT > (0::VDMNat))
		 else
			undefined
		)
		))))"

\<comment>\<open>VDM source: h'' = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 41:15\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_14_h''_FUNC_APPLY :: "\<bool>"
where
	"PO_14_h''_FUNC_APPLY  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h'' x) \<longrightarrow> (pre_g x  x))))"

\<comment>\<open>VDM source: h'' = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 41:20\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_15_h''_SUB_TYPE :: "\<bool>"
where
	"PO_15_h''_SUB_TYPE  \<equiv> (\<forall> (x :: VDMNat)  . ((((inv_VDMNat x))) \<longrightarrow> ((pre_h'' x) \<longrightarrow> (x > (0::VDMNat)))))"

\<comment>\<open>VDM source: curriedS = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 50:5\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_16_curriedS_FUNC_POST_CONDITION :: "\<bool>"
where
	"PO_16_curriedS_FUNC_POST_CONDITION  \<equiv> (\<forall> (x :: VDMNat)   (y :: VDMNat)  . ((((inv_VDMNat x)))  \<and>  (((inv_VDMNat y))) \<longrightarrow> (((pre_curriedS x) y) \<longrightarrow> ((post_curriedS x) y  (x + y)))))"

\<comment>\<open>VDM source: implicit = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 56:15\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_17_implicit_TOTAL :: "\<bool>"
where
	"PO_17_implicit_TOTAL  \<equiv> (\<forall> (x :: VDMNat)   (y :: VDMNat)   (z :: VDMNat VDMSet)  . ((((inv_VDMNat x)))  \<and>  (((inv_VDMNat y)))  \<and>  (((inv_VDMSet' (inv_VDMNat) z))) \<longrightarrow> isTest ((pre_implicit x  y  z)) (inv_bool)))"

\<comment>\<open>VDM source: implicit = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 55:5\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_18_implicit_FUNC_SATISFIABILITY :: "\<bool>"
where
	"PO_18_implicit_FUNC_SATISFIABILITY  \<equiv> (\<forall> (x :: VDMNat)   (y :: VDMNat)   (z :: VDMNat VDMSet)  . ((((inv_VDMNat x)))  \<and>  (((inv_VDMNat y)))  \<and>  (((inv_VDMSet' (inv_VDMNat) z))) \<longrightarrow> ((pre_implicit x  y  z) \<longrightarrow> (\<exists> (r :: VDMNat VDMSeq)  . ((((inv_VDMSeq' (inv_VDMNat) r))) \<longrightarrow> (post_implicit x  y  z  r))))))"

\<comment>\<open>VDM source: implicitexplicit = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 61:15\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_19_implicitexplicit_TOTAL :: "\<bool>"
where
	"PO_19_implicitexplicit_TOTAL  \<equiv> (\<forall> (x :: VDMNat)   (y :: VDMNat)   (z :: VDMNat VDMSet)  . ((((inv_VDMNat x)))  \<and>  (((inv_VDMNat y)))  \<and>  (((inv_VDMSet' (inv_VDMNat) z))) \<longrightarrow> isTest ((pre_implicitexplicit x  y  z)) (inv_bool)))"

\<comment>\<open>VDM source: implicitexplicit = ?\<close>
\<comment>\<open>in 'TestV2IFcns' (/Users/nljsf/Local/reps/git/VDM_Toolkit/plugins/vdm2isa/src/test/resources/TestV2IFcns.vdmsl) at line 59:5\<close>

\<comment>\<open>Implicitly defined type invariant checks for quantified type binds\<close>

definition
	PO_20_implicitexplicit_FUNC_POST_CONDITION :: "\<bool>"
where
	"PO_20_implicitexplicit_FUNC_POST_CONDITION  \<equiv> (\<forall> (x :: VDMNat)   (y :: VDMNat)   (z :: VDMNat VDMSet)  . ((((inv_VDMNat x)))  \<and>  (((inv_VDMNat y)))  \<and>  (((inv_VDMSet' (inv_VDMNat) z))) \<longrightarrow> ((pre_implicitexplicit x  y  z) \<longrightarrow> (post_implicitexplicit x  y  z  [x , y]))))"

\<comment>\<open>Processing VDM exports as Isabelle hidden declarations\<close>

locale TestV2IFcns_POG =
	assumes
			 TestV2IFcns_PO_01: PO_01_constS_FUNC_POST_CONDITION
	 and TestV2IFcns_PO_02: PO_02_g_FUNC_POST_CONDITION
	 and TestV2IFcns_PO_03: PO_03_h_SUB_TYPE
	 and TestV2IFcns_PO_04: PO_04_h_FUNC_POST_CONDITION
	 and TestV2IFcns_PO_05: PO_05_h_SUB_TYPE
	 and TestV2IFcns_PO_06: PO_06_h_SUB_TYPE
	 and TestV2IFcns_PO_07: PO_07_h_FUNC_APPLY
	 and TestV2IFcns_PO_08: PO_08_h_SUB_TYPE
	 and TestV2IFcns_PO_09: PO_09_h'_FUNC_POST_CONDITION
	 and TestV2IFcns_PO_10: PO_10_h'_FUNC_APPLY
	 and TestV2IFcns_PO_11: PO_11_h'_SUB_TYPE
	 and TestV2IFcns_PO_12: PO_12_h''_FUNC_POST_CONDITION
	 and TestV2IFcns_PO_13: PO_13_h''_SUB_TYPE
	 and TestV2IFcns_PO_14: PO_14_h''_FUNC_APPLY
	 and TestV2IFcns_PO_15: PO_15_h''_SUB_TYPE
	 and TestV2IFcns_PO_16: PO_16_curriedS_FUNC_POST_CONDITION
	 and TestV2IFcns_PO_17: PO_17_implicit_TOTAL
	 and TestV2IFcns_PO_18: PO_18_implicit_FUNC_SATISFIABILITY
	 and TestV2IFcns_PO_19: PO_19_implicitexplicit_TOTAL
	 and TestV2IFcns_PO_20: PO_20_implicitexplicit_FUNC_POST_CONDITION
begin
	\<comment>\<open>User defined lemmas for TestV2IFcns POs\<close>
end

lemma TestV2IFcns_POG_l1[simp]: \<open>PO_01_constS_FUNC_POST_CONDITION\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	 by (simp add: PO_01_constS_FUNC_POST_CONDITION_def inv_VDMNat_def post_constS_def)

lemma TestV2IFcns_POG_l2[simp]: \<open>PO_02_g_FUNC_POST_CONDITION\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	 using PO_02_g_FUNC_POST_CONDITION_def inv_VDMNat1_def inv_VDMNat_def post_g_def by force

lemma TestV2IFcns_POG_l3[simp]: \<open>PO_03_h_SUB_TYPE\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	nitpick

	oops

lemma TestV2IFcns_POG_l4[simp]: \<open>PO_04_h_FUNC_POST_CONDITION\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	 by (smt (verit, ccfv_SIG) PO_02_g_FUNC_POST_CONDITION_def PO_04_h_FUNC_POST_CONDITION_def TestV2IFcns_POG_l2 g_def inv_VDMNat_def post_h_def pre_g_def pre_h_def)

lemma TestV2IFcns_POG_l5[simp]: \<open>PO_05_h_SUB_TYPE\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	 by (simp add: PO_05_h_SUB_TYPE_def g_def inv_VDMNat_def pre_g_def pre_h_def)

lemma TestV2IFcns_POG_l6[simp]: \<open>PO_06_h_SUB_TYPE\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	 using PO_05_h_SUB_TYPE_def PO_06_h_SUB_TYPE_def g_def by fastforce

lemma TestV2IFcns_POG_l7[simp]: \<open>PO_07_h_FUNC_APPLY\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	 using PO_07_h_FUNC_APPLY_def pre_h_def by blast

lemma TestV2IFcns_POG_l8[simp]: \<open>PO_08_h_SUB_TYPE\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	 using PO_08_h_SUB_TYPE_def pre_g_def pre_h_def by force

lemma TestV2IFcns_POG_l9[simp]: \<open>PO_09_h'_FUNC_POST_CONDITION\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	nitpick

	oops

lemma TestV2IFcns_POG_l10[simp]: \<open>PO_10_h'_FUNC_APPLY\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	nitpick

	oops

lemma TestV2IFcns_POG_l11[simp]: \<open>PO_11_h'_SUB_TYPE\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	nitpick

	oops

lemma TestV2IFcns_POG_l12[simp]: \<open>PO_12_h''_FUNC_POST_CONDITION\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	nitpick

	oops

lemma TestV2IFcns_POG_l13[simp]: \<open>PO_13_h''_SUB_TYPE\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	nitpick

	oops

lemma TestV2IFcns_POG_l14[simp]: \<open>PO_14_h''_FUNC_APPLY\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	nitpick

	oops

lemma TestV2IFcns_POG_l15[simp]: \<open>PO_15_h''_SUB_TYPE\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	nitpick

	oops

lemma TestV2IFcns_POG_l16[simp]: \<open>PO_16_curriedS_FUNC_POST_CONDITION\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	nitpick

	oops

lemma TestV2IFcns_POG_l17[simp]: \<open>PO_17_implicit_TOTAL\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	 by (simp add: PO_17_implicit_TOTAL_def)

named_theorems Fcns_defs and Fcns_PO_defs

lemmas [Fcns_PO_defs] = PO_18_implicit_FUNC_SATISFIABILITY_def
lemmas [Fcns_defs] = post_implicit_def pre_implicit_def Fcns_PO_defs

lemma TestV2IFcns_POG_l18[simp]: \<open>PO_18_implicit_FUNC_SATISFIABILITY\<close>
  thm Fcns_PO_defs
  apply (simp add: Fcns_PO_defs, safe?)+
  thm Fcns_defs
  apply (simp add: Fcns_defs, safe?)+
  thm VDM_seq_defs
  apply (simp add: VDM_seq_defs, safe?)+
  apply (simp add: VDM_set_defs, safe?)+
  apply (simp add: VDM_basic_defs, safe?)+
  apply (metis diff_ge_0_iff_ge inv_VDMNat_def inv_VDMSeq'_defs(2) l_inv_SeqElems_append not_one_le_zero)
  oops

lemma TestV2IFcns_POG_l18[simp]: \<open>PO_18_implicit_FUNC_SATISFIABILITY\<close>
  apply (simp add: VDM_basic_defs VDM_set_defs VDM_seq_defs Fcns_defs, safe?)+
  by (metis diff_ge_0_iff_ge inv_VDMNat_def inv_VDMSeq'_defs(2) l_inv_SeqElems_append not_one_le_zero)

lemma TestV2IFcns_POG_l18[simp]: \<open>PO_18_implicit_FUNC_SATISFIABILITY\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	unfolding PO_18_implicit_FUNC_SATISFIABILITY_def
  apply (safe?, simp?)
  unfolding post_implicit_def pre_implicit_def
  apply (safe?, simp?)
  unfolding inv_VDMSeq'_def inv_SeqElems_def
  apply (safe?, simp?)
  unfolding inv_VDMSet'_def inv_VDMSet_def inv_SetElems_def
  apply (safe?, simp?)
  unfolding inv_VDMNat_def
  by (metis diff_ge_0_iff_ge inv_VDMSeq'_defs(2) l_inv_SeqElems_append not_one_le_zero)

lemma TestV2IFcns_POG_l19[simp]: \<open>PO_19_implicitexplicit_TOTAL\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	 by (simp add: PO_19_implicitexplicit_TOTAL_def)

lemma TestV2IFcns_POG_l20[simp]: \<open>PO_20_implicitexplicit_FUNC_POST_CONDITION\<close>
	 \<comment>\<open>Inferred proof strategy for lemma:\<close>
	unfolding PO_20_implicitexplicit_FUNC_POST_CONDITION_def
  apply (safe?, simp?)
  unfolding post_implicitexplicit_def pre_implicitexplicit_def
  apply (safe?, simp?)
  unfolding inv_VDMSeq'_def inv_SeqElems_def
  apply (safe?, simp?)
  unfolding inv_VDMSet'_def inv_VDMSet_def inv_SetElems_def
  apply (safe?, simp?)
  unfolding inv_VDMNat_def
  oops

interpretation TestV2IFcns_POG
	 	apply unfold_locales
	apply simp_all
  oops
end


(*  Title:       TLList_CCPO.thy
    Author:      Andreas Lochbihler, ETH Zurich
*)

section \<open>Ccpo structure for terminated lazy lists\<close>

theory TLList_CCPO imports TLList begin

lemma Set_is_empty_parametric [transfer_rule]:
  includes lifting_syntax
  shows "(rel_set A ===> (=)) Set.is_empty Set.is_empty"
by(auto simp add: rel_fun_def Set.is_empty_def dest: rel_setD1 rel_setD2)

lemma monotone_comp: "\<lbrakk> monotone orda ordb g; monotone ordb ordc f \<rbrakk> \<Longrightarrow> monotone orda ordc (f \<circ> g)"
by(rule monotoneI)(simp add: monotoneD)

lemma mcont_comp: "\<lbrakk> mcont luba orda lubb ordb g; mcont lubb ordb lubc ordc f \<rbrakk> \<Longrightarrow> mcont luba orda lubc ordc (f \<circ> g)"
by(auto simp add: mcont_def intro: cont_comp monotone_comp)

context includes lifting_syntax
begin

lemma monotone_parametric [transfer_rule]:
  assumes [transfer_rule]: "bi_total A"
  shows "((A ===> A ===> (=)) ===> (B ===> B ===> (=)) ===> (A ===> B) ===> (=)) monotone monotone"
unfolding monotone_def[abs_def] by transfer_prover

lemma cont_parametric [transfer_rule]:
  assumes [transfer_rule]: "bi_total A" "bi_unique B"
  shows "((rel_set A ===> A) ===> (A ===> A ===> (=)) ===> (rel_set B ===> B) ===> (B ===> B ===> (=)) ===> (A ===> B) ===> (=)) cont cont"
unfolding cont_def[abs_def] Set.is_empty_def[symmetric] by transfer_prover

lemma mcont_parametric [transfer_rule]:
  assumes [transfer_rule]: "bi_total A" "bi_unique B"
  shows "((rel_set A ===> A) ===> (A ===> A ===> (=)) ===> (rel_set B ===> B) ===> (B ===> B ===> (=)) ===> (A ===> B) ===> (=)) mcont mcont"
unfolding mcont_def[abs_def] by transfer_prover

end

lemma (in ccpo) Sup_Un_less:
  assumes chain: "Complete_Partial_Order.chain (\<le>) (A \<union> B)"
  and AB: "\<forall>x\<in>A. \<exists>y\<in>B. x \<le> y"
  shows "Sup (A \<union> B) = Sup B"
proof(rule antisym)
  from chain have chain': "Complete_Partial_Order.chain (\<le>) B"
    by(blast intro: chain_subset)
  show "Sup (A \<union> B) \<le> Sup B" using chain
  proof(rule ccpo_Sup_least)
    fix x
    assume "x \<in> A \<union> B"
    thus "x \<le> Sup B"
    proof
      assume "x \<in> A"
      then obtain y where "x \<le> y" "y \<in> B" using AB by blast
      note \<open>x \<le> y\<close>
      also from chain' \<open>y \<in> B\<close> have "y \<le> Sup B" by(rule ccpo_Sup_upper)
      finally show ?thesis .
    qed(rule ccpo_Sup_upper[OF chain'])
  qed
  show "Sup B \<le> Sup (A \<union> B)"
    using chain chain' by(blast intro: ccpo_Sup_least ccpo_Sup_upper)
qed

subsection \<open>The ccpo structure\<close>

context includes tllist.lifting fixes b :: 'b begin

lift_definition tllist_ord :: "('a, 'b) tllist \<Rightarrow> ('a, 'b) tllist \<Rightarrow> bool"
is "\<lambda>(xs1, b1) (xs2, b2). if lfinite xs1 then b1 = b \<and> lprefix xs1 xs2 \<or> xs1 = xs2 \<and> flat_ord b b1 b2 else xs1 = xs2"
by auto

lift_definition tSup :: "('a, 'b) tllist set \<Rightarrow> ('a, 'b) tllist"
is "\<lambda>A. (lSup (fst ` A), flat_lub b (snd ` (A \<inter> {(xs, _). lfinite xs})))"
proof goal_cases
  case (1 A1 A2)
  hence "fst ` A1 = fst ` A2" "snd ` (A1 \<inter> {(xs, _). lfinite xs}) = snd ` (A2 \<inter> {(xs, _). lfinite xs})"
    by(auto 4 3 simp add: rel_set_def intro: rev_image_eqI)
  thus ?case by simp
qed

lemma tllist_ord_simps [simp, code]: (* FIXME: does not work with transfer *)
  shows tllist_ord_TNil_TNil: "tllist_ord (TNil b1) (TNil b2) \<longleftrightarrow> flat_ord b b1 b2"
  and tllist_ord_TNil_TCons: "tllist_ord (TNil b1) (TCons y ys) \<longleftrightarrow> b1 = b"
  and tllist_ord_TCons_TNil: "tllist_ord (TCons x xs) (TNil b2) \<longleftrightarrow> False"
  and tllist_ord_TCons_TCons: "tllist_ord (TCons x xs) (TCons y ys) \<longleftrightarrow> x = y \<and> tllist_ord xs ys"
by(auto simp add: tllist_ord.rep_eq flat_ord_def)

lemma tllist_ord_refl [simp]: "tllist_ord xs xs"
by transfer(auto simp add: flat_ord_def)

lemma tllist_ord_antisym: "\<lbrakk> tllist_ord xs ys; tllist_ord ys xs \<rbrakk> \<Longrightarrow> xs = ys"
by transfer(auto simp add: flat_ord_def split: if_split_asm intro: lprefix_antisym)

lemma tllist_ord_trans [trans]: "\<lbrakk> tllist_ord xs ys; tllist_ord ys zs \<rbrakk> \<Longrightarrow> tllist_ord xs zs"
by transfer(auto simp add: flat_ord_def split: if_split_asm intro: lprefix_trans)

lemma chain_tllist_llist_of_tllist:
  assumes "Complete_Partial_Order.chain tllist_ord A"
  shows "Complete_Partial_Order.chain lprefix (llist_of_tllist ` A)"
by(rule chainI)(auto 4 3 simp add: tllist_ord.rep_eq split: if_split_asm dest: chainD[OF assms])

lemma chain_tllist_terminal:
  assumes "Complete_Partial_Order.chain tllist_ord A"
  shows "Complete_Partial_Order.chain (flat_ord b) {terminal xs|xs. xs \<in> A \<and> tfinite xs}"
by(rule chainI)(auto simp add: tllist_ord.rep_eq flat_ord_def dest: chainD[OF assms])

lemma flat_ord_chain_finite:
  assumes "Complete_Partial_Order.chain (flat_ord b) A"
  shows "finite A"
proof -
  from assms have "\<exists>z. \<forall>x\<in>A. x = b \<or> x = z"
    by(clarsimp simp add: chain_def flat_ord_def) metis
  then obtain z where "\<And>x. x \<in> A \<Longrightarrow> x = b \<or> x = z" by blast
  hence "A \<subseteq> {b, z}" by auto
  thus ?thesis by(rule finite_subset) simp
qed

lemma tSup_empty [simp]: "tSup {} = TNil b"
by(transfer)(simp add: flat_lub_def)

lemma is_TNil_tSup [simp]: "is_TNil (tSup A) \<longleftrightarrow> (\<forall>x\<in>A. is_TNil x)"
by transfer(simp add: split_beta)

lemma chain_tllist_ord_tSup:
  assumes chain: "Complete_Partial_Order.chain tllist_ord A"
  and A: "xs \<in> A"
  shows "tllist_ord xs (tSup A)"
proof(cases "tfinite xs")
  case True
  show ?thesis
  proof(cases "llist_of_tllist xs = llist_of_tllist (tSup A)")
    case True
    with \<open>tfinite xs\<close> have "lfinite (lSup (llist_of_tllist ` A))"
      by(simp add: tSup_def image_image)
    hence "terminal (tSup A) = flat_lub b {terminal xs|xs. xs \<in> A \<and> tfinite xs}" (is "_ = flat_lub _ ?A")
      by(simp add: tSup_def terminal_tllist_of_llist image_image)(auto intro: rev_image_eqI intro!: arg_cong[where f="flat_lub b"])
    moreover have "flat_ord b (terminal xs) (flat_lub b ?A)"
      by(rule ccpo.ccpo_Sup_upper[OF Partial_Function.ccpo[OF flat_interpretation]])(blast intro: chain_tllist_terminal[OF chain] A \<open>tfinite xs\<close>)+
    ultimately show ?thesis using True by(simp add: tllist_ord.rep_eq)
  next
    case False
    hence "\<exists>ys\<in>A. \<not> tllist_ord ys xs"
      by(rule contrapos_np)(auto intro!: lprefix_antisym chain_lSup_lprefix chain_lprefix_lSup simp add: tSup_def image_image A chain_tllist_llist_of_tllist[OF chain] tllist_ord.rep_eq split: if_split_asm)
    then obtain ys where "ys \<in> A" "\<not> tllist_ord ys xs" by blast
    with A have "tllist_ord xs ys" "xs \<noteq> ys" by(auto dest: chainD[OF chain])
    with True have "terminal xs = b" by transfer(auto simp add: flat_ord_def)
    with True False show ?thesis
      by(simp add: tllist_ord.rep_eq tSup_def image_image chain_lprefix_lSup chain_tllist_llist_of_tllist chain A)
  qed
next
  case False
  thus ?thesis using assms by(simp add: tllist_ord.rep_eq tSup_def image_image chain_lprefix_lSup chain_tllist_llist_of_tllist not_lfinite_lprefix_conv_eq[THEN iffD1] terminal_tllist_of_llist split: if_split_asm)
qed

lemma chain_tSup_tllist_ord:
  assumes chain: "Complete_Partial_Order.chain tllist_ord A"
  and lub: "\<And>xs'. xs' \<in> A \<Longrightarrow> tllist_ord xs' xs"
  shows "tllist_ord (tSup A) xs"
proof -
  have "\<And>xs'. xs' \<in> llist_of_tllist ` A \<Longrightarrow> lprefix xs' (llist_of_tllist xs)"
    by(auto dest!: lub simp add: tllist_ord.rep_eq split: if_split_asm)
  with chain_tllist_llist_of_tllist[OF chain]
  have prefix: "lprefix (lSup (llist_of_tllist ` A)) (llist_of_tllist xs)"
    by(rule chain_lSup_lprefix)

  show ?thesis
  proof(cases "tfinite (tSup A)")
    case False thus ?thesis using prefix
      by(simp add: tllist_ord.rep_eq tSup_def image_image not_lfinite_lprefix_conv_eq[THEN iffD1])
  next
    case True
    from True have fin: "lfinite (lSup (llist_of_tllist ` A))" by(simp add: tSup_def image_image)
    have eq: "terminal (tSup A) = flat_lub b {terminal xs|xs. xs \<in> A \<and> tfinite xs}" (is "_ = flat_lub _ ?A")
      by(simp add: tSup_def terminal_tllist_of_llist image_image fin)(auto intro: rev_image_eqI intro!: arg_cong[where f="flat_lub b"])

    show ?thesis
    proof(cases "lprefix (llist_of_tllist xs) (lSup (llist_of_tllist ` A))")
      case True
      with prefix have "lSup (llist_of_tllist ` A) = llist_of_tllist xs" by(rule lprefix_antisym)
      moreover have "flat_ord b (flat_lub b ?A) (terminal xs)"
        by(rule ccpo.ccpo_Sup_least[OF Partial_Function.ccpo[OF flat_interpretation]])(auto intro: chain_tllist_terminal[OF chain] dest: lub simp add: tllist_ord.rep_eq flat_ord_def)
      ultimately show ?thesis using eq by(simp add: tllist_ord.rep_eq tSup_def image_image)
    next
      case False
      { fix xs'
        assume "xs' \<in> A"
        with False have "\<not> lprefix (llist_of_tllist xs) (llist_of_tllist xs')"
          by-(erule contrapos_nn, auto 4 4 intro: lprefix_trans chain_lprefix_lSup chain_tllist_llist_of_tllist chain)
        with lub[OF \<open>xs' \<in> A\<close>] have "terminal xs' = b"
          by(auto simp add: tllist_ord.rep_eq split: if_split_asm) }
      with chain_tllist_terminal[OF chain] have "flat_ord b (flat_lub b ?A) b"
        by -(rule ccpo.ccpo_Sup_least[OF Partial_Function.ccpo[OF flat_interpretation]], auto simp add: flat_ord_def)
      hence "flat_lub b ?A = b" by(simp add: flat_ord_def)
      thus ?thesis using True eq prefix
        by(simp add: tSup_def terminal_tllist_of_llist tllist_ord.rep_eq image_image)
    qed
  qed
qed

lemma tllist_ord_ccpo [simp, cont_intro]:
  "class.ccpo tSup tllist_ord (mk_less tllist_ord)"
by unfold_locales(auto simp add: mk_less_def intro: tllist_ord_antisym tllist_ord_trans chain_tllist_ord_tSup chain_tSup_tllist_ord)

lemma tllist_ord_partial_function_definitions: "partial_function_definitions tllist_ord tSup"
by unfold_locales(auto simp add: mk_less_def intro: tllist_ord_antisym tllist_ord_trans chain_tllist_ord_tSup chain_tSup_tllist_ord)

interpretation tllist: partial_function_definitions "tllist_ord" "tSup"
by(rule tllist_ord_partial_function_definitions)

lemma admissible_mcont_is_TNil [THEN admissible_subst, cont_intro, simp]:
  shows admissible_is_TNil: "ccpo.admissible tSup tllist_ord is_TNil"
by(rule ccpo.admissibleI)(simp)

lemma terminal_tSup:
  "\<forall>xs\<in>Y. is_TNil xs \<Longrightarrow> terminal (tSup Y) = flat_lub b (terminal ` Y)"
  including tllist.lifting apply transfer
  apply (auto simp add: split_def)
  apply (rule arg_cong [where f = "flat_lub b"])
  apply force
  done

lemma thd_tSup:
  "\<exists>xs \<in> Y. \<not> is_TNil xs
  \<Longrightarrow> thd (tSup Y) = (THE x. x \<in> thd ` (Y \<inter> {xs. \<not> is_TNil xs}))"
apply(simp add: tSup_def image_image)
apply(rule arg_cong[where f=The])
apply(auto intro: rev_image_eqI intro!: ext)
done

lemma ex_TCons_raw_parametric:
  includes lifting_syntax
  shows "(rel_set (rel_prod (llist_all2 A) B) ===> (=)) (\<lambda>Y. \<exists>(xs, b) \<in> Y. \<not> lnull xs) (\<lambda>Y. \<exists>(xs, b) \<in> Y. \<not> lnull xs)"
by(auto 4 4 simp add: rel_fun_def dest: rel_setD1 rel_setD2 llist_all2_lnullD intro: rev_bexI)

lift_definition ex_TCons :: "('a, 'b) tllist set \<Rightarrow> bool"
is "\<lambda>Y. \<exists>(xs, b) \<in> Y. \<not> lnull xs" parametric ex_TCons_raw_parametric
by (blast dest: rel_setD1 rel_setD2)+

lemma ex_TCons_iff: "ex_TCons Y \<longleftrightarrow> (\<exists>xs \<in> Y. \<not> is_TNil xs)"
by transfer auto

lemma retain_TCons_raw_parametric:
  includes lifting_syntax
  shows "(rel_set (rel_prod (llist_all2 A) B) ===> rel_set (rel_prod (llist_all2 A) B))
    (\<lambda>A. A \<inter> {(xs, b). \<not> lnull xs}) (\<lambda>A. A \<inter> {(xs, b). \<not> lnull xs})"
by(rule rel_funI rel_setI)+(auto 4 4 dest: llist_all2_lnullD rel_setD2 rel_setD1 intro: rev_bexI)

lift_definition retain_TCons :: "('a, 'b) tllist set \<Rightarrow> ('a, 'b) tllist set"
is "\<lambda>A. A \<inter> {(xs, b). \<not> lnull xs}" parametric retain_TCons_raw_parametric
by(rule rel_setI)(fastforce dest: rel_setD1 rel_setD2)+

lemma retain_TCons_conv: "retain_TCons A = A \<inter> {xs. \<not> is_TNil xs}"
by(auto simp add: retain_TCons_def intro: rev_image_eqI)

lemma ttl_tSup:
  "\<lbrakk> Complete_Partial_Order.chain tllist_ord Y; \<exists>xs \<in> Y. \<not> is_TNil xs \<rbrakk>
  \<Longrightarrow> ttl (tSup Y) = tSup (ttl ` (Y \<inter> {xs. \<not> is_TNil xs}))"
unfolding ex_TCons_iff[symmetric] retain_TCons_conv[symmetric]
proof (transfer, goal_cases)
  case prems: (1 Y)
  then obtain xs b' where xsb: "(xs, b') \<in> Y" "\<not> lnull xs" by blast
  note chain = prems(1)

  have "flat_lub b (snd ` (Y \<inter> {(xs, _). lfinite xs})) = flat_lub b (insert b (snd ` (Y \<inter> {(xs, _). lfinite xs})))"
    by(auto simp add: flat_lub_def)
  also have "insert b (snd ` (Y \<inter> {(xs, _). lfinite xs})) = insert b (snd ` (apfst ltl ` (Y \<inter> {(xs, b). \<not> lnull xs}) \<inter> {(xs, _). lfinite xs}))"
    apply(auto intro: rev_image_eqI)
    apply(erule contrapos_np)
    apply(frule chainD[OF chain \<open>(xs, b') \<in> Y\<close>])
    using \<open>\<not> lnull xs\<close> xsb
    by(fastforce split: if_split_asm simp add: lprefix_lnull intro!: rev_image_eqI)
  also have "flat_lub b \<dots> = flat_lub b (snd ` (apfst ltl ` (Y \<inter> {(xs, b). \<not> lnull xs}) \<inter> {(xs, _). lfinite xs}))"
    by(auto simp add: flat_lub_def)
  also
  have "ltl ` (fst ` Y \<inter> {xs. \<not> lnull xs}) = fst ` apfst ltl ` (Y \<inter> {(xs, b). \<not> lnull xs})"
    by(auto simp add: image_image)
  ultimately show ?case using prems by clarsimp
qed

lemma tSup_TCons: "A \<noteq> {} \<Longrightarrow> tSup (TCons x ` A) = TCons x (tSup A)"
unfolding Set.is_empty_def[symmetric]
apply transfer
unfolding Set.is_empty_def
apply(clarsimp simp add: image_image lSup_LCons[symmetric])
apply(rule arg_cong[where f="flat_lub b"])
apply(auto 4 3 intro: rev_image_eqI)
done

lemma tllist_ord_terminalD:
  "\<lbrakk> tllist_ord xs ys; is_TNil ys \<rbrakk> \<Longrightarrow> flat_ord b (terminal xs) (terminal ys)"
by(cases xs)(auto simp add: is_TNil_def)

lemma tllist_ord_bot [simp]: "tllist_ord (TNil b) xs"
by(cases xs)(simp_all add: flat_ord_def)

lemma tllist_ord_ttlI:
  "tllist_ord xs ys \<Longrightarrow> tllist_ord (ttl xs) (ttl ys)"
by(cases xs ys rule: tllist.exhaust[case_product tllist.exhaust])(simp_all)

lemma not_is_TNil_conv: "\<not> is_TNil xs \<longleftrightarrow> (\<exists>x xs'. xs = TCons x xs')"
by(cases xs) simp_all

subsection \<open>Continuity of predefined constants\<close>

lemma mono_tllist_ord_case:
  fixes bot
  assumes mono: "\<And>x. monotone tllist_ord ord (\<lambda>xs. f x xs (TCons x xs))"
  and ord: "class.preorder ord (mk_less ord)"
  and bot: "\<And>x. ord (bot b) x"
  shows "monotone tllist_ord ord (\<lambda>xs. case xs of TNil b \<Rightarrow> bot b | TCons x xs' \<Rightarrow> f x xs' xs)"
proof -
  interpret preorder ord "mk_less ord" by (fact ord)
  show ?thesis by(rule monotoneI)(auto split: tllist.split dest: monotoneD[OF mono] simp add: flat_ord_def bot)
qed

lemma mcont_lprefix_case_aux:
  fixes f bot ord
  defines "g \<equiv> \<lambda>xs. f (thd xs) (ttl xs) (TCons (thd xs) (ttl xs))"
  assumes mcont: "\<And>x. mcont tSup tllist_ord lub ord (\<lambda>xs. f x xs (TCons x xs))"
  and ccpo: "class.ccpo lub ord (mk_less ord)"
  and bot: "\<And>x. ord (bot b) x"
  and cont_bot: "cont (flat_lub b) (flat_ord b) lub ord bot"
  shows "mcont tSup tllist_ord lub ord (\<lambda>xs. case xs of TNil b \<Rightarrow> bot b | TCons x xs' \<Rightarrow> f x xs' xs)"
  (is "mcont _ _ _ _ ?f")
proof(rule mcontI)
  interpret b: ccpo lub ord "mk_less ord" by(rule ccpo)

  show "cont tSup tllist_ord lub ord ?f"
  proof(rule contI)
    fix Y :: "('a, 'b) tllist set"
    assume chain: "Complete_Partial_Order.chain tllist_ord Y"
      and Y: "Y \<noteq> {}"
    from chain have chain': "Complete_Partial_Order.chain ord (?f ` Y)"
      by(rule chain_imageI)(auto split: tllist.split simp add: flat_ord_def intro!: bot mcont_monoD[OF mcont])

    show "?f (tSup Y) = lub (?f ` Y)"
    proof(cases "is_TNil (tSup Y)")
      case True
      hence "?f ` Y = bot ` terminal ` Y"
        by(auto 4 3 split: tllist.split intro: rev_image_eqI intro!: imageI)
      moreover from True have "tSup Y = TNil (flat_lub b (terminal ` Y))"
        by -(rule tllist.expand, simp_all add: terminal_tSup)
      moreover have "Complete_Partial_Order.chain (flat_ord b) (terminal ` Y)"
        using chain True by(auto intro: chain_imageI tllist_ord_terminalD)
      ultimately show ?thesis using Y
      by (simp add: contD [OF cont_bot] cong del: b.SUP_cong_simp)
    next
      case False
      hence eq: "tSup Y = TCons (thd (tSup Y)) (ttl (tSup Y))" by simp
      have eq':
        "?f ` Y =
         (\<lambda>x. bot (terminal x)) ` (Y \<inter> {xs. is_TNil xs}) \<union>
         (\<lambda>xs. f (thd xs) (ttl xs) xs) ` (Y \<inter> {xs. \<not> is_TNil xs})"
        by(auto 4 3 split: tllist.splits intro: rev_image_eqI)

      from False obtain xs where xs: "xs \<in> Y" "\<not> is_TNil xs" by auto
      { fix ys
        assume "ys \<in> Y" "is_TNil ys"
        hence "terminal ys = b" using xs
          by(cases xs ys rule: tllist.exhaust[case_product tllist.exhaust])(auto dest: chainD[OF chain]) }
      then have lub: "lub (?f ` Y) = lub ((\<lambda>xs. f (thd xs) (ttl xs) xs) ` (Y \<inter> {xs. \<not> is_TNil xs}))"
        using xs chain' unfolding eq'
        by -(erule ccpo.Sup_Un_less[OF ccpo], auto simp add: intro!: bot)
      { fix xs
        assume xs:  "xs \<in> Y \<inter> {xs. \<not> is_TNil xs}"
        hence "(THE x. x \<in> thd ` (Y \<inter> {xs. \<not> is_TNil xs})) = thd xs"
          by(auto dest: chainD[OF chain] simp add: not_is_TNil_conv intro!: the_equality)
        hence "f (THE x. x \<in> thd ` (Y \<inter> {xs. \<not> is_TNil xs})) (ttl xs) (TCons (THE x. x \<in> thd ` (Y \<inter> {xs. \<not> is_TNil xs})) (ttl xs)) = f (thd xs) (ttl xs) xs"
          using xs by simp }
      moreover have "Complete_Partial_Order.chain tllist_ord (ttl ` (Y \<inter> {xs. \<not> is_TNil xs}))"
        using chain by(rule chain_imageI[OF chain_subset])(auto simp add: tllist_ord_ttlI)
      moreover from False have "Y \<inter> {xs. \<not> is_TNil xs} \<noteq> {}" by auto
      ultimately show ?thesis
        apply(subst (1 2) eq)
        using False
        apply(simp add: thd_tSup ttl_tSup[OF chain] mcont_contD[OF mcont] image_image lub)
        done
    qed
  qed
  from mcont_mono[OF mcont] _ bot
  show "monotone tllist_ord ord ?f"
    by(rule mono_tllist_ord_case)(unfold_locales)
qed

lemma cont_TNil [simp, cont_intro]: "cont (flat_lub b) (flat_ord b) tSup tllist_ord TNil"
apply(rule contI)
apply transfer
apply(simp add: image_image image_constant_conv)
apply(rule arg_cong[where f="flat_lub b"])
apply(auto intro: rev_image_eqI)
done

lemma monotone_TCons: "monotone tllist_ord tllist_ord (TCons x)"
by(rule monotoneI) simp

lemmas mono2mono_TCons[cont_intro] = monotone_TCons[THEN tllist.mono2mono]

lemma mcont_TCons: "mcont tSup tllist_ord tSup tllist_ord (TCons x)"
apply(rule mcontI)
apply(rule monotone_TCons)
apply(rule contI)
apply(simp add: tSup_TCons)
done

lemmas mcont2mcont_TCons[cont_intro] = mcont_TCons[THEN tllist.mcont2mcont]

lemmas [transfer_rule del] = tllist_ord.transfer tSup.transfer

lifting_update tllist.lifting
lifting_forget tllist.lifting

lemmas [transfer_rule] = tllist_ord.transfer tSup.transfer

lemma mono2mono_tset[THEN lfp.mono2mono, cont_intro]:
  shows smonotone_tset: "monotone tllist_ord (\<subseteq>) tset"
including tllist.lifting
by transfer(rule monotone_comp[OF _ monotone_lset], auto intro: monotoneI)

lemma mcont2mcont_tset [THEN lfp.mcont2mcont, cont_intro]:
  shows mcont_tset: "mcont tSup tllist_ord Union (\<subseteq>) tset"
including tllist.lifting
apply transfer
apply(rule mcont_comp[OF _ mcont_lset])
unfolding mcont_def by(auto intro: monotoneI contI )

end

context includes lifting_syntax
begin

lemma rel_fun_lift:
  "(\<And>x. A (f x) (g x)) \<Longrightarrow> ((=) ===> A) f g"
by(simp add: rel_fun_def)

lemma tllist_ord_transfer [transfer_rule]:
  "((=) ===> pcr_tllist (=) (=) ===> pcr_tllist (=) (=) ===> (=))
     (\<lambda>b (xs1, b1) (xs2, b2). if lfinite xs1 then b1 = b \<and> lprefix xs1 xs2 \<or> xs1 = xs2 \<and> flat_ord b b1 b2 else xs1 = xs2)
     tllist_ord"
by(rule rel_fun_lift)(rule tllist_ord.transfer)

lemma tSup_transfer [transfer_rule]:
  "((=) ===> rel_set (pcr_tllist (=) (=)) ===> pcr_tllist (=) (=))
     (\<lambda>b A. (lSup (fst ` A), flat_lub b (snd ` (A \<inter> {(xs, _). lfinite xs}))))
     tSup"
by(rule rel_fun_lift)(rule tSup.transfer)

end

lifting_update tllist.lifting
lifting_forget tllist.lifting

interpretation tllist: partial_function_definitions "tllist_ord b" "tSup b" for b
by(rule tllist_ord_partial_function_definitions)

lemma tllist_case_mono [partial_function_mono, cont_intro]:
  assumes tnil: "\<And>b. monotone orda ordb (\<lambda>f. tnil f b)"
  and tcons: "\<And>x xs. monotone orda ordb (\<lambda>f. tcons f x xs)"
  shows "monotone orda ordb (\<lambda>f. case_tllist (tnil f) (tcons f) xs)"
by(rule monotoneI)(auto split: tllist.split dest: monotoneD[OF tnil] monotoneD[OF tcons])

subsection \<open>Definition of recursive functions\<close>

locale tllist_pf = fixes b :: 'b
begin

declaration \<open>Partial_Function.init "tllist" @{term "tllist.fixp_fun b"}
  @{term "tllist.mono_body b"} @{thm tllist.fixp_rule_uc[where b=b]} @{thm tllist.fixp_induct_uc[where b=b]} NONE\<close>

abbreviation mono_tllist where "mono_tllist \<equiv> monotone (fun_ord (tllist_ord b)) (tllist_ord b)"

lemma LCons_mono [partial_function_mono, cont_intro]:
  "mono_tllist A \<Longrightarrow> mono_tllist (\<lambda>f. TCons x (A f))"
by(rule monotoneI)(auto dest: monotoneD)

end

lemma mono_tllist_lappendt2 [partial_function_mono]:
  "tllist_pf.mono_tllist b A \<Longrightarrow> tllist_pf.mono_tllist b (\<lambda>f. lappendt xs (A f))"
apply(rule monotoneI)
apply(drule (1) monotoneD)
apply(simp add: tllist_ord.rep_eq split: if_split_asm)
apply(auto simp add: lappend_inf)
done

lemma mono_tllist_tappend2 [partial_function_mono]:
  assumes "\<And>y. tllist_pf.mono_tllist b (C y)"
  shows "tllist_pf.mono_tllist b (\<lambda>f. tappend xs (\<lambda>y. C y f))"
apply(cases "tfinite xs")
 apply(rule monotoneI)
 apply(drule monotoneD[OF assms[where y="terminal xs"]])
 including tllist.lifting
 apply transfer
 apply(fastforce split: if_split_asm)
apply(simp add: tappend_inf)
done

end


(*  Title:      HOL/MicroJava/DFA/Typing_Framework_err.thy
    Author:     Gerwin Klein
    Copyright   2000 TUM
*)

section {* Lifting the Typing Framework to err, app, and eff *}

theory Typing_Framework_err
imports Typing_Framework SemilatAlg
begin

definition wt_err_step :: "'s ord \<Rightarrow> 's err step_type \<Rightarrow> 's err list \<Rightarrow> bool" where
"wt_err_step r step ts \<equiv> wt_step (Err.le r) Err step ts"

definition wt_app_eff :: "'s ord \<Rightarrow> (nat \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> bool" where
"wt_app_eff r app step ts \<equiv>
  \<forall>p < size ts. app p (ts!p) \<and> (\<forall>(q,t) \<in> set (step p (ts!p)). t <=_r ts!q)"

definition map_snd :: "('b \<Rightarrow> 'c) \<Rightarrow> ('a \<times> 'b) list \<Rightarrow> ('a \<times> 'c) list" where
"map_snd f \<equiv> map (\<lambda>(x,y). (x, f y))"

definition error :: "nat \<Rightarrow> (nat \<times> 'a err) list" where
"error n \<equiv> map (\<lambda>x. (x,Err)) [0..<n]"

definition err_step :: "nat \<Rightarrow> (nat \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's step_type \<Rightarrow> 's err step_type" where
"err_step n app step p t \<equiv>
  case t of
    Err   \<Rightarrow> error n
  | OK t' \<Rightarrow> if app p t' then map_snd OK (step p t') else error n"

definition app_mono :: "'s ord \<Rightarrow> (nat \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> 's set \<Rightarrow> bool" where
"app_mono r app n A \<equiv>
 \<forall>s p t. s \<in> A \<and> p < n \<and> s <=_r t \<longrightarrow> app p t \<longrightarrow> app p s"

lemmas err_step_defs = err_step_def map_snd_def error_def

lemma bounded_err_stepD:
  "bounded (err_step n app step) n \<Longrightarrow>
  p < n \<Longrightarrow>  app p a \<Longrightarrow> (q,b) \<in> set (step p a) \<Longrightarrow>
  q < n"
  apply (simp add: bounded_def err_step_def)
  apply (erule allE, erule impE, assumption)
  apply (erule_tac x = "OK a" in allE, drule bspec)
   apply (simp add: map_snd_def)
   apply fast
  apply simp
  done

lemma in_map_sndD: "(a,b) \<in> set (map_snd f xs) \<Longrightarrow> \<exists>b'. (a,b') \<in> set xs"
  apply (induct xs)
  apply (auto simp add: map_snd_def)
  done

lemma bounded_err_stepI:
  "\<forall>p. p < n \<longrightarrow> (\<forall>s. ap p s \<longrightarrow> (\<forall>(q,s') \<in> set (step p s). q < n))
  \<Longrightarrow> bounded (err_step n ap step) n"
apply (clarsimp simp: bounded_def err_step_def split: err.splits)
apply (simp add: error_def image_def)
apply (blast dest: in_map_sndD)
done

lemma bounded_lift:
  "bounded step n \<Longrightarrow> bounded (err_step n app step) n"
  apply (unfold bounded_def err_step_def error_def)
  apply clarify
  apply (erule allE, erule impE, assumption)
  apply (case_tac s)
  apply (auto simp add: map_snd_def split: split_if_asm)
  done

lemma le_list_map_OK [simp]:
  "\<And>b. map OK a <=[Err.le r] map OK b = (a <=[r] b)"
  apply (induct a)
   apply simp
  apply simp
  apply (case_tac b)
   apply simp
  apply simp
  done

lemma map_snd_lessI:
  "x <=|r| y \<Longrightarrow> map_snd OK x <=|Err.le r| map_snd OK y"
  apply (induct x)
  apply (unfold lesubstep_type_def map_snd_def)
  apply auto
  done

lemma mono_lift:
  "order r \<Longrightarrow> app_mono r app n A \<Longrightarrow> bounded (err_step n app step) n \<Longrightarrow>
  \<forall>s p t. s \<in> A \<and> p < n \<and> s <=_r t \<longrightarrow> app p t \<longrightarrow> step p s <=|r| step p t \<Longrightarrow>
  mono (Err.le r) (err_step n app step) n (err A)"
apply (unfold app_mono_def mono_def err_step_def)
apply clarify
apply (case_tac s)
 apply simp
apply simp
apply (case_tac t)
 apply simp
 apply clarify
 apply (simp add: lesubstep_type_def error_def)
 apply clarify
 apply (drule in_map_sndD)
 apply clarify
 apply (drule bounded_err_stepD, assumption+)
 apply (rule exI [of _ Err])
 apply simp
apply simp
apply (erule allE, erule allE, erule allE, erule impE)
 apply (rule conjI, assumption)
 apply (rule conjI, assumption)
 apply assumption
apply (rule conjI)
apply clarify
apply (erule allE, erule allE, erule allE, erule impE)
 apply (rule conjI, assumption)
 apply (rule conjI, assumption)
 apply assumption
apply (erule impE, assumption)
apply (rule map_snd_lessI, assumption)
apply clarify
apply (simp add: lesubstep_type_def error_def)
apply clarify
apply (drule in_map_sndD)
apply clarify
apply (drule bounded_err_stepD, assumption+)
apply (rule exI [of _ Err])
apply simp
done

lemma in_errorD:
  "(x,y) \<in> set (error n) \<Longrightarrow> y = Err"
  by (auto simp add: error_def)

lemma pres_type_lift:
  "\<forall>s\<in>A. \<forall>p. p < n \<longrightarrow> app p s \<longrightarrow> (\<forall>(q, s')\<in>set (step p s). s' \<in> A)
  \<Longrightarrow> pres_type (err_step n app step) n (err A)"
apply (unfold pres_type_def err_step_def)
apply clarify
apply (case_tac b)
 apply simp
apply (case_tac s)
 apply simp
 apply (drule in_errorD)
 apply simp
apply (simp add: map_snd_def split: split_if_asm)
 apply fast
apply (drule in_errorD)
apply simp
done

text {*
  There used to be a condition here that each instruction must have a
  successor. This is not needed any more, because the definition of
  @{term error} trivially ensures that there is a successor for
  the critical case where @{term app} does not hold.
*}
lemma wt_err_imp_wt_app_eff:
  assumes wt: "wt_err_step r (err_step (size ts) app step) ts"
  assumes b:  "bounded (err_step (size ts) app step) (size ts)"
  shows "wt_app_eff r app step (map ok_val ts)"
proof (unfold wt_app_eff_def, intro strip, rule conjI)
  fix p assume "p < size (map ok_val ts)"
  hence lp: "p < size ts" by simp
  hence ts: "0 < size ts" by (cases p) auto
  hence err: "(0,Err) \<in> set (error (size ts))" by (simp add: error_def)

  from wt lp
  have [intro?]: "\<And>p. p < size ts \<Longrightarrow> ts ! p \<noteq> Err"
    by (unfold wt_err_step_def wt_step_def) simp

  show app: "app p (map ok_val ts ! p)"
  proof (rule ccontr)
    from wt lp obtain s where
      OKp:  "ts ! p = OK s" and
      less: "\<forall>(q,t) \<in> set (err_step (size ts) app step p (ts!p)). t <=_(Err.le r) ts!q"
      by (unfold wt_err_step_def wt_step_def stable_def)
         (auto iff: not_Err_eq)
    assume "\<not> app p (map ok_val ts ! p)"
    with OKp lp have "\<not> app p s" by simp
    with OKp have "err_step (size ts) app step p (ts!p) = error (size ts)"
      by (simp add: err_step_def)
    with err ts obtain q where
      "(q,Err) \<in> set (err_step (size ts) app step p (ts!p))" and
      q: "q < size ts" by auto
    with less have "ts!q = Err" by auto
    moreover from q have "ts!q \<noteq> Err" ..
    ultimately show False by blast
  qed

  show "\<forall>(q,t)\<in>set(step p (map ok_val ts ! p)). t <=_r map ok_val ts ! q"
  proof clarify
    fix q t assume q: "(q,t) \<in> set (step p (map ok_val ts ! p))"

    from wt lp q
    obtain s where
      OKp:  "ts ! p = OK s" and
      less: "\<forall>(q,t) \<in> set (err_step (size ts) app step p (ts!p)). t <=_(Err.le r) ts!q"
      by (unfold wt_err_step_def wt_step_def stable_def)
         (auto iff: not_Err_eq)

    from b lp app q have lq: "q < size ts" by (rule bounded_err_stepD)
    hence "ts!q \<noteq> Err" ..
    then obtain s' where OKq: "ts ! q = OK s'" by (auto iff: not_Err_eq)

    from lp lq OKp OKq app less q
    show "t <=_r map ok_val ts ! q"
      by (auto simp add: err_step_def map_snd_def)
  qed
qed

lemma wt_app_eff_imp_wt_err:
  assumes app_eff: "wt_app_eff r app step ts"
  assumes bounded: "bounded (err_step (size ts) app step) (size ts)"
  shows "wt_err_step r (err_step (size ts) app step) (map OK ts)"
proof (unfold wt_err_step_def wt_step_def, intro strip, rule conjI)
  fix p assume "p < size (map OK ts)"
  hence p: "p < size ts" by simp
  thus "map OK ts ! p \<noteq> Err" by simp
  { fix q t
    assume q: "(q,t) \<in> set (err_step (size ts) app step p (map OK ts ! p))"
    with p app_eff obtain
      "app p (ts ! p)" "\<forall>(q,t) \<in> set (step p (ts!p)). t <=_r ts!q"
      by (unfold wt_app_eff_def) blast
    moreover
    from q p bounded have "q < size ts"
      by - (rule boundedD)
    hence "map OK ts ! q = OK (ts!q)" by simp
    moreover
    have "p < size ts" by (rule p)
    moreover note q
    ultimately
    have "t <=_(Err.le r) map OK ts ! q"
      by (auto simp add: err_step_def map_snd_def)
  }
  thus "stable (Err.le r) (err_step (size ts) app step) (map OK ts) p"
    by (unfold stable_def) blast
qed

end